Merge pull request #191 from mflatt/dv0

fix `(define-values () ....)` to expand to a definition
original commit: ce11b3485fc146704fc466377bf6e6f9357cdc9d
This commit is contained in:
R. Kent Dybvig 2017-07-16 23:31:40 -04:00 committed by GitHub
commit 5fc720d9dd
3 changed files with 21 additions and 8 deletions

2
LOG
View File

@ -541,3 +541,5 @@
misc.ms misc.ms
- minor wordsmithing and fix for an overfull hbox - minor wordsmithing and fix for an overfull hbox
objects.stex, system.stex objects.stex, system.stex
- fix (define-values () ....) to expand to a definition
syntax.ss, 3.ms

View File

@ -1087,6 +1087,16 @@
(define-values (args . rot) (values #'(x ...) #'(x ...) 3)) (define-values (args . rot) (values #'(x ...) #'(x ...) 3))
(list args rot))]) (list args rot))])
'((a b c) ((a b c) 3))) '((a b c) ((a b c) 3)))
(equal?
(let ()
(define x 1)
(define-values ()
(begin
"don't interrupt definitions"
(values)))
(define y 2)
(list x y))
'(1 2))
) )
(mat assimilation (mat assimilation

View File

@ -7848,14 +7848,15 @@
(syntax-case x () (syntax-case x ()
[(_ () expr) [(_ () expr)
(if (= (optimize-level) 3) (if (= (optimize-level) 3)
#'(begin expr (void)) #'(define unused (begin expr (void)))
#`(call-with-values #`(define unused
(lambda () expr) (call-with-values
(case-lambda (lambda () expr)
[() (void)] (case-lambda
[args #,($make-source-oops #'define-values [() (void)]
"incorrect number of values from rhs" [args #,($make-source-oops #'define-values
#'expr)])))] "incorrect number of values from rhs"
#'expr)]))))]
[(_ (x) expr) [(_ (x) expr)
(identifier? #'x) (identifier? #'x)
(if (= (optimize-level) 3) (if (= (optimize-level) 3)