expnder: fix problem with nested instantiation
A use of `local-expand` and other things in a module's phase-1 instantiation could trigger a nested attempt to instantiate a module.
This commit is contained in:
parent
0cd7cdaa1f
commit
ee4ceb7ae4
|
@ -3117,6 +3117,32 @@ case of module-leve bindings; it doesn't cover local bindings.
|
||||||
(test 0 length vals)
|
(test 0 length vals)
|
||||||
(test 1 length stxes)))
|
(test 1 length stxes)))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Check that a `local-expand`-triggered lazy instantiation does not
|
||||||
|
;; re-enter an instantiation that is already in progress
|
||||||
|
|
||||||
|
(module uses-local-expand-at-phase-1-instantiation racket/base
|
||||||
|
(require (for-syntax racket/base
|
||||||
|
(for-syntax racket/base)))
|
||||||
|
(provide (for-syntax true))
|
||||||
|
(struct Π- (X))
|
||||||
|
(begin-for-syntax
|
||||||
|
(define TY/internal+ (local-expand #'Π- 'expression null))
|
||||||
|
(define true (lambda (x) #t))))
|
||||||
|
|
||||||
|
(module imports-uses-local-expand-at-phase-1-instantiation racket/base
|
||||||
|
(require (for-syntax racket/base)
|
||||||
|
'uses-local-expand-at-phase-1-instantiation)
|
||||||
|
(provide #%module-begin)
|
||||||
|
(define-for-syntax predicate true))
|
||||||
|
|
||||||
|
(module lang-is-imports-uses-local-expand 'imports-uses-local-expand-at-phase-1-instantiation)
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
;; important that both of these are in the same top-level evaluation:
|
||||||
|
(test (void) namespace-require ''lang-is-imports-uses-local-expand)
|
||||||
|
(test #t namespace? (module->namespace ''lang-is-imports-uses-local-expand)))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -139,7 +139,7 @@
|
||||||
(struct module-instance (namespace
|
(struct module-instance (namespace
|
||||||
module ; can be #f for the module being expanded
|
module ; can be #f for the module being expanded
|
||||||
[shifted-requires #:mutable] ; computed on demand; shifted from `module-requires`
|
[shifted-requires #:mutable] ; computed on demand; shifted from `module-requires`
|
||||||
phase-level-to-state ; phase-level -> #f, 'available, or 'started
|
phase-level-to-state ; phase-level -> #f, 'available, 'trying-to-start, or 'started
|
||||||
[made-available? #:mutable] ; no #f in `phase-level-to-state`?
|
[made-available? #:mutable] ; no #f in `phase-level-to-state`?
|
||||||
[attached? #:mutable] ; whether the instance has been attached elsewhere
|
[attached? #:mutable] ; whether the instance has been attached elsewhere
|
||||||
data-box) ; for use by module implementation
|
data-box) ; for use by module implementation
|
||||||
|
@ -417,7 +417,9 @@
|
||||||
(define instance-phase (namespace-0-phase m-ns))
|
(define instance-phase (namespace-0-phase m-ns))
|
||||||
(define run-phase-level (phase- run-phase instance-phase))
|
(define run-phase-level (phase- run-phase instance-phase))
|
||||||
(unless (and (or skip-run?
|
(unless (and (or skip-run?
|
||||||
(eq? 'started (small-hash-ref (module-instance-phase-level-to-state mi) run-phase-level #f)))
|
(let ([v (small-hash-ref (module-instance-phase-level-to-state mi) run-phase-level #f)])
|
||||||
|
(or (eq? 'started v)
|
||||||
|
(eq? 'trying-to-start v))))
|
||||||
(or (not otherwise-available?)
|
(or (not otherwise-available?)
|
||||||
(module-instance-made-available? mi)))
|
(module-instance-made-available? mi)))
|
||||||
;; Something to do...
|
;; Something to do...
|
||||||
|
@ -431,6 +433,13 @@
|
||||||
(when (hash-ref seen mi #f)
|
(when (hash-ref seen mi #f)
|
||||||
(error 'require "import cycle detected during module instantiation"))
|
(error 'require "import cycle detected during module instantiation"))
|
||||||
|
|
||||||
|
(unless (or skip-run?
|
||||||
|
(eq? (small-hash-ref (module-instance-phase-level-to-state mi) run-phase-level #f) 'started))
|
||||||
|
;; In case instantiating imported modules does something that triggers
|
||||||
|
;; a force of available modules, make sure we don't try to instantiate
|
||||||
|
;; while we're in the process of instantiating:
|
||||||
|
(small-hash-set! (module-instance-phase-level-to-state mi) run-phase-level 'trying-to-start))
|
||||||
|
|
||||||
;; If we haven't shifted required mpis already, do that
|
;; If we haven't shifted required mpis already, do that
|
||||||
(unless (module-instance-shifted-requires mi)
|
(unless (module-instance-shifted-requires mi)
|
||||||
(set-module-instance-shifted-requires!
|
(set-module-instance-shifted-requires!
|
||||||
|
|
|
@ -14212,12 +14212,13 @@ static const char *startup_source =
|
||||||
"(if(if(let-values(((or-part_0) skip-run?_0))"
|
"(if(if(let-values(((or-part_0) skip-run?_0))"
|
||||||
"(if or-part_0"
|
"(if or-part_0"
|
||||||
" or-part_0"
|
" or-part_0"
|
||||||
"(eq?"
|
"(let-values(((v_0)"
|
||||||
" 'started"
|
|
||||||
"(small-hash-ref"
|
"(small-hash-ref"
|
||||||
"(module-instance-phase-level-to-state mi_0)"
|
"(module-instance-phase-level-to-state mi_0)"
|
||||||
" run-phase-level_0"
|
" run-phase-level_0"
|
||||||
" #f))))"
|
" #f)))"
|
||||||
|
"(let-values(((or-part_1)(eq? 'started v_0)))"
|
||||||
|
"(if or-part_1 or-part_1(eq? 'trying-to-start v_0))))))"
|
||||||
"(let-values(((or-part_0)(not otherwise-available?_0)))"
|
"(let-values(((or-part_0)(not otherwise-available?_0)))"
|
||||||
"(if or-part_0 or-part_0(module-instance-made-available? mi_0)))"
|
"(if or-part_0 or-part_0(module-instance-made-available? mi_0)))"
|
||||||
" #f)"
|
" #f)"
|
||||||
|
@ -14244,6 +14245,21 @@ static const char *startup_source =
|
||||||
" 'require"
|
" 'require"
|
||||||
" \"import cycle detected during module instantiation\"))"
|
" \"import cycle detected during module instantiation\"))"
|
||||||
"(void))"
|
"(void))"
|
||||||
|
"(if(let-values(((or-part_0) skip-run?_0))"
|
||||||
|
"(if or-part_0"
|
||||||
|
" or-part_0"
|
||||||
|
"(eq?"
|
||||||
|
"(small-hash-ref"
|
||||||
|
"(module-instance-phase-level-to-state mi_0)"
|
||||||
|
" run-phase-level_0"
|
||||||
|
" #f)"
|
||||||
|
" 'started)))"
|
||||||
|
"(void)"
|
||||||
|
"(let-values()"
|
||||||
|
"(small-hash-set!"
|
||||||
|
"(module-instance-phase-level-to-state mi_0)"
|
||||||
|
" run-phase-level_0"
|
||||||
|
" 'trying-to-start)))"
|
||||||
"(if(module-instance-shifted-requires mi_0)"
|
"(if(module-instance-shifted-requires mi_0)"
|
||||||
"(void)"
|
"(void)"
|
||||||
"(let-values()"
|
"(let-values()"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user