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

expander: fix namespace-require/copy for some require specs

Browse Source
This commit is contained in:
Matthew Flatt 2019-04-12 17:17:42 -06:00
parent c800b61f0b
commit 7e9d167101
3 changed files with 103 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-test-core/tests/racket/namespac.rktl
View File

@ -321,6 +321,19 @@
(test #f identifier-binding (namespace-syntax-introduce (datum->syntax #f 'void)))
(test #t list? (identifier-binding (namespace-syntax-introduce (datum->syntax #f 'lambda)))))
;; ----------------------------------------
;; Check that `namespace-require/copy` works with complex module specs
(let ()
(define ns (make-base-namespace))
(eval '(module m racket/base
(provide y x)
(define-syntax-rule (y) 8)
(define x 5))
ns)
(namespace-require/copy '(for-meta 0 'm) ns)
(test 5 eval 'x ns))
;; ----------------------------------------
;; Check that bulk `require` replaces individual bindings

2
racket/src/expander/namespace/api.rkt
View File

@ -143,6 +143,8 @@
ns
(namespace-phase ns)
(make-requires+provides #f)
#:copy-variable-phase-level copy-variable-phase-level
#:copy-variable-as-constant? copy-variable-as-constant?
#:skip-variable-phase-level skip-variable-phase-level
#:who who)]))

151
racket/src/racket/src/startup.inc
View File

@ -35791,9 +35791,24 @@ static const char *startup_source =
" rhs_1)))"
"(loop_0 #f)))"
"(let-values()"
"(let-values(((lst_4)"
"(let-values(((ids*_0)"
"(correlated->list"
" ids_0)))"
"(if(if(pair?"
" ids*_0)"
"(null?"
"(cdr ids*_0))"
" #f)"
"(let-values()"
"(hash-set"
" locals_2"
"(correlated-e"
"(car ids*_0))"
"(infer-known"
" rhs_1)))"
"(let-values()"
"(let-values(((lst_4)"
" ids*_0))"
"(begin"
"(if(variable-reference-from-unsafe?"
"(#%variable-reference))"
@ -35835,7 +35850,7 @@ static const char *startup_source =
" locals_3)))))"
" for-loop_1)"
" locals_2"
" lst_4)))))))))))"
" lst_4))))))))))))))"
" loop_0)"
" rhs_0))))"
"(values locals_3)))))"
@ -35846,6 +35861,14 @@ static const char *startup_source =
" lst_0"
" lst_1))))))"
"(define-values"
"(infer-known)"
"(lambda(e_0)"
"(begin"
"(let-values(((tmp_0)(if(pair?(correlated-e e_0))(correlated-e(car(correlated-e e_0))) #f)))"
"(if(if(equal? tmp_0 'lambda) #t(equal? tmp_0 'case-lambda))"
"(let-values()(known-satisfies7.1 'procedure))"
"(let-values() #t))))))"
"(define-values"
"(ok-make-struct-type-property?)"
"(lambda(e_0 defns_0)"
"(begin"
@ -48332,20 +48355,22 @@ static const char *startup_source =
"((ns87_0) ns_0)"
"((temp88_0)(namespace-phase ns_0))"
"((temp89_0)"
"(let-values(((temp92_0) #f))(make-requires+provides8.1 #f temp92_0)))"
"((skip-variable-phase-level90_0) skip-variable-phase-level_0)"
"((who91_0) who_0))"
"(let-values(((temp94_0) #f))(make-requires+provides8.1 #f temp94_0)))"
"((copy-variable-phase-level90_0) copy-variable-phase-level_0)"
"((copy-variable-as-constant?91_0) copy-variable-as-constant?_0)"
"((skip-variable-phase-level92_0) skip-variable-phase-level_0)"
"((who93_0) who_0))"
"(parse-and-perform-requires!30.1"
" #f"
" #f"
" copy-variable-as-constant?91_0"
" copy-variable-phase-level90_0"
" unsafe-undefined"
" #f"
" unsafe-undefined"
" run?83_0"
" #f"
" skip-variable-phase-level90_0"
" skip-variable-phase-level92_0"
" visit?84_0"
" who91_0"
" who93_0"
" temp85_0"
" temp86_0"
" ns87_0"
@ -48362,8 +48387,8 @@ static const char *startup_source =
"(let-values()"
"(let-values()"
"(let-values()"
"(let-values(((who94_0) 'namespace-require)((req95_0) req_0)((ns96_0) ns_0))"
"(do-namespace-require21.1 #f #f #t #f #f who94_0 req95_0 ns96_0)))))))))))"
"(let-values(((who96_0) 'namespace-require)((req97_0) req_0)((ns98_0) ns_0))"
"(do-namespace-require21.1 #f #f #t #f #f who96_0 req97_0 ns98_0)))))))))))"
"(case-lambda"
"((req_0)(begin 'namespace-require(namespace-require26_0 req_0 unsafe-undefined)))"
"((req_0 ns24_0)(namespace-require26_0 req_0 ns24_0)))))"
@ -48378,20 +48403,20 @@ static const char *startup_source =
"(let-values()"
"(let-values()"
"(let-values()"
"(let-values(((temp98_0) #f)"
"((temp99_0) #t)"
"((who100_0) 'namespace-require/expansion-time)"
"((req101_0) req_0)"
"((ns102_0) ns_0))"
"(let-values(((temp100_0) #f)"
"((temp101_0) #t)"
"((who102_0) 'namespace-require/expansion-time)"
"((req103_0) req_0)"
"((ns104_0) ns_0))"
"(do-namespace-require21.1"
" #f"
" #f"
" temp98_0"
" temp100_0"
" #f"
" temp99_0"
" who100_0"
" req101_0"
" ns102_0)))))))))))"
" temp101_0"
" who102_0"
" req103_0"
" ns104_0)))))))))))"
"(case-lambda"
"((req_0)(begin 'namespace-require/expansion-time(namespace-require/expansion-time30_0 req_0 unsafe-undefined)))"
"((req_0 ns28_0)(namespace-require/expansion-time30_0 req_0 ns28_0)))))"
@ -48406,20 +48431,20 @@ static const char *startup_source =
"(let-values()"
"(let-values()"
"(let-values()"
"(let-values(((who104_0) 'namespace-require/constant)"
"((req105_0) req_0)"
"((ns106_0) ns_0)"
"((temp107_0) 0)"
"((temp108_0) #t))"
"(let-values(((who106_0) 'namespace-require/constant)"
"((req107_0) req_0)"
"((ns108_0) ns_0)"
"((temp109_0) 0)"
"((temp110_0) #t))"
"(do-namespace-require21.1"
" temp108_0"
" temp107_0"
" temp110_0"
" temp109_0"
" #t"
" #f"
" #f"
" who104_0"
" req105_0"
" ns106_0)))))))))))"
" who106_0"
" req107_0"
" ns108_0)))))))))))"
"(case-lambda"
"((req_0)(begin 'namespace-require/constant(namespace-require/constant34_0 req_0 unsafe-undefined)))"
"((req_0 ns32_0)(namespace-require/constant34_0 req_0 ns32_0)))))"
@ -48434,20 +48459,20 @@ static const char *startup_source =
"(let-values()"
"(let-values()"
"(let-values()"
"(let-values(((who110_0) 'namespace-require/copy)"
"((req111_0) req_0)"
"((ns112_0) ns_0)"
"((temp113_0) 0)"
"((temp114_0) 0))"
"(let-values(((who112_0) 'namespace-require/copy)"
"((req113_0) req_0)"
"((ns114_0) ns_0)"
"((temp115_0) 0)"
"((temp116_0) 0))"
"(do-namespace-require21.1"
" #f"
" temp113_0"
" temp115_0"
" #t"
" temp114_0"
" temp116_0"
" #f"
" who110_0"
" req111_0"
" ns112_0)))))))))))"
" who112_0"
" req113_0"
" ns114_0)))))))))))"
"(case-lambda"
"((req_0)(begin 'namespace-require/copy(namespace-require/copy38_0 req_0 unsafe-undefined)))"
"((req_0 ns36_0)(namespace-require/copy38_0 req_0 ns36_0)))))"
@ -48508,23 +48533,23 @@ static const char *startup_source =
" extra-inspector_0"
" protected?_0)"
"(if b_0"
"(let-values(((b116_0) b_0)"
"((empty-env117_0)"
"(let-values(((b118_0) b_0)"
"((empty-env119_0)"
" empty-env)"
"((null118_0) null)"
"((ns119_0) ns_0)"
"((temp120_0)"
"((null120_0) null)"
"((ns121_0) ns_0)"
"((temp122_0)"
"(namespace-phase ns_0))"
"((id121_0) id_0))"
"((id123_0) id_0))"
"(binding-lookup52.1"
" #f"
" #f"
" b116_0"
" empty-env117_0"
" null118_0"
" ns119_0"
" temp120_0"
" id121_0))"
" b118_0"
" empty-env119_0"
" null120_0"
" ns121_0"
" temp122_0"
" id123_0))"
"(values variable #f #f #f))))"
"(begin"
"(if(variable? v_0)"
@ -48620,11 +48645,11 @@ static const char *startup_source =
" sym_0)"
"(values))))"
"(let-values(((id_0)(1/datum->syntax #f sym_0)))"
"(let-values(((temp123_0)(1/namespace-syntax-introduce id_0 ns_0))"
"((temp124_0)"
"(let-values(((temp126_0)(namespace-mpi ns_0))"
"((temp127_0)(namespace-phase ns_0))"
"((sym128_0) sym_0))"
"(let-values(((temp125_0)(1/namespace-syntax-introduce id_0 ns_0))"
"((temp126_0)"
"(let-values(((temp128_0)(namespace-mpi ns_0))"
"((temp129_0)(namespace-phase ns_0))"
"((sym130_0) sym_0))"
"(make-module-binding20.1"
" #f"
" null"
@ -48634,11 +48659,11 @@ static const char *startup_source =
" unsafe-undefined"
" 0"
" unsafe-undefined"
" temp126_0"
" temp127_0"
" sym128_0)))"
"((temp125_0)(namespace-phase ns_0)))"
"(add-binding!17.1 #f #f temp123_0 temp124_0 temp125_0)))))"
" temp128_0"
" temp129_0"
" sym130_0)))"
"((temp127_0)(namespace-phase ns_0)))"
"(add-binding!17.1 #f #f temp125_0 temp126_0 temp127_0)))))"
"(void)))))))))))))))"
"(case-lambda"
"((sym_0 val_0)"