From e33ed803d006ae48189b83952ee633a848a0bf04 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 24 Apr 2007 23:19:43 +0000 Subject: [PATCH] yet another hook for create-embedding-executable svn: r6035 --- collects/compiler/doc.txt | 11 ++++++++++- collects/compiler/embed-unit.ss | 20 +++++++++++++------- 2 files changed, 23 insertions(+), 8 deletions(-) diff --git a/collects/compiler/doc.txt b/collects/compiler/doc.txt index e291e3d2d5..bd8f37d2bf 100644 --- a/collects/compiler/doc.txt +++ b/collects/compiler/doc.txt @@ -409,7 +409,8 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_. [#:verbose? verbose?] [#:compiler compile-proc] [#: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, embedding code into the copied executable to be loaded on startup. (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 port may be redirected to the result executable when the filter 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]) diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss index 039c22efeb..855c53a180 100644 --- a/collects/compiler/embed-unit.ss +++ b/collects/compiler/embed-unit.ss @@ -337,7 +337,7 @@ ;; 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 - compiler expand-namespace) + compiler expand-namespace get-extra-imports) (let ([a (assoc filename (unbox codes))]) (if a ;; Already have this module. Make sure that library-referenced @@ -397,7 +397,8 @@ [code (let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)]) (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))) all-file-imports)] [sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) @@ -412,7 +413,8 @@ collects-dest on-extension compiler - expand-namespace)) + expand-namespace + get-extra-imports)) sub-files sub-paths) (let ([runtime-paths (parameterize ([current-namespace expand-namespace]) @@ -560,7 +562,8 @@ ;; 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. (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)] [files (map (lambda (mp) @@ -589,7 +592,8 @@ ;; loasing imports, so the list in the right order. [codes (box null)]) (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 collapsed-mps) ;; Drop elements of `codes' that just record copied libs: @@ -745,7 +749,8 @@ [compiler (lambda (expr) (parameterize ([current-namespace expand-namespace]) (compile expr)))] - [src-filter (lambda (filename) #f)]) + [src-filter (lambda (filename) #f)] + [get-extra-imports (lambda (filename code) null)]) (define keep-exe? (and launcher? (let ([m (assq 'forget-exe? aux)]) (or (not m) @@ -845,7 +850,8 @@ (file-name-from-path dest) compiler expand-namespace - src-filter))]) + src-filter + get-extra-imports))]) (let-values ([(start end) (if (and (eq? (system-type) 'macosx) (not unix-starter?))