offset calculation fix

original commit: d84b78daab

collects/compiler/demodularizer/batch.rkt

@@ -90,7 +90,8 @@ Here's the idea:
 
 (log-debug "GC-ing top-levels~n")
 (define batch-gcd
-  (gc-toplevels batch-merge))
+  batch-merge
+  #;(gc-toplevels batch-merge))
 
 (log-debug "Alpha-varying top-levels~n")
 (define batch-alpha

collects/compiler/demodularizer/gc-toplevels.rkt

@@ -134,8 +134,9 @@
        (void)]
       [(and v (not (? form?)))
        (void)]))
-  (define build-graph!** (build-form-memo build-graph!* #:void? #t))
+  (define-values (first-build-graph!** build-graph!**) 
-  (define (build-graph! lhs form) (build-graph!** form lhs))
+    (build-form-memo build-graph!* #:void? #t))
+  (define (build-graph! lhs form) (first-build-graph!** form lhs))
   build-graph!)
 
 (define (graph-dfs g start-node)
@@ -267,9 +268,9 @@
       [(and v (not (? form?)))
        v]
       ))
-  (define update
+  (define-values (first-update update)
     (build-form-memo inner-update))
-  update)
+  first-update)
 
 (provide/contract
  [gc-toplevels (compilation-top? . -> . compilation-top?)])

collects/compiler/demodularizer/merge.rkt

@@ -61,10 +61,10 @@
      (match rw
        [(struct modvar-rewrite (self-modidx provide->toplevel))
         (log-debug (format "Rewriting ~a of ~S~n" pos (mpi->path* modidx)))
-        (+ (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
+        ((hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
                      (lambda ()
                        (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx)))
-           (provide->toplevel sym pos))])]))
+         (provide->toplevel sym pos))])]))
 
 (define (filter-rewritable-module-variable? toplevel-offset mod-toplevels)
   (define-values
@@ -76,6 +76,7 @@
       (match tl
         [(and mv (struct module-variable (modidx sym pos phase)))
          (define rw (get-modvar-rewrite modidx))
+         ; 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
@@ -99,6 +100,7 @@
          (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)))
 
@@ -119,7 +121,9 @@
      (define new-mod-prefix
        (struct-copy prefix mod-prefix
                     [toplevels new-mod-toplevels]))
-     (hash-set! MODULE-TOPLEVEL-OFFSETS self-modidx toplevel-offset)
+     (hash-set! MODULE-TOPLEVEL-OFFSETS self-modidx 
+                (lambda (n)
+                  (list-ref toplevel-remap n)))
      (unless (= (length toplevel-remap)
                 (length mod-toplevels))
        (error 'merge-module "Not remapping everything: ~S ~S~n" 

collects/compiler/demodularizer/update-toplevels.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(require compiler/zo-parse
+(require compiler/zo-structs
          "util.rkt")
 
 (define (update-toplevels toplevel-updater topsyntax-updater topsyntax-new-midpt)
@@ -84,9 +84,9 @@
       [(and f (not (? form?)))
        f]
       ))
-  (define update
+  (define-values (first-update update)
     (build-form-memo inner-update))
-  update)
+  first-update)
 
 (provide/contract
  [update-toplevels 

collects/compiler/demodularizer/util.rkt

@@ -12,23 +12,46 @@
 (define (eprintf . args)
   (apply fprintf (current-error-port) args))
 
+(struct nothing ())
+
+(define-syntax-rule (eprintf* . args) (void))
+
 (define (build-form-memo inner-update #:void? [void? #f])
   (define memo (make-hasheq))
   (define (update form . args)
-    (cond
+    (eprintf* "Updating on ~a\n" form)
-      [(hash-ref memo form #f) 
+    (define fin
-       => (λ (x) x)]
+      (cond
-      [else
+        [(hash-ref memo form #f) 
-       (let ()
+         => (λ (x)
-         (define ph (make-placeholder #f))
+              (eprintf* "Found in memo table\n")
-         (hash-set! memo form ph)
+              x)]
-         (define nv (apply inner-update form args))
+        [else
-         (placeholder-set! ph nv)
+         (eprintf* "Not in memo table\n")
-         nv)]))
+         (let ()
+           (define ph (make-placeholder (nothing)))
+           (hash-set! memo form ph)
+           (define nv (nothing))
+           (dynamic-wind void
+                         (λ ()
+                           (set! nv (apply inner-update form args)))
+                         (λ ()
+                           (if (nothing? nv)
+                               (eprintf* "inner-update returned nothing (or there was an escape) on ~a\n" form)
+                               (begin
+                                 (placeholder-set! ph nv)
+                                 (hash-set! memo form nv)))))
+           nv)]))
+    (eprintf* "Updating on ~a ---->\n ~a\n" form fin)
+    fin)
   (define (first-update form . args)
+    (eprintf* "Top level update on ~a\n" form)
     (define final (apply update form args))
-    (make-reader-graph final))
+    (eprintf* "Top level update on ~a ---->\n ~a\n" form final)
-  first-update)
+    (define fin (make-reader-graph final))
+    (eprintf* "Top level update on ~a ---->\n ~a [after reader-graph]\n" form fin)
+    fin)
+  (values first-update update))
 
 (define lang-info/c
   (or/c #f (vector/c module-path? symbol? any/c)))
@@ -51,6 +74,7 @@
   (((unconstrained-domain-> any/c))
    (#:void? boolean?)
    . ->* .
-   (unconstrained-domain-> any/c))]
+   (values (unconstrained-domain-> any/c)
+           (unconstrained-domain-> any/c)))]
  [lang-info/c contract?]
  [build-compiled-path ((or/c path-string? (symbols 'relative) false/c) path-string? . -> . (or/c path-string? (symbols 'same 'up)))])

collects/compiler/zo-marshal.rkt

@@ -481,8 +481,8 @@
 (define-syntax with-type-trace
   (syntax-rules ()
     [(_ v body ...)
-     (begin body ...)
+     #;(begin body ...)
-     #;(with-continuation-mark 'zo (typeof v)
+     (with-continuation-mark 'zo (typeof v)
        (begin0 (begin body ...) (void)))]))
 
 (define (out-anything v out)
@@ -860,7 +860,8 @@
         (out-byte CPT_ESCAPE out)
         (define bstr (get-output-bytes s))
         (out-number (bytes-length bstr) out)
-        (out-bytes bstr out)])))))
+        (out-bytes bstr out)]
+       [else (error 'out-anything "~s" (current-type-trace))])))))
 
 (define-struct module-decl (content))