Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

`raco exe' uses a `main' submodule, if any

  • Loading branch information...
commit 85802f45f2ff1c3cf1701d30eb0899815a16e280 1 parent 6743900
@mflatt mflatt authored
View
18 collects/compiler/commands/exe.rkt
@@ -89,19 +89,23 @@
#:mred? (gui)
#:variant (if (3m) '3m 'cgc)
#:verbose? (very-verbose)
- #:modules (cons `(#%mzc: (file ,source-file))
+ #:modules (cons `(#%mzc: (file ,source-file) (main))
(map (lambda (l) `(#t (lib ,l)))
(exe-embedded-libraries)))
#:configure-via-first-module? #t
#:literal-expression
(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
- `(namespace-require
- '',(string->symbol
- (format "#%mzc:~a"
- (let-values ([(base name dir?)
- (split-path source-file)])
- (path->bytes (path-replace-suffix name #""))))))))
+ `(begin
+ (namespace-require '',mod-sym)
+ (when (module-declared? '',main-sym)
+ (dynamic-require '',main-sym #f)))))
#:cmdline (exe-embedded-flags)
#:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest)
View
162 collects/compiler/embed-unit.rkt
@@ -339,7 +339,7 @@
(define-struct extension (path))
;; 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)
;; filename can have the form `(submod ,filename ,sym ...)
(let ([a (assoc filename (unbox codes))])
@@ -384,30 +384,31 @@
""
submod-path)))])
(hash-set! working filename full-name)
- (let ([code (get-module-code just-filename
- #:submodule-path submod-path
- "compiled"
- compiler
- (if on-extension
- (lambda (f l?)
- (on-extension f l?)
- #f)
- (lambda (file _loader?)
- (if _loader?
- (error 'create-embedding-executable
- "cannot use a _loader extension: ~e"
- file)
- (make-extension file))))
- #:choose
- ;; Prefer extensions, if we're handling them:
- (lambda (src zo so)
- (set! actual-filename src) ; remember convert source name
- (if on-extension
- #f
- (if (and (file-exists? so)
- ((file-date so) . >= . (file-date zo)))
- 'so
- #f))))])
+ (let ([code (or ready-code
+ (get-module-code just-filename
+ #:submodule-path submod-path
+ "compiled"
+ compiler
+ (if on-extension
+ (lambda (f l?)
+ (on-extension f l?)
+ #f)
+ (lambda (file _loader?)
+ (if _loader?
+ (error 'create-embedding-executable
+ "cannot use a _loader extension: ~e"
+ file)
+ (make-extension file))))
+ #:choose
+ ;; Prefer extensions, if we're handling them:
+ (lambda (src zo so)
+ (set! actual-filename src) ; remember convert source name
+ (if on-extension
+ #f
+ (if (and (file-exists? so)
+ ((file-date so) . >= . (file-date zo)))
+ 'so
+ #f)))))])
(cond
[(extension? code)
(when verbose?
@@ -450,15 +451,23 @@
(eq? (car p) 'module)
(cadr p)))
runtime-paths))]
- [code (module-compiled-submodules
- (module-compiled-submodules
- (if (symbol? (module-compiled-name code))
- code
- (module-compiled-name code (last (module-compiled-name code))))
- #f
- null)
- #t
- null)])
+ [renamed-code (if (symbol? (module-compiled-name code))
+ 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
+ null)
+ #t
+ null)])
(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))
@@ -470,19 +479,27 @@
;; getting runtime-module-path symbols below
;; relies on extra-runtime-paths being first:
(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:
- (for-each (lambda (sub-filename sub-path)
- (get-code sub-filename
- sub-path
- codes
- prefixes
- verbose?
- collects-dest
- on-extension
- compiler
- expand-namespace
- get-extra-imports
- working))
+ (for-each (lambda (sf sp) (get-one-code sf sp #f))
(append sub-files extra-files)
(append sub-paths normalized-extra-paths))
(when verbose?
@@ -513,18 +530,27 @@
(mod-full-name m)
;; must have been a cycle...
(hash-ref working sub-filename))))]
- [mappings (map (lambda (sub-i sub-filename sub-path)
- (and (not (and collects-dest
- (is-lib-path? sub-path)))
- (let-values ([(path base) (module-path-index-split sub-i)])
- (and base ; can be #f if path isn't relative
- (begin
- ;; Assert: base should refer to this module:
- (let-values ([(path2 base2) (module-path-index-split base)])
- (when (or path2 base2)
- (error 'embed "unexpected nested module path index")))
- (cons path (lookup-full-name sub-filename)))))))
- all-file-imports sub-files sub-paths)])
+ [mappings (append
+ (map (lambda (sub-i sub-filename sub-path)
+ (and (not (and collects-dest
+ (is-lib-path? sub-path)))
+ (let-values ([(path base) (module-path-index-split sub-i)])
+ (and base ; can be #f if path isn't relative
+ (begin
+ ;; Assert: base should refer to this module:
+ (let-values ([(path2 base2) (module-path-index-split base)])
+ (when (or path2 base2)
+ (error 'embed "unexpected nested module path index")))
+ (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
(set-box! codes
(cons (make-mod filename module-path code
@@ -545,7 +571,9 @@
[else
(cons #f (loop (cdr runtime-paths) extra-files))]))
actual-filename)
- (unbox codes)))))))))]
+ (unbox codes)))
+ ;; Add code for post submodules:
+ (for-each get-one-submodule-code post-submods)))))))]
[else
(set-box! codes
(cons (make-mod filename module-path code
@@ -829,6 +857,7 @@
(path->bytes program-name)
#"?")]
[module-paths (map cadr modules)]
+ [use-submoduless (map (lambda (m) (if (pair? (cddr m)) (caddr m) '())) modules)]
[resolve-one-path (lambda (mp)
(let ([f (resolve-module-path mp #f)])
(unless f
@@ -853,14 +882,14 @@
;; As we descend the module tree, we append to the front after
;; loading imports, so the list in the right order.
[codes (box null)]
- [get-code-at (lambda (f mp)
- (get-code f mp codes prefix-mapping verbose? collects-dest
- on-extension compiler expand-namespace
- get-extra-imports
- (make-hash)))]
+ [get-code-at (lambda (f mp submods)
+ (get-code f mp #f submods codes prefix-mapping verbose? collects-dest
+ on-extension compiler expand-namespace
+ get-extra-imports
+ (make-hash)))]
[__
;; 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?
(let ([a (assoc (car files) (unbox codes))])
(let ([info (module-compiled-language-info (mod-code a))])
@@ -874,7 +903,8 @@
(for ([config-info (in-list config-infos)])
(let ([mp (vector-ref config-info 0)])
(get-code-at (resolve-one-path mp)
- (collapse-one mp)))))
+ (collapse-one mp)
+ null))))
;; Drop elements of `codes' that just record copied libs:
(set-box! codes (filter mod-code (unbox codes)))
;; Bind `module' to get started:
View
13 collects/compiler/embed.rkt
@@ -13,7 +13,11 @@
(->* (path-string?
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?)
any/c
(listof string?))
@@ -27,8 +31,11 @@
[create-embedding-executable
(->* (path-string?)
(#:modules
- (listof (list/c (or/c symbol? #f #t)
- (or/c path? module-path?)))
+ (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?))))
#:configure-via-first-module? any/c
#:literal-files (listof path-string?)
#:literal-expression any/c
View
38 collects/scribblings/raco/exe-api.scrbl
@@ -43,9 +43,11 @@ parameter is true.
@defproc[(create-embedding-executable [dest path-string?]
[#:modules mod-list
- (listof (list/c (or/c symbol? #t #f)
- (or/c path? module-path?)))
- null]
+ (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
+ (or/c module-path? path?))
+ (list/c (or/c symbol? (one-of/c #t #f))
+ (or/c module-path? path?)
+ (listof symbol?))))]
[#:configure-via-first-module? config-via-first?
any/c
#f]
@@ -140,17 +142,21 @@ evaluates an expression or loads a file will be executed after the
embedded code is loaded.
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,
-and the second item is a module path datum (that's in the format
-understood by the default module name resolver). The prefix can be a
-symbol, @racket[#f] to indicate no prefix, or @racket[#t] to indicate
-an auto-generated prefix. For example,
+two- or three-item list, where the first item is a prefix for the
+module name, and the second item is a module path datum (that's in the
+format understood by the default module name resolver), and the third
+is a list of submodule names to be included if they are available. The
+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"))]
embeds the module @racket[m] from the file @filepath{m.rkt}, without
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
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?]
[mred? any/c]
[verbose? any/c]
- [mod-list (listof (list/c (or/c symbol? (one-of/c #t #f))
- module-path?))]
+ [mod-list (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
+ (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-sexp any/c]
[cmdline (listof string?)]
@@ -366,8 +375,11 @@ Old (keywordless) interface to @racket[create-embedding-executable].}
@defproc[(write-module-bundle [verbose? any/c]
- [mod-list (listof (list/c (or/c symbol? (one-of/c #t #f))
- module-path?))]
+ [mod-list (listof (or/c (list/c (or/c symbol? (one-of/c #t #f))
+ (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-sexp any/c])
void?]{
View
6 collects/tests/racket/embed-me15.rkt
@@ -1,5 +1,5 @@
#lang racket/base
(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)
View
7 collects/tests/racket/embed-me16.rkt
@@ -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))
View
10 collects/tests/racket/embed.rktl
@@ -223,7 +223,7 @@
(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-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:
(prepare dest "unicode")
@@ -277,6 +277,14 @@
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
(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
(system* raco
"exe"
Please sign in to comment.
Something went wrong with that request. Please try again.