repair reference to "dummy" top level
The demodularizer used to include multiple dummy toplevels from every module that needed one, which didn't work with the unresolver. That change makes it so all references to dummy toplevels point to the same one.
This commit is contained in:
parent
92e9ac99f5
commit
08a40b5998
|
@ -25,6 +25,9 @@
|
||||||
(log-debug (format "total toplevels ~S" total-tls))
|
(log-debug (format "total toplevels ~S" total-tls))
|
||||||
(log-debug (format "total stxs ~S" total-stxs))
|
(log-debug (format "total stxs ~S" total-stxs))
|
||||||
(log-debug (format "num-lifts ~S" total-lifts))
|
(log-debug (format "num-lifts ~S" total-lifts))
|
||||||
|
(for ([i (in-naturals)]
|
||||||
|
[p (in-list (prefix-toplevels new-prefix))])
|
||||||
|
(log-debug (format "new-prefix tls\t~v ~v" i p)))
|
||||||
(make-compilation-top
|
(make-compilation-top
|
||||||
new-max-let-depth new-prefix
|
new-max-let-depth new-prefix
|
||||||
(make-splice (gen-new-forms new-prefix)))]
|
(make-splice (gen-new-forms new-prefix)))]
|
||||||
|
@ -52,15 +55,19 @@
|
||||||
[else
|
[else
|
||||||
(values max-let-depth prefix (lambda _ (list form)))]))
|
(values max-let-depth prefix (lambda _ (list form)))]))
|
||||||
|
|
||||||
|
(define (index-of v l)
|
||||||
|
(for/or ([e (in-list l)]
|
||||||
|
[i (in-naturals)]
|
||||||
|
#:when (eq? e v))
|
||||||
|
i))
|
||||||
|
|
||||||
(define (merge-prefix root-prefix mod-prefix)
|
(define (merge-prefix root-prefix mod-prefix)
|
||||||
(match root-prefix
|
(match-define (struct prefix (root-num-lifts root-toplevels root-stxs root-src-insp-desc)) root-prefix)
|
||||||
[(struct prefix (root-num-lifts root-toplevels root-stxs root-src-insp-desc))
|
(match-define (struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc)) mod-prefix)
|
||||||
(match mod-prefix
|
|
||||||
[(struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc))
|
|
||||||
(make-prefix (+ root-num-lifts mod-num-lifts)
|
(make-prefix (+ root-num-lifts mod-num-lifts)
|
||||||
(append root-toplevels mod-toplevels)
|
(append root-toplevels mod-toplevels)
|
||||||
(append root-stxs mod-stxs)
|
(append root-stxs mod-stxs)
|
||||||
root-src-insp-desc)])]))
|
root-src-insp-desc))
|
||||||
|
|
||||||
(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
|
(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
|
||||||
|
|
||||||
|
@ -82,13 +89,16 @@
|
||||||
sym pos (mpi->path* modidx) tl meta res))
|
sym pos (mpi->path* modidx) tl meta res))
|
||||||
res])]))
|
res])]))
|
||||||
|
|
||||||
(define (filter-rewritable-module-variable? toplevel-offset mod-toplevels)
|
(define (filter-rewritable-module-variable? name new-#f-idx toplevel-offset mod-toplevels)
|
||||||
(define-values
|
(define-values
|
||||||
(i new-toplevels remap)
|
(i new-toplevels remap)
|
||||||
(for/fold ([i 0]
|
(for/fold ([i 0]
|
||||||
[new-toplevels empty]
|
[new-toplevels empty]
|
||||||
[remap empty])
|
[remap empty])
|
||||||
([tl (in-list mod-toplevels)])
|
([tl (in-list mod-toplevels)]
|
||||||
|
[idx (in-naturals)])
|
||||||
|
(log-debug (format "[~S] mod-prefix tls\t~v ~v"
|
||||||
|
name idx tl))
|
||||||
(match tl
|
(match tl
|
||||||
[(and mv (struct module-variable (modidx sym pos phase constantness)))
|
[(and mv (struct module-variable (modidx sym pos phase constantness)))
|
||||||
(define rw ((current-get-modvar-rewrite) modidx))
|
(define rw ((current-get-modvar-rewrite) modidx))
|
||||||
|
@ -113,9 +123,17 @@
|
||||||
[else
|
[else
|
||||||
(error 'filter-rewritable-module-variable? "Unsupported module-rewrite: ~S" rw)])]
|
(error 'filter-rewritable-module-variable? "Unsupported module-rewrite: ~S" rw)])]
|
||||||
[tl
|
[tl
|
||||||
|
(cond
|
||||||
|
[(and new-#f-idx (not tl))
|
||||||
|
(log-debug (format "[~S] dropping a #f at ~v that would have been at ~v but is now at ~v"
|
||||||
|
name idx (+ i toplevel-offset) new-#f-idx))
|
||||||
|
(values i
|
||||||
|
new-toplevels
|
||||||
|
(list* new-#f-idx remap))]
|
||||||
|
[else
|
||||||
(values (add1 i)
|
(values (add1 i)
|
||||||
(list* tl new-toplevels)
|
(list* tl new-toplevels)
|
||||||
(list* (+ i toplevel-offset) remap))])))
|
(list* (+ i toplevel-offset) remap))])])))
|
||||||
; XXX This would be more efficient as a vector
|
; XXX This would be more efficient as a vector
|
||||||
(values (reverse new-toplevels)
|
(values (reverse new-toplevels)
|
||||||
(reverse remap)))
|
(reverse remap)))
|
||||||
|
@ -127,12 +145,18 @@
|
||||||
unexported mod-max-let-depth dummy lang-info
|
unexported mod-max-let-depth dummy lang-info
|
||||||
internal-context binding-names
|
internal-context binding-names
|
||||||
flags pre-submodules post-submodules))
|
flags pre-submodules post-submodules))
|
||||||
(define toplevel-offset (length (prefix-toplevels top-prefix)))
|
(define top-toplevels (prefix-toplevels top-prefix))
|
||||||
|
(define toplevel-offset (length top-toplevels))
|
||||||
(define topsyntax-offset (length (prefix-stxs top-prefix)))
|
(define topsyntax-offset (length (prefix-stxs top-prefix)))
|
||||||
(define lift-offset (prefix-num-lifts top-prefix))
|
(define lift-offset (prefix-num-lifts top-prefix))
|
||||||
(define mod-toplevels (prefix-toplevels mod-prefix))
|
(define mod-toplevels (prefix-toplevels mod-prefix))
|
||||||
|
(define new-#f-idx
|
||||||
|
(index-of #f top-toplevels))
|
||||||
|
(when new-#f-idx
|
||||||
|
(log-debug (format "[~S] found a #f entry in prefix already at ~v, squashing"
|
||||||
|
name new-#f-idx)))
|
||||||
(define-values (new-mod-toplevels toplevel-remap)
|
(define-values (new-mod-toplevels toplevel-remap)
|
||||||
(filter-rewritable-module-variable? toplevel-offset mod-toplevels))
|
(filter-rewritable-module-variable? name new-#f-idx toplevel-offset mod-toplevels))
|
||||||
(define num-mod-toplevels
|
(define num-mod-toplevels
|
||||||
(length toplevel-remap))
|
(length toplevel-remap))
|
||||||
(define mod-stxs
|
(define mod-stxs
|
||||||
|
@ -177,9 +201,11 @@
|
||||||
(define update
|
(define update
|
||||||
(update-toplevels
|
(update-toplevels
|
||||||
(lambda (n)
|
(lambda (n)
|
||||||
|
(define new-idx
|
||||||
(cond
|
(cond
|
||||||
[(mod-lift-start . <= . n)
|
[(mod-lift-start . <= . n)
|
||||||
; This is a lift
|
(log-debug (format "[~S] ~v is a lift"
|
||||||
|
name n))
|
||||||
(define which-lift (- n mod-lift-start))
|
(define which-lift (- n mod-lift-start))
|
||||||
(define lift-tl (+ top-lift-start lift-offset which-lift))
|
(define lift-tl (+ top-lift-start lift-offset which-lift))
|
||||||
(when (lift-tl . >= . max-toplevel)
|
(when (lift-tl . >= . max-toplevel)
|
||||||
|
@ -187,7 +213,11 @@
|
||||||
name n which-lift num-mod-toplevels mod-num-lifts lift-tl))
|
name n which-lift num-mod-toplevels mod-num-lifts lift-tl))
|
||||||
lift-tl]
|
lift-tl]
|
||||||
[else
|
[else
|
||||||
|
;; xxx maybe change this to a vector after it is made to make this efficient
|
||||||
(list-ref toplevel-remap n)]))
|
(list-ref toplevel-remap n)]))
|
||||||
|
(log-debug (format "[~S] ~v is remapped to ~v"
|
||||||
|
name n new-idx))
|
||||||
|
new-idx)
|
||||||
(lambda (n)
|
(lambda (n)
|
||||||
(+ n topsyntax-offset))
|
(+ n topsyntax-offset))
|
||||||
(prefix-syntax-start top-prefix)))
|
(prefix-syntax-start top-prefix)))
|
||||||
|
|
|
@ -18,7 +18,7 @@
|
||||||
(define idx-map (make-hash))
|
(define idx-map (make-hash))
|
||||||
(parameterize ([ZOS (make-hash)]
|
(parameterize ([ZOS (make-hash)]
|
||||||
[MODULE-IDX-MAP idx-map]
|
[MODULE-IDX-MAP idx-map]
|
||||||
[PHASE*MODULE-CACHE (make-hash)])
|
[PHASE*MODULE-CACHE (make-hasheq)])
|
||||||
(define (get-modvar-rewrite modidx)
|
(define (get-modvar-rewrite modidx)
|
||||||
(define pth (mpi->path* modidx))
|
(define pth (mpi->path* modidx))
|
||||||
(hash-ref idx-map pth
|
(hash-ref idx-map pth
|
||||||
|
|
Loading…
Reference in New Issue
Block a user