suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yet another hook for create-embedding-executable

Browse Source 
svn: r6035
This commit is contained in:
Matthew Flatt 2007-04-24 23:19:43 +00:00
parent c3e07c0a8c
commit e33ed803d0
2 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/compiler/doc.txt
View File

@ -409,7 +409,8 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
[#:verbose? verbose?] [#:verbose? verbose?]
[#:compiler compile-proc] [#:compiler compile-proc]
[#:expand-namespace expand-namespace] [#:expand-namespace expand-namespace]
[#:src-filter src-filter-proc]) [#:src-filter src-filter-proc]
[#:get-extra-imports extra-imports-proc])
- Copies the MzScheme (if `mred?' is #f) or MrEd (otherwise) binary, - Copies the MzScheme (if `mred?' is #f) or MrEd (otherwise) binary,
embedding code into the copied executable to be loaded on startup. embedding code into the copied executable to be loaded on startup.
(Under Unix, the binary is actually a wrapper executable that execs (Under Unix, the binary is actually a wrapper executable that execs
@ -608,6 +609,14 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
default returns #f for all paths. Beware that the current output default returns #f for all paths. Beware that the current output
port may be redirected to the result executable when the filter port may be redirected to the result executable when the filter
procedure is called. procedure is called.
The `extra-imports-proc' takes a source pathname and compiled
module for each module to be included in the executable. It returns
a list of module path indices for extra modules to be included in
the executable (in addition to the modules that the source module
requires). For example, these modules might correspond to reader
extensions needed to parse a module that will be included as
source.
> (make-embedding-executable dest mred? verbose? mod-list literal-file-list literal-sexpr cmdline-list [aux launcher? variant]) > (make-embedding-executable dest mred? verbose? mod-list literal-file-list literal-sexpr cmdline-list [aux launcher? variant])

20
collects/compiler/embed-unit.ss
View File

@ -337,7 +337,7 @@
;; Loads module code, using .zo if there, compiling from .scm if not ;; Loads module code, using .zo if there, compiling from .scm if not
(define (get-code filename module-path codes prefixes verbose? collects-dest on-extension (define (get-code filename module-path codes prefixes verbose? collects-dest on-extension
compiler expand-namespace) compiler expand-namespace get-extra-imports)
(let ([a (assoc filename (unbox codes))]) (let ([a (assoc filename (unbox codes))])
(if a (if a
;; Already have this module. Make sure that library-referenced ;; Already have this module. Make sure that library-referenced
@ -397,7 +397,8 @@
[code [code
(let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)]) (let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)])
(let ([all-file-imports (filter (lambda (x) (not (symbol? x))) (let ([all-file-imports (filter (lambda (x) (not (symbol? x)))
(append imports fs-imports ft-imports))]) (append imports fs-imports ft-imports
(get-extra-imports filename code)))])
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
all-file-imports)] all-file-imports)]
[sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) [sub-paths (map (lambda (i) (collapse-module-path-index i module-path))
@ -412,7 +413,8 @@
collects-dest collects-dest
on-extension on-extension
compiler compiler
expand-namespace)) expand-namespace
get-extra-imports))
sub-files sub-paths) sub-files sub-paths)
(let ([runtime-paths (let ([runtime-paths
(parameterize ([current-namespace expand-namespace]) (parameterize ([current-namespace expand-namespace])
@ -560,7 +562,8 @@
;; Write a module bundle that can be loaded with 'load' (do not embed it ;; Write a module bundle that can be loaded with 'load' (do not embed it
;; into an executable). The bundle is written to the current output port. ;; into an executable). The bundle is written to the current output port.
(define (write-module-bundle verbose? modules literal-files literal-expression collects-dest (define (write-module-bundle verbose? modules literal-files literal-expression collects-dest
on-extension program-name compiler expand-namespace src-filter) on-extension program-name compiler expand-namespace
src-filter get-extra-imports)
(let* ([module-paths (map cadr modules)] (let* ([module-paths (map cadr modules)]
[files (map [files (map
(lambda (mp) (lambda (mp)
@ -589,7 +592,8 @@
;; loasing imports, so the list in the right order. ;; loasing imports, so the list in the right order.
[codes (box null)]) [codes (box null)])
(for-each (lambda (f mp) (get-code f mp codes prefix-mapping verbose? collects-dest (for-each (lambda (f mp) (get-code f mp codes prefix-mapping verbose? collects-dest
on-extension compiler expand-namespace)) on-extension compiler expand-namespace
get-extra-imports))
files files
collapsed-mps) collapsed-mps)
;; Drop elements of `codes' that just record copied libs: ;; Drop elements of `codes' that just record copied libs:
@ -745,7 +749,8 @@
[compiler (lambda (expr) [compiler (lambda (expr)
(parameterize ([current-namespace expand-namespace]) (parameterize ([current-namespace expand-namespace])
(compile expr)))] (compile expr)))]
[src-filter (lambda (filename) #f)]) [src-filter (lambda (filename) #f)]
[get-extra-imports (lambda (filename code) null)])
(define keep-exe? (and launcher? (define keep-exe? (and launcher?
(let ([m (assq 'forget-exe? aux)]) (let ([m (assq 'forget-exe? aux)])
(or (not m) (or (not m)
@ -845,7 +850,8 @@
(file-name-from-path dest) (file-name-from-path dest)
compiler compiler
expand-namespace expand-namespace
src-filter))]) src-filter
get-extra-imports))])
(let-values ([(start end) (let-values ([(start end)
(if (and (eq? (system-type) 'macosx) (if (and (eq? (system-type) 'macosx)
(not unix-starter?)) (not unix-starter?))