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

add src-filter to create-exembedding-executable

Browse Source 
svn: r6028
This commit is contained in:
Matthew Flatt 2007-04-24 01:18:58 +00:00
parent 93492c90b6
commit d5b1cc6baf
4 changed files with 74 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/compiler/doc.txt
View File

@ -408,7 +408,8 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
[#:launcher? launcher?]
[#:verbose? verbose?]
[#:compiler compile-proc]
[#:expand-namespace expand-namespace])
[#:expand-namespace expand-namespace]
[#:src-filter src-filter-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
@ -601,6 +602,13 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
be directed to the current locations (and, unltimately, redirected
to copies in a distribution).
The `src-filter-proc' takes a path and returns true if the
corresponding file source be included in the embedding executable
in source form (insteda of compiled form), #f otherwise. The
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.
> (make-embedding-executable dest mred? verbose? mod-list literal-file-list literal-sexpr cmdline-list [aux launcher? variant])
Old (keywordless) interface to `create-embedding-executable'.

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

@ -328,6 +328,10 @@
(let-values ([(base name dir?) (split-path p)])
(make-directory* base)
p))))
(define (file-date f)
(with-handlers ([exn:fail:filesystem? (lambda (x) -inf.0)])
(file-or-directory-modify-seconds f)))
(define-struct extension (path))
@ -365,8 +369,15 @@
"cannot use a _loader extension: ~e"
file)
(make-extension file))))
;; Prefer extensions if we're handling them:
(not on-extension))]
#:choose
;; Prefer extensions, if we're handling them:
(lambda (src zo so)
(if on-extension
#f
(if (and (file-exists? so)
((file-date so) . >= . (file-date zo)))
'so
#f))))]
[name (let-values ([(base name dir?) (split-path filename)])
(path->string (path-replace-suffix name #"")))]
[prefix (let ([a (assoc filename prefixes)])
@ -549,7 +560,7 @@
;; 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)
on-extension program-name compiler expand-namespace src-filter)
(let* ([module-paths (map cadr modules)]
[files (map
(lambda (mp)
@ -676,7 +687,11 @@
(when verbose?
(fprintf (current-error-port) "Writing module from ~s~n" (mod-file nc)))
(write `(current-module-name-prefix ',(string->symbol (mod-prefix nc))))
(write (mod-code nc))))
(if (src-filter (mod-file nc))
(with-input-from-file (mod-file nc)
(lambda ()
(copy-port (current-input-port) (current-output-port))))
(write (mod-code nc)))))
l))
(write '(current-module-name-prefix #f))
(newline)
@ -729,7 +744,8 @@
[expand-namespace (current-namespace)]
[compiler (lambda (expr)
(parameterize ([current-namespace expand-namespace])
(compile expr)))])
(compile expr)))]
[src-filter (lambda (filename) #f)])
(define keep-exe? (and launcher?
(let ([m (assq 'forget-exe? aux)])
(or (not m)
@ -828,7 +844,8 @@
on-extension
(file-name-from-path dest)
compiler
expand-namespace))])
expand-namespace
src-filter))])
(let-values ([(start end)
(if (and (eq? (system-type) 'macosx)
(not unix-starter?))

35
collects/syntax/doc.txt
View File

@ -323,7 +323,8 @@ _modread.ss_: reading module source code
_modcode.ss_: getting module compiled code
======================================================================
> (get-module-code path [compiled-subdir compile-proc ext-proc prefer-ext?]) -
> (get-module-code path [compiled-subdir compile-proc ext-proc]
[#:choose choose-proc]) -
returns a compiled expression for the declaration of the module
specified by `module-path-v'. The `module-path-v' argument is a
quoted module path, as for MzScheme's `dynamic-require' using the
@ -337,21 +338,29 @@ _modcode.ss_: getting module compiled code
available.
The `ext-proc' argument defaults to #f. If it is not #f, it must be
a procedure of two arguments that is used when `path' does not exist
and no ".zo" version of `path' can be found, but an extension
implementing `path' is found. In that case, the arguments to
a procedure of two arguments that is called when a native-code
version of `path' is should be used. In that case, the arguments to
`ext-proc' are the path for the extension, and a boolean indicating
whether the extension is a _loader file (#t) or not (#f).
If a ".zo" version of `path' is available and newer than var `path'
(in one of the directories specified by `compiled-subdir'), then it
is used instead of the source. Native-code versions of `path' are
ignored --- unless only a native-code version exists (i.e., `path'
itself does not exist), or `prefer-ext?' is true and the native-code
file is not a _loader variant. If a native-code version is prefer or
is the only file that exists, it is supplied to `ext-proc' when
`ext-proc' is #f, or an exception is raised (to report that an
extension file cannot be used) when `ext-proc' is #f.
The `choose-proc' argument is a procedure that takes three paths: a
source path, a .zo file path, and an extension path (for a
non-_loader extension). Some of the paths may not exist. The result
should be either 'src, 'zo, 'so, or #f, indicating which variant
should be used or (in the case of #f) that the default choice should
be used.
The default choice is computed as follows: if a ".zo" version of
`path' is available and newer than `path' itself (in one of the
directories specified by `compiled-subdir'), then it is used instead
of the source. Native-code versions of `path' are ignored, unless
only a native-code non_loader version exists (i.e., `path' itself
does not exist). A _loader extension is selected a last resort.
If an extension is prefered or is the only file that exists, it is
supplied to `ext-proc' when `ext-proc' is #f, or an exception is
raised (to report that an extension file cannot be used) when
`ext-proc' is #f.
> moddep-current-open-input-file

27
collects/syntax/modcode.ss
View File

@ -9,7 +9,10 @@
exn:get-module-code
exn:get-module-code?
exn:get-module-code-path
make-exn:get-module-code)
make-exn:get-module-code
get-module-code)
#;
;; Contracts don't yet play well with keyword arguments:
(provide/contract
[get-module-code ([path-string?]
[(and/c path-string? relative-path?)
@ -65,7 +68,9 @@
(define/kw (get-module-code path
#:optional
[sub-path "compiled"] [compiler compile] [extension-handler #f] [prefer-so? #f])
[sub-path "compiled"] [compiler compile] [extension-handler #f]
#:key
[choose (lambda (src zo so) #f)])
(unless (path-string? path)
(raise-type-error 'get-module-code "path or string (sans nul)" path))
(let*-values ([(path) (resolve path)]
@ -87,13 +92,19 @@
(if (path? base)
base
(current-directory))])
(t)))])
(t)))]
[prefer (choose path zo so)])
(cond
;; Use .zo, if it's new enough
[(date>=? zo path-d) (read-one zo #f)]
[(or (eq? prefer 'zo)
(and (not prefer)
(date>=? zo path-d)))
(read-one zo #f)]
;; Maybe there's an .so? Use it only if we don't prefer source.
[(and (or (not path-d) prefer-so?)
(date>=? so path-d))
[(or (eq? prefer 'so)
(and (not prefer)
(or (not path-d)
(date>=? so path-d))))
(if extension-handler
(extension-handler so #f)
(raise (make-exn:get-module-code
@ -101,7 +112,9 @@
(current-continuation-marks)
so)))]
;; Use source if it exists
[path-d (with-dir (lambda () (compiler (read-one path #t))))]
[(or (eq? prefer 'src)
path-d)
(with-dir (lambda () (compiler (read-one path #t))))]
;; Or maybe even a _loader.so?
[(and (not path-d)
(date>=? _loader-so path-d)