racket/pkgs/compiler-lib/compiler/demodularizer/main.rkt
2013-07-01 12:08:42 -04:00

77 lines
2.4 KiB
Racket

#lang racket/base
(require compiler/cm
compiler/zo-marshal
"alpha.rkt"
"gc-toplevels.rkt"
"merge.rkt"
"module.rkt"
"mpi.rkt"
"nodep.rkt"
"replace-modidx.rkt")
(provide current-excluded-modules
garbage-collect-toplevels-enabled
demodularize)
(define garbage-collect-toplevels-enabled (make-parameter #f))
(define logger (make-logger 'demodularizer (current-logger)))
(define (demodularize file-to-batch [output-file #f])
(parameterize ([current-logger logger])
(define-values (base name must-be-dir?) (split-path file-to-batch))
(when must-be-dir?
(error 'demodularize "Cannot run on directory: ~a" file-to-batch))
(unless (file-exists? file-to-batch)
(error 'demodularize "File does not exist: ~a" file-to-batch))
;; Compile
(log-info "Compiling module")
(parameterize ([current-namespace (make-base-empty-namespace)])
(managed-compile-zo file-to-batch))
(define merged-zo-path
(or output-file
(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)))
(define batch-gcd
(if (garbage-collect-toplevels-enabled)
(begin
(log-info "GC-ing top-levels")
(gc-toplevels batch-merge))
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))))