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.

compiler-lib/compiler/demodularizer/merge.rkt

@@ -25,6 +25,9 @@
        (log-debug (format "total toplevels ~S" total-tls))
        (log-debug (format "total stxs ~S" total-stxs))
        (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
         new-max-let-depth new-prefix
         (make-splice (gen-new-forms new-prefix)))]
@@ -32,14 +35,14 @@
 
 (define (merge-forms max-let-depth prefix forms)
   (if (empty? forms)
-    (values max-let-depth prefix (lambda _ empty))
+      (values max-let-depth prefix (lambda _ empty))
-    (let*-values ([(fmax-let-depth fprefix gen-fform) (merge-form max-let-depth prefix (first forms))]
+      (let*-values ([(fmax-let-depth fprefix gen-fform) (merge-form max-let-depth prefix (first forms))]
-                  [(rmax-let-depth rprefix gen-rforms) (merge-forms fmax-let-depth fprefix (rest forms))])
+                    [(rmax-let-depth rprefix gen-rforms) (merge-forms fmax-let-depth fprefix (rest forms))])
-      (values rmax-let-depth
+        (values rmax-let-depth
-              rprefix
+                rprefix
-              (lambda args
+                (lambda args
-                (append (apply gen-fform args)
+                  (append (apply gen-fform args)
-                        (apply gen-rforms args)))))))
+                          (apply gen-rforms args)))))))
 
 (define (merge-form max-let-depth prefix form)
   (match form
@@ -52,15 +55,19 @@
     [else
      (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)
-  (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
+  (make-prefix (+ root-num-lifts mod-num-lifts)
-       [(struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc))
+               (append root-toplevels mod-toplevels)
-        (make-prefix (+ root-num-lifts mod-num-lifts)
+               (append root-stxs mod-stxs)
-                     (append root-toplevels mod-toplevels)
+               root-src-insp-desc))
-                     (append root-stxs mod-stxs)
-                     root-src-insp-desc)])]))
 
 (struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
 
@@ -73,22 +80,25 @@
         (define tl (provide->toplevel sym pos))
         (log-debug (format "Rewriting ~a@~a of ~S to ~S" sym pos (mpi->path* modidx) tl))
         (match-define (toplevel-offset-rewriter rewrite-fun meta)
-                      (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
+          (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
-                                (lambda ()
+                    (lambda ()
-                                  (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))))
+                      (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))))
         (log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S" sym pos (mpi->path* modidx) tl meta))
         (define res (rewrite-fun tl))
         (log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S and got ~S"
                            sym pos (mpi->path* modidx) tl meta 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
     (i new-toplevels remap)
     (for/fold ([i 0]
                [new-toplevels 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
         [(and mv (struct module-variable (modidx sym pos phase constantness)))
          (define rw ((current-get-modvar-rewrite) modidx))
@@ -96,7 +106,7 @@
          (unless (or (not phase) (zero? phase))
            (error 'eliminate-module-variables "Non-zero phases not supported: ~S" mv))
          (cond
-                                        ; Primitive module like #%paramz
+           ; Primitive module like #%paramz
            [(symbol? rw)
             (log-debug (format "~S from ~S" sym rw))
             (values (add1 i)
@@ -113,10 +123,18 @@
            [else
             (error 'filter-rewritable-module-variable? "Unsupported module-rewrite: ~S" rw)])]
         [tl
-         (values (add1 i)
+         (cond
-                 (list* tl new-toplevels)
+           [(and new-#f-idx (not tl))
-                 (list* (+ i toplevel-offset) remap))])))
+            (log-debug (format "[~S] dropping a #f at ~v that would have been at ~v but is now at ~v"
-                                        ; XXX This would be more efficient as a vector
+                               name idx (+ i toplevel-offset) new-#f-idx))
+            (values i
+                    new-toplevels
+                    (list* new-#f-idx remap))]
+           [else
+            (values (add1 i)
+                    (list* tl new-toplevels)
+                    (list* (+ i toplevel-offset) remap))])])))
+  ; XXX This would be more efficient as a vector
   (values (reverse new-toplevels)
           (reverse remap)))
 
@@ -127,12 +145,18 @@
                        unexported mod-max-let-depth dummy lang-info
                        internal-context binding-names
                        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 lift-offset (prefix-num-lifts top-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)
-       (filter-rewritable-module-variable? toplevel-offset mod-toplevels))
+       (filter-rewritable-module-variable? name new-#f-idx toplevel-offset mod-toplevels))
      (define num-mod-toplevels
        (length toplevel-remap))
      (define mod-stxs
@@ -177,17 +201,23 @@
                (define update
                  (update-toplevels
                   (lambda (n)
-                    (cond
+                    (define new-idx
-                      [(mod-lift-start . <= . n)
+                      (cond
-                                        ; This is a lift
+                        [(mod-lift-start . <= . n)
-                       (define which-lift (- n mod-lift-start))
+                         (log-debug (format "[~S] ~v is a lift"
-                       (define lift-tl (+ top-lift-start lift-offset which-lift))
+                                            name n))
-                       (when (lift-tl . >= . max-toplevel)
+                         (define which-lift (- n mod-lift-start))
-                         (error 'merge-module "[~S] lift error: orig(~a) which(~a) max(~a) lifts(~a) now(~a)"
+                         (define lift-tl (+ top-lift-start lift-offset which-lift))
-                                name n which-lift num-mod-toplevels mod-num-lifts lift-tl))
+                         (when (lift-tl . >= . max-toplevel)
-                       lift-tl]
+                           (error 'merge-module "[~S] lift error: orig(~a) which(~a) max(~a) lifts(~a) now(~a)"
-                      [else
+                                  name n which-lift num-mod-toplevels mod-num-lifts lift-tl))
-                       (list-ref toplevel-remap n)]))
+                         lift-tl]
+                        [else
+                         ;; xxx maybe change this to a vector after it is made to make this efficient
+                         (list-ref toplevel-remap n)]))
+                    (log-debug (format "[~S] ~v is remapped to ~v"
+                                       name n new-idx))
+                    new-idx)
                   (lambda (n)
                     (+ n topsyntax-offset))
                   (prefix-syntax-start top-prefix)))

compiler-lib/compiler/demodularizer/nodep.rkt

@@ -18,7 +18,7 @@
   (define idx-map (make-hash))
   (parameterize ([ZOS (make-hash)]
                  [MODULE-IDX-MAP idx-map]
-                 [PHASE*MODULE-CACHE (make-hash)])
+                 [PHASE*MODULE-CACHE (make-hasheq)])
     (define (get-modvar-rewrite modidx)
       (define pth (mpi->path* modidx))
       (hash-ref idx-map pth