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

14
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)])
(compile (define mod-sym (string->symbol
`(namespace-require
'',(string->symbol
(format "#%mzc:~a" (format "#%mzc:~a"
(let-values ([(base name dir?) (let-values ([(base name dir?)
(split-path source-file)]) (split-path source-file)])
(path->bytes (path-replace-suffix name #"")))))))) (path->bytes (path-replace-suffix name #""))))))
(define main-sym (string->symbol (format "~a(main)" mod-sym)))
(compile
`(begin
(namespace-require '',mod-sym)
(when (module-declared? '',main-sym)
(dynamic-require '',main-sym #f)))))
#: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)

66
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,7 +384,8 @@
"" ""
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
(get-module-code just-filename
#:submodule-path submod-path #:submodule-path submod-path
"compiled" "compiled"
compiler compiler
@ -407,7 +408,7 @@
(if (and (file-exists? so) (if (and (file-exists? so)
((file-date so) . >= . (file-date zo))) ((file-date so) . >= . (file-date zo)))
'so 'so
#f))))]) #f)))))])
(cond (cond
[(extension? code) [(extension? code)
(when verbose? (when verbose?
@ -450,11 +451,19 @@
(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
(if (symbol? (module-compiled-name code))
code code
(module-compiled-name code (last (module-compiled-name code)))) (module-compiled-name code (last (module-compiled-name code))))]
[extract-submods (lambda (l)
(if (null? use-submods)
null
(for/list ([m l]
#:when (member (cadr (module-compiled-name m)) use-submods))
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 #f
null) null)
#t #t
@ -470,10 +479,8 @@
;; 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))])
;; Get code for imports: (define (get-one-code sub-filename sub-path ready-code)
(for-each (lambda (sub-filename sub-path) (get-code sub-filename sub-path ready-code null
(get-code sub-filename
sub-path
codes codes
prefixes prefixes
verbose? verbose?
@ -483,6 +490,16 @@
expand-namespace expand-namespace
get-extra-imports get-extra-imports
working)) 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:
(for-each (lambda (sf sp) (get-one-code sf sp #f))
(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,7 +530,8 @@
(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
(map (lambda (sub-i sub-filename sub-path)
(and (not (and collects-dest (and (not (and collects-dest
(is-lib-path? sub-path))) (is-lib-path? sub-path)))
(let-values ([(path base) (module-path-index-split sub-i)]) (let-values ([(path base) (module-path-index-split sub-i)])
@ -524,7 +542,15 @@
(when (or path2 base2) (when (or path2 base2)
(error 'embed "unexpected nested module path index"))) (error 'embed "unexpected nested module path index")))
(cons path (lookup-full-name sub-filename))))))) (cons path (lookup-full-name sub-filename)))))))
all-file-imports sub-files sub-paths)]) 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"