suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: fix compilation of begin0 with only one expression

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

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

5
racket/src/cs/rumble/begin0.ss
View File

@ -1,7 +1,10 @@
;; See copy in "expander.sls" ;; See copy in "expander.sls"
(define-syntax begin0 (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 ...) [(_ expr0 expr ...)
(call-with-values (lambda () (call-with-values (lambda ()
(call-with-values (lambda () expr0) (call-with-values (lambda () expr0)

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "7.2.0.11" #define MZSCHEME_VERSION "7.2.0.12"
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0 #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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

6
racket/src/schemify/interpret.rkt
View File

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