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

raco exe' uses a main' submodule, if any

Browse Source
This commit is contained in:
Matthew Flatt 2012-03-09 10:22:50 -07:00
parent 6743900fc7
commit 85802f45f2
7 changed files with 161 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/compiler/commands/exe.rkt
View File

@ -89,19 +89,23 @@
#:mred? (gui) #:mred? (gui)
#:variant (if (3m) '3m 'cgc) #:variant (if (3m) '3m 'cgc)
#:verbose? (very-verbose) #:verbose? (very-verbose)
#:modules (cons `(#%mzc: (file ,source-file)) #:modules (cons `(#%mzc: (file ,source-file) (main))
(map (lambda (l) `(#t (lib ,l))) (map (lambda (l) `(#t (lib ,l)))
(exe-embedded-libraries))) (exe-embedded-libraries)))
#:configure-via-first-module? #t #:configure-via-first-module? #t
#:literal-expression #:literal-expression
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(define mod-sym (string->symbol
(format "#%mzc:~a"
(let-values ([(base name dir?)
(split-path source-file)])
(path->bytes (path-replace-suffix name #""))))))
(define main-sym (string->symbol (format "~a(main)" mod-sym)))
(compile (compile
`(namespace-require `(begin
'',(string->symbol (namespace-require '',mod-sym)
(format "#%mzc:~a" (when (module-declared? '',main-sym)
(let-values ([(base name dir?) (dynamic-require '',main-sym #f)))))
(split-path source-file)])
(path->bytes (path-replace-suffix name #""))))))))
#:cmdline (exe-embedded-flags) #:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path) #:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest) #:collects-dest (exe-embedded-collects-dest)

162
collects/compiler/embed-unit.rkt
View File

@ -339,7 +339,7 @@
(define-struct extension (path)) (define-struct extension (path))
;; 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 ready-code use-submods codes prefixes verbose? collects-dest on-extension
compiler expand-namespace get-extra-imports working) compiler expand-namespace get-extra-imports working)
;; filename can have the form `(submod ,filename ,sym ...) ;; filename can have the form `(submod ,filename ,sym ...)
(let ([a (assoc filename (unbox codes))]) (let ([a (assoc filename (unbox codes))])
@ -384,30 +384,31 @@
"" ""
submod-path)))]) submod-path)))])
(hash-set! working filename full-name) (hash-set! working filename full-name)
(let ([code (get-module-code just-filename (let ([code (or ready-code
#:submodule-path submod-path (get-module-code just-filename
"compiled" #:submodule-path submod-path
compiler "compiled"
(if on-extension compiler
(lambda (f l?) (if on-extension
(on-extension f l?) (lambda (f l?)
#f) (on-extension f l?)
(lambda (file _loader?) #f)
(if _loader? (lambda (file _loader?)
(error 'create-embedding-executable (if _loader?
"cannot use a _loader extension: ~e" (error 'create-embedding-executable
file) "cannot use a _loader extension: ~e"
(make-extension file)))) file)
#:choose (make-extension file))))
;; Prefer extensions, if we're handling them: #:choose
(lambda (src zo so) ;; Prefer extensions, if we're handling them:
(set! actual-filename src) ; remember convert source name (lambda (src zo so)
(if on-extension (set! actual-filename src) ; remember convert source name
#f (if on-extension
(if (and (file-exists? so) #f
((file-date so) . >= . (file-date zo))) (if (and (file-exists? so)
'so ((file-date so) . >= . (file-date zo)))
#f))))]) 'so
#f)))))])
(cond (cond
[(extension? code) [(extension? code)
(when verbose? (when verbose?
@ -450,15 +451,23 @@
(eq? (car p) 'module) (eq? (car p) 'module)
(cadr p))) (cadr p)))
runtime-paths))] runtime-paths))]
[code (module-compiled-submodules [renamed-code (if (symbol? (module-compiled-name code))
(module-compiled-submodules code
(if (symbol? (module-compiled-name code)) (module-compiled-name code (last (module-compiled-name code))))]
code [extract-submods (lambda (l)
(module-compiled-name code (last (module-compiled-name code)))) (if (null? use-submods)
#f null
null) (for/list ([m l]
#t #:when (member (cadr (module-compiled-name m)) use-submods))
null)]) m)))]
[pre-submods (extract-submods (module-compiled-submodules renamed-code #t))]
[post-submods (extract-submods (module-compiled-submodules renamed-code #f))]
[code (module-compiled-submodules (module-compiled-submodules
renamed-code
#f
null)
#t
null)])
(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))
@ -470,19 +479,27 @@
;; getting runtime-module-path symbols below ;; getting runtime-module-path symbols below
;; relies on extra-runtime-paths being first: ;; relies on extra-runtime-paths being first:
(append extra-runtime-paths extra-paths))]) (append extra-runtime-paths extra-paths))])
(define (get-one-code sub-filename sub-path ready-code)
(get-code sub-filename sub-path ready-code null
codes
prefixes
verbose?
collects-dest
on-extension
compiler
expand-namespace
get-extra-imports
working))
(define (get-one-submodule-code m)
(define name (cadr (module-compiled-name m)))
(define mpi (module-path-index-join `(submod "." ,name) #f))
(get-one-code (resolve-module-path-index mpi filename)
(collapse-module-path-index mpi filename)
m))
;; Add code for pre submodules:
(for-each get-one-submodule-code pre-submods)
;; Get code for imports: ;; Get code for imports:
(for-each (lambda (sub-filename sub-path) (for-each (lambda (sf sp) (get-one-code sf sp #f))
(get-code sub-filename
sub-path
codes
prefixes
verbose?
collects-dest
on-extension
compiler
expand-namespace
get-extra-imports
working))
(append sub-files extra-files) (append sub-files extra-files)
(append sub-paths normalized-extra-paths)) (append sub-paths normalized-extra-paths))
(when verbose? (when verbose?
@ -513,18 +530,27 @@
(mod-full-name m) (mod-full-name m)
;; must have been a cycle... ;; must have been a cycle...
(hash-ref working sub-filename))))] (hash-ref working sub-filename))))]
[mappings (map (lambda (sub-i sub-filename sub-path) [mappings (append
(and (not (and collects-dest (map (lambda (sub-i sub-filename sub-path)
(is-lib-path? sub-path))) (and (not (and collects-dest
(let-values ([(path base) (module-path-index-split sub-i)]) (is-lib-path? sub-path)))
(and base ; can be #f if path isn't relative (let-values ([(path base) (module-path-index-split sub-i)])
(begin (and base ; can be #f if path isn't relative
;; Assert: base should refer to this module: (begin
(let-values ([(path2 base2) (module-path-index-split base)]) ;; Assert: base should refer to this module:
(when (or path2 base2) (let-values ([(path2 base2) (module-path-index-split base)])
(error 'embed "unexpected nested module path index"))) (when (or path2 base2)
(cons path (lookup-full-name sub-filename))))))) (error 'embed "unexpected nested module path index")))
all-file-imports sub-files sub-paths)]) (cons path (lookup-full-name sub-filename)))))))
all-file-imports sub-files sub-paths)
(map (lambda (m)
(define name (cadr (module-compiled-name m)))
(cons `(submod "." ,name)
(lookup-full-name
(collapse-module-path-index
(module-path-index-join `(submod "." ,name) #f)
filename))))
(append pre-submods post-submods)))])
;; Record the module ;; Record the module
(set-box! codes (set-box! codes
(cons (make-mod filename module-path code (cons (make-mod filename module-path code
@ -545,7 +571,9 @@
[else [else
(cons #f (loop (cdr runtime-paths) extra-files))])) (cons #f (loop (cdr runtime-paths) extra-files))]))
actual-filename) actual-filename)
(unbox codes)))))))))] (unbox codes)))
;; Add code for post submodules:
(for-each get-one-submodule-code post-submods)))))))]
[else [else
(set-box! codes (set-box! codes
(cons (make-mod filename module-path code (cons (make-mod filename module-path code
@ -829,6 +857,7 @@
(path->bytes program-name) (path->bytes program-name)
#"?")] #"?")]
[module-paths (map cadr modules)] [module-paths (map cadr modules)]
[use-submoduless (map (lambda (m) (if (pair? (cddr m)) (caddr m) '())) modules)]
[resolve-one-path (lambda (mp) [resolve-one-path (lambda (mp)
(let ([f (resolve-module-path mp #f)]) (let ([f (resolve-module-path mp #f)])
(unless f (unless f
@ -853,14 +882,14 @@
;; As we descend the module tree, we append to the front after ;; As we descend the module tree, we append to the front after
;; loading imports, so the list in the right order. ;; loading imports, so the list in the right order.
[codes (box null)] [codes (box null)]
[get-code-at (lambda (f mp) [get-code-at (lambda (f mp submods)
(get-code f mp codes prefix-mapping verbose? collects-dest (get-code f mp #f submods codes prefix-mapping verbose? collects-dest
on-extension compiler expand-namespace on-extension compiler expand-namespace
get-extra-imports get-extra-imports
(make-hash)))] (make-hash)))]
[__ [__
;; Load all code: ;; Load all code:
(for-each get-code-at files collapsed-mps)] (for-each get-code-at files collapsed-mps use-submoduless)]
[config-infos (if config? [config-infos (if config?
(let ([a (assoc (car files) (unbox codes))]) (let ([a (assoc (car files) (unbox codes))])
(let ([info (module-compiled-language-info (mod-code a))]) (let ([info (module-compiled-language-info (mod-code a))])
@ -874,7 +903,8 @@
(for ([config-info (in-list config-infos)]) (for ([config-info (in-list config-infos)])
(let ([mp (vector-ref config-info 0)]) (let ([mp (vector-ref config-info 0)])
(get-code-at (resolve-one-path mp) (get-code-at (resolve-one-path mp)
(collapse-one mp))))) (collapse-one mp)
null))))
;; Drop elements of `codes' that just record copied libs: ;; Drop elements of `codes' that just record copied libs:
(set-box! codes (filter mod-code (unbox codes))) (set-box! codes (filter mod-code (unbox codes)))
;; Bind `module' to get started: ;; Bind `module' to get started:

13
collects/compiler/embed.rkt
View File

@ -13,7 +13,11 @@
(->* (path-string? (->* (path-string?
any/c any/c
any/c any/c
(listof (list/c (or/c boolean? symbol?) any/c)) (listof (or/c (list/c (or/c symbol? #f #t)
(or/c path? module-path?))
(list/c (or/c symbol? #f #t)
(or/c path? module-path?)
(listof symbol?))))
(listof path-string?) (listof path-string?)
any/c any/c
(listof string?)) (listof string?))
@ -27,8 +31,11 @@
[create-embedding-executable [create-embedding-executable
(->* (path-string?) (->* (path-string?)
(#:modules (#:modules
(listof (list/c (or/c symbol? #f #t) (listof (or/c (list/c (or/c symbol? #f #t)
(or/c path? module-path?))) (or/c path? module-path?))
(list/c (or/c symbol? #f #t)
(or/c path? module-path?)
(listof symbol?))))
#:configure-via-first-module? any/c #:configure-via-first-module? any/c
#:literal-files (listof path-string?) #:literal-files (listof path-string?)
#:literal-expression any/c #:literal-expression any/c

38
collects/scribblings/raco/exe-api.scrbl
View File

@ -43,9 +43,11 @@ parameter is true.
@defproc[(create-embedding-executable [dest path-string?] @defproc[(create-embedding-executable [dest path-string?]
[#:modules mod-list [#:modules mod-list
(listof (list/c (or/c symbol? #t #f) (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
(or/c path? module-path?))) (or/c module-path? path?))
null] (list/c (or/c symbol? (one-of/c #t #f))
(or/c module-path? path?)
(listof symbol?))))]
[#:configure-via-first-module? config-via-first? [#:configure-via-first-module? config-via-first?
any/c any/c
#f] #f]
@ -140,17 +142,21 @@ evaluates an expression or loads a file will be executed after the
embedded code is loaded. embedded code is loaded.
Each element of the @racket[#:modules] argument @racket[mod-list] is a Each element of the @racket[#:modules] argument @racket[mod-list] is a
two-item list, where the first item is a prefix for the module name, two- or three-item list, where the first item is a prefix for the
and the second item is a module path datum (that's in the format module name, and the second item is a module path datum (that's in the
understood by the default module name resolver). The prefix can be a format understood by the default module name resolver), and the third
symbol, @racket[#f] to indicate no prefix, or @racket[#t] to indicate is a list of submodule names to be included if they are available. The
an auto-generated prefix. For example, prefix can be a symbol, @racket[#f] to indicate no prefix, or
@racket[#t] to indicate an auto-generated prefix. For example,
@racketblock['((#f "m.rkt"))] @racketblock['((#f "m.rkt"))]
embeds the module @racket[m] from the file @filepath{m.rkt}, without embeds the module @racket[m] from the file @filepath{m.rkt}, without
prefixing the name of the module; the @racket[literal-sexpr] argument prefixing the name of the module; the @racket[literal-sexpr] argument
to go with the above might be @racket['(require m)]. to go with the above might be @racket['(require m)]. When submodules
are available and included, the submodule is given a name by
symbol-appending the @racket[write] form of submodule path to the
enclosing module's name.
Modules are normally compiled before they are embedded into the target Modules are normally compiled before they are embedded into the target
executable; see also @racket[#:compiler] and @racket[#:src-filter] executable; see also @racket[#:compiler] and @racket[#:src-filter]
@ -348,8 +354,11 @@ have been applied as needed to refer to the existing file).}
@defproc[(make-embedding-executable [dest path-string?] @defproc[(make-embedding-executable [dest path-string?]
[mred? any/c] [mred? any/c]
[verbose? any/c] [verbose? any/c]
[mod-list (listof (list/c (or/c symbol? (one-of/c #t #f)) [mod-list (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
module-path?))] (or/c module-path? path?))
(list/c (or/c symbol? (one-of/c #t #f))
(or/c module-path? path?)
(listof symbol?))))]
[literal-files (listof path-string?)] [literal-files (listof path-string?)]
[literal-sexp any/c] [literal-sexp any/c]
[cmdline (listof string?)] [cmdline (listof string?)]
@ -366,8 +375,11 @@ Old (keywordless) interface to @racket[create-embedding-executable].}
@defproc[(write-module-bundle [verbose? any/c] @defproc[(write-module-bundle [verbose? any/c]
[mod-list (listof (list/c (or/c symbol? (one-of/c #t #f)) [mod-list (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
module-path?))] (or/c module-path? path?))
(list/c (or/c symbol? (one-of/c #t #f))
(or/c module-path? path?)
(listof symbol?))))]
[literal-files (listof path-string?)] [literal-files (listof path-string?)]
[literal-sexp any/c]) [literal-sexp any/c])
void?]{ void?]{

6
collects/tests/racket/embed-me15.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require (submod "embed-me15-one.rkt" one)) (require (submod "embed-me15-one.rkt" one))
(printf "This is ~a.\n" (+ 9 one two three)) (with-output-to-file "stdout"
(lambda () (printf "This is ~a.\n" (+ 9 one two three)))
#:exists 'append)

7
collects/tests/racket/embed-me16.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
;; a `main' submodule:
(module main racket/base
(with-output-to-file "stdout"
(lambda () (printf "This is 16.\n"))
#:exists 'append))

10
collects/tests/racket/embed.rktl
View File

@ -223,7 +223,7 @@
(one-mz-test "embed-me2.rkt" "This is 1\nThis is 2: #t\n" #t) (one-mz-test "embed-me2.rkt" "This is 1\nThis is 2: #t\n" #t)
(one-mz-test "embed-me13.rkt" "This is 14\n" #f) (one-mz-test "embed-me13.rkt" "This is 14\n" #f)
(one-mz-test "embed-me14.rkt" "This is 14\n" #f) (one-mz-test "embed-me14.rkt" "This is 14\n" #f)
(one-mz-test "embed-me15.rkt" "This is 15\n" #f) (one-mz-test "embed-me15.rkt" "This is 15.\n" #f)
;; Try unicode expr and cmdline: ;; Try unicode expr and cmdline:
(prepare dest "unicode") (prepare dest "unicode")
@ -277,6 +277,14 @@
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt"))) (path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
(try-exe (mk-dest mred?) "This is 1\n" mred?) (try-exe (mk-dest mred?) "This is 1\n" mred?)
;; raco exe on a module with a `main' submodule
(system* raco
"exe"
"-o" (path->string (mk-dest mred?))
(if mred? "--gui" "--")
(path->string (build-path (collection-path "tests" "racket") "embed-me16.rkt")))
(try-exe (mk-dest mred?) "This is 16.\n" mred?)
;;raco exe --launcher ;;raco exe --launcher
(system* raco (system* raco
"exe" "exe"