Exposing more values to GC by not making them toplevels

This commit is contained in:
Jay McCarthy 2010-10-30 09:14:58 -06:00
parent 255489e0af
commit 26c7625c79
4 changed files with 69 additions and 67 deletions

View File

@ -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"))
(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))
;; Compile
(define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo"))
(log-info "Compiling module")
(void (system* (find-executable-path "raco") "make" file-to-batch))
;; 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)))
(define merged-zo-path (path-add-suffix file-to-batch #"_merged.zo"))
(log-info "Merging modules")
(define batch-merge
(parameterize ([MODULE-PATHS path-cache])
(merge-compilation-top get-modvar-rewrite batch-nodep)))
;; 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)))
; Not doing this for now
;(log-info "GC-ing top-levels")
(define batch-gcd
batch-merge
#;(gc-toplevels batch-merge))
(log-info "Merging modules")
(define batch-merge
(merge-compilation-top get-modvar-rewrite batch-nodep))
(log-info "Alpha-varying top-levels")
(define batch-alpha
(alpha-vary-ctop batch-gcd))
; Not doing this for now
;(log-info "GC-ing top-levels")
(define batch-gcd
batch-merge
#;(gc-toplevels batch-merge))
(log-info "Replacing self-modidx")
(define batch-replace-modidx
(replace-modidx batch-alpha top-self-modidx))
(log-info "Alpha-varying top-levels")
(define batch-alpha
(alpha-vary-ctop batch-gcd))
(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 "Replacing self-modidx")
(define batch-replace-modidx
(replace-modidx batch-alpha top-self-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 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))
(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))

View File

@ -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))

View File

@ -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?))])

View File

@ -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))])