From 26c7625c7903b4edb74d745ff9737fc7ab1e0021 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Sat, 30 Oct 2010 09:14:58 -0600 Subject: [PATCH] Exposing more values to GC by not making them toplevels --- collects/compiler/demodularizer/batch.rkt | 116 +++++++++++---------- collects/compiler/demodularizer/module.rkt | 1 - collects/compiler/demodularizer/mpi.rkt | 9 +- collects/compiler/demodularizer/nodep.rkt | 10 +- 4 files changed, 69 insertions(+), 67 deletions(-) diff --git a/collects/compiler/demodularizer/batch.rkt b/collects/compiler/demodularizer/batch.rkt index 8bc8967d43..97ec868b12 100644 --- a/collects/compiler/demodularizer/batch.rkt +++ b/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 file-to-batch - (command-line #:program "batch" - #:multi - [("-e" "--exclude-modules") mod - "Exclude a module from being batched" - (excluded-modules (set-add (excluded-modules) mod))] - #:args (filename) filename)) +(define (main file-to-batch) + (define-values (base name dir?) (split-path file-to-batch)) + (when (or (eq? base #f) dir?) + (error 'batch "Cannot run on directory")) + + ;; Compile + + (log-info "Compiling module") + (void (system* (find-executable-path "raco") "make" file-to-batch)) + + (define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo")) + + ;; Transformations + (define path-cache (make-hash)) + + (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))) + + (log-info "Merging modules") + (define batch-merge + (parameterize ([MODULE-PATHS path-cache]) + (merge-compilation-top get-modvar-rewrite batch-nodep))) + + ; 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") + (define batch-alpha + (alpha-vary-ctop batch-gcd)) + + (log-info "Replacing self-modidx") + (define batch-replace-modidx + (replace-modidx batch-alpha top-self-modidx)) + + (define batch-modname + (string->symbol (regexp-replace #rx"\\.zo$" (path->string merged-zo-path) ""))) + (log-info (format "Modularizing into ~a" batch-modname)) + (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") + (void + (with-output-to-file + merged-zo-path + (lambda () + (zo-marshal-to batch-mod (current-output-port))) + #:exists 'replace))) -(define-values (base name dir?) (split-path file-to-batch)) -(when (or (eq? base #f) dir?) - (error 'batch "Cannot run on directory")) - - -;; Compile - -(log-info "Compiling module") -(void (system* (find-executable-path "raco") "make" file-to-batch)) - - -(define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo")) - -;; Transformations -(log-info "Removing dependencies") -(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 get-modvar-rewrite batch-nodep)) - -; 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") -(define batch-alpha - (alpha-vary-ctop batch-gcd)) - -(log-info "Replacing self-modidx") -(define batch-replace-modidx - (replace-modidx batch-alpha top-self-modidx)) - -(define batch-modname - (string->symbol (regexp-replace #rx"\\.zo$" (path->string merged-zo-path) ""))) -(log-info (format "Modularizing into ~a" batch-modname)) -(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") -(void - (with-output-to-file - merged-zo-path - (lambda () - (zo-marshal-to batch-mod (current-output-port))) - #:exists 'replace)) \ No newline at end of file +(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)) \ No newline at end of file diff --git a/collects/compiler/demodularizer/module.rkt b/collects/compiler/demodularizer/module.rkt index 74d7ccd77b..faa47c49e7 100644 --- a/collects/compiler/demodularizer/module.rkt +++ b/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)) diff --git a/collects/compiler/demodularizer/mpi.rkt b/collects/compiler/demodularizer/mpi.rkt index 135bf24ecc..3c86837115 100644 --- a/collects/compiler/demodularizer/mpi.rkt +++ b/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?))]) \ No newline at end of file diff --git a/collects/compiler/demodularizer/nodep.rkt b/collects/compiler/demodularizer/nodep.rkt index aaa98503e3..0d8c01642d 100644 --- a/collects/compiler/demodularizer/nodep.rkt +++ b/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))]) \ No newline at end of file