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

expander: more flexible top-level #%app expansion

Browse Source 
Adjust top-level compilation to accomodate an `#%app` macro that
expands to definitions. Allowing `#%app` to expand to a non-expression
is more consistent with expansion in a module.

There's still an issue with top-level expansion where

 (define-syntax-rule (#%app id)
   (begin
     (define-syntax (id stx) 'ok)
     id))

does not work, because the kind of partial expansion used for the top
level doesn't trigger `#%app`, and so the macro and use are expanded
together in a `begin` instead of separately. Changing that would be
subtle and maybe not worthwhile for the top level. Also, although the
behavior of the (very) old expander may not be relevant anymore, it
behaved the same way on that example.

Closes #3728
This commit is contained in:
Matthew Flatt 2021-04-12 16:26:34 -06:00
parent 4d6a23d1d5
commit 84b58d9bae
5 changed files with 369 additions and 315 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -2618,5 +2618,20 @@
(test 1 dynamic-require ''block-define-syntax-evaluation 'final-counter) (test 1 dynamic-require ''block-define-syntax-evaluation 'final-counter)
;; ----------------------------------------
;; Allow `#%app` at the top level to expand to a definition
(parameterize ([current-namespace (make-base-namespace)])
(eval '(define-syntax-rule (#%app id) (begin (define id 'id) id)))
(test 'v eval '(v))
(test 'v eval 'v))
(parameterize ([current-namespace (make-base-namespace)])
(eval '(require (for-syntax racket/base)))
(eval '(define-syntax-rule (#%app id) (begin (define-syntax (id stx) #''id) (begin))))
(eval '(v))
(test 'v eval 'v))
;; ----------------------------------------
(report-errs) (report-errs)

319
racket/src/bc/src/startup.inc
View File

@ -38315,7 +38315,7 @@ static const char *startup_source =
" phase-to-link-extra-inspectorss_0" " phase-to-link-extra-inspectorss_0"
" syntax-literals_0" " syntax-literals_0"
" no-root-context-pos_0)" " no-root-context-pos_0)"
"(let-values(((temp14_0)(list p_0))" "(let-values(((temp14_0)(flatten-begin p_0))"
"((cctx15_0) cctx_0)" "((cctx15_0) cctx_0)"
"((mpis16_0) mpis_0)" "((mpis16_0) mpis_0)"
"((temp17_0)" "((temp17_0)"
@ -38492,6 +38492,13 @@ static const char *startup_source =
"(list top-level-require!-id form-stx_0 ns-id)))" "(list top-level-require!-id form-stx_0 ns-id)))"
"(let-values() #f))))))" "(let-values() #f))))))"
"(define-values" "(define-values"
"(flatten-begin)"
"(lambda(p_0)"
"(begin"
"(if(parsed-begin? p_0)"
"(let-values()(apply append(map2 flatten-begin(parsed-begin-body p_0))))"
"(let-values()(list p_0))))))"
"(define-values"
"(select-defined-syms-and-bind!.1)" "(select-defined-syms-and-bind!.1)"
"(lambda(as-transformer?5_0" "(lambda(as-transformer?5_0"
" frame-id1_0" " frame-id1_0"
@ -74768,13 +74775,19 @@ static const char *startup_source =
"(values begin355_0)))))" "(values begin355_0)))))"
"(values #t begin354_0)))" "(values #t begin354_0)))"
"(values #f #f)))))" "(values #f #f)))))"
"(if ok?_0 s_0(nonempty-begin_0 s_0 ctx_0)))))" "(if ok?_0"
"(if(expand-context-to-parsed? ctx_0)"
"(parsed-begin12.1"
"(let-values(((ctx356_0) ctx_0)((s357_0) s_0))(keep-as-needed.1 #f #f #f ctx356_0 s357_0))"
" '())"
" s_0)"
"(nonempty-begin_0 s_0 ctx_0)))))"
"(let-values()(nonempty-begin_0 s_0 ctx_0))))))))" "(let-values()(nonempty-begin_0 s_0 ctx_0))))))))"
"(void" "(void"
"(add-core-form!*" "(add-core-form!*"
" 'begin0" " 'begin0"
"(let-values(((temp356_0) 'prim-begin0)((parsed-begin0357_0) parsed-begin013.1)((temp358_0) #f))" "(let-values(((temp358_0) 'prim-begin0)((parsed-begin0359_0) parsed-begin013.1)((temp360_0) #f))"
"(make-begin.1 temp358_0 temp356_0 parsed-begin0357_0))))" "(make-begin.1 temp360_0 temp358_0 parsed-begin0359_0))))"
"(define-values" "(define-values"
"(register-eventual-variable!?)" "(register-eventual-variable!?)"
"(lambda(id_0 ctx_0)" "(lambda(id_0 ctx_0)"
@ -74792,13 +74805,13 @@ static const char *startup_source =
"(void" "(void"
"(add-core-form!*" "(add-core-form!*"
" '#%top" " '#%top"
"(let-values(((...nder/expand/expr.rkt:600:1_0)" "(let-values(((...nder/expand/expr.rkt:602:1_0)"
"(lambda(s360_0 ctx361_0 implicit-omitted?359_0)" "(lambda(s362_0 ctx363_0 implicit-omitted?361_0)"
"(begin" "(begin"
" '...nder/expand/expr.rkt:600:1" " '...nder/expand/expr.rkt:602:1"
"(let-values(((s_0) s360_0))" "(let-values(((s_0) s362_0))"
"(let-values(((ctx_0) ctx361_0))" "(let-values(((ctx_0) ctx363_0))"
"(let-values(((implicit-omitted?_0) implicit-omitted?359_0))" "(let-values(((implicit-omitted?_0) implicit-omitted?361_0))"
"(let-values()" "(let-values()"
"(let-values(((disarmed-s_0)(syntax-disarm$1 s_0)))" "(let-values(((disarmed-s_0)(syntax-disarm$1 s_0)))"
"(let-values((()" "(let-values((()"
@ -74814,21 +74827,21 @@ static const char *startup_source =
"(if implicit-omitted?_0" "(if implicit-omitted?_0"
"(let-values() s_0)" "(let-values() s_0)"
"(let-values()" "(let-values()"
"(let-values(((ok?_0 #%top362_0 id363_0)" "(let-values(((ok?_0 #%top364_0 id365_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(let-values(((orig-s_0) s_1))" "(let-values(((orig-s_0) s_1))"
"(let-values(((#%top362_0 id363_0)" "(let-values(((#%top364_0 id365_0)"
"(let-values(((s_2)" "(let-values(((s_2)"
"(if(syntax?$1 s_1)" "(if(syntax?$1 s_1)"
"(syntax-e$1 s_1)" "(syntax-e$1 s_1)"
" s_1)))" " s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
"(let-values(((#%top364_0)" "(let-values(((#%top366_0)"
"(let-values(((s_3)" "(let-values(((s_3)"
"(car" "(car"
" s_2)))" " s_2)))"
" s_3))" " s_3))"
"((id365_0)" "((id367_0)"
"(let-values(((s_3)" "(let-values(((s_3)"
"(cdr" "(cdr"
" s_2)))" " s_2)))"
@ -74849,25 +74862,25 @@ static const char *startup_source =
" \"not an identifier\"" " \"not an identifier\""
" orig-s_0" " orig-s_0"
" s_3)))))" " s_3)))))"
"(values #%top364_0 id365_0))" "(values #%top366_0 id367_0))"
"(raise-syntax-error$1" "(raise-syntax-error$1"
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0)))))" " orig-s_0)))))"
"(values #t #%top362_0 id363_0))))))" "(values #t #%top364_0 id365_0))))))"
" id363_0)))))" " id365_0)))))"
"(let-values(((b_0)" "(let-values(((b_0)"
"(let-values(((id366_0) id_0)" "(let-values(((id368_0) id_0)"
"((temp367_0)(expand-context-phase ctx_0))" "((temp369_0)(expand-context-phase ctx_0))"
"((temp368_0) 'ambiguous))" "((temp370_0) 'ambiguous))"
"(resolve+shift.1" "(resolve+shift.1"
" temp368_0" " temp370_0"
" #f" " #f"
" null" " null"
" unsafe-undefined" " unsafe-undefined"
" #f" " #f"
" id366_0" " id368_0"
" temp367_0))))" " temp369_0))))"
"(if(eq? b_0 'ambiguous)" "(if(eq? b_0 'ambiguous)"
"(let-values()(raise-ambiguous-error id_0 ctx_0))" "(let-values()(raise-ambiguous-error id_0 ctx_0))"
"(if(if b_0" "(if(if b_0"
@ -74900,10 +74913,10 @@ static const char *startup_source =
" id_0" " id_0"
"(root-expand-context-top-level-bind-scope ctx_0))))" "(root-expand-context-top-level-bind-scope ctx_0))))"
"(let-values(((tl-b_0)" "(let-values(((tl-b_0)"
"(let-values(((tl-id369_0) tl-id_0)" "(let-values(((tl-id371_0) tl-id_0)"
"((temp370_0)" "((temp372_0)"
"(expand-context-phase ctx_0)))" "(expand-context-phase ctx_0)))"
"(resolve.1 #f #f null #f tl-id369_0 temp370_0))))" "(resolve.1 #f #f null #f tl-id371_0 temp372_0))))"
"(if tl-b_0" "(if tl-b_0"
"(let-values()" "(let-values()"
"(if(expand-context-to-parsed? ctx_0)" "(if(expand-context-to-parsed? ctx_0)"
@ -74911,10 +74924,10 @@ static const char *startup_source =
"(if implicit-omitted?_0" "(if implicit-omitted?_0"
"(let-values() id_0)" "(let-values() id_0)"
"(let-values()" "(let-values()"
"(let-values(((ok?_0 #%top371_0 id372_0)" "(let-values(((ok?_0 #%top373_0 id374_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(let-values(((orig-s_0) s_1))" "(let-values(((orig-s_0) s_1))"
"(let-values(((#%top371_0 id372_0)" "(let-values(((#%top373_0 id374_0)"
"(let-values(((s_2)" "(let-values(((s_2)"
"(if(syntax?$1" "(if(syntax?$1"
" s_1)" " s_1)"
@ -74922,12 +74935,12 @@ static const char *startup_source =
" s_1)" " s_1)"
" s_1)))" " s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
"(let-values(((#%top373_0)" "(let-values(((#%top375_0)"
"(let-values(((s_3)" "(let-values(((s_3)"
"(car" "(car"
" s_2)))" " s_2)))"
" s_3))" " s_3))"
"((id374_0)" "((id376_0)"
"(let-values(((s_3)" "(let-values(((s_3)"
"(cdr" "(cdr"
" s_2)))" " s_2)))"
@ -74949,23 +74962,23 @@ static const char *startup_source =
" orig-s_0" " orig-s_0"
" s_3)))))" " s_3)))))"
"(values" "(values"
" #%top373_0" " #%top375_0"
" id374_0))" " id376_0))"
"(raise-syntax-error$1" "(raise-syntax-error$1"
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0)))))" " orig-s_0)))))"
"(values #t #%top371_0 id372_0))))))" "(values #t #%top373_0 id374_0))))))"
"(let-values(((s375_0) s_0)" "(let-values(((s377_0) s_0)"
"((temp376_0)(cons #%top371_0 id_0)))" "((temp378_0)(cons #%top373_0 id_0)))"
"(rebuild.1 #t s375_0 temp376_0)))))))" "(rebuild.1 #t s377_0 temp378_0)))))))"
"(let-values()" "(let-values()"
"(if(expand-context-to-parsed? ctx_0)" "(if(expand-context-to-parsed? ctx_0)"
"(parsed-top-id4.1 id_0 b_0 #f)" "(parsed-top-id4.1 id_0 b_0 #f)"
" s_0)))))))))))))))))))))))" " s_0)))))))))))))))))))))))"
"(case-lambda" "(case-lambda"
"((s_0 ctx_0)(begin '...nder/expand/expr.rkt:600:1(...nder/expand/expr.rkt:600:1_0 s_0 ctx_0 #f)))" "((s_0 ctx_0)(begin '...nder/expand/expr.rkt:602:1(...nder/expand/expr.rkt:602:1_0 s_0 ctx_0 #f)))"
"((s_0 ctx_0 implicit-omitted?359_0)(...nder/expand/expr.rkt:600:1_0 s_0 ctx_0 implicit-omitted?359_0))))))" "((s_0 ctx_0 implicit-omitted?361_0)(...nder/expand/expr.rkt:602:1_0 s_0 ctx_0 implicit-omitted?361_0))))))"
"(void" "(void"
"(add-core-form!*" "(add-core-form!*"
" 'set!" " 'set!"
@ -74978,19 +74991,19 @@ static const char *startup_source =
"(let-values()(let-values()(call-expand-observe obs_0 'prim-set! disarmed-s_0)))" "(let-values()(let-values()(call-expand-observe obs_0 'prim-set! disarmed-s_0)))"
"(void)))" "(void)))"
"(values))))" "(values))))"
"(let-values(((ok?_0 set!377_0 id378_0 rhs379_0)" "(let-values(((ok?_0 set!379_0 id380_0 rhs381_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(let-values(((orig-s_0) s_1))" "(let-values(((orig-s_0) s_1))"
"(let-values(((set!377_0 id378_0 rhs379_0)" "(let-values(((set!379_0 id380_0 rhs381_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
"(let-values(((set!380_0)(let-values(((s_3)(car s_2))) s_3))" "(let-values(((set!382_0)(let-values(((s_3)(car s_2))) s_3))"
"((id381_0 rhs382_0)" "((id383_0 rhs384_0)"
"(let-values(((s_3)(cdr s_2)))" "(let-values(((s_3)(cdr s_2)))"
"(let-values(((s_4)" "(let-values(((s_4)"
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))" "(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
"(if(pair? s_4)" "(if(pair? s_4)"
"(let-values(((id383_0)" "(let-values(((id385_0)"
"(let-values(((s_5)(car s_4)))" "(let-values(((s_5)(car s_4)))"
"(if(let-values(((or-part_0)" "(if(let-values(((or-part_0)"
"(if(syntax?$1 s_5)" "(if(syntax?$1 s_5)"
@ -75006,14 +75019,14 @@ static const char *startup_source =
" \"not an identifier\"" " \"not an identifier\""
" orig-s_0" " orig-s_0"
" s_5))))" " s_5))))"
"((rhs384_0)" "((rhs386_0)"
"(let-values(((s_5)(cdr s_4)))" "(let-values(((s_5)(cdr s_4)))"
"(let-values(((s_6)" "(let-values(((s_6)"
"(if(syntax?$1 s_5)" "(if(syntax?$1 s_5)"
"(syntax-e$1 s_5)" "(syntax-e$1 s_5)"
" s_5)))" " s_5)))"
"(if(pair? s_6)" "(if(pair? s_6)"
"(let-values(((rhs385_0)" "(let-values(((rhs387_0)"
"(let-values(((s_7)" "(let-values(((s_7)"
"(car" "(car"
" s_6)))" " s_6)))"
@ -75034,27 +75047,27 @@ static const char *startup_source =
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0))))))" " orig-s_0))))))"
"(values rhs385_0))" "(values rhs387_0))"
"(raise-syntax-error$1" "(raise-syntax-error$1"
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0))))))" " orig-s_0))))))"
"(values id383_0 rhs384_0))" "(values id385_0 rhs386_0))"
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0))))))" " (raise-syntax-error$1 #f \"bad syntax\" orig-s_0))))))"
"(values set!380_0 id381_0 rhs382_0))" "(values set!382_0 id383_0 rhs384_0))"
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))" " (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))"
"(values #t set!377_0 id378_0 rhs379_0))))))" "(values #t set!379_0 id380_0 rhs381_0))))))"
"(let-values(((orig-id_0) id378_0))" "(let-values(((orig-id_0) id380_0))"
"((letrec-values(((rename-loop_0)" "((letrec-values(((rename-loop_0)"
"(lambda(id_0 from-rename?_0)" "(lambda(id_0 from-rename?_0)"
"(begin" "(begin"
" 'rename-loop" " 'rename-loop"
"(let-values(((binding_0)" "(let-values(((binding_0)"
"(let-values(((id386_0) id_0)" "(let-values(((id388_0) id_0)"
"((temp387_0)(expand-context-phase ctx_0))" "((temp389_0)(expand-context-phase ctx_0))"
"((temp388_0) 'ambiguous)" "((temp390_0) 'ambiguous)"
"((temp389_0) #t))" "((temp391_0) #t))"
"(resolve+shift.1 temp388_0 #f null temp389_0 #f id386_0 temp387_0))))" "(resolve+shift.1 temp390_0 #f null temp391_0 #f id388_0 temp389_0))))"
"(let-values((()" "(let-values((()"
"(begin" "(begin"
"(if(eq? binding_0 'ambiguous)" "(if(eq? binding_0 'ambiguous)"
@ -75063,10 +75076,10 @@ static const char *startup_source =
"(values))))" "(values))))"
"(let-values(((t_0 primitive?_0 insp_0 protected?_0)" "(let-values(((t_0 primitive?_0 insp_0 protected?_0)"
"(if binding_0" "(if binding_0"
"(let-values(((binding390_0) binding_0)" "(let-values(((binding392_0) binding_0)"
"((ctx391_0) ctx_0)" "((ctx393_0) ctx_0)"
"((s392_0) s_0))" "((s394_0) s_0))"
"(lookup.1 #f #f binding390_0 ctx391_0 s392_0))" "(lookup.1 #f #f binding392_0 ctx393_0 s394_0))"
"(values #f #f #f #f))))" "(values #f #f #f #f))))"
"(begin" "(begin"
"(let-values(((obs_0)(expand-context-observer ctx_0)))" "(let-values(((obs_0)(expand-context-observer ctx_0)))"
@ -75114,33 +75127,33 @@ static const char *startup_source =
" ctx_0)" " ctx_0)"
"(values))))" "(values))))"
"(let-values(((rebuild-s_0)" "(let-values(((rebuild-s_0)"
"(let-values(((ctx393_0) ctx_0)((s394_0) s_0))" "(let-values(((ctx395_0) ctx_0)((s396_0) s_0))"
"(keep-as-needed.1 #f #f #f ctx393_0 s394_0))))" "(keep-as-needed.1 #f #f #f ctx395_0 s396_0))))"
"(let-values(((exp-rhs_0)" "(let-values(((exp-rhs_0)"
"(let-values(((temp395_0) rhs379_0)" "(let-values(((temp397_0) rhs381_0)"
"((temp396_0)" "((temp398_0)"
"(as-expression-context ctx_0)))" "(as-expression-context ctx_0)))"
"(expand.1 #f #f temp395_0 temp396_0))))" "(expand.1 #f #f temp397_0 temp398_0))))"
"(if(expand-context-to-parsed? ctx_0)" "(if(expand-context-to-parsed? ctx_0)"
"(parsed-set!9.1" "(parsed-set!9.1"
" rebuild-s_0" " rebuild-s_0"
"(parsed-id2.1 id_0 binding_0 #f)" "(parsed-id2.1 id_0 binding_0 #f)"
" exp-rhs_0)" " exp-rhs_0)"
"(let-values(((rebuild-s397_0) rebuild-s_0)" "(let-values(((rebuild-s399_0) rebuild-s_0)"
"((temp398_0)" "((temp400_0)"
"(list" "(list"
" set!377_0" " set!379_0"
"(let-values(((id399_0) id_0)" "(let-values(((id401_0) id_0)"
"((t400_0) t_0)" "((t402_0) t_0)"
"((temp401_0)" "((temp403_0)"
"(free-id-set-empty-or-just-module*?" "(free-id-set-empty-or-just-module*?"
"(expand-context-stops ctx_0))))" "(expand-context-stops ctx_0))))"
"(substitute-variable.1" "(substitute-variable.1"
" temp401_0" " temp403_0"
" id399_0" " id401_0"
" t400_0))" " t402_0))"
" exp-rhs_0)))" " exp-rhs_0)))"
"(rebuild.1 #t rebuild-s397_0 temp398_0)))))))))" "(rebuild.1 #t rebuild-s399_0 temp400_0)))))))))"
"(if(not binding_0)" "(if(not binding_0)"
"(let-values()" "(let-values()"
"(raise-unbound-syntax-error" "(raise-unbound-syntax-error"
@ -75154,61 +75167,61 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(if(not-in-this-expand-context? t_0 ctx_0)" "(if(not-in-this-expand-context? t_0 ctx_0)"
"(let-values()" "(let-values()"
"(let-values(((temp402_0)" "(let-values(((temp404_0)"
"(avoid-current-expand-context" "(avoid-current-expand-context"
"(substitute-set!-rename" "(substitute-set!-rename"
" s_0" " s_0"
" disarmed-s_0" " disarmed-s_0"
" set!377_0" " set!379_0"
" rhs379_0" " rhs381_0"
" id_0" " id_0"
" from-rename?_0" " from-rename?_0"
" ctx_0)" " ctx_0)"
" t_0" " t_0"
" ctx_0))" " ctx_0))"
"((ctx403_0) ctx_0))" "((ctx405_0) ctx_0))"
"(expand.1 #f #f temp402_0 ctx403_0)))" "(expand.1 #f #f temp404_0 ctx405_0)))"
"(let-values()" "(let-values()"
"(let-values(((exp-s_0 re-ctx_0)" "(let-values(((exp-s_0 re-ctx_0)"
"(let-values(((t404_0) t_0)" "(let-values(((t406_0) t_0)"
"((insp405_0) insp_0)" "((insp407_0) insp_0)"
"((s406_0) s_0)" "((s408_0) s_0)"
"((orig-id407_0) orig-id_0)" "((orig-id409_0) orig-id_0)"
"((ctx408_0) ctx_0)" "((ctx410_0) ctx_0)"
"((binding409_0) binding_0)" "((binding411_0) binding_0)"
"((orig-id410_0) orig-id_0))" "((orig-id412_0) orig-id_0))"
"(apply-transformer.1" "(apply-transformer.1"
" orig-id410_0" " orig-id412_0"
" t404_0" " t406_0"
" insp405_0" " insp407_0"
" s406_0" " s408_0"
" orig-id407_0" " orig-id409_0"
" ctx408_0" " ctx410_0"
" binding409_0))))" " binding411_0))))"
"(if(expand-context-just-once? ctx_0)" "(if(expand-context-just-once? ctx_0)"
"(let-values() exp-s_0)" "(let-values() exp-s_0)"
"(let-values()" "(let-values()"
"(let-values(((exp-s411_0) exp-s_0)" "(let-values(((exp-s413_0) exp-s_0)"
"((re-ctx412_0) re-ctx_0))" "((re-ctx414_0) re-ctx_0))"
"(expand.1 #f #f exp-s411_0 re-ctx412_0))))))))" "(expand.1 #f #f exp-s413_0 re-ctx414_0))))))))"
"(if(1/rename-transformer? t_0)" "(if(1/rename-transformer? t_0)"
"(let-values()" "(let-values()"
"(if(not-in-this-expand-context? t_0 ctx_0)" "(if(not-in-this-expand-context? t_0 ctx_0)"
"(let-values()" "(let-values()"
"(let-values(((temp413_0)" "(let-values(((temp415_0)"
"(avoid-current-expand-context" "(avoid-current-expand-context"
"(substitute-set!-rename" "(substitute-set!-rename"
" s_0" " s_0"
" disarmed-s_0" " disarmed-s_0"
" set!377_0" " set!379_0"
" rhs379_0" " rhs381_0"
" id_0" " id_0"
" from-rename?_0" " from-rename?_0"
" ctx_0)" " ctx_0)"
" t_0" " t_0"
" ctx_0))" " ctx_0))"
"((ctx414_0) ctx_0))" "((ctx416_0) ctx_0))"
"(expand.1 #f #f temp413_0 ctx414_0)))" "(expand.1 #f #f temp415_0 ctx416_0)))"
"(let-values()" "(let-values()"
"(rename-loop_0(apply-rename-transformer t_0 id_0 ctx_0) #t))))" "(rename-loop_0(apply-rename-transformer t_0 id_0 ctx_0) #t))))"
"(let-values()" "(let-values()"
@ -75241,7 +75254,7 @@ static const char *startup_source =
"(let-values()(call-expand-observe obs_0 'prim-#%variable-reference disarmed-s_0)))" "(let-values()(call-expand-observe obs_0 'prim-#%variable-reference disarmed-s_0)))"
"(void)))" "(void)))"
"(values))))" "(values))))"
"(let-values(((ok?_0 #%variable-reference415_0 id416_0)" "(let-values(((ok?_0 #%variable-reference417_0 id418_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(if(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(if(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
@ -75261,15 +75274,15 @@ static const char *startup_source =
" #f)" " #f)"
" #f))" " #f))"
"(let-values()" "(let-values()"
"(let-values(((#%variable-reference415_0 id416_0)" "(let-values(((#%variable-reference417_0 id418_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(let-values(((#%variable-reference417_0)" "(let-values(((#%variable-reference419_0)"
"(let-values(((s_3)(car s_2))) s_3))" "(let-values(((s_3)(car s_2))) s_3))"
"((id418_0)" "((id420_0)"
"(let-values(((s_3)(cdr s_2)))" "(let-values(((s_3)(cdr s_2)))"
"(let-values(((s_4)" "(let-values(((s_4)"
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))" "(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
"(let-values(((id419_0)" "(let-values(((id421_0)"
"(let-values(((s_5)(car s_4))) s_5))" "(let-values(((s_5)(car s_4))) s_5))"
"(()" "(()"
"(let-values(((s_5)(cdr s_4)))" "(let-values(((s_5)(cdr s_4)))"
@ -75278,11 +75291,11 @@ static const char *startup_source =
"(syntax-e$1 s_5)" "(syntax-e$1 s_5)"
" s_5)))" " s_5)))"
"(values)))))" "(values)))))"
"(values id419_0))))))" "(values id421_0))))))"
"(values #%variable-reference417_0 id418_0)))))" "(values #%variable-reference419_0 id420_0)))))"
"(values #t #%variable-reference415_0 id416_0)))" "(values #t #%variable-reference417_0 id418_0)))"
"(values #f #f #f)))))" "(values #f #f #f)))))"
"(let-values(((ok?_1 #%variable-reference420_0 #%top421_0 id422_0)" "(let-values(((ok?_1 #%variable-reference422_0 #%top423_0 id424_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(if(if(not ok?_0)" "(if(if(not ok?_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
@ -75312,31 +75325,31 @@ static const char *startup_source =
" #f))" " #f))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(let-values(((#%variable-reference420_0 #%top421_0 id422_0)" "(let-values(((#%variable-reference422_0 #%top423_0 id424_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(let-values(((#%variable-reference423_0)" "(let-values(((#%variable-reference425_0)"
"(let-values(((s_3)(car s_2))) s_3))" "(let-values(((s_3)(car s_2))) s_3))"
"((#%top424_0 id425_0)" "((#%top426_0 id427_0)"
"(let-values(((s_3)(cdr s_2)))" "(let-values(((s_3)(cdr s_2)))"
"(let-values(((s_4)" "(let-values(((s_4)"
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))" "(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
"(let-values(((#%top426_0 id427_0)" "(let-values(((#%top428_0 id429_0)"
"(let-values(((s_5)(car s_4)))" "(let-values(((s_5)(car s_4)))"
"(let-values(((s_6)" "(let-values(((s_6)"
"(if(syntax?$1 s_5)" "(if(syntax?$1 s_5)"
"(syntax-e$1 s_5)" "(syntax-e$1 s_5)"
" s_5)))" " s_5)))"
"(let-values(((#%top428_0)" "(let-values(((#%top430_0)"
"(let-values(((s_7)" "(let-values(((s_7)"
"(car" "(car"
" s_6)))" " s_6)))"
" s_7))" " s_7))"
"((id429_0)" "((id431_0)"
"(let-values(((s_7)" "(let-values(((s_7)"
"(cdr" "(cdr"
" s_6)))" " s_6)))"
" s_7)))" " s_7)))"
"(values #%top428_0 id429_0)))))" "(values #%top430_0 id431_0)))))"
"(()" "(()"
"(let-values(((s_5)(cdr s_4)))" "(let-values(((s_5)(cdr s_4)))"
"(let-values(((s_6)" "(let-values(((s_6)"
@ -75344,18 +75357,18 @@ static const char *startup_source =
"(syntax-e$1 s_5)" "(syntax-e$1 s_5)"
" s_5)))" " s_5)))"
"(values)))))" "(values)))))"
"(values #%top426_0 id427_0))))))" "(values #%top428_0 id429_0))))))"
"(values #%variable-reference423_0 #%top424_0 id425_0)))))" "(values #%variable-reference425_0 #%top426_0 id427_0)))))"
"(values #t #%variable-reference420_0 #%top421_0 id422_0)))" "(values #t #%variable-reference422_0 #%top423_0 id424_0)))"
"(values #f #f #f #f)))))" "(values #f #f #f #f)))))"
"(let-values(((ok?_2 #%variable-reference430_0)" "(let-values(((ok?_2 #%variable-reference432_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(if(if(not(let-values(((or-part_0) ok?_0))(if or-part_0 or-part_0 ok?_1))) #t #f)" "(if(if(not(let-values(((or-part_0) ok?_0))(if or-part_0 or-part_0 ok?_1))) #t #f)"
"(let-values(((orig-s_0) s_1))" "(let-values(((orig-s_0) s_1))"
"(let-values(((#%variable-reference430_0)" "(let-values(((#%variable-reference432_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
"(let-values(((#%variable-reference431_0)" "(let-values(((#%variable-reference433_0)"
"(let-values(((s_3)(car s_2))) s_3))" "(let-values(((s_3)(car s_2))) s_3))"
"(()" "(()"
"(let-values(((s_3)(cdr s_2)))" "(let-values(((s_3)(cdr s_2)))"
@ -75369,18 +75382,18 @@ static const char *startup_source =
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0))))))" " orig-s_0))))))"
"(values #%variable-reference431_0))" "(values #%variable-reference433_0))"
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))" " (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))"
"(values #t #%variable-reference430_0)))" "(values #t #%variable-reference432_0)))"
"(values #f #f)))))" "(values #f #f)))))"
"(if(let-values(((or-part_0) ok?_0))(if or-part_0 or-part_0 ok?_1))" "(if(let-values(((or-part_0) ok?_0))(if or-part_0 or-part_0 ok?_1))"
"(let-values()" "(let-values()"
"(let-values(((var-id_0)(if ok?_0 id416_0 id422_0)))" "(let-values(((var-id_0)(if ok?_0 id418_0 id424_0)))"
"(let-values(((binding_0)" "(let-values(((binding_0)"
"(let-values(((var-id432_0) var-id_0)" "(let-values(((var-id434_0) var-id_0)"
"((temp433_0)(expand-context-phase ctx_0))" "((temp435_0)(expand-context-phase ctx_0))"
"((temp434_0) 'ambiguous))" "((temp436_0) 'ambiguous))"
"(resolve+shift.1 temp434_0 #f null unsafe-undefined #f var-id432_0 temp433_0))))" "(resolve+shift.1 temp436_0 #f null unsafe-undefined #f var-id434_0 temp435_0))))"
"(let-values((()" "(let-values((()"
"(begin" "(begin"
"(if(eq? binding_0 'ambiguous)" "(if(eq? binding_0 'ambiguous)"
@ -75403,12 +75416,12 @@ static const char *startup_source =
"(values))))" "(values))))"
"(let-values(((t_0 primitive?_0 insp-of-t_0 protected?_0)" "(let-values(((t_0 primitive?_0 insp-of-t_0 protected?_0)"
"(if binding_0" "(if binding_0"
"(let-values(((binding435_0) binding_0)" "(let-values(((binding437_0) binding_0)"
"((ctx436_0) ctx_0)" "((ctx438_0) ctx_0)"
"((var-id437_0) var-id_0)" "((var-id439_0) var-id_0)"
"((s438_0) s_0)" "((s440_0) s_0)"
"((temp439_0)(expand-context-in-local-expand? ctx_0)))" "((temp441_0)(expand-context-in-local-expand? ctx_0)))"
"(lookup.1 s438_0 temp439_0 binding435_0 ctx436_0 var-id437_0))" "(lookup.1 s440_0 temp441_0 binding437_0 ctx438_0 var-id439_0))"
"(values #f #f #f #f))))" "(values #f #f #f #f))))"
"(begin" "(begin"
"(if(if t_0(not(variable? t_0)) #f)" "(if(if t_0(not(variable? t_0)) #f)"
@ -75440,19 +75453,19 @@ static const char *startup_source =
"(let-values()(let-values()(call-expand-observe obs_0 'prim-#%expression disarmed-s_0)))" "(let-values()(let-values()(call-expand-observe obs_0 'prim-#%expression disarmed-s_0)))"
"(void)))" "(void)))"
"(values))))" "(values))))"
"(let-values(((ok?_0 #%expression440_0 e441_0)" "(let-values(((ok?_0 #%expression442_0 e443_0)"
"(let-values(((s_1) disarmed-s_0))" "(let-values(((s_1) disarmed-s_0))"
"(let-values(((orig-s_0) s_1))" "(let-values(((orig-s_0) s_1))"
"(let-values(((#%expression440_0 e441_0)" "(let-values(((#%expression442_0 e443_0)"
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))" "(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
"(if(pair? s_2)" "(if(pair? s_2)"
"(let-values(((#%expression442_0)(let-values(((s_3)(car s_2))) s_3))" "(let-values(((#%expression444_0)(let-values(((s_3)(car s_2))) s_3))"
"((e443_0)" "((e445_0)"
"(let-values(((s_3)(cdr s_2)))" "(let-values(((s_3)(cdr s_2)))"
"(let-values(((s_4)" "(let-values(((s_4)"
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))" "(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
"(if(pair? s_4)" "(if(pair? s_4)"
"(let-values(((e444_0)" "(let-values(((e446_0)"
"(let-values(((s_5)(car s_4))) s_5))" "(let-values(((s_5)(car s_4))) s_5))"
"(()" "(()"
"(let-values(((s_5)(cdr s_4)))" "(let-values(((s_5)(cdr s_4)))"
@ -75466,20 +75479,20 @@ static const char *startup_source =
" #f" " #f"
" \"bad syntax\"" " \"bad syntax\""
" orig-s_0))))))" " orig-s_0))))))"
"(values e444_0))" "(values e446_0))"
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0))))))" " (raise-syntax-error$1 #f \"bad syntax\" orig-s_0))))))"
"(values #%expression442_0 e443_0))" "(values #%expression444_0 e445_0))"
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))" " (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))"
"(values #t #%expression440_0 e441_0))))))" "(values #t #%expression442_0 e443_0))))))"
"(let-values(((rebuild-s_0)" "(let-values(((rebuild-s_0)"
"(let-values(((ctx445_0) ctx_0)((s446_0) s_0)((temp447_0) #t))" "(let-values(((ctx447_0) ctx_0)((s448_0) s_0)((temp449_0) #t))"
"(keep-as-needed.1 temp447_0 #f #f ctx445_0 s446_0))))" "(keep-as-needed.1 temp449_0 #f #f ctx447_0 s448_0))))"
"(let-values(((exp-e_0)" "(let-values(((exp-e_0)"
"(let-values(((temp448_0) e441_0)" "(let-values(((temp450_0) e443_0)"
"((temp449_0)" "((temp451_0)"
"(let-values(((temp450_0)(as-expression-context ctx_0))((ctx451_0) ctx_0))" "(let-values(((temp452_0)(as-expression-context ctx_0))((ctx453_0) ctx_0))"
"(as-tail-context.1 ctx451_0 temp450_0))))" "(as-tail-context.1 ctx453_0 temp452_0))))"
"(expand.1 #f #f temp448_0 temp449_0))))" "(expand.1 #f #f temp450_0 temp451_0))))"
"(if(expand-context-to-parsed? ctx_0)" "(if(expand-context-to-parsed? ctx_0)"
" exp-e_0" " exp-e_0"
"(if(let-values(((or-part_0)" "(if(let-values(((or-part_0)"
@ -75488,8 +75501,8 @@ static const char *startup_source =
" #f)))" " #f)))"
"(if or-part_0 or-part_0(eq? 'top-level(expand-context-context ctx_0))))" "(if or-part_0 or-part_0(eq? 'top-level(expand-context-context ctx_0))))"
"(let-values()" "(let-values()"
"(let-values(((rebuild-s452_0) rebuild-s_0)((temp453_0)(list #%expression440_0 exp-e_0)))" "(let-values(((rebuild-s454_0) rebuild-s_0)((temp455_0)(list #%expression442_0 exp-e_0)))"
"(rebuild.1 #t rebuild-s452_0 temp453_0)))" "(rebuild.1 #t rebuild-s454_0 temp455_0)))"
"(let-values()" "(let-values()"
"(let-values(((result-s_0)(syntax-track-origin$1 exp-e_0 rebuild-s_0)))" "(let-values(((result-s_0)(syntax-track-origin$1 exp-e_0 rebuild-s_0)))"
"(begin" "(begin"

325
racket/src/cs/schemified/expander.scm
View File

@ -43777,7 +43777,7 @@
(let ((purely-functional?_0 #t)) (let ((purely-functional?_0 #t))
(call-with-values (call-with-values
(lambda () (lambda ()
(let ((temp14_0 (list p7_0))) (let ((temp14_0 (flatten-begin p7_0)))
(let ((temp17_0 (let ((temp17_0
(if single-expression?2_0 (if single-expression?2_0
(list* '() (list syntax-literals-id) '(())) (list* '() (list syntax-literals-id) '(()))
@ -44011,6 +44011,11 @@
(compile-quote-syntax (syntax-disarm$1 (parsed-s p_0)) cctx_0))) (compile-quote-syntax (syntax-disarm$1 (parsed-s p_0)) cctx_0)))
(list top-level-require!-id form-stx_0 ns-id)) (list top-level-require!-id form-stx_0 ns-id))
#f)))) #f))))
(define flatten-begin
(lambda (p_0)
(if (parsed-begin? p_0)
(apply append (map_1346 flatten-begin (parsed-begin-body p_0)))
(list p_0))))
(define select-defined-syms-and-bind!.1 (define select-defined-syms-and-bind!.1
(|#%name| (|#%name|
select-defined-syms-and-bind! select-defined-syms-and-bind!
@ -83104,7 +83109,7 @@
(let ((temp350_0 (cons begin339_0 exp-es_0))) (let ((temp350_0 (cons begin339_0 exp-es_0)))
(rebuild.1 #t rebuild-s_0 temp350_0))))))) (rebuild.1 #t rebuild-s_0 temp350_0)))))))
(args (raise-binding-result-arity-error 3 args))))))))))) (args (raise-binding-result-arity-error 3 args)))))))))))
(define effect_2495 (define effect_1829
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
@ -83158,7 +83163,15 @@
(values #f #f))) (values #f #f)))
(case-lambda (case-lambda
((ok?_0 begin354_0) ((ok?_0 begin354_0)
(if ok?_0 s_0 (|#%app| nonempty-begin_0 s_0 ctx_0))) (if ok?_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-begin12.1
(keep-as-needed.1 #f #f #f ctx_0 s_0)
'())
s_0)
(|#%app| nonempty-begin_0 s_0 ctx_0)))
(args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))))
(|#%app| nonempty-begin_0 s_0 ctx_0))))))) (|#%app| nonempty-begin_0 s_0 ctx_0)))))))
(void))) (void)))
@ -83198,22 +83211,22 @@
null))))) null)))))
#t) #t)
#f))) #f)))
(define effect_2283 (define effect_2286
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
'|#%top| '|#%top|
(let ((...nder/expand/expr.rkt:600:1_0 (let ((...nder/expand/expr.rkt:602:1_0
(|#%name| (|#%name|
...nder/expand/expr.rkt:600:1 ...nder/expand/expr.rkt:602:1
(lambda (s360_0 ctx361_0 implicit-omitted?359_0) (lambda (s362_0 ctx363_0 implicit-omitted?361_0)
(begin (begin
(let ((disarmed-s_0 (syntax-disarm$1 s360_0))) (let ((disarmed-s_0 (syntax-disarm$1 s362_0)))
(begin (begin
(let ((obs_0 (let ((obs_0
(begin-unsafe (begin-unsafe
(expand-context/inner-observer (expand-context/inner-observer
(root-expand-context/outer-inner ctx361_0))))) (root-expand-context/outer-inner ctx363_0)))))
(if obs_0 (if obs_0
(call-expand-observe (call-expand-observe
obs_0 obs_0
@ -83221,8 +83234,8 @@
disarmed-s_0) disarmed-s_0)
(void))) (void)))
(let ((id_0 (let ((id_0
(if implicit-omitted?359_0 (if implicit-omitted?361_0
s360_0 s362_0
(call-with-values (call-with-values
(lambda () (lambda ()
(call-with-values (call-with-values
@ -83232,9 +83245,9 @@
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(if (pair? s_0) (if (pair? s_0)
(let ((|#%top364_0| (let ((|#%top366_0|
(let ((s_1 (car s_0))) s_1))) (let ((s_1 (car s_0))) s_1)))
(let ((id365_0 (let ((id367_0
(let ((s_1 (cdr s_0))) (let ((s_1 (cdr s_0)))
(if (let ((or-part_0 (if (let ((or-part_0
(if (syntax?$1 (if (syntax?$1
@ -83252,29 +83265,29 @@
"not an identifier" "not an identifier"
disarmed-s_0 disarmed-s_0
s_1))))) s_1)))))
(let ((|#%top364_1| |#%top364_0|)) (let ((|#%top366_1| |#%top366_0|))
(values |#%top364_1| id365_0)))) (values |#%top366_1| id367_0))))
(raise-syntax-error$1 (raise-syntax-error$1
#f #f
"bad syntax" "bad syntax"
disarmed-s_0)))) disarmed-s_0))))
(case-lambda (case-lambda
((|#%top362_0| id363_0) ((|#%top364_0| id365_0)
(values #t |#%top362_0| id363_0)) (values #t |#%top364_0| id365_0))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
2 2
args))))) args)))))
(case-lambda (case-lambda
((ok?_0 |#%top362_0| id363_0) id363_0) ((ok?_0 |#%top364_0| id365_0) id365_0)
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
3 3
args))))))) args)))))))
(let ((temp367_0 (let ((temp369_0
(begin-unsafe (begin-unsafe
(expand-context/inner-phase (expand-context/inner-phase
(root-expand-context/outer-inner ctx361_0))))) (root-expand-context/outer-inner ctx363_0)))))
(let ((b_0 (let ((b_0
(resolve+shift.1 (resolve+shift.1
'ambiguous 'ambiguous
@ -83283,9 +83296,9 @@
unsafe-undefined unsafe-undefined
#f #f
id_0 id_0
temp367_0))) temp369_0)))
(if (eq? b_0 'ambiguous) (if (eq? b_0 'ambiguous)
(raise-ambiguous-error id_0 ctx361_0) (raise-ambiguous-error id_0 ctx363_0)
(if (if b_0 (if (if b_0
(if (module-binding? b_0) (if (module-binding? b_0)
(eq? (eq?
@ -83293,13 +83306,13 @@
(begin-unsafe (begin-unsafe
(root-expand-context/inner-self-mpi (root-expand-context/inner-self-mpi
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0)))) ctx363_0))))
#f) #f)
#f) #f)
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0))) ctx363_0)))
(parsed-id2.1 id_0 b_0 #f) (parsed-id2.1 id_0 b_0 #f)
(if (let ((mpi_0 (if (let ((mpi_0
(module-binding-module b_0))) (module-binding-module b_0)))
@ -83307,41 +83320,41 @@
(eq? (eq?
top-level-module-path-index top-level-module-path-index
mpi_0))) mpi_0)))
s360_0 s362_0
id_0)) id_0))
(if (register-eventual-variable!? (if (register-eventual-variable!?
id_0 id_0
ctx361_0) ctx363_0)
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0))) ctx363_0)))
(parsed-id2.1 id_0 b_0 #f) (parsed-id2.1 id_0 b_0 #f)
id_0) id_0)
(if (not (if (not
(begin-unsafe (begin-unsafe
(expand-context/inner-allow-unbound? (expand-context/inner-allow-unbound?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0)))) ctx363_0))))
(raise-unbound-syntax-error (raise-unbound-syntax-error
#f #f
"unbound identifier" "unbound identifier"
id_0 id_0
#f #f
null null
(syntax-debug-info-string id_0 ctx361_0)) (syntax-debug-info-string id_0 ctx363_0))
(let ((tl-id_0 (let ((tl-id_0
(add-scope (add-scope
id_0 id_0
(begin-unsafe (begin-unsafe
(root-expand-context/inner-top-level-bind-scope (root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0)))))) ctx363_0))))))
(let ((temp370_0 (let ((temp372_0
(begin-unsafe (begin-unsafe
(expand-context/inner-phase (expand-context/inner-phase
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0))))) ctx363_0)))))
(let ((tl-b_0 (let ((tl-b_0
(resolve.1 (resolve.1
#f #f
@ -83349,17 +83362,17 @@
null null
#f #f
tl-id_0 tl-id_0
temp370_0))) temp372_0)))
(if tl-b_0 (if tl-b_0
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0))) ctx363_0)))
(parsed-top-id4.1 (parsed-top-id4.1
tl-id_0 tl-id_0
tl-b_0 tl-b_0
#f) #f)
(if implicit-omitted?359_0 (if implicit-omitted?361_0
id_0 id_0
(call-with-values (call-with-values
(lambda () (lambda ()
@ -83372,12 +83385,12 @@
disarmed-s_0) disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(if (pair? s_0) (if (pair? s_0)
(let ((|#%top373_0| (let ((|#%top375_0|
(let ((s_1 (let ((s_1
(car (car
s_0))) s_0)))
s_1))) s_1)))
(let ((id374_0 (let ((id376_0
(let ((s_1 (let ((s_1
(cdr (cdr
s_0))) s_0)))
@ -83398,35 +83411,35 @@
"not an identifier" "not an identifier"
disarmed-s_0 disarmed-s_0
s_1))))) s_1)))))
(let ((|#%top373_1| (let ((|#%top375_1|
|#%top373_0|)) |#%top375_0|))
(values (values
|#%top373_1| |#%top375_1|
id374_0)))) id376_0))))
(raise-syntax-error$1 (raise-syntax-error$1
#f #f
"bad syntax" "bad syntax"
disarmed-s_0)))) disarmed-s_0))))
(case-lambda (case-lambda
((|#%top371_0| id372_0) ((|#%top373_0| id374_0)
(values (values
#t #t
|#%top371_0| |#%top373_0|
id372_0)) id374_0))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
2 2
args))))) args)))))
(case-lambda (case-lambda
((ok?_0 |#%top371_0| id372_0) ((ok?_0 |#%top373_0| id374_0)
(let ((temp376_0 (let ((temp378_0
(cons (cons
|#%top371_0| |#%top373_0|
id_0))) id_0)))
(rebuild.1 (rebuild.1
#t #t
s360_0 s362_0
temp376_0))) temp378_0)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
3 3
@ -83434,20 +83447,20 @@
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx361_0))) ctx363_0)))
(parsed-top-id4.1 id_0 b_0 #f) (parsed-top-id4.1 id_0 b_0 #f)
s360_0))))))))))))))))))) s362_0)))))))))))))))))))
(|#%name| (|#%name|
...nder/expand/expr.rkt:600:1 ...nder/expand/expr.rkt:602:1
(case-lambda (case-lambda
((s_0 ctx_0) (begin (...nder/expand/expr.rkt:600:1_0 s_0 ctx_0 #f))) ((s_0 ctx_0) (begin (...nder/expand/expr.rkt:602:1_0 s_0 ctx_0 #f)))
((s_0 ctx_0 implicit-omitted?359_0) ((s_0 ctx_0 implicit-omitted?361_0)
(...nder/expand/expr.rkt:600:1_0 (...nder/expand/expr.rkt:602:1_0
s_0 s_0
ctx_0 ctx_0
implicit-omitted?359_0))))))) implicit-omitted?361_0)))))))
(void))) (void)))
(define effect_2325 (define effect_2261
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
@ -83471,14 +83484,14 @@
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(if (pair? s_1) (if (pair? s_1)
(let ((set!380_0 (let ((s_2 (car s_1))) s_2))) (let ((set!382_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values (call-with-values
(lambda () (lambda ()
(let ((s_2 (cdr s_1))) (let ((s_2 (cdr s_1)))
(let ((s_3 (let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2))) (if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3) (if (pair? s_3)
(let ((id383_0 (let ((id385_0
(let ((s_4 (car s_3))) (let ((s_4 (car s_3)))
(if (let ((or-part_0 (if (let ((or-part_0
(if (syntax?$1 s_4) (if (syntax?$1 s_4)
@ -83494,14 +83507,14 @@
"not an identifier" "not an identifier"
disarmed-s_0 disarmed-s_0
s_4))))) s_4)))))
(let ((rhs384_0 (let ((rhs386_0
(let ((s_4 (cdr s_3))) (let ((s_4 (cdr s_3)))
(let ((s_5 (let ((s_5
(if (syntax?$1 s_4) (if (syntax?$1 s_4)
(syntax-e$1 s_4) (syntax-e$1 s_4)
s_4))) s_4)))
(if (pair? s_5) (if (pair? s_5)
(let ((rhs385_0 (let ((rhs387_0
(let ((s_6 (car s_5))) (let ((s_6 (car s_5)))
s_6))) s_6)))
(call-with-values (call-with-values
@ -83521,8 +83534,8 @@
disarmed-s_0))))) disarmed-s_0)))))
(case-lambda (case-lambda
(() (()
(let ((rhs385_1 rhs385_0)) (let ((rhs387_1 rhs387_0))
(values rhs385_1))) (values rhs387_1)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
0 0
@ -83531,31 +83544,31 @@
#f #f
"bad syntax" "bad syntax"
disarmed-s_0)))))) disarmed-s_0))))))
(let ((id383_1 id383_0)) (let ((id385_1 id385_0))
(values id383_1 rhs384_0)))) (values id385_1 rhs386_0))))
(raise-syntax-error$1 (raise-syntax-error$1
#f #f
"bad syntax" "bad syntax"
disarmed-s_0))))) disarmed-s_0)))))
(case-lambda (case-lambda
((id381_0 rhs382_0) ((id383_0 rhs384_0)
(let ((set!380_1 set!380_0)) (let ((set!382_1 set!382_0))
(values set!380_1 id381_0 rhs382_0))) (values set!382_1 id383_0 rhs384_0)))
(args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) (raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda (case-lambda
((set!377_0 id378_0 rhs379_0) ((set!379_0 id380_0 rhs381_0)
(values #t set!377_0 id378_0 rhs379_0)) (values #t set!379_0 id380_0 rhs381_0))
(args (raise-binding-result-arity-error 3 args))))) (args (raise-binding-result-arity-error 3 args)))))
(case-lambda (case-lambda
((ok?_0 set!377_0 id378_0 rhs379_0) ((ok?_0 set!379_0 id380_0 rhs381_0)
(letrec* (letrec*
((rename-loop_0 ((rename-loop_0
(|#%name| (|#%name|
rename-loop rename-loop
(lambda (id_0 from-rename?_0) (lambda (id_0 from-rename?_0)
(begin (begin
(let ((temp387_0 (let ((temp389_0
(begin-unsafe (begin-unsafe
(expand-context/inner-phase (expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))) (root-expand-context/outer-inner ctx_0)))))
@ -83567,7 +83580,7 @@
#t #t
#f #f
id_0 id_0
temp387_0))) temp389_0)))
(begin (begin
(if (eq? binding_0 'ambiguous) (if (eq? binding_0 'ambiguous)
(raise-ambiguous-error id_0 ctx_0) (raise-ambiguous-error id_0 ctx_0)
@ -83640,14 +83653,14 @@
ctx_0 ctx_0
s_0))) s_0)))
(let ((exp-rhs_0 (let ((exp-rhs_0
(let ((temp396_0 (let ((temp398_0
(as-expression-context (as-expression-context
ctx_0))) ctx_0)))
(expand.1 (expand.1
#f #f
#f #f
rhs379_0 rhs381_0
temp396_0)))) temp398_0))))
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner (root-expand-context/outer-inner
@ -83659,24 +83672,24 @@
binding_0 binding_0
#f) #f)
exp-rhs_0) exp-rhs_0)
(let ((temp398_0 (let ((temp400_0
(list (list
set!377_0 set!379_0
(let ((temp401_0 (let ((temp403_0
(free-id-set-empty-or-just-module*? (free-id-set-empty-or-just-module*?
(begin-unsafe (begin-unsafe
(expand-context/inner-stops (expand-context/inner-stops
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx_0)))))) ctx_0))))))
(substitute-variable.1 (substitute-variable.1
temp401_0 temp403_0
id_0 id_0
t_0)) t_0))
exp-rhs_0))) exp-rhs_0)))
(rebuild.1 (rebuild.1
#t #t
rebuild-s_0 rebuild-s_0
temp398_0)))))))) temp400_0))))))))
(if (not binding_0) (if (not binding_0)
(raise-unbound-syntax-error (raise-unbound-syntax-error
#f #f
@ -83689,28 +83702,28 @@
(if (not-in-this-expand-context? (if (not-in-this-expand-context?
t_0 t_0
ctx_0) ctx_0)
(let ((temp402_0 (let ((temp404_0
(avoid-current-expand-context (avoid-current-expand-context
(|#%app| (|#%app|
substitute-set!-rename substitute-set!-rename
s_0 s_0
disarmed-s_0 disarmed-s_0
set!377_0 set!379_0
rhs379_0 rhs381_0
id_0 id_0
from-rename?_0 from-rename?_0
ctx_0) ctx_0)
t_0 t_0
ctx_0))) ctx_0)))
(expand.1 #f #f temp402_0 ctx_0)) (expand.1 #f #f temp404_0 ctx_0))
(call-with-values (call-with-values
(lambda () (lambda ()
(apply-transformer.1 (apply-transformer.1
id378_0 id380_0
t_0 t_0
insp_0 insp_0
s_0 s_0
id378_0 id380_0
ctx_0 ctx_0
binding_0)) binding_0))
(case-lambda (case-lambda
@ -83733,20 +83746,20 @@
(if (not-in-this-expand-context? (if (not-in-this-expand-context?
t_0 t_0
ctx_0) ctx_0)
(let ((temp413_0 (let ((temp415_0
(avoid-current-expand-context (avoid-current-expand-context
(|#%app| (|#%app|
substitute-set!-rename substitute-set!-rename
s_0 s_0
disarmed-s_0 disarmed-s_0
set!377_0 set!379_0
rhs379_0 rhs381_0
id_0 id_0
from-rename?_0 from-rename?_0
ctx_0) ctx_0)
t_0 t_0
ctx_0))) ctx_0)))
(expand.1 #f #f temp413_0 ctx_0)) (expand.1 #f #f temp415_0 ctx_0))
(rename-loop_0 (rename-loop_0
(apply-rename-transformer (apply-rename-transformer
t_0 t_0
@ -83762,7 +83775,7 @@
(raise-binding-result-arity-error (raise-binding-result-arity-error
4 4
args)))))))))))) args))))))))))))
(rename-loop_0 id378_0 #f))) (rename-loop_0 id380_0 #f)))
(args (raise-binding-result-arity-error 4 args))))))))) (args (raise-binding-result-arity-error 4 args)))))))))
(void))) (void)))
(define substitute-set!-rename (define substitute-set!-rename
@ -83776,7 +83789,7 @@
disarmed-s_0) disarmed-s_0)
s_0) s_0)
s_0))) s_0)))
(define effect_2375 (define effect_2456
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
@ -83828,15 +83841,15 @@
(if (syntax?$1 disarmed-s_0) (if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(let ((|#%variable-reference417_0| (let ((|#%variable-reference419_0|
(let ((s_2 (car s_1))) s_2))) (let ((s_2 (car s_1))) s_2)))
(let ((id418_0 (let ((id420_0
(let ((s_2 (cdr s_1))) (let ((s_2 (cdr s_1)))
(let ((s_3 (let ((s_3
(if (syntax?$1 s_2) (if (syntax?$1 s_2)
(syntax-e$1 s_2) (syntax-e$1 s_2)
s_2))) s_2)))
(let ((id419_0 (let ((s_4 (car s_3))) s_4))) (let ((id421_0 (let ((s_4 (car s_3))) s_4)))
(call-with-values (call-with-values
(lambda () (lambda ()
(let ((s_4 (cdr s_3))) (let ((s_4 (cdr s_3)))
@ -83847,22 +83860,22 @@
(values)))) (values))))
(case-lambda (case-lambda
(() (()
(let ((id419_1 id419_0)) (let ((id421_1 id421_0))
(values id419_1))) (values id421_1)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
0 0
args))))))))) args)))))))))
(let ((|#%variable-reference417_1| (let ((|#%variable-reference419_1|
|#%variable-reference417_0|)) |#%variable-reference419_0|))
(values |#%variable-reference417_1| id418_0)))))) (values |#%variable-reference419_1| id420_0))))))
(case-lambda (case-lambda
((|#%variable-reference415_0| id416_0) ((|#%variable-reference417_0| id418_0)
(values #t |#%variable-reference415_0| id416_0)) (values #t |#%variable-reference417_0| id418_0))
(args (raise-binding-result-arity-error 2 args)))) (args (raise-binding-result-arity-error 2 args))))
(values #f #f #f))) (values #f #f #f)))
(case-lambda (case-lambda
((ok?_0 |#%variable-reference415_0| id416_0) ((ok?_0 |#%variable-reference417_0| id418_0)
(call-with-values (call-with-values
(lambda () (lambda ()
(if (if (not ok?_0) (if (if (not ok?_0)
@ -83913,7 +83926,7 @@
(if (syntax?$1 disarmed-s_0) (if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(let ((|#%variable-reference423_0| (let ((|#%variable-reference425_0|
(let ((s_2 (car s_1))) s_2))) (let ((s_2 (car s_1))) s_2)))
(call-with-values (call-with-values
(lambda () (lambda ()
@ -83929,16 +83942,16 @@
(if (syntax?$1 s_4) (if (syntax?$1 s_4)
(syntax-e$1 s_4) (syntax-e$1 s_4)
s_4))) s_4)))
(let ((|#%top428_0| (let ((|#%top430_0|
(let ((s_6 (car s_5))) s_6))) (let ((s_6 (car s_5))) s_6)))
(let ((id429_0 (let ((id431_0
(let ((s_6 (cdr s_5))) s_6))) (let ((s_6 (cdr s_5))) s_6)))
(let ((|#%top428_1| |#%top428_0|)) (let ((|#%top430_1| |#%top430_0|))
(values (values
|#%top428_1| |#%top430_1|
id429_0))))))) id431_0)))))))
(case-lambda (case-lambda
((|#%top426_0| id427_0) ((|#%top428_0| id429_0)
(call-with-values (call-with-values
(lambda () (lambda ()
(let ((s_4 (cdr s_3))) (let ((s_4 (cdr s_3)))
@ -83949,9 +83962,9 @@
(values)))) (values))))
(case-lambda (case-lambda
(() (()
(let ((|#%top426_1| |#%top426_0|) (let ((|#%top428_1| |#%top428_0|)
(id427_1 id427_0)) (id429_1 id429_0))
(values |#%top426_1| id427_1))) (values |#%top428_1| id429_1)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
0 0
@ -83961,36 +83974,36 @@
2 2
args))))))) args)))))))
(case-lambda (case-lambda
((|#%top424_0| id425_0) ((|#%top426_0| id427_0)
(let ((|#%variable-reference423_1| (let ((|#%variable-reference425_1|
|#%variable-reference423_0|)) |#%variable-reference425_0|))
(values (values
|#%variable-reference423_1| |#%variable-reference425_1|
|#%top424_0| |#%top426_0|
id425_0))) id427_0)))
(args (args
(raise-binding-result-arity-error 2 args))))))) (raise-binding-result-arity-error 2 args)))))))
(case-lambda (case-lambda
((|#%variable-reference420_0| |#%top421_0| id422_0) ((|#%variable-reference422_0| |#%top423_0| id424_0)
(values (values
#t #t
|#%variable-reference420_0| |#%variable-reference422_0|
|#%top421_0| |#%top423_0|
id422_0)) id424_0))
(args (raise-binding-result-arity-error 3 args)))) (args (raise-binding-result-arity-error 3 args))))
(values #f #f #f #f))) (values #f #f #f #f)))
(case-lambda (case-lambda
((ok?_1 |#%variable-reference420_0| |#%top421_0| id422_0) ((ok?_1 |#%variable-reference422_0| |#%top423_0| id424_0)
(call-with-values (call-with-values
(lambda () (lambda ()
(if (if (not (if ok?_0 ok?_0 ok?_1)) #t #f) (if (if (not (if ok?_0 ok?_0 ok?_1)) #t #f)
(let ((|#%variable-reference430_0| (let ((|#%variable-reference432_0|
(let ((s_1 (let ((s_1
(if (syntax?$1 disarmed-s_0) (if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(if (pair? s_1) (if (pair? s_1)
(let ((|#%variable-reference431_0| (let ((|#%variable-reference433_0|
(let ((s_2 (car s_1))) s_2))) (let ((s_2 (car s_1))) s_2)))
(call-with-values (call-with-values
(lambda () (lambda ()
@ -84007,9 +84020,9 @@
disarmed-s_0))))) disarmed-s_0)))))
(case-lambda (case-lambda
(() (()
(let ((|#%variable-reference431_1| (let ((|#%variable-reference433_1|
|#%variable-reference431_0|)) |#%variable-reference433_0|))
(values |#%variable-reference431_1|))) (values |#%variable-reference433_1|)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
0 0
@ -84018,13 +84031,13 @@
#f #f
"bad syntax" "bad syntax"
disarmed-s_0))))) disarmed-s_0)))))
(values #t |#%variable-reference430_0|)) (values #t |#%variable-reference432_0|))
(values #f #f))) (values #f #f)))
(case-lambda (case-lambda
((ok?_2 |#%variable-reference430_0|) ((ok?_2 |#%variable-reference432_0|)
(if (if ok?_0 ok?_0 ok?_1) (if (if ok?_0 ok?_0 ok?_1)
(let ((var-id_0 (if ok?_0 id416_0 id422_0))) (let ((var-id_0 (if ok?_0 id418_0 id424_0)))
(let ((temp433_0 (let ((temp435_0
(begin-unsafe (begin-unsafe
(expand-context/inner-phase (expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))) (root-expand-context/outer-inner ctx_0)))))
@ -84036,7 +84049,7 @@
unsafe-undefined unsafe-undefined
#f #f
var-id_0 var-id_0
temp433_0))) temp435_0)))
(begin (begin
(if (eq? binding_0 'ambiguous) (if (eq? binding_0 'ambiguous)
(raise-ambiguous-error var-id_0 ctx_0) (raise-ambiguous-error var-id_0 ctx_0)
@ -84059,14 +84072,14 @@
(call-with-values (call-with-values
(lambda () (lambda ()
(if binding_0 (if binding_0
(let ((temp439_0 (let ((temp441_0
(begin-unsafe (begin-unsafe
(expand-context/inner-in-local-expand? (expand-context/inner-in-local-expand?
(root-expand-context/outer-inner (root-expand-context/outer-inner
ctx_0))))) ctx_0)))))
(lookup.1 (lookup.1
s_0 s_0
temp439_0 temp441_0
binding_0 binding_0
ctx_0 ctx_0
var-id_0)) var-id_0))
@ -84117,7 +84130,7 @@
(args (raise-binding-result-arity-error 4 args))))) (args (raise-binding-result-arity-error 4 args)))))
(args (raise-binding-result-arity-error 3 args))))))))) (args (raise-binding-result-arity-error 3 args)))))))))
(void))) (void)))
(define effect_1916 (define effect_2559
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
@ -84141,15 +84154,15 @@
(syntax-e$1 disarmed-s_0) (syntax-e$1 disarmed-s_0)
disarmed-s_0))) disarmed-s_0)))
(if (pair? s_1) (if (pair? s_1)
(let ((|#%expression442_0| (let ((s_2 (car s_1))) s_2))) (let ((|#%expression444_0| (let ((s_2 (car s_1))) s_2)))
(let ((e443_0 (let ((e445_0
(let ((s_2 (cdr s_1))) (let ((s_2 (cdr s_1)))
(let ((s_3 (let ((s_3
(if (syntax?$1 s_2) (if (syntax?$1 s_2)
(syntax-e$1 s_2) (syntax-e$1 s_2)
s_2))) s_2)))
(if (pair? s_3) (if (pair? s_3)
(let ((e444_0 (let ((e446_0
(let ((s_4 (car s_3))) s_4))) (let ((s_4 (car s_3))) s_4)))
(call-with-values (call-with-values
(lambda () (lambda ()
@ -84166,8 +84179,8 @@
disarmed-s_0))))) disarmed-s_0)))))
(case-lambda (case-lambda
(() (()
(let ((e444_1 e444_0)) (let ((e446_1 e446_0))
(values e444_1))) (values e446_1)))
(args (args
(raise-binding-result-arity-error (raise-binding-result-arity-error
0 0
@ -84176,21 +84189,21 @@
#f #f
"bad syntax" "bad syntax"
disarmed-s_0)))))) disarmed-s_0))))))
(let ((|#%expression442_1| |#%expression442_0|)) (let ((|#%expression444_1| |#%expression444_0|))
(values |#%expression442_1| e443_0)))) (values |#%expression444_1| e445_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0)))) (raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda (case-lambda
((|#%expression440_0| e441_0) ((|#%expression442_0| e443_0)
(values #t |#%expression440_0| e441_0)) (values #t |#%expression442_0| e443_0))
(args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))))
(case-lambda (case-lambda
((ok?_0 |#%expression440_0| e441_0) ((ok?_0 |#%expression442_0| e443_0)
(let ((rebuild-s_0 (keep-as-needed.1 #t #f #f ctx_0 s_0))) (let ((rebuild-s_0 (keep-as-needed.1 #t #f #f ctx_0 s_0)))
(let ((exp-e_0 (let ((exp-e_0
(let ((temp449_0 (let ((temp451_0
(let ((temp450_0 (as-expression-context ctx_0))) (let ((temp452_0 (as-expression-context ctx_0)))
(as-tail-context.1 ctx_0 temp450_0)))) (as-tail-context.1 ctx_0 temp452_0))))
(expand.1 #f #f e441_0 temp449_0)))) (expand.1 #f #f e443_0 temp451_0))))
(if (begin-unsafe (if (begin-unsafe
(expand-context/inner-to-parsed? (expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0))) (root-expand-context/outer-inner ctx_0)))
@ -84209,8 +84222,8 @@
'top-level 'top-level
(begin-unsafe (begin-unsafe
(expand-context/outer-context ctx_0))))) (expand-context/outer-context ctx_0)))))
(let ((temp453_0 (list |#%expression440_0| exp-e_0))) (let ((temp455_0 (list |#%expression442_0| exp-e_0)))
(rebuild.1 #t rebuild-s_0 temp453_0)) (rebuild.1 #t rebuild-s_0 temp455_0))
(let ((result-s_0 (let ((result-s_0
(syntax-track-origin$1 exp-e_0 rebuild-s_0))) (syntax-track-origin$1 exp-e_0 rebuild-s_0)))
(begin (begin
@ -93348,7 +93361,7 @@
(values (values
tl-ids_0 tl-ids_0
(select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0)))))))) (select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0))))))))
(define effect_2376 (define effect_2375
(begin (begin
(void (void
(add-core-form!* (add-core-form!*
@ -94339,7 +94352,7 @@
(declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp42_0)) (declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp42_0))
(1/current-namespace ns_0) (1/current-namespace ns_0)
(1/dynamic-require ''|#%kernel| 0)))))) (1/dynamic-require ''|#%kernel| 0))))))
(define effect_2377 (define effect_2376
(begin (begin
(|#%call-with-values| (lambda () (namespace-init!)) print-values) (|#%call-with-values| (lambda () (namespace-init!)) print-values)
(void))) (void)))

21
racket/src/expander/compile/top.rkt
View File

@ -34,10 +34,9 @@
#:single-expression? #t)) #:single-expression? #t))
;; Compile a single form, which can be a `define-values` form, a ;; Compile a single form, which can be a `define-values` form, a
;; `define-syntaxes` form, or an expression (where `begin` is treated ;; `define-syntaxes` form, a `begin` form, or an expression. If
;; as an expression form). If `serializable?` is false, don't bother ;; `serializable?` is false, don't bother generating the linklet for
;; generating the linklet for serialized data, because it won't be ;; serialized data, because it won't be used.
;; used.
(define (compile-top p cctx (define (compile-top p cctx
#:serializable? [serializable? #t] #:serializable? [serializable? #t]
#:single-expression? [single-expression? #f] #:single-expression? [single-expression? #f]
@ -59,7 +58,7 @@
phase-to-link-extra-inspectorss phase-to-link-extra-inspectorss
syntax-literals syntax-literals
no-root-context-pos) no-root-context-pos)
(compile-forms (list p) cctx mpis (compile-forms (flatten-begin p) cctx mpis
#:body-imports (if single-expression? #:body-imports (if single-expression?
`([] `([]
[,syntax-literals-id] [,syntax-literals-id]
@ -166,3 +165,15 @@
(define form-stx (compile-quote-syntax (syntax-disarm (parsed-s p)) cctx)) (define form-stx (compile-quote-syntax (syntax-disarm (parsed-s p)) cctx))
`(,top-level-require!-id ,form-stx ,ns-id)] `(,top-level-require!-id ,form-stx ,ns-id)]
[else #f])) [else #f]))
;; Normally, `begin` flattening is the job of a previous layer, so
;; that each definition in a `begin` can affect the expansion and
;; compilation of later forms in the `begin`. It's possible, however,
;; for a form to claim to be an expression and yet expand to a `begin`
;; that contains definitions. To be flexible (and, to a lesser degree,
;; for historical reasons), allow that kind of `begin`.
(define (flatten-begin p)
(cond
[(parsed-begin? p)
(apply append (map flatten-begin (parsed-begin-body p)))]
[else (list p)]))

4
racket/src/expander/expand/expr.rkt
View File

@ -573,7 +573,9 @@
(define disarmed-s (syntax-disarm s)) (define disarmed-s (syntax-disarm s))
(define-match m disarmed-s #:try '(begin)) (define-match m disarmed-s #:try '(begin))
(if (m) (if (m)
s (if (expand-context-to-parsed? ctx)
(parsed-begin (keep-as-needed ctx s) '())
s)
(nonempty-begin s ctx))] (nonempty-begin s ctx))]
[else [else
(nonempty-begin s ctx)])))) (nonempty-begin s ctx)]))))