Saving time by only reading zos once and saving space by limiting the extent of the hash tables

original commit: 255489e0af

collects/compiler/demodularizer/batch.rkt

@@ -75,12 +75,12 @@ Here's the idea:
 
 ;; Transformations
 (log-info "Removing dependencies")
-(define-values (batch-nodep top-lang-info top-self-modidx)
+(define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite)
   (nodep-file file-to-batch (excluded-modules)))
 
 (log-info "Merging modules")
 (define batch-merge
-  (merge-compilation-top batch-nodep))
+  (merge-compilation-top get-modvar-rewrite batch-nodep))
 
 ; Not doing this for now
 ;(log-info "GC-ing top-levels")

collects/compiler/demodularizer/merge.rkt

@@ -7,22 +7,24 @@
 
 (define MODULE-TOPLEVEL-OFFSETS (make-hash))
 
-(define (merge-compilation-top top)
-  (match top
-    [(struct compilation-top (max-let-depth prefix form))
-     (define-values (new-max-let-depth new-prefix gen-new-forms)
-       (merge-form max-let-depth prefix form))
-     (define total-tls (length (prefix-toplevels new-prefix)))
-     (define total-stxs (length (prefix-stxs new-prefix)))
-     (define total-lifts (prefix-num-lifts new-prefix))
-     (log-debug (format "max-let-depth ~S to ~S" max-let-depth new-max-let-depth))
-     (log-debug (format "total toplevels ~S" total-tls))
-     (log-debug (format "total stxs ~S" total-stxs))
-     (log-debug (format "num-lifts ~S" total-lifts))
-     (make-compilation-top 
-      new-max-let-depth new-prefix 
-      (make-splice (gen-new-forms new-prefix)))]
-    [else (error 'merge "unrecognized: ~e" top)]))
+(define current-get-modvar-rewrite (make-parameter #f))
+(define (merge-compilation-top get-modvar-rewrite top)
+  (parameterize ([current-get-modvar-rewrite get-modvar-rewrite])
+    (match top
+      [(struct compilation-top (max-let-depth prefix form))
+       (define-values (new-max-let-depth new-prefix gen-new-forms)
+         (merge-form max-let-depth prefix form))
+       (define total-tls (length (prefix-toplevels new-prefix)))
+       (define total-stxs (length (prefix-stxs new-prefix)))
+       (define total-lifts (prefix-num-lifts new-prefix))
+       (log-debug (format "max-let-depth ~S to ~S" max-let-depth new-max-let-depth))
+       (log-debug (format "total toplevels ~S" total-tls))
+       (log-debug (format "total stxs ~S" total-stxs))
+       (log-debug (format "num-lifts ~S" total-lifts))
+       (make-compilation-top 
+        new-max-let-depth new-prefix 
+        (make-splice (gen-new-forms new-prefix)))]
+      [else (error 'merge "unrecognized: ~e" top)])))
 
 (define (merge-forms max-let-depth prefix forms)
   (if (empty? forms)
@@ -75,7 +77,7 @@
       ([tl (in-list mod-toplevels)])
       (match tl
         [(and mv (struct module-variable (modidx sym pos phase)))
-         (define rw (get-modvar-rewrite modidx))
+         (define rw ((current-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))
@@ -166,4 +168,6 @@
                (map update body)))]))
 
 (provide/contract
- [merge-compilation-top (compilation-top? . -> . compilation-top?)])
+ [merge-compilation-top (-> get-modvar-rewrite/c
+                            compilation-top?
+                            compilation-top?)])

collects/compiler/demodularizer/nodep.rkt

@@ -6,45 +6,53 @@
 
 (define excluded-modules (make-parameter null))
 
+(define ZOS (make-parameter #f))
+(define MODULE-IDX-MAP (make-parameter #f))
+(define PHASE*MODULE-CACHE (make-parameter #f))
+
 (define (nodep-file file-to-batch excluded)
-  (excluded-modules excluded)
-  (match (get-nodep-module-code/path file-to-batch 0)
-    [(struct @phase (_ (struct module-code (modvar-rewrite lang-info ctop))))
-     (values ctop lang-info (modvar-rewrite-modidx modvar-rewrite))]))
+  (define idx-map (make-hash))
+  (parameterize ([ZOS (make-hash)]
+                 [MODULE-IDX-MAP idx-map]
+                 [PHASE*MODULE-CACHE (make-hash)])
+    (define (get-modvar-rewrite modidx)
+      (define pth (mpi->path* modidx))
+      (hash-ref idx-map pth
+                (lambda ()
+                  (error 'get-modvar-rewrite "Cannot locate modvar rewrite for ~S" pth))))
+    (excluded-modules excluded)
+    (match (get-nodep-module-code/path file-to-batch 0)
+      [(struct @phase (_ (struct module-code (modvar-rewrite lang-info ctop))))
+       (values ctop lang-info (modvar-rewrite-modidx modvar-rewrite) get-modvar-rewrite)])))
 
 (define (path->comp-top pth)
-  (call-with-input-file pth zo-parse))
+  (hash-ref! (ZOS) pth
+             (λ ()
+               (call-with-input-file pth zo-parse))))
 
 (define (excluded? pth)
   (set-member? (excluded-modules) (path->string pth)))
 
-(define MODULE-IDX-MAP (make-hash))
 (define (get-nodep-module-code/index mpi phase)
   (define pth (mpi->path! mpi))
   (cond
     [(symbol? pth)
-     (hash-set! MODULE-IDX-MAP pth pth)
+     (hash-set! (MODULE-IDX-MAP) pth pth)
      pth]
     [(excluded? pth)
-     (hash-set! MODULE-IDX-MAP pth mpi)
+     (hash-set! (MODULE-IDX-MAP) pth mpi)
      mpi]
     [else
      (get-nodep-module-code/path pth phase)]))
-(define (get-modvar-rewrite modidx)
-  (define pth (mpi->path* modidx))
-  (hash-ref MODULE-IDX-MAP pth
-            (lambda ()
-              (error 'get-modvar-rewrite "Cannot locate modvar rewrite for ~S" pth))))
 
 (define-struct @phase (phase code))
 (define-struct modvar-rewrite (modidx provide->toplevel))
 (define-struct module-code (modvar-rewrite lang-info ctop))
 (define @phase-ctop (compose module-code-ctop @phase-code))
 
-(define PHASE*MODULE-CACHE (make-hash))
 (define (get-nodep-module-code/path pth phase)
   (define MODULE-CACHE
-    (hash-ref! PHASE*MODULE-CACHE phase make-hash))
+    (hash-ref! (PHASE*MODULE-CACHE) phase make-hash))
   (if (hash-ref MODULE-CACHE pth #f)
       #f
       (hash-ref! 
@@ -67,7 +75,7 @@
               pth
               phase)))
          (when (and phase (zero? phase))
-           (hash-set! MODULE-IDX-MAP pth modvar-rewrite))
+           (hash-set! (MODULE-IDX-MAP) pth modvar-rewrite))
          (make-@phase 
           phase
           (make-module-code modvar-rewrite lang-info ctop))))))
@@ -170,9 +178,12 @@
     [else
      (error 'extract-modules "Unknown extraction: ~S" ct)]))
 
+(define get-modvar-rewrite/c 
+  (module-path-index? . -> . (or/c symbol? modvar-rewrite? module-path-index?)))
 (provide/contract
  [struct modvar-rewrite 
          ([modidx module-path-index?]
           [provide->toplevel (symbol? exact-nonnegative-integer? . -> . exact-nonnegative-integer?)])]
- [get-modvar-rewrite (module-path-index? . -> . (or/c symbol? modvar-rewrite? module-path-index?))]
- [nodep-file (path-string? set? . -> . (values compilation-top? lang-info/c module-path-index?))])
+ [get-modvar-rewrite/c contract?]
+ [nodep-file (-> path-string? set?
+                 (values compilation-top? lang-info/c module-path-index? get-modvar-rewrite/c))])