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)
#: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)])
(compile
`(namespace-require
'',(string->symbol
(define mod-sym (string->symbol
(format "#%mzc:~a"
(let-values ([(base name dir?)
(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)
#:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest)

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

@ -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,7 +384,8 @@
""
submod-path)))])
(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
"compiled"
compiler
@ -407,7 +408,7 @@
(if (and (file-exists? so)
((file-date so) . >= . (file-date zo)))
'so
#f))))])
#f)))))])
(cond
[(extension? code)
(when verbose?
@ -450,11 +451,19 @@
(eq? (car p) 'module)
(cadr p)))
runtime-paths))]
[code (module-compiled-submodules
(module-compiled-submodules
(if (symbol? (module-compiled-name code))
[renamed-code (if (symbol? (module-compiled-name 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
null)
#t
@ -470,10 +479,8 @@
;; getting runtime-module-path symbols below
;; relies on extra-runtime-paths being first:
(append extra-runtime-paths extra-paths))])
;; Get code for imports:
(for-each (lambda (sub-filename sub-path)
(get-code sub-filename
sub-path
(define (get-one-code sub-filename sub-path ready-code)
(get-code sub-filename sub-path ready-code null
codes
prefixes
verbose?
@ -483,6 +490,16 @@
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 (sf sp) (get-one-code sf sp #f))
(append sub-files extra-files)
(append sub-paths normalized-extra-paths))
(when verbose?
@ -513,7 +530,8 @@
(mod-full-name m)
;; must have been a cycle...
(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
(is-lib-path? sub-path)))
(let-values ([(path base) (module-path-index-split sub-i)])
@ -524,7 +542,15 @@
(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)])
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
[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:

13
collects/compiler/embed.rkt
View File

@ -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

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

@ -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?]{

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

@ -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)

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-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"