Added define-values

This commit is contained in:
Justin Ethier 2020-01-02 13:41:04 -05:00
parent 31036f3b1f
commit 40894ecb3e
2 changed files with 45 additions and 7 deletions

View file

@ -1,5 +1,11 @@
# Changelog
## 0.11.9 - TBD
Features
- Added `define-values` from R7RS.
## 0.11.8 - December 30, 2019
Features

View file

@ -162,6 +162,7 @@
letrec
let*-values
let-values
define-values
begin
case
cond
@ -203,13 +204,6 @@
; rationalize
;
; ;; syntax-rules
; define-values
;
; unclassified TODO's:
; import
; include
; let-syntax
; letrec-syntax
;;;;
)
(inline
@ -2025,4 +2019,42 @@
(,(rename 'vector)
,@make-fields))))
)))))
(define-syntax define-values
(syntax-rules ()
((define-values () expr)
(define dummy
(call-with-values (lambda () expr)
(lambda args #f))))
((define-values (var) expr)
(define var expr))
((define-values (var0 var1 ... varn) expr)
(begin
(define var0
(call-with-values (lambda () expr) list))
(define var1
(let ((v (cadr var0)))
(set-cdr! var0 (cddr var0))
v))
...
(define varn
(let ((v (cadr var0)))
(set! var0 (car var0))
v))))
;((define-values (var0 var1 ... . var-dot) expr)
; (begin
; (define var0
; (call-with-values (lambda () expr) list))
; (define var1
; (let ((v (cadr var0)))
; (set-cdr! var0 (cddr var0))
; v))
; ...
; (define var-dot
; (let ((v (cdr var0)))
; (set! var0 (car var0))
; v))))
((define-values var expr)
(define var
(call-with-values (lambda () expr) list)))))
))