mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-17 01:37:34 +02:00
Added call-with-values back
This commit is contained in:
parent
a1898f20ab
commit
e7c050ef2c
5 changed files with 18 additions and 17 deletions
|
@ -131,8 +131,8 @@
|
||||||
input-program)))
|
input-program)))
|
||||||
(cond
|
(cond
|
||||||
((and library? (equal? lib-name '(scheme base)))
|
((and library? (equal? lib-name '(scheme base)))
|
||||||
(set! globals (cons 'call/cc globals))
|
(set! globals (append '(call-with-values call/cc) globals))
|
||||||
(set! module-globals (cons 'call/cc module-globals))
|
(set! module-globals (append '(call-with-values call/cc) module-globals))
|
||||||
(set! input-program
|
(set! input-program
|
||||||
(cons
|
(cons
|
||||||
;; Experimental version of call-with-values,
|
;; Experimental version of call-with-values,
|
||||||
|
|
1
eval.scm
1
eval.scm
|
@ -188,6 +188,7 @@
|
||||||
(define primitive-procedures
|
(define primitive-procedures
|
||||||
(list
|
(list
|
||||||
(list 'call/cc call/cc)
|
(list 'call/cc call/cc)
|
||||||
|
(list 'call-with-values call-with-values)
|
||||||
(list 'Cyc-global-vars Cyc-global-vars)
|
(list 'Cyc-global-vars Cyc-global-vars)
|
||||||
(list 'Cyc-get-cvar Cyc-get-cvar)
|
(list 'Cyc-get-cvar Cyc-get-cvar)
|
||||||
(list 'Cyc-set-cvar! Cyc-set-cvar!)
|
(list 'Cyc-set-cvar! Cyc-set-cvar!)
|
||||||
|
|
|
@ -6,9 +6,9 @@
|
||||||
;delete-duplicates
|
;delete-duplicates
|
||||||
call-with-current-continuation
|
call-with-current-continuation
|
||||||
call/cc
|
call/cc
|
||||||
;call-with-values
|
call-with-values
|
||||||
;dynamic-wind
|
dynamic-wind
|
||||||
;values
|
values
|
||||||
;(Cyc-bin-op cmp x lst)
|
;(Cyc-bin-op cmp x lst)
|
||||||
;(Cyc-bin-op-char cmp c cs)
|
;(Cyc-bin-op-char cmp c cs)
|
||||||
char=?
|
char=?
|
||||||
|
@ -74,14 +74,14 @@
|
||||||
(lambda (cont) (apply cont things))))
|
(lambda (cont) (apply cont things))))
|
||||||
;; TODO: just need something good enough for bootstrapping (for now)
|
;; TODO: just need something good enough for bootstrapping (for now)
|
||||||
;; does not have to be perfect (this is not, does not handle call/cc or exceptions)
|
;; does not have to be perfect (this is not, does not handle call/cc or exceptions)
|
||||||
;(define (dynamic-wind before thunk after)
|
(define (dynamic-wind before thunk after)
|
||||||
; (before)
|
(before)
|
||||||
; (call-with-values
|
(call-with-values
|
||||||
; thunk
|
thunk
|
||||||
; (lambda (result) ;results
|
(lambda (result) ;results
|
||||||
; (after)
|
(after)
|
||||||
; result)))
|
result)))
|
||||||
; ;(apply values results))))
|
;(apply values results))))
|
||||||
(define (Cyc-bin-op cmp x lst)
|
(define (Cyc-bin-op cmp x lst)
|
||||||
(cond
|
(cond
|
||||||
((null? lst) #t)
|
((null? lst) #t)
|
||||||
|
|
6
test.scm
6
test.scm
|
@ -20,7 +20,7 @@
|
||||||
(define b (vector 10 20 30 40 50))
|
(define b (vector 10 20 30 40 50))
|
||||||
(vector-copy! b 1 a 0 2)
|
(vector-copy! b 1 a 0 2)
|
||||||
(write (equal? b #(10 1 2 40 50)))
|
(write (equal? b #(10 1 2 40 50)))
|
||||||
;(call-with-values
|
(call-with-values
|
||||||
; (lambda () (values 1 1))
|
(lambda () (values 1 1))
|
||||||
; (lambda (a) (write a)))
|
(lambda (a) (write a)))
|
||||||
|
|
||||||
|
|
|
@ -126,7 +126,7 @@
|
||||||
|
|
||||||
|
|
||||||
(define (built-in-syms)
|
(define (built-in-syms)
|
||||||
'(call/cc define))
|
'(call-with-values call/cc define))
|
||||||
|
|
||||||
;; Tuning
|
;; Tuning
|
||||||
(define *do-code-gen* #t) ; Generate C code?
|
(define *do-code-gen* #t) ; Generate C code?
|
||||||
|
|
Loading…
Add table
Reference in a new issue