Exposing more values to GC by not making them toplevels
This commit is contained in:
parent
255489e0af
commit
26c7625c79
|
@ -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))
|
|
@ -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))
|
||||
|
|
|
@ -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?))])
|
|
@ -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))])
|
Loading…
Reference in New Issue
Block a user