cs: fix compilation of begin0 with only one expression

The problem was especially bad in the fallback interpreter,
where an ill-formed `begin` was created as a nested expression.
This commit is contained in:
Matthew Flatt 2019-03-29 08:52:48 -06:00
parent 7a9b1d065e
commit 6c195d521c
4 changed files with 12 additions and 5 deletions

View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.2.0.11")
(define version "7.2.0.12")
(define deps `("racket-lib"
["racket" #:version ,version]))

View File

@ -1,7 +1,10 @@
;; See copy in "expander.sls"
(define-syntax begin0
(syntax-rules ()
(syntax-rules (void)
[(_ expr0) expr0]
[(_ expr0 (void)) ; detect this pattern as a way of accessing the `$value` form
($value expr0)]
[(_ expr0 expr ...)
(call-with-values (lambda ()
(call-with-values (lambda () expr0)

View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.2.0.11"
#define MZSCHEME_VERSION "7.2.0.12"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_W 12
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

View File

@ -224,13 +224,15 @@
[`(letrec* . ,_) (compile-letrec e env stack-depth stk-i tail?)]
[`(begin . ,vs)
(compile-body vs env stack-depth stk-i tail?)]
[`(begin0 ,e)
(compile-expr e env stack-depth stk-i tail?)]
[`(begin0 ,e . ,vs)
(define new-body (compile-body vs env stack-depth stk-i #f))
(vector 'begin0
(compile-expr e env stack-depth stk-i #f)
new-body)]
[`($value ,e)
(compile-expr e env stack-depth stk-i tail?)]
(vector '$value (compile-expr e env stack-depth stk-i #f))]
[`(if ,tst ,thn ,els)
(define then-stk-i (stack-info-branch stk-i))
(define else-stk-i (stack-info-branch stk-i))
@ -610,6 +612,8 @@
(apply values vals)
(apply values new-stack vals))
(loop (fx+ i 1) new-stack)))))]
[#($value ,e)
(begin0 (interpret e stack) (void))]
[#(clear ,clears ,e)
(let loop ([clears clears] [stack stack])
(cond