59ef254318
This commit merges changes that were developed in the "racket7" repo. See that repo (which is no longer modified) for a more fine-grained change history. The commit includes experimental support for running Racket on Chez Scheme, but that "CS" variant is not built by default.
64 lines
2.3 KiB
Racket
64 lines
2.3 KiB
Racket
#lang racket/base
|
|
(require racket/set
|
|
compiler/cm
|
|
"find.rkt"
|
|
"name.rkt"
|
|
"merge.rkt"
|
|
"gc.rkt"
|
|
"bundle.rkt"
|
|
"write.rkt")
|
|
|
|
(provide demodularize
|
|
|
|
garbage-collect-toplevels-enabled
|
|
current-excluded-modules
|
|
recompile-enabled)
|
|
|
|
(define garbage-collect-toplevels-enabled (make-parameter #f))
|
|
(define recompile-enabled (make-parameter #f))
|
|
|
|
(define logger (make-logger 'demodularizer (current-logger)))
|
|
|
|
(define (demodularize input-file [given-output-file #f])
|
|
(parameterize ([current-logger logger]
|
|
[current-excluded-modules (for/set ([path (in-set (current-excluded-modules))])
|
|
(normal-case-path (simplify-path (path->complete-path path))))])
|
|
|
|
(log-info "Compiling module")
|
|
(parameterize ([current-namespace (make-base-empty-namespace)])
|
|
(managed-compile-zo input-file))
|
|
|
|
(log-info "Finding modules")
|
|
(define-values (runs excluded-module-mpis) (find-modules input-file))
|
|
|
|
(log-info "Selecting names")
|
|
(define-values (names internals lifts imports) (select-names runs))
|
|
|
|
(log-info "Merging linklets")
|
|
(define-values (body first-internal-pos get-merge-info)
|
|
(merge-linklets runs names internals lifts imports))
|
|
|
|
(log-info "GCing definitions")
|
|
(define-values (new-body new-internals new-lifts)
|
|
(gc-definitions body internals lifts first-internal-pos
|
|
#:assume-pure? (garbage-collect-toplevels-enabled)))
|
|
|
|
(log-info "Bundling linklet")
|
|
(define bundle (wrap-bundle new-body new-internals new-lifts
|
|
excluded-module-mpis
|
|
get-merge-info))
|
|
|
|
(log-info "Writing bytecode")
|
|
(define output-file (or given-output-file
|
|
(path-add-suffix input-file #"_merged.zo")))
|
|
(write-module output-file bundle)
|
|
|
|
(when (recompile-enabled)
|
|
(log-info "Recompiling and rewriting bytecode")
|
|
(define zo (compiled-expression-recompile
|
|
(parameterize ([read-accept-compiled #t])
|
|
(call-with-input-file* output-file read))))
|
|
(call-with-output-file* output-file
|
|
#:exists 'replace
|
|
(lambda (out) (write zo out))))))
|