Exposing more values to GC by not making them toplevels

collects/compiler/demodularizer/batch.rkt

@@ -40,6 +40,7 @@ Here's the idea:
 
 (require racket/pretty
          racket/system
+         "mpi.rkt"
          "util.rkt"
          "nodep.rkt"
          "merge.rkt"
@@ -51,61 +52,62 @@ Here's the idea:
          compiler/zo-marshal
          racket/set)
 
-(define excluded-modules (make-parameter (set)))
+(define (main file-to-batch)
-(define file-to-batch
+  (define-values (base name dir?) (split-path file-to-batch))
-  (command-line #:program "batch" 
+  (when (or (eq? base #f) dir?)
-                #:multi
-                [("-e" "--exclude-modules") mod
-                                            "Exclude a module from being batched"
-                                            (excluded-modules (set-add (excluded-modules) mod))]
-                #:args (filename) filename))
-
-(define-values (base name dir?) (split-path file-to-batch))
-(when (or (eq? base #f) dir?)
     (error 'batch "Cannot run on directory"))
   
+  ;; Compile 
   
-;; Compile 
+  (log-info "Compiling module")
+  (void (system* (find-executable-path "raco") "make" file-to-batch)) 
   
-(log-info "Compiling module")
+  (define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo"))
-(void (system* (find-executable-path "raco") "make" file-to-batch)) 
   
+  ;; Transformations
+  (define path-cache (make-hash))
   
-(define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo"))
+  (log-info "Removing dependencies")
+  (define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite)
+    (parameterize ([MODULE-PATHS path-cache])
+      (nodep-file file-to-batch)))
   
-;; Transformations
+  (log-info "Merging modules")
-(log-info "Removing dependencies")
+  (define batch-merge
-(define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite)
+    (parameterize ([MODULE-PATHS path-cache])
-  (nodep-file file-to-batch (excluded-modules)))
+      (merge-compilation-top get-modvar-rewrite batch-nodep)))
   
-(log-info "Merging modules")
+  ; Not doing this for now
-(define batch-merge
+  ;(log-info "GC-ing top-levels")
-  (merge-compilation-top get-modvar-rewrite batch-nodep))
+  (define batch-gcd
-
-; Not doing this for now
-;(log-info "GC-ing top-levels")
-(define batch-gcd
     batch-merge
     #;(gc-toplevels batch-merge))
   
-(log-info "Alpha-varying top-levels")
+  (log-info "Alpha-varying top-levels")
-(define batch-alpha
+  (define batch-alpha
     (alpha-vary-ctop batch-gcd))
   
-(log-info "Replacing self-modidx")
+  (log-info "Replacing self-modidx")
-(define batch-replace-modidx
+  (define batch-replace-modidx
     (replace-modidx batch-alpha top-self-modidx))
   
-(define batch-modname
+  (define batch-modname
     (string->symbol (regexp-replace #rx"\\.zo$" (path->string merged-zo-path) "")))
-(log-info (format "Modularizing into ~a" batch-modname))
+  (log-info (format "Modularizing into ~a" batch-modname))
-(define batch-mod
+  (define batch-mod
     (wrap-in-kernel-module batch-modname batch-modname top-lang-info top-self-modidx batch-replace-modidx))
   
-(log-info "Writing merged zo")
+  (log-info "Writing merged zo")
-(void
+  (void
    (with-output-to-file 
        merged-zo-path
      (lambda ()
        (zo-marshal-to batch-mod (current-output-port)))
-   #:exists 'replace))
+     #:exists 'replace)))
+
+(command-line #:program "batch" 
+              #:multi
+              [("-e" "--exclude-modules") mod
+                                          "Exclude a module from being batched"
+                                          (current-excluded-modules (set-add (current-excluded-modules) mod))]
+              #:args (filename) (main filename))

collects/compiler/demodularizer/module.rkt

@@ -7,7 +7,6 @@
       s
       (module-path-index-join `(quote ,s) #f)))
 
-
 (define (wrap-in-kernel-module name srcname lang-info self-modidx top)
   (match top
     [(struct compilation-top (max-let-depth prefix form))

collects/compiler/demodularizer/mpi.rkt

@@ -1,4 +1,4 @@
-#lang scheme
+#lang racket
 (require syntax/modresolve)
 
 (define current-module-path (make-parameter #f))
@@ -9,10 +9,10 @@
     [else 
      (mpi->path! modidx)]))
 
-(define MODULE-PATHS (make-hash))
+(define MODULE-PATHS (make-parameter #f))
 (define (mpi->path! mpi)
   (hash-ref! 
-   MODULE-PATHS mpi 
+   (MODULE-PATHS) mpi 
    (lambda ()
      (define _pth
        (resolve-module-path-index mpi (current-module-path)))
@@ -20,11 +20,12 @@
          (simplify-path _pth #t)
          _pth))))
 (define (mpi->path* mpi)
-  (hash-ref MODULE-PATHS mpi 
+  (hash-ref (MODULE-PATHS) mpi 
             (lambda ()
               (error 'mpi->path* "Cannot locate cache of path for ~S" mpi))))
 
 (provide/contract
+ [MODULE-PATHS (parameter/c (or/c false/c hash?))]
  [current-module-path (parameter/c path-string?)]
  [mpi->path! (module-path-index? . -> . (or/c symbol? path?))]
  [mpi->path* (module-path-index? . -> . (or/c symbol? path?))])

collects/compiler/demodularizer/nodep.rkt

@@ -4,13 +4,13 @@
          "mpi.rkt"
          racket/set)
 
-(define excluded-modules (make-parameter null))
+(define current-excluded-modules (make-parameter (set)))
 
 (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)
+(define (nodep-file file-to-batch)
   (define idx-map (make-hash))
   (parameterize ([ZOS (make-hash)]
                  [MODULE-IDX-MAP idx-map]
@@ -20,7 +20,6 @@
       (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)])))
@@ -31,7 +30,7 @@
                (call-with-input-file pth zo-parse))))
 
 (define (excluded? pth)
-  (set-member? (excluded-modules) (path->string pth)))
+  (set-member? (current-excluded-modules) (path->string pth)))
 
 (define (get-nodep-module-code/index mpi phase)
   (define pth (mpi->path! mpi))
@@ -185,5 +184,6 @@
          ([modidx module-path-index?]
           [provide->toplevel (symbol? exact-nonnegative-integer? . -> . exact-nonnegative-integer?)])]
  [get-modvar-rewrite/c contract?]
- [nodep-file (-> path-string? set?
+ [current-excluded-modules (parameter/c set?)]
+ [nodep-file (-> path-string?
                  (values compilation-top? lang-info/c module-path-index? get-modvar-rewrite/c))])