diff --git a/collects/compiler/commands/exe.rkt b/collects/compiler/commands/exe.rkt index 0ac336f9a5..b18f17dabc 100644 --- a/collects/compiler/commands/exe.rkt +++ b/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) diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index b38139904e..7fa15d0e06 100644 --- a/collects/compiler/embed-unit.rkt +++ b/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: diff --git a/collects/compiler/embed.rkt b/collects/compiler/embed.rkt index 74c8cb3727..0a5d9c04d4 100644 --- a/collects/compiler/embed.rkt +++ b/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 diff --git a/collects/scribblings/raco/exe-api.scrbl b/collects/scribblings/raco/exe-api.scrbl index 7e35e91b71..b3a35c6a6f 100644 --- a/collects/scribblings/raco/exe-api.scrbl +++ b/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?]{ diff --git a/collects/tests/racket/embed-me15.rkt b/collects/tests/racket/embed-me15.rkt index b6c4f00c57..d8107232ec 100644 --- a/collects/tests/racket/embed-me15.rkt +++ b/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) diff --git a/collects/tests/racket/embed-me16.rkt b/collects/tests/racket/embed-me16.rkt new file mode 100644 index 0000000000..3b109f622f --- /dev/null +++ b/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)) diff --git a/collects/tests/racket/embed.rktl b/collects/tests/racket/embed.rktl index 7e6254f467..1ccbc1bafd 100644 --- a/collects/tests/racket/embed.rktl +++ b/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"