grudingly supporting MV continuations

This commit is contained in:
Alex Shinn 2011-05-25 23:29:30 +09:00
parent 8b6c8afd3f
commit ad30b48a9f

View file

@ -569,11 +569,13 @@
(define *values-tag* (list 'values))
(define (values . ls)
(define (%values ls)
(if (and (pair? ls) (null? (cdr ls)))
(car ls)
(cons *values-tag* ls)))
(define (values . ls) (%values ls))
(define (call-with-values producer consumer)
(let ((res (producer)))
(if (and (pair? res) (eq? *values-tag* (car res)))
@ -604,7 +606,7 @@
(define (call-with-current-continuation proc)
(let ((dk *dk*))
(%call/cc (lambda (k) (proc (lambda (x) (set-dk! dk) (k x)))))))
(%call/cc (lambda (k) (proc (lambda x (set-dk! dk) (k (%values x))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syntax-rules