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:
parent
7a9b1d065e
commit
6c195d521c
|
@ -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]))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user