Base now works, but was broken before

pkgs/compiler-lib/compiler/demodularizer/merge.rkt

@@ -9,7 +9,7 @@
          "nodep.rkt"
          "update-toplevels.rkt")
 
-(define MODULE-TOPLEVEL-OFFSETS (make-hash))
+(define MODULE-TOPLEVEL-OFFSETS (make-hasheq))
 
 (define current-get-modvar-rewrite (make-parameter #f))
 (define (merge-compilation-top get-modvar-rewrite top)
@@ -32,14 +32,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
@@ -61,16 +61,20 @@
                      (append root-toplevels mod-toplevels)
                      (append root-stxs mod-stxs))])]))
 
+(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
+
 (define (compute-new-modvar mv rw)
   (match mv
     [(struct module-variable (modidx sym pos phase constantness))
      (match rw
        [(struct modvar-rewrite (self-modidx provide->toplevel))
         (log-debug (format "Rewriting ~a of ~S" pos (mpi->path* modidx)))
-        ((hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
+        (match-define (toplevel-offset-rewriter rewrite-fun meta)
-                     (lambda ()
+                      (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
-                       (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx)))
+                                (lambda ()
-         (provide->toplevel sym pos))])]))
+                                  (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))))
+        (log-debug (format "Rewriting ~a of ~S from ~S" pos (mpi->path* modidx) meta))
+        (rewrite-fun (provide->toplevel sym pos))])]))
 
 (define (filter-rewritable-module-variable? toplevel-offset mod-toplevels)
   (define-values
@@ -78,15 +82,15 @@
     (for/fold ([i 0]
                [new-toplevels empty]
                [remap empty])
-      ([tl (in-list mod-toplevels)])
+        ([tl (in-list mod-toplevels)])
       (match tl
         [(and mv (struct module-variable (modidx sym pos phase constantness)))
          (define rw ((current-get-modvar-rewrite) modidx))
-         ; XXX We probably don't need to deal with #f phase
+                                        ; XXX We probably don't need to deal with #f phase
          (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)
@@ -106,7 +110,7 @@
          (values (add1 i)
                  (list* tl new-toplevels)
                  (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)
           (reverse remap)))
 
@@ -119,7 +123,8 @@
      (define topsyntax-offset (length (prefix-stxs top-prefix)))
      (define lift-offset (prefix-num-lifts top-prefix))
      (define mod-toplevels (prefix-toplevels mod-prefix))
-     (define-values (new-mod-toplevels toplevel-remap) (filter-rewritable-module-variable? toplevel-offset mod-toplevels))
+     (define-values (new-mod-toplevels toplevel-remap)
+       (filter-rewritable-module-variable? toplevel-offset mod-toplevels))
      (define num-mod-toplevels
        (length toplevel-remap))
      (define mod-stxs
@@ -129,9 +134,16 @@
      (define new-mod-prefix
        (struct-copy prefix mod-prefix
                     [toplevels new-mod-toplevels]))
+     (define offset-meta (vector name srcname self-modidx))
+     (log-debug "Setting toplevel offsets rewriter for ~S and it is currently ~S"
+                offset-meta
+                (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx #f))
      (hash-set! MODULE-TOPLEVEL-OFFSETS self-modidx
-                (lambda (n)
+                (toplevel-offset-rewriter
-                  (list-ref toplevel-remap n)))
+                 (lambda (n)
+                   (log-debug "Finding offset ~a in ~S of ~S" n toplevel-remap offset-meta)
+                   (list-ref toplevel-remap n))
+                 offset-meta))
      (unless (= (length toplevel-remap)
                 (length mod-toplevels))
        (error 'merge-module "Not remapping everything: ~S ~S"
@@ -159,7 +171,7 @@
                   (lambda (n)
                     (cond
                       [(mod-lift-start . <= . n)
-                       ; This is a lift
+                                        ; This is a lift
                        (define which-lift (- n mod-lift-start))
                        (define lift-tl (+ top-lift-start lift-offset which-lift))
                        (when (lift-tl . >= . max-toplevel)

pkgs/compiler-lib/compiler/demodularizer/nodep.rkt

@@ -128,10 +128,13 @@
       (when (symbol? tl)
         (hash-set! provide-ht (intern tl) i)))  
   (lambda (sym pos)
-    (log-debug (format "Looking up ~S@~a" sym pos))
+    (log-debug (format "Looking up ~S@~a in ~S" sym pos prefix))
-    (hash-ref provide-ht (intern sym)
+    (define res
+      (hash-ref provide-ht (intern sym)
               (lambda ()
-                (error 'provide->toplevel "Cannot find ~S in ~S" sym prefix)))))
+                (error 'provide->toplevel "Cannot find ~S in ~S" sym prefix))))
+    (log-debug (format "Looked up ~S@~a and got ~v" sym pos res))
+    res))
 
 (define (nodep-module mod-form phase)
   (match mod-form

pkgs/racket-pkgs/racket-test/tests/compiler/demodularizer/demod-test.rkt

@@ -13,7 +13,7 @@
   (values (get-output-string o) (get-output-string e)))
 
 (define (test-on-program filename)
-  ; run modular program, capture output
+  ;; run modular program, capture output
   (define-values (modular-output modular-error)
     (capture-output (find-exe) filename))
   
@@ -24,15 +24,15 @@
         (find-system-path 'temp-dir)
         (path-add-suffix filename #"_merged.zo")))))
   
-  ; demodularize
+  ;; demodularize
   (parameterize ([current-input-port (open-input-string "")])
     (system* (find-exe) "-l-" "raco" "demod" "-o" demod-filename filename))
   
-  ; run whole program
+  ;; run whole program
   (define-values (whole-output whole-error)
     (capture-output (find-exe) demod-filename))
   
-  ; compare output 
+  ;; compare output 
   (test
    #:failure-prefix (format "~a stdout" filename)
    whole-output => modular-output

pkgs/racket-pkgs/racket-test/tests/compiler/demodularizer/tests/base-5.rkt

@@ -0,0 +1,2 @@
+#lang racket/base
+5