expander: more flexible top-level #%app
expansion
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:
parent
4d6a23d1d5
commit
84b58d9bae
|
@ -2618,5 +2618,20 @@
|
|||
|
||||
(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)
|
||||
|
|
|
@ -38315,7 +38315,7 @@ static const char *startup_source =
|
|||
" phase-to-link-extra-inspectorss_0"
|
||||
" syntax-literals_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)"
|
||||
"((mpis16_0) mpis_0)"
|
||||
"((temp17_0)"
|
||||
|
@ -38492,6 +38492,13 @@ static const char *startup_source =
|
|||
"(list top-level-require!-id form-stx_0 ns-id)))"
|
||||
"(let-values() #f))))))"
|
||||
"(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)"
|
||||
"(lambda(as-transformer?5_0"
|
||||
" frame-id1_0"
|
||||
|
@ -74768,13 +74775,19 @@ static const char *startup_source =
|
|||
"(values begin355_0)))))"
|
||||
"(values #t begin354_0)))"
|
||||
"(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))))))))"
|
||||
"(void"
|
||||
"(add-core-form!*"
|
||||
" 'begin0"
|
||||
"(let-values(((temp356_0) 'prim-begin0)((parsed-begin0357_0) parsed-begin013.1)((temp358_0) #f))"
|
||||
"(make-begin.1 temp358_0 temp356_0 parsed-begin0357_0))))"
|
||||
"(let-values(((temp358_0) 'prim-begin0)((parsed-begin0359_0) parsed-begin013.1)((temp360_0) #f))"
|
||||
"(make-begin.1 temp360_0 temp358_0 parsed-begin0359_0))))"
|
||||
"(define-values"
|
||||
"(register-eventual-variable!?)"
|
||||
"(lambda(id_0 ctx_0)"
|
||||
|
@ -74792,13 +74805,13 @@ static const char *startup_source =
|
|||
"(void"
|
||||
"(add-core-form!*"
|
||||
" '#%top"
|
||||
"(let-values(((...nder/expand/expr.rkt:600:1_0)"
|
||||
"(lambda(s360_0 ctx361_0 implicit-omitted?359_0)"
|
||||
"(let-values(((...nder/expand/expr.rkt:602:1_0)"
|
||||
"(lambda(s362_0 ctx363_0 implicit-omitted?361_0)"
|
||||
"(begin"
|
||||
" '...nder/expand/expr.rkt:600:1"
|
||||
"(let-values(((s_0) s360_0))"
|
||||
"(let-values(((ctx_0) ctx361_0))"
|
||||
"(let-values(((implicit-omitted?_0) implicit-omitted?359_0))"
|
||||
" '...nder/expand/expr.rkt:602:1"
|
||||
"(let-values(((s_0) s362_0))"
|
||||
"(let-values(((ctx_0) ctx363_0))"
|
||||
"(let-values(((implicit-omitted?_0) implicit-omitted?361_0))"
|
||||
"(let-values()"
|
||||
"(let-values(((disarmed-s_0)(syntax-disarm$1 s_0)))"
|
||||
"(let-values((()"
|
||||
|
@ -74814,21 +74827,21 @@ static const char *startup_source =
|
|||
"(if implicit-omitted?_0"
|
||||
"(let-values() s_0)"
|
||||
"(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(((orig-s_0) s_1))"
|
||||
"(let-values(((#%top362_0 id363_0)"
|
||||
"(let-values(((#%top364_0 id365_0)"
|
||||
"(let-values(((s_2)"
|
||||
"(if(syntax?$1 s_1)"
|
||||
"(syntax-e$1 s_1)"
|
||||
" s_1)))"
|
||||
"(if(pair? s_2)"
|
||||
"(let-values(((#%top364_0)"
|
||||
"(let-values(((#%top366_0)"
|
||||
"(let-values(((s_3)"
|
||||
"(car"
|
||||
" s_2)))"
|
||||
" s_3))"
|
||||
"((id365_0)"
|
||||
"((id367_0)"
|
||||
"(let-values(((s_3)"
|
||||
"(cdr"
|
||||
" s_2)))"
|
||||
|
@ -74849,25 +74862,25 @@ static const char *startup_source =
|
|||
" \"not an identifier\""
|
||||
" orig-s_0"
|
||||
" s_3)))))"
|
||||
"(values #%top364_0 id365_0))"
|
||||
"(values #%top366_0 id367_0))"
|
||||
"(raise-syntax-error$1"
|
||||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0)))))"
|
||||
"(values #t #%top362_0 id363_0))))))"
|
||||
" id363_0)))))"
|
||||
"(values #t #%top364_0 id365_0))))))"
|
||||
" id365_0)))))"
|
||||
"(let-values(((b_0)"
|
||||
"(let-values(((id366_0) id_0)"
|
||||
"((temp367_0)(expand-context-phase ctx_0))"
|
||||
"((temp368_0) 'ambiguous))"
|
||||
"(let-values(((id368_0) id_0)"
|
||||
"((temp369_0)(expand-context-phase ctx_0))"
|
||||
"((temp370_0) 'ambiguous))"
|
||||
"(resolve+shift.1"
|
||||
" temp368_0"
|
||||
" temp370_0"
|
||||
" #f"
|
||||
" null"
|
||||
" unsafe-undefined"
|
||||
" #f"
|
||||
" id366_0"
|
||||
" temp367_0))))"
|
||||
" id368_0"
|
||||
" temp369_0))))"
|
||||
"(if(eq? b_0 'ambiguous)"
|
||||
"(let-values()(raise-ambiguous-error id_0 ctx_0))"
|
||||
"(if(if b_0"
|
||||
|
@ -74900,10 +74913,10 @@ static const char *startup_source =
|
|||
" id_0"
|
||||
"(root-expand-context-top-level-bind-scope ctx_0))))"
|
||||
"(let-values(((tl-b_0)"
|
||||
"(let-values(((tl-id369_0) tl-id_0)"
|
||||
"((temp370_0)"
|
||||
"(let-values(((tl-id371_0) tl-id_0)"
|
||||
"((temp372_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"
|
||||
"(let-values()"
|
||||
"(if(expand-context-to-parsed? ctx_0)"
|
||||
|
@ -74911,10 +74924,10 @@ static const char *startup_source =
|
|||
"(if implicit-omitted?_0"
|
||||
"(let-values() id_0)"
|
||||
"(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(((orig-s_0) s_1))"
|
||||
"(let-values(((#%top371_0 id372_0)"
|
||||
"(let-values(((#%top373_0 id374_0)"
|
||||
"(let-values(((s_2)"
|
||||
"(if(syntax?$1"
|
||||
" s_1)"
|
||||
|
@ -74922,12 +74935,12 @@ static const char *startup_source =
|
|||
" s_1)"
|
||||
" s_1)))"
|
||||
"(if(pair? s_2)"
|
||||
"(let-values(((#%top373_0)"
|
||||
"(let-values(((#%top375_0)"
|
||||
"(let-values(((s_3)"
|
||||
"(car"
|
||||
" s_2)))"
|
||||
" s_3))"
|
||||
"((id374_0)"
|
||||
"((id376_0)"
|
||||
"(let-values(((s_3)"
|
||||
"(cdr"
|
||||
" s_2)))"
|
||||
|
@ -74949,23 +74962,23 @@ static const char *startup_source =
|
|||
" orig-s_0"
|
||||
" s_3)))))"
|
||||
"(values"
|
||||
" #%top373_0"
|
||||
" id374_0))"
|
||||
" #%top375_0"
|
||||
" id376_0))"
|
||||
"(raise-syntax-error$1"
|
||||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0)))))"
|
||||
"(values #t #%top371_0 id372_0))))))"
|
||||
"(let-values(((s375_0) s_0)"
|
||||
"((temp376_0)(cons #%top371_0 id_0)))"
|
||||
"(rebuild.1 #t s375_0 temp376_0)))))))"
|
||||
"(values #t #%top373_0 id374_0))))))"
|
||||
"(let-values(((s377_0) s_0)"
|
||||
"((temp378_0)(cons #%top373_0 id_0)))"
|
||||
"(rebuild.1 #t s377_0 temp378_0)))))))"
|
||||
"(let-values()"
|
||||
"(if(expand-context-to-parsed? ctx_0)"
|
||||
"(parsed-top-id4.1 id_0 b_0 #f)"
|
||||
" s_0)))))))))))))))))))))))"
|
||||
"(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 implicit-omitted?359_0)(...nder/expand/expr.rkt:600:1_0 s_0 ctx_0 implicit-omitted?359_0))))))"
|
||||
"((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?361_0)(...nder/expand/expr.rkt:602:1_0 s_0 ctx_0 implicit-omitted?361_0))))))"
|
||||
"(void"
|
||||
"(add-core-form!*"
|
||||
" 'set!"
|
||||
|
@ -74978,19 +74991,19 @@ static const char *startup_source =
|
|||
"(let-values()(let-values()(call-expand-observe obs_0 'prim-set! disarmed-s_0)))"
|
||||
"(void)))"
|
||||
"(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(((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)))"
|
||||
"(if(pair? s_2)"
|
||||
"(let-values(((set!380_0)(let-values(((s_3)(car s_2))) s_3))"
|
||||
"((id381_0 rhs382_0)"
|
||||
"(let-values(((set!382_0)(let-values(((s_3)(car s_2))) s_3))"
|
||||
"((id383_0 rhs384_0)"
|
||||
"(let-values(((s_3)(cdr s_2)))"
|
||||
"(let-values(((s_4)"
|
||||
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
|
||||
"(if(pair? s_4)"
|
||||
"(let-values(((id383_0)"
|
||||
"(let-values(((id385_0)"
|
||||
"(let-values(((s_5)(car s_4)))"
|
||||
"(if(let-values(((or-part_0)"
|
||||
"(if(syntax?$1 s_5)"
|
||||
|
@ -75006,14 +75019,14 @@ static const char *startup_source =
|
|||
" \"not an identifier\""
|
||||
" orig-s_0"
|
||||
" s_5))))"
|
||||
"((rhs384_0)"
|
||||
"((rhs386_0)"
|
||||
"(let-values(((s_5)(cdr s_4)))"
|
||||
"(let-values(((s_6)"
|
||||
"(if(syntax?$1 s_5)"
|
||||
"(syntax-e$1 s_5)"
|
||||
" s_5)))"
|
||||
"(if(pair? s_6)"
|
||||
"(let-values(((rhs385_0)"
|
||||
"(let-values(((rhs387_0)"
|
||||
"(let-values(((s_7)"
|
||||
"(car"
|
||||
" s_6)))"
|
||||
|
@ -75034,27 +75047,27 @@ static const char *startup_source =
|
|||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0))))))"
|
||||
"(values rhs385_0))"
|
||||
"(values rhs387_0))"
|
||||
"(raise-syntax-error$1"
|
||||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0))))))"
|
||||
"(values id383_0 rhs384_0))"
|
||||
"(values id385_0 rhs386_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)))))"
|
||||
"(values #t set!377_0 id378_0 rhs379_0))))))"
|
||||
"(let-values(((orig-id_0) id378_0))"
|
||||
"(values #t set!379_0 id380_0 rhs381_0))))))"
|
||||
"(let-values(((orig-id_0) id380_0))"
|
||||
"((letrec-values(((rename-loop_0)"
|
||||
"(lambda(id_0 from-rename?_0)"
|
||||
"(begin"
|
||||
" 'rename-loop"
|
||||
"(let-values(((binding_0)"
|
||||
"(let-values(((id386_0) id_0)"
|
||||
"((temp387_0)(expand-context-phase ctx_0))"
|
||||
"((temp388_0) 'ambiguous)"
|
||||
"((temp389_0) #t))"
|
||||
"(resolve+shift.1 temp388_0 #f null temp389_0 #f id386_0 temp387_0))))"
|
||||
"(let-values(((id388_0) id_0)"
|
||||
"((temp389_0)(expand-context-phase ctx_0))"
|
||||
"((temp390_0) 'ambiguous)"
|
||||
"((temp391_0) #t))"
|
||||
"(resolve+shift.1 temp390_0 #f null temp391_0 #f id388_0 temp389_0))))"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
"(if(eq? binding_0 'ambiguous)"
|
||||
|
@ -75063,10 +75076,10 @@ static const char *startup_source =
|
|||
"(values))))"
|
||||
"(let-values(((t_0 primitive?_0 insp_0 protected?_0)"
|
||||
"(if binding_0"
|
||||
"(let-values(((binding390_0) binding_0)"
|
||||
"((ctx391_0) ctx_0)"
|
||||
"((s392_0) s_0))"
|
||||
"(lookup.1 #f #f binding390_0 ctx391_0 s392_0))"
|
||||
"(let-values(((binding392_0) binding_0)"
|
||||
"((ctx393_0) ctx_0)"
|
||||
"((s394_0) s_0))"
|
||||
"(lookup.1 #f #f binding392_0 ctx393_0 s394_0))"
|
||||
"(values #f #f #f #f))))"
|
||||
"(begin"
|
||||
"(let-values(((obs_0)(expand-context-observer ctx_0)))"
|
||||
|
@ -75114,33 +75127,33 @@ static const char *startup_source =
|
|||
" ctx_0)"
|
||||
"(values))))"
|
||||
"(let-values(((rebuild-s_0)"
|
||||
"(let-values(((ctx393_0) ctx_0)((s394_0) s_0))"
|
||||
"(keep-as-needed.1 #f #f #f ctx393_0 s394_0))))"
|
||||
"(let-values(((ctx395_0) ctx_0)((s396_0) s_0))"
|
||||
"(keep-as-needed.1 #f #f #f ctx395_0 s396_0))))"
|
||||
"(let-values(((exp-rhs_0)"
|
||||
"(let-values(((temp395_0) rhs379_0)"
|
||||
"((temp396_0)"
|
||||
"(let-values(((temp397_0) rhs381_0)"
|
||||
"((temp398_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)"
|
||||
"(parsed-set!9.1"
|
||||
" rebuild-s_0"
|
||||
"(parsed-id2.1 id_0 binding_0 #f)"
|
||||
" exp-rhs_0)"
|
||||
"(let-values(((rebuild-s397_0) rebuild-s_0)"
|
||||
"((temp398_0)"
|
||||
"(let-values(((rebuild-s399_0) rebuild-s_0)"
|
||||
"((temp400_0)"
|
||||
"(list"
|
||||
" set!377_0"
|
||||
"(let-values(((id399_0) id_0)"
|
||||
"((t400_0) t_0)"
|
||||
"((temp401_0)"
|
||||
" set!379_0"
|
||||
"(let-values(((id401_0) id_0)"
|
||||
"((t402_0) t_0)"
|
||||
"((temp403_0)"
|
||||
"(free-id-set-empty-or-just-module*?"
|
||||
"(expand-context-stops ctx_0))))"
|
||||
"(substitute-variable.1"
|
||||
" temp401_0"
|
||||
" id399_0"
|
||||
" t400_0))"
|
||||
" temp403_0"
|
||||
" id401_0"
|
||||
" t402_0))"
|
||||
" exp-rhs_0)))"
|
||||
"(rebuild.1 #t rebuild-s397_0 temp398_0)))))))))"
|
||||
"(rebuild.1 #t rebuild-s399_0 temp400_0)))))))))"
|
||||
"(if(not binding_0)"
|
||||
"(let-values()"
|
||||
"(raise-unbound-syntax-error"
|
||||
|
@ -75154,61 +75167,61 @@ static const char *startup_source =
|
|||
"(let-values()"
|
||||
"(if(not-in-this-expand-context? t_0 ctx_0)"
|
||||
"(let-values()"
|
||||
"(let-values(((temp402_0)"
|
||||
"(let-values(((temp404_0)"
|
||||
"(avoid-current-expand-context"
|
||||
"(substitute-set!-rename"
|
||||
" s_0"
|
||||
" disarmed-s_0"
|
||||
" set!377_0"
|
||||
" rhs379_0"
|
||||
" set!379_0"
|
||||
" rhs381_0"
|
||||
" id_0"
|
||||
" from-rename?_0"
|
||||
" ctx_0)"
|
||||
" t_0"
|
||||
" ctx_0))"
|
||||
"((ctx403_0) ctx_0))"
|
||||
"(expand.1 #f #f temp402_0 ctx403_0)))"
|
||||
"((ctx405_0) ctx_0))"
|
||||
"(expand.1 #f #f temp404_0 ctx405_0)))"
|
||||
"(let-values()"
|
||||
"(let-values(((exp-s_0 re-ctx_0)"
|
||||
"(let-values(((t404_0) t_0)"
|
||||
"((insp405_0) insp_0)"
|
||||
"((s406_0) s_0)"
|
||||
"((orig-id407_0) orig-id_0)"
|
||||
"((ctx408_0) ctx_0)"
|
||||
"((binding409_0) binding_0)"
|
||||
"((orig-id410_0) orig-id_0))"
|
||||
"(let-values(((t406_0) t_0)"
|
||||
"((insp407_0) insp_0)"
|
||||
"((s408_0) s_0)"
|
||||
"((orig-id409_0) orig-id_0)"
|
||||
"((ctx410_0) ctx_0)"
|
||||
"((binding411_0) binding_0)"
|
||||
"((orig-id412_0) orig-id_0))"
|
||||
"(apply-transformer.1"
|
||||
" orig-id410_0"
|
||||
" t404_0"
|
||||
" insp405_0"
|
||||
" s406_0"
|
||||
" orig-id407_0"
|
||||
" ctx408_0"
|
||||
" binding409_0))))"
|
||||
" orig-id412_0"
|
||||
" t406_0"
|
||||
" insp407_0"
|
||||
" s408_0"
|
||||
" orig-id409_0"
|
||||
" ctx410_0"
|
||||
" binding411_0))))"
|
||||
"(if(expand-context-just-once? ctx_0)"
|
||||
"(let-values() exp-s_0)"
|
||||
"(let-values()"
|
||||
"(let-values(((exp-s411_0) exp-s_0)"
|
||||
"((re-ctx412_0) re-ctx_0))"
|
||||
"(expand.1 #f #f exp-s411_0 re-ctx412_0))))))))"
|
||||
"(let-values(((exp-s413_0) exp-s_0)"
|
||||
"((re-ctx414_0) re-ctx_0))"
|
||||
"(expand.1 #f #f exp-s413_0 re-ctx414_0))))))))"
|
||||
"(if(1/rename-transformer? t_0)"
|
||||
"(let-values()"
|
||||
"(if(not-in-this-expand-context? t_0 ctx_0)"
|
||||
"(let-values()"
|
||||
"(let-values(((temp413_0)"
|
||||
"(let-values(((temp415_0)"
|
||||
"(avoid-current-expand-context"
|
||||
"(substitute-set!-rename"
|
||||
" s_0"
|
||||
" disarmed-s_0"
|
||||
" set!377_0"
|
||||
" rhs379_0"
|
||||
" set!379_0"
|
||||
" rhs381_0"
|
||||
" id_0"
|
||||
" from-rename?_0"
|
||||
" ctx_0)"
|
||||
" t_0"
|
||||
" ctx_0))"
|
||||
"((ctx414_0) ctx_0))"
|
||||
"(expand.1 #f #f temp413_0 ctx414_0)))"
|
||||
"((ctx416_0) ctx_0))"
|
||||
"(expand.1 #f #f temp415_0 ctx416_0)))"
|
||||
"(let-values()"
|
||||
"(rename-loop_0(apply-rename-transformer t_0 id_0 ctx_0) #t))))"
|
||||
"(let-values()"
|
||||
|
@ -75241,7 +75254,7 @@ static const char *startup_source =
|
|||
"(let-values()(call-expand-observe obs_0 'prim-#%variable-reference disarmed-s_0)))"
|
||||
"(void)))"
|
||||
"(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))"
|
||||
"(if(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
|
||||
"(if(pair? s_2)"
|
||||
|
@ -75261,15 +75274,15 @@ static const char *startup_source =
|
|||
" #f)"
|
||||
" #f))"
|
||||
"(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(((#%variable-reference417_0)"
|
||||
"(let-values(((#%variable-reference419_0)"
|
||||
"(let-values(((s_3)(car s_2))) s_3))"
|
||||
"((id418_0)"
|
||||
"((id420_0)"
|
||||
"(let-values(((s_3)(cdr s_2)))"
|
||||
"(let-values(((s_4)"
|
||||
"(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)(cdr s_4)))"
|
||||
|
@ -75278,11 +75291,11 @@ static const char *startup_source =
|
|||
"(syntax-e$1 s_5)"
|
||||
" s_5)))"
|
||||
"(values)))))"
|
||||
"(values id419_0))))))"
|
||||
"(values #%variable-reference417_0 id418_0)))))"
|
||||
"(values #t #%variable-reference415_0 id416_0)))"
|
||||
"(values id421_0))))))"
|
||||
"(values #%variable-reference419_0 id420_0)))))"
|
||||
"(values #t #%variable-reference417_0 id418_0)))"
|
||||
"(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))"
|
||||
"(if(if(not ok?_0)"
|
||||
"(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)"
|
||||
"(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(((#%variable-reference423_0)"
|
||||
"(let-values(((#%variable-reference425_0)"
|
||||
"(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_4)"
|
||||
"(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_6)"
|
||||
"(if(syntax?$1 s_5)"
|
||||
"(syntax-e$1 s_5)"
|
||||
" s_5)))"
|
||||
"(let-values(((#%top428_0)"
|
||||
"(let-values(((#%top430_0)"
|
||||
"(let-values(((s_7)"
|
||||
"(car"
|
||||
" s_6)))"
|
||||
" s_7))"
|
||||
"((id429_0)"
|
||||
"((id431_0)"
|
||||
"(let-values(((s_7)"
|
||||
"(cdr"
|
||||
" s_6)))"
|
||||
" s_7)))"
|
||||
"(values #%top428_0 id429_0)))))"
|
||||
"(values #%top430_0 id431_0)))))"
|
||||
"(()"
|
||||
"(let-values(((s_5)(cdr s_4)))"
|
||||
"(let-values(((s_6)"
|
||||
|
@ -75344,18 +75357,18 @@ static const char *startup_source =
|
|||
"(syntax-e$1 s_5)"
|
||||
" s_5)))"
|
||||
"(values)))))"
|
||||
"(values #%top426_0 id427_0))))))"
|
||||
"(values #%variable-reference423_0 #%top424_0 id425_0)))))"
|
||||
"(values #t #%variable-reference420_0 #%top421_0 id422_0)))"
|
||||
"(values #%top428_0 id429_0))))))"
|
||||
"(values #%variable-reference425_0 #%top426_0 id427_0)))))"
|
||||
"(values #t #%variable-reference422_0 #%top423_0 id424_0)))"
|
||||
"(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))"
|
||||
"(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(((#%variable-reference430_0)"
|
||||
"(let-values(((#%variable-reference432_0)"
|
||||
"(let-values(((s_2)(if(syntax?$1 s_1)(syntax-e$1 s_1) s_1)))"
|
||||
"(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)(cdr s_2)))"
|
||||
|
@ -75369,18 +75382,18 @@ static const char *startup_source =
|
|||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0))))))"
|
||||
"(values #%variable-reference431_0))"
|
||||
"(values #%variable-reference433_0))"
|
||||
" (raise-syntax-error$1 #f \"bad syntax\" orig-s_0)))))"
|
||||
"(values #t #%variable-reference430_0)))"
|
||||
"(values #t #%variable-reference432_0)))"
|
||||
"(values #f #f)))))"
|
||||
"(if(let-values(((or-part_0) ok?_0))(if or-part_0 or-part_0 ok?_1))"
|
||||
"(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(((var-id432_0) var-id_0)"
|
||||
"((temp433_0)(expand-context-phase ctx_0))"
|
||||
"((temp434_0) 'ambiguous))"
|
||||
"(resolve+shift.1 temp434_0 #f null unsafe-undefined #f var-id432_0 temp433_0))))"
|
||||
"(let-values(((var-id434_0) var-id_0)"
|
||||
"((temp435_0)(expand-context-phase ctx_0))"
|
||||
"((temp436_0) 'ambiguous))"
|
||||
"(resolve+shift.1 temp436_0 #f null unsafe-undefined #f var-id434_0 temp435_0))))"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
"(if(eq? binding_0 'ambiguous)"
|
||||
|
@ -75403,12 +75416,12 @@ static const char *startup_source =
|
|||
"(values))))"
|
||||
"(let-values(((t_0 primitive?_0 insp-of-t_0 protected?_0)"
|
||||
"(if binding_0"
|
||||
"(let-values(((binding435_0) binding_0)"
|
||||
"((ctx436_0) ctx_0)"
|
||||
"((var-id437_0) var-id_0)"
|
||||
"((s438_0) s_0)"
|
||||
"((temp439_0)(expand-context-in-local-expand? ctx_0)))"
|
||||
"(lookup.1 s438_0 temp439_0 binding435_0 ctx436_0 var-id437_0))"
|
||||
"(let-values(((binding437_0) binding_0)"
|
||||
"((ctx438_0) ctx_0)"
|
||||
"((var-id439_0) var-id_0)"
|
||||
"((s440_0) s_0)"
|
||||
"((temp441_0)(expand-context-in-local-expand? ctx_0)))"
|
||||
"(lookup.1 s440_0 temp441_0 binding437_0 ctx438_0 var-id439_0))"
|
||||
"(values #f #f #f #f))))"
|
||||
"(begin"
|
||||
"(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)))"
|
||||
"(void)))"
|
||||
"(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(((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)))"
|
||||
"(if(pair? s_2)"
|
||||
"(let-values(((#%expression442_0)(let-values(((s_3)(car s_2))) s_3))"
|
||||
"((e443_0)"
|
||||
"(let-values(((#%expression444_0)(let-values(((s_3)(car s_2))) s_3))"
|
||||
"((e445_0)"
|
||||
"(let-values(((s_3)(cdr s_2)))"
|
||||
"(let-values(((s_4)"
|
||||
"(if(syntax?$1 s_3)(syntax-e$1 s_3) s_3)))"
|
||||
"(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)(cdr s_4)))"
|
||||
|
@ -75466,20 +75479,20 @@ static const char *startup_source =
|
|||
" #f"
|
||||
" \"bad syntax\""
|
||||
" orig-s_0))))))"
|
||||
"(values e444_0))"
|
||||
"(values e446_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)))))"
|
||||
"(values #t #%expression440_0 e441_0))))))"
|
||||
"(values #t #%expression442_0 e443_0))))))"
|
||||
"(let-values(((rebuild-s_0)"
|
||||
"(let-values(((ctx445_0) ctx_0)((s446_0) s_0)((temp447_0) #t))"
|
||||
"(keep-as-needed.1 temp447_0 #f #f ctx445_0 s446_0))))"
|
||||
"(let-values(((ctx447_0) ctx_0)((s448_0) s_0)((temp449_0) #t))"
|
||||
"(keep-as-needed.1 temp449_0 #f #f ctx447_0 s448_0))))"
|
||||
"(let-values(((exp-e_0)"
|
||||
"(let-values(((temp448_0) e441_0)"
|
||||
"((temp449_0)"
|
||||
"(let-values(((temp450_0)(as-expression-context ctx_0))((ctx451_0) ctx_0))"
|
||||
"(as-tail-context.1 ctx451_0 temp450_0))))"
|
||||
"(expand.1 #f #f temp448_0 temp449_0))))"
|
||||
"(let-values(((temp450_0) e443_0)"
|
||||
"((temp451_0)"
|
||||
"(let-values(((temp452_0)(as-expression-context ctx_0))((ctx453_0) ctx_0))"
|
||||
"(as-tail-context.1 ctx453_0 temp452_0))))"
|
||||
"(expand.1 #f #f temp450_0 temp451_0))))"
|
||||
"(if(expand-context-to-parsed? ctx_0)"
|
||||
" exp-e_0"
|
||||
"(if(let-values(((or-part_0)"
|
||||
|
@ -75488,8 +75501,8 @@ static const char *startup_source =
|
|||
" #f)))"
|
||||
"(if or-part_0 or-part_0(eq? 'top-level(expand-context-context ctx_0))))"
|
||||
"(let-values()"
|
||||
"(let-values(((rebuild-s452_0) rebuild-s_0)((temp453_0)(list #%expression440_0 exp-e_0)))"
|
||||
"(rebuild.1 #t rebuild-s452_0 temp453_0)))"
|
||||
"(let-values(((rebuild-s454_0) rebuild-s_0)((temp455_0)(list #%expression442_0 exp-e_0)))"
|
||||
"(rebuild.1 #t rebuild-s454_0 temp455_0)))"
|
||||
"(let-values()"
|
||||
"(let-values(((result-s_0)(syntax-track-origin$1 exp-e_0 rebuild-s_0)))"
|
||||
"(begin"
|
||||
|
|
|
@ -43777,7 +43777,7 @@
|
|||
(let ((purely-functional?_0 #t))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(let ((temp14_0 (list p7_0)))
|
||||
(let ((temp14_0 (flatten-begin p7_0)))
|
||||
(let ((temp17_0
|
||||
(if single-expression?2_0
|
||||
(list* '() (list syntax-literals-id) '(()))
|
||||
|
@ -44011,6 +44011,11 @@
|
|||
(compile-quote-syntax (syntax-disarm$1 (parsed-s p_0)) cctx_0)))
|
||||
(list top-level-require!-id form-stx_0 ns-id))
|
||||
#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
|
||||
(|#%name|
|
||||
select-defined-syms-and-bind!
|
||||
|
@ -83104,7 +83109,7 @@
|
|||
(let ((temp350_0 (cons begin339_0 exp-es_0)))
|
||||
(rebuild.1 #t rebuild-s_0 temp350_0)))))))
|
||||
(args (raise-binding-result-arity-error 3 args)))))))))))
|
||||
(define effect_2495
|
||||
(define effect_1829
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
|
@ -83158,7 +83163,15 @@
|
|||
(values #f #f)))
|
||||
(case-lambda
|
||||
((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)))))
|
||||
(|#%app| nonempty-begin_0 s_0 ctx_0)))))))
|
||||
(void)))
|
||||
|
@ -83198,22 +83211,22 @@
|
|||
null)))))
|
||||
#t)
|
||||
#f)))
|
||||
(define effect_2283
|
||||
(define effect_2286
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
'|#%top|
|
||||
(let ((...nder/expand/expr.rkt:600:1_0
|
||||
(let ((...nder/expand/expr.rkt:602:1_0
|
||||
(|#%name|
|
||||
...nder/expand/expr.rkt:600:1
|
||||
(lambda (s360_0 ctx361_0 implicit-omitted?359_0)
|
||||
...nder/expand/expr.rkt:602:1
|
||||
(lambda (s362_0 ctx363_0 implicit-omitted?361_0)
|
||||
(begin
|
||||
(let ((disarmed-s_0 (syntax-disarm$1 s360_0)))
|
||||
(let ((disarmed-s_0 (syntax-disarm$1 s362_0)))
|
||||
(begin
|
||||
(let ((obs_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-observer
|
||||
(root-expand-context/outer-inner ctx361_0)))))
|
||||
(root-expand-context/outer-inner ctx363_0)))))
|
||||
(if obs_0
|
||||
(call-expand-observe
|
||||
obs_0
|
||||
|
@ -83221,8 +83234,8 @@
|
|||
disarmed-s_0)
|
||||
(void)))
|
||||
(let ((id_0
|
||||
(if implicit-omitted?359_0
|
||||
s360_0
|
||||
(if implicit-omitted?361_0
|
||||
s362_0
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(call-with-values
|
||||
|
@ -83232,9 +83245,9 @@
|
|||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(if (pair? s_0)
|
||||
(let ((|#%top364_0|
|
||||
(let ((|#%top366_0|
|
||||
(let ((s_1 (car s_0))) s_1)))
|
||||
(let ((id365_0
|
||||
(let ((id367_0
|
||||
(let ((s_1 (cdr s_0)))
|
||||
(if (let ((or-part_0
|
||||
(if (syntax?$1
|
||||
|
@ -83252,29 +83265,29 @@
|
|||
"not an identifier"
|
||||
disarmed-s_0
|
||||
s_1)))))
|
||||
(let ((|#%top364_1| |#%top364_0|))
|
||||
(values |#%top364_1| id365_0))))
|
||||
(let ((|#%top366_1| |#%top366_0|))
|
||||
(values |#%top366_1| id367_0))))
|
||||
(raise-syntax-error$1
|
||||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0))))
|
||||
(case-lambda
|
||||
((|#%top362_0| id363_0)
|
||||
(values #t |#%top362_0| id363_0))
|
||||
((|#%top364_0| id365_0)
|
||||
(values #t |#%top364_0| id365_0))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
2
|
||||
args)))))
|
||||
(case-lambda
|
||||
((ok?_0 |#%top362_0| id363_0) id363_0)
|
||||
((ok?_0 |#%top364_0| id365_0) id365_0)
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
3
|
||||
args)))))))
|
||||
(let ((temp367_0
|
||||
(let ((temp369_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-phase
|
||||
(root-expand-context/outer-inner ctx361_0)))))
|
||||
(root-expand-context/outer-inner ctx363_0)))))
|
||||
(let ((b_0
|
||||
(resolve+shift.1
|
||||
'ambiguous
|
||||
|
@ -83283,9 +83296,9 @@
|
|||
unsafe-undefined
|
||||
#f
|
||||
id_0
|
||||
temp367_0)))
|
||||
temp369_0)))
|
||||
(if (eq? b_0 'ambiguous)
|
||||
(raise-ambiguous-error id_0 ctx361_0)
|
||||
(raise-ambiguous-error id_0 ctx363_0)
|
||||
(if (if b_0
|
||||
(if (module-binding? b_0)
|
||||
(eq?
|
||||
|
@ -83293,13 +83306,13 @@
|
|||
(begin-unsafe
|
||||
(root-expand-context/inner-self-mpi
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0))))
|
||||
ctx363_0))))
|
||||
#f)
|
||||
#f)
|
||||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0)))
|
||||
ctx363_0)))
|
||||
(parsed-id2.1 id_0 b_0 #f)
|
||||
(if (let ((mpi_0
|
||||
(module-binding-module b_0)))
|
||||
|
@ -83307,41 +83320,41 @@
|
|||
(eq?
|
||||
top-level-module-path-index
|
||||
mpi_0)))
|
||||
s360_0
|
||||
s362_0
|
||||
id_0))
|
||||
(if (register-eventual-variable!?
|
||||
id_0
|
||||
ctx361_0)
|
||||
ctx363_0)
|
||||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0)))
|
||||
ctx363_0)))
|
||||
(parsed-id2.1 id_0 b_0 #f)
|
||||
id_0)
|
||||
(if (not
|
||||
(begin-unsafe
|
||||
(expand-context/inner-allow-unbound?
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0))))
|
||||
ctx363_0))))
|
||||
(raise-unbound-syntax-error
|
||||
#f
|
||||
"unbound identifier"
|
||||
id_0
|
||||
#f
|
||||
null
|
||||
(syntax-debug-info-string id_0 ctx361_0))
|
||||
(syntax-debug-info-string id_0 ctx363_0))
|
||||
(let ((tl-id_0
|
||||
(add-scope
|
||||
id_0
|
||||
(begin-unsafe
|
||||
(root-expand-context/inner-top-level-bind-scope
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0))))))
|
||||
(let ((temp370_0
|
||||
ctx363_0))))))
|
||||
(let ((temp372_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-phase
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0)))))
|
||||
ctx363_0)))))
|
||||
(let ((tl-b_0
|
||||
(resolve.1
|
||||
#f
|
||||
|
@ -83349,17 +83362,17 @@
|
|||
null
|
||||
#f
|
||||
tl-id_0
|
||||
temp370_0)))
|
||||
temp372_0)))
|
||||
(if tl-b_0
|
||||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0)))
|
||||
ctx363_0)))
|
||||
(parsed-top-id4.1
|
||||
tl-id_0
|
||||
tl-b_0
|
||||
#f)
|
||||
(if implicit-omitted?359_0
|
||||
(if implicit-omitted?361_0
|
||||
id_0
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
|
@ -83372,12 +83385,12 @@
|
|||
disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(if (pair? s_0)
|
||||
(let ((|#%top373_0|
|
||||
(let ((|#%top375_0|
|
||||
(let ((s_1
|
||||
(car
|
||||
s_0)))
|
||||
s_1)))
|
||||
(let ((id374_0
|
||||
(let ((id376_0
|
||||
(let ((s_1
|
||||
(cdr
|
||||
s_0)))
|
||||
|
@ -83398,35 +83411,35 @@
|
|||
"not an identifier"
|
||||
disarmed-s_0
|
||||
s_1)))))
|
||||
(let ((|#%top373_1|
|
||||
|#%top373_0|))
|
||||
(let ((|#%top375_1|
|
||||
|#%top375_0|))
|
||||
(values
|
||||
|#%top373_1|
|
||||
id374_0))))
|
||||
|#%top375_1|
|
||||
id376_0))))
|
||||
(raise-syntax-error$1
|
||||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0))))
|
||||
(case-lambda
|
||||
((|#%top371_0| id372_0)
|
||||
((|#%top373_0| id374_0)
|
||||
(values
|
||||
#t
|
||||
|#%top371_0|
|
||||
id372_0))
|
||||
|#%top373_0|
|
||||
id374_0))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
2
|
||||
args)))))
|
||||
(case-lambda
|
||||
((ok?_0 |#%top371_0| id372_0)
|
||||
(let ((temp376_0
|
||||
((ok?_0 |#%top373_0| id374_0)
|
||||
(let ((temp378_0
|
||||
(cons
|
||||
|#%top371_0|
|
||||
|#%top373_0|
|
||||
id_0)))
|
||||
(rebuild.1
|
||||
#t
|
||||
s360_0
|
||||
temp376_0)))
|
||||
s362_0
|
||||
temp378_0)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
3
|
||||
|
@ -83434,20 +83447,20 @@
|
|||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner
|
||||
ctx361_0)))
|
||||
ctx363_0)))
|
||||
(parsed-top-id4.1 id_0 b_0 #f)
|
||||
s360_0)))))))))))))))))))
|
||||
s362_0)))))))))))))))))))
|
||||
(|#%name|
|
||||
...nder/expand/expr.rkt:600:1
|
||||
...nder/expand/expr.rkt:602:1
|
||||
(case-lambda
|
||||
((s_0 ctx_0) (begin (...nder/expand/expr.rkt:600: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) (begin (...nder/expand/expr.rkt:602:1_0 s_0 ctx_0 #f)))
|
||||
((s_0 ctx_0 implicit-omitted?361_0)
|
||||
(...nder/expand/expr.rkt:602:1_0
|
||||
s_0
|
||||
ctx_0
|
||||
implicit-omitted?359_0)))))))
|
||||
implicit-omitted?361_0)))))))
|
||||
(void)))
|
||||
(define effect_2325
|
||||
(define effect_2261
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
|
@ -83471,14 +83484,14 @@
|
|||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(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
|
||||
(lambda ()
|
||||
(let ((s_2 (cdr s_1)))
|
||||
(let ((s_3
|
||||
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
|
||||
(if (pair? s_3)
|
||||
(let ((id383_0
|
||||
(let ((id385_0
|
||||
(let ((s_4 (car s_3)))
|
||||
(if (let ((or-part_0
|
||||
(if (syntax?$1 s_4)
|
||||
|
@ -83494,14 +83507,14 @@
|
|||
"not an identifier"
|
||||
disarmed-s_0
|
||||
s_4)))))
|
||||
(let ((rhs384_0
|
||||
(let ((rhs386_0
|
||||
(let ((s_4 (cdr s_3)))
|
||||
(let ((s_5
|
||||
(if (syntax?$1 s_4)
|
||||
(syntax-e$1 s_4)
|
||||
s_4)))
|
||||
(if (pair? s_5)
|
||||
(let ((rhs385_0
|
||||
(let ((rhs387_0
|
||||
(let ((s_6 (car s_5)))
|
||||
s_6)))
|
||||
(call-with-values
|
||||
|
@ -83521,8 +83534,8 @@
|
|||
disarmed-s_0)))))
|
||||
(case-lambda
|
||||
(()
|
||||
(let ((rhs385_1 rhs385_0))
|
||||
(values rhs385_1)))
|
||||
(let ((rhs387_1 rhs387_0))
|
||||
(values rhs387_1)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
0
|
||||
|
@ -83531,31 +83544,31 @@
|
|||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0))))))
|
||||
(let ((id383_1 id383_0))
|
||||
(values id383_1 rhs384_0))))
|
||||
(let ((id385_1 id385_0))
|
||||
(values id385_1 rhs386_0))))
|
||||
(raise-syntax-error$1
|
||||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0)))))
|
||||
(case-lambda
|
||||
((id381_0 rhs382_0)
|
||||
(let ((set!380_1 set!380_0))
|
||||
(values set!380_1 id381_0 rhs382_0)))
|
||||
((id383_0 rhs384_0)
|
||||
(let ((set!382_1 set!382_0))
|
||||
(values set!382_1 id383_0 rhs384_0)))
|
||||
(args (raise-binding-result-arity-error 2 args)))))
|
||||
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
|
||||
(case-lambda
|
||||
((set!377_0 id378_0 rhs379_0)
|
||||
(values #t set!377_0 id378_0 rhs379_0))
|
||||
((set!379_0 id380_0 rhs381_0)
|
||||
(values #t set!379_0 id380_0 rhs381_0))
|
||||
(args (raise-binding-result-arity-error 3 args)))))
|
||||
(case-lambda
|
||||
((ok?_0 set!377_0 id378_0 rhs379_0)
|
||||
((ok?_0 set!379_0 id380_0 rhs381_0)
|
||||
(letrec*
|
||||
((rename-loop_0
|
||||
(|#%name|
|
||||
rename-loop
|
||||
(lambda (id_0 from-rename?_0)
|
||||
(begin
|
||||
(let ((temp387_0
|
||||
(let ((temp389_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-phase
|
||||
(root-expand-context/outer-inner ctx_0)))))
|
||||
|
@ -83567,7 +83580,7 @@
|
|||
#t
|
||||
#f
|
||||
id_0
|
||||
temp387_0)))
|
||||
temp389_0)))
|
||||
(begin
|
||||
(if (eq? binding_0 'ambiguous)
|
||||
(raise-ambiguous-error id_0 ctx_0)
|
||||
|
@ -83640,14 +83653,14 @@
|
|||
ctx_0
|
||||
s_0)))
|
||||
(let ((exp-rhs_0
|
||||
(let ((temp396_0
|
||||
(let ((temp398_0
|
||||
(as-expression-context
|
||||
ctx_0)))
|
||||
(expand.1
|
||||
#f
|
||||
#f
|
||||
rhs379_0
|
||||
temp396_0))))
|
||||
rhs381_0
|
||||
temp398_0))))
|
||||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner
|
||||
|
@ -83659,24 +83672,24 @@
|
|||
binding_0
|
||||
#f)
|
||||
exp-rhs_0)
|
||||
(let ((temp398_0
|
||||
(let ((temp400_0
|
||||
(list
|
||||
set!377_0
|
||||
(let ((temp401_0
|
||||
set!379_0
|
||||
(let ((temp403_0
|
||||
(free-id-set-empty-or-just-module*?
|
||||
(begin-unsafe
|
||||
(expand-context/inner-stops
|
||||
(root-expand-context/outer-inner
|
||||
ctx_0))))))
|
||||
(substitute-variable.1
|
||||
temp401_0
|
||||
temp403_0
|
||||
id_0
|
||||
t_0))
|
||||
exp-rhs_0)))
|
||||
(rebuild.1
|
||||
#t
|
||||
rebuild-s_0
|
||||
temp398_0))))))))
|
||||
temp400_0))))))))
|
||||
(if (not binding_0)
|
||||
(raise-unbound-syntax-error
|
||||
#f
|
||||
|
@ -83689,28 +83702,28 @@
|
|||
(if (not-in-this-expand-context?
|
||||
t_0
|
||||
ctx_0)
|
||||
(let ((temp402_0
|
||||
(let ((temp404_0
|
||||
(avoid-current-expand-context
|
||||
(|#%app|
|
||||
substitute-set!-rename
|
||||
s_0
|
||||
disarmed-s_0
|
||||
set!377_0
|
||||
rhs379_0
|
||||
set!379_0
|
||||
rhs381_0
|
||||
id_0
|
||||
from-rename?_0
|
||||
ctx_0)
|
||||
t_0
|
||||
ctx_0)))
|
||||
(expand.1 #f #f temp402_0 ctx_0))
|
||||
(expand.1 #f #f temp404_0 ctx_0))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(apply-transformer.1
|
||||
id378_0
|
||||
id380_0
|
||||
t_0
|
||||
insp_0
|
||||
s_0
|
||||
id378_0
|
||||
id380_0
|
||||
ctx_0
|
||||
binding_0))
|
||||
(case-lambda
|
||||
|
@ -83733,20 +83746,20 @@
|
|||
(if (not-in-this-expand-context?
|
||||
t_0
|
||||
ctx_0)
|
||||
(let ((temp413_0
|
||||
(let ((temp415_0
|
||||
(avoid-current-expand-context
|
||||
(|#%app|
|
||||
substitute-set!-rename
|
||||
s_0
|
||||
disarmed-s_0
|
||||
set!377_0
|
||||
rhs379_0
|
||||
set!379_0
|
||||
rhs381_0
|
||||
id_0
|
||||
from-rename?_0
|
||||
ctx_0)
|
||||
t_0
|
||||
ctx_0)))
|
||||
(expand.1 #f #f temp413_0 ctx_0))
|
||||
(expand.1 #f #f temp415_0 ctx_0))
|
||||
(rename-loop_0
|
||||
(apply-rename-transformer
|
||||
t_0
|
||||
|
@ -83762,7 +83775,7 @@
|
|||
(raise-binding-result-arity-error
|
||||
4
|
||||
args))))))))))))
|
||||
(rename-loop_0 id378_0 #f)))
|
||||
(rename-loop_0 id380_0 #f)))
|
||||
(args (raise-binding-result-arity-error 4 args)))))))))
|
||||
(void)))
|
||||
(define substitute-set!-rename
|
||||
|
@ -83776,7 +83789,7 @@
|
|||
disarmed-s_0)
|
||||
s_0)
|
||||
s_0)))
|
||||
(define effect_2375
|
||||
(define effect_2456
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
|
@ -83828,15 +83841,15 @@
|
|||
(if (syntax?$1 disarmed-s_0)
|
||||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(let ((|#%variable-reference417_0|
|
||||
(let ((|#%variable-reference419_0|
|
||||
(let ((s_2 (car s_1))) s_2)))
|
||||
(let ((id418_0
|
||||
(let ((id420_0
|
||||
(let ((s_2 (cdr s_1)))
|
||||
(let ((s_3
|
||||
(if (syntax?$1 s_2)
|
||||
(syntax-e$1 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
|
||||
(lambda ()
|
||||
(let ((s_4 (cdr s_3)))
|
||||
|
@ -83847,22 +83860,22 @@
|
|||
(values))))
|
||||
(case-lambda
|
||||
(()
|
||||
(let ((id419_1 id419_0))
|
||||
(values id419_1)))
|
||||
(let ((id421_1 id421_0))
|
||||
(values id421_1)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
0
|
||||
args)))))))))
|
||||
(let ((|#%variable-reference417_1|
|
||||
|#%variable-reference417_0|))
|
||||
(values |#%variable-reference417_1| id418_0))))))
|
||||
(let ((|#%variable-reference419_1|
|
||||
|#%variable-reference419_0|))
|
||||
(values |#%variable-reference419_1| id420_0))))))
|
||||
(case-lambda
|
||||
((|#%variable-reference415_0| id416_0)
|
||||
(values #t |#%variable-reference415_0| id416_0))
|
||||
((|#%variable-reference417_0| id418_0)
|
||||
(values #t |#%variable-reference417_0| id418_0))
|
||||
(args (raise-binding-result-arity-error 2 args))))
|
||||
(values #f #f #f)))
|
||||
(case-lambda
|
||||
((ok?_0 |#%variable-reference415_0| id416_0)
|
||||
((ok?_0 |#%variable-reference417_0| id418_0)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(if (if (not ok?_0)
|
||||
|
@ -83913,7 +83926,7 @@
|
|||
(if (syntax?$1 disarmed-s_0)
|
||||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(let ((|#%variable-reference423_0|
|
||||
(let ((|#%variable-reference425_0|
|
||||
(let ((s_2 (car s_1))) s_2)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
|
@ -83929,16 +83942,16 @@
|
|||
(if (syntax?$1 s_4)
|
||||
(syntax-e$1 s_4)
|
||||
s_4)))
|
||||
(let ((|#%top428_0|
|
||||
(let ((|#%top430_0|
|
||||
(let ((s_6 (car s_5))) s_6)))
|
||||
(let ((id429_0
|
||||
(let ((id431_0
|
||||
(let ((s_6 (cdr s_5))) s_6)))
|
||||
(let ((|#%top428_1| |#%top428_0|))
|
||||
(let ((|#%top430_1| |#%top430_0|))
|
||||
(values
|
||||
|#%top428_1|
|
||||
id429_0)))))))
|
||||
|#%top430_1|
|
||||
id431_0)))))))
|
||||
(case-lambda
|
||||
((|#%top426_0| id427_0)
|
||||
((|#%top428_0| id429_0)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(let ((s_4 (cdr s_3)))
|
||||
|
@ -83949,9 +83962,9 @@
|
|||
(values))))
|
||||
(case-lambda
|
||||
(()
|
||||
(let ((|#%top426_1| |#%top426_0|)
|
||||
(id427_1 id427_0))
|
||||
(values |#%top426_1| id427_1)))
|
||||
(let ((|#%top428_1| |#%top428_0|)
|
||||
(id429_1 id429_0))
|
||||
(values |#%top428_1| id429_1)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
0
|
||||
|
@ -83961,36 +83974,36 @@
|
|||
2
|
||||
args)))))))
|
||||
(case-lambda
|
||||
((|#%top424_0| id425_0)
|
||||
(let ((|#%variable-reference423_1|
|
||||
|#%variable-reference423_0|))
|
||||
((|#%top426_0| id427_0)
|
||||
(let ((|#%variable-reference425_1|
|
||||
|#%variable-reference425_0|))
|
||||
(values
|
||||
|#%variable-reference423_1|
|
||||
|#%top424_0|
|
||||
id425_0)))
|
||||
|#%variable-reference425_1|
|
||||
|#%top426_0|
|
||||
id427_0)))
|
||||
(args
|
||||
(raise-binding-result-arity-error 2 args)))))))
|
||||
(case-lambda
|
||||
((|#%variable-reference420_0| |#%top421_0| id422_0)
|
||||
((|#%variable-reference422_0| |#%top423_0| id424_0)
|
||||
(values
|
||||
#t
|
||||
|#%variable-reference420_0|
|
||||
|#%top421_0|
|
||||
id422_0))
|
||||
|#%variable-reference422_0|
|
||||
|#%top423_0|
|
||||
id424_0))
|
||||
(args (raise-binding-result-arity-error 3 args))))
|
||||
(values #f #f #f #f)))
|
||||
(case-lambda
|
||||
((ok?_1 |#%variable-reference420_0| |#%top421_0| id422_0)
|
||||
((ok?_1 |#%variable-reference422_0| |#%top423_0| id424_0)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(if (if (not (if ok?_0 ok?_0 ok?_1)) #t #f)
|
||||
(let ((|#%variable-reference430_0|
|
||||
(let ((|#%variable-reference432_0|
|
||||
(let ((s_1
|
||||
(if (syntax?$1 disarmed-s_0)
|
||||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(if (pair? s_1)
|
||||
(let ((|#%variable-reference431_0|
|
||||
(let ((|#%variable-reference433_0|
|
||||
(let ((s_2 (car s_1))) s_2)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
|
@ -84007,9 +84020,9 @@
|
|||
disarmed-s_0)))))
|
||||
(case-lambda
|
||||
(()
|
||||
(let ((|#%variable-reference431_1|
|
||||
|#%variable-reference431_0|))
|
||||
(values |#%variable-reference431_1|)))
|
||||
(let ((|#%variable-reference433_1|
|
||||
|#%variable-reference433_0|))
|
||||
(values |#%variable-reference433_1|)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
0
|
||||
|
@ -84018,13 +84031,13 @@
|
|||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0)))))
|
||||
(values #t |#%variable-reference430_0|))
|
||||
(values #t |#%variable-reference432_0|))
|
||||
(values #f #f)))
|
||||
(case-lambda
|
||||
((ok?_2 |#%variable-reference430_0|)
|
||||
((ok?_2 |#%variable-reference432_0|)
|
||||
(if (if ok?_0 ok?_0 ok?_1)
|
||||
(let ((var-id_0 (if ok?_0 id416_0 id422_0)))
|
||||
(let ((temp433_0
|
||||
(let ((var-id_0 (if ok?_0 id418_0 id424_0)))
|
||||
(let ((temp435_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-phase
|
||||
(root-expand-context/outer-inner ctx_0)))))
|
||||
|
@ -84036,7 +84049,7 @@
|
|||
unsafe-undefined
|
||||
#f
|
||||
var-id_0
|
||||
temp433_0)))
|
||||
temp435_0)))
|
||||
(begin
|
||||
(if (eq? binding_0 'ambiguous)
|
||||
(raise-ambiguous-error var-id_0 ctx_0)
|
||||
|
@ -84059,14 +84072,14 @@
|
|||
(call-with-values
|
||||
(lambda ()
|
||||
(if binding_0
|
||||
(let ((temp439_0
|
||||
(let ((temp441_0
|
||||
(begin-unsafe
|
||||
(expand-context/inner-in-local-expand?
|
||||
(root-expand-context/outer-inner
|
||||
ctx_0)))))
|
||||
(lookup.1
|
||||
s_0
|
||||
temp439_0
|
||||
temp441_0
|
||||
binding_0
|
||||
ctx_0
|
||||
var-id_0))
|
||||
|
@ -84117,7 +84130,7 @@
|
|||
(args (raise-binding-result-arity-error 4 args)))))
|
||||
(args (raise-binding-result-arity-error 3 args)))))))))
|
||||
(void)))
|
||||
(define effect_1916
|
||||
(define effect_2559
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
|
@ -84141,15 +84154,15 @@
|
|||
(syntax-e$1 disarmed-s_0)
|
||||
disarmed-s_0)))
|
||||
(if (pair? s_1)
|
||||
(let ((|#%expression442_0| (let ((s_2 (car s_1))) s_2)))
|
||||
(let ((e443_0
|
||||
(let ((|#%expression444_0| (let ((s_2 (car s_1))) s_2)))
|
||||
(let ((e445_0
|
||||
(let ((s_2 (cdr s_1)))
|
||||
(let ((s_3
|
||||
(if (syntax?$1 s_2)
|
||||
(syntax-e$1 s_2)
|
||||
s_2)))
|
||||
(if (pair? s_3)
|
||||
(let ((e444_0
|
||||
(let ((e446_0
|
||||
(let ((s_4 (car s_3))) s_4)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
|
@ -84166,8 +84179,8 @@
|
|||
disarmed-s_0)))))
|
||||
(case-lambda
|
||||
(()
|
||||
(let ((e444_1 e444_0))
|
||||
(values e444_1)))
|
||||
(let ((e446_1 e446_0))
|
||||
(values e446_1)))
|
||||
(args
|
||||
(raise-binding-result-arity-error
|
||||
0
|
||||
|
@ -84176,21 +84189,21 @@
|
|||
#f
|
||||
"bad syntax"
|
||||
disarmed-s_0))))))
|
||||
(let ((|#%expression442_1| |#%expression442_0|))
|
||||
(values |#%expression442_1| e443_0))))
|
||||
(let ((|#%expression444_1| |#%expression444_0|))
|
||||
(values |#%expression444_1| e445_0))))
|
||||
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
|
||||
(case-lambda
|
||||
((|#%expression440_0| e441_0)
|
||||
(values #t |#%expression440_0| e441_0))
|
||||
((|#%expression442_0| e443_0)
|
||||
(values #t |#%expression442_0| e443_0))
|
||||
(args (raise-binding-result-arity-error 2 args)))))
|
||||
(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 ((exp-e_0
|
||||
(let ((temp449_0
|
||||
(let ((temp450_0 (as-expression-context ctx_0)))
|
||||
(as-tail-context.1 ctx_0 temp450_0))))
|
||||
(expand.1 #f #f e441_0 temp449_0))))
|
||||
(let ((temp451_0
|
||||
(let ((temp452_0 (as-expression-context ctx_0)))
|
||||
(as-tail-context.1 ctx_0 temp452_0))))
|
||||
(expand.1 #f #f e443_0 temp451_0))))
|
||||
(if (begin-unsafe
|
||||
(expand-context/inner-to-parsed?
|
||||
(root-expand-context/outer-inner ctx_0)))
|
||||
|
@ -84209,8 +84222,8 @@
|
|||
'top-level
|
||||
(begin-unsafe
|
||||
(expand-context/outer-context ctx_0)))))
|
||||
(let ((temp453_0 (list |#%expression440_0| exp-e_0)))
|
||||
(rebuild.1 #t rebuild-s_0 temp453_0))
|
||||
(let ((temp455_0 (list |#%expression442_0| exp-e_0)))
|
||||
(rebuild.1 #t rebuild-s_0 temp455_0))
|
||||
(let ((result-s_0
|
||||
(syntax-track-origin$1 exp-e_0 rebuild-s_0)))
|
||||
(begin
|
||||
|
@ -93348,7 +93361,7 @@
|
|||
(values
|
||||
tl-ids_0
|
||||
(select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0))))))))
|
||||
(define effect_2376
|
||||
(define effect_2375
|
||||
(begin
|
||||
(void
|
||||
(add-core-form!*
|
||||
|
@ -94339,7 +94352,7 @@
|
|||
(declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp42_0))
|
||||
(1/current-namespace ns_0)
|
||||
(1/dynamic-require ''|#%kernel| 0))))))
|
||||
(define effect_2377
|
||||
(define effect_2376
|
||||
(begin
|
||||
(|#%call-with-values| (lambda () (namespace-init!)) print-values)
|
||||
(void)))
|
||||
|
|
|
@ -34,10 +34,9 @@
|
|||
#:single-expression? #t))
|
||||
|
||||
;; Compile a single form, which can be a `define-values` form, a
|
||||
;; `define-syntaxes` form, or an expression (where `begin` is treated
|
||||
;; as an expression form). If `serializable?` is false, don't bother
|
||||
;; generating the linklet for serialized data, because it won't be
|
||||
;; used.
|
||||
;; `define-syntaxes` form, a `begin` form, or an expression. If
|
||||
;; `serializable?` is false, don't bother generating the linklet for
|
||||
;; serialized data, because it won't be used.
|
||||
(define (compile-top p cctx
|
||||
#:serializable? [serializable? #t]
|
||||
#:single-expression? [single-expression? #f]
|
||||
|
@ -59,7 +58,7 @@
|
|||
phase-to-link-extra-inspectorss
|
||||
syntax-literals
|
||||
no-root-context-pos)
|
||||
(compile-forms (list p) cctx mpis
|
||||
(compile-forms (flatten-begin p) cctx mpis
|
||||
#:body-imports (if single-expression?
|
||||
`([]
|
||||
[,syntax-literals-id]
|
||||
|
@ -166,3 +165,15 @@
|
|||
(define form-stx (compile-quote-syntax (syntax-disarm (parsed-s p)) cctx))
|
||||
`(,top-level-require!-id ,form-stx ,ns-id)]
|
||||
[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)]))
|
||||
|
|
|
@ -573,7 +573,9 @@
|
|||
(define disarmed-s (syntax-disarm s))
|
||||
(define-match m disarmed-s #:try '(begin))
|
||||
(if (m)
|
||||
s
|
||||
(if (expand-context-to-parsed? ctx)
|
||||
(parsed-begin (keep-as-needed ctx s) '())
|
||||
s)
|
||||
(nonempty-begin s ctx))]
|
||||
[else
|
||||
(nonempty-begin s ctx)]))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user