diff --git a/collects/compiler/commands/exe.rkt b/collects/compiler/commands/exe.rkt index 79254aa879..cdea3a3153 100644 --- a/collects/compiler/commands/exe.rkt +++ b/collects/compiler/commands/exe.rkt @@ -101,22 +101,29 @@ dest (exe-aux)))] [else + (define mod-sym (string->symbol + (format "#%mzc:~a" + (let-values ([(base name dir?) + (split-path source-file)]) + (path->bytes (path-replace-suffix name #"")))))) (mzc:create-embedding-executable dest #:mred? (gui) #:variant (if (3m) '3m 'cgc) #:verbose? (very-verbose) - #:modules (cons `(#%mzc: (file ,source-file) (main)) + #:modules (cons `(#%mzc: (file ,source-file) (main configure-runtime)) (map (lambda (l) `(#t (lib ,l))) (exe-embedded-libraries))) #:configure-via-first-module? #t + #:early-literal-expressions + (parameterize ([current-namespace (make-base-namespace)]) + (define cr-sym (string->symbol (format "~a(configure-runtime)" mod-sym))) + (list + (compile + `(when (module-declared? '',cr-sym) + (dynamic-require '',cr-sym #f))))) #: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 `(begin diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index c26ee4ddb8..39d6f395cf 100644 --- a/collects/compiler/embed-unit.rkt +++ b/collects/compiler/embed-unit.rkt @@ -935,7 +935,9 @@ ;; Write a module bundle that can be loaded with 'load' (do not embed it ;; into an executable). The bundle is written to the current output port. - (define (do-write-module-bundle outp verbose? modules config? literal-files literal-expressions collects-dest + (define (do-write-module-bundle outp verbose? modules + early-literal-expressions config? literal-files literal-expressions + collects-dest on-extension program-name compiler expand-namespace src-filter get-extra-imports on-decls-done) (let* ([program-name-bytes (if program-name @@ -1143,6 +1145,7 @@ (write (compile-using-kernel '(namespace-undefine-variable! 'module)) outp) (on-decls-done outp) (newline outp) + (for-each (lambda (v) (write v outp)) early-literal-expressions) (when config-infos (for ([config-info (in-list config-infos)]) (let ([a (assoc (resolve-one-path (vector-ref config-info 0)) (unbox codes))]) @@ -1163,6 +1166,7 @@ #:modules [modules null] #:configure-via-first-module? [config? #f] #:literal-files [literal-files null] + #:early-literal-expressions [early-literal-expressions null] #:literal-expressions [literal-expressions null] #:on-extension [on-extension #f] #:expand-namespace [expand-namespace (current-namespace)] @@ -1171,7 +1175,8 @@ (compile expr)))] #:src-filter [src-filter (lambda (filename) #f)] #:get-extra-imports [get-extra-imports (lambda (filename code) null)]) - (do-write-module-bundle (current-output-port) verbose? modules config? literal-files literal-expressions + (do-write-module-bundle (current-output-port) verbose? modules + early-literal-expressions config? literal-files literal-expressions #f ; collects-dest on-extension #f ; program-name @@ -1210,6 +1215,7 @@ #:modules [modules null] #:configure-via-first-module? [config? #f] #:literal-files [literal-files null] + #:early-literal-expressions [early-literal-expressions null] #:literal-expression [literal-expression #f] #:literal-expressions [literal-expressions (if literal-expression @@ -1324,7 +1330,9 @@ (lambda (s) (define pos #f) (do-write-module-bundle s - verbose? modules config? literal-files literal-expressions collects-dest + verbose? modules + early-literal-expressions config? + literal-files literal-expressions collects-dest on-extension (file-name-from-path dest) compiler diff --git a/collects/compiler/embed.rkt b/collects/compiler/embed.rkt index f0f36b7181..c8ff6b7e20 100644 --- a/collects/compiler/embed.rkt +++ b/collects/compiler/embed.rkt @@ -37,6 +37,7 @@ (or/c path? module-path?) (listof symbol?)))) #:configure-via-first-module? any/c + #:early-literal-expressions (listof any/c) #:literal-files (listof path-string?) #:literal-expression any/c #:literal-expressions (listof any/c) diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index bdd72a9a2a..a892a7a13b 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -465,7 +465,10 @@ (for ([config (in-list configs)]) ((dynamic-require (vector-ref config 0) (vector-ref config 1)) - (vector-ref config 2)))))))) + (vector-ref config 2))))))) + (let ([cr-submod `(submod ,modspec configure-runtime)]) + (when (module-declared? cr-submod) + (dynamic-require cr-submod #f)))) ;; here's where they're all combined with the module expression (expr-getter *pre module-expr *post)) diff --git a/collects/scribblings/raco/exe-api.scrbl b/collects/scribblings/raco/exe-api.scrbl index 0a32c44159..319730214d 100644 --- a/collects/scribblings/raco/exe-api.scrbl +++ b/collects/scribblings/raco/exe-api.scrbl @@ -49,6 +49,9 @@ parameter is true. (list/c (or/c symbol? (one-of/c #t #f)) (or/c module-path? path?) (listof symbol?))))] + [#:early-literal-expressions early-literal-sexps + list? + null] [#:configure-via-first-module? config-via-first? any/c #f] @@ -114,26 +117,27 @@ namespace except as specified in @racket[mod-list], other modules generated prefix, so that they are not directly accessible. The @racket[#:modules] argument @racket[mod-list] designates modules -to be embedded, as described below. The @racket[#:literal-files] and +to be embedded, as described below. The @racket[#:early-literal-expressions], @racket[#:literal-files], and @racket[#:literal-expressions] arguments specify literal code to be -copied into the executable: the content of each file in -@racket[literal-files] is copied in order (with no intervening space), -followed by each element of @racket[literal-sexps]. The -@racket[literal-files] files or @racket[literal-sexps] list can +copied into the executable: each element of @racket[early-literal-sexps] +is copied in order, then +the content of each file in +@racket[literal-files] in order (with no intervening spaces), +and then each element of @racket[literal-sexps]. The +@racket[literal-files] files or @racket[early-literal-sexps] or @racket[literal-sexps] lists can contain compiled bytecode, and it's possible that the content of the @racket[literal-files] files only parse when concatenated; the files and expression are not compiled or inspected in any way during the embedding process. Beware that the initial namespace contains no -bindings; use compiled expressions to bootstrap the namespace. If -@racket[literal-sexp] is @racket[#f], no literal expression is -included in the executable. The @racket[#:literal-expression] +bindings; use compiled expressions to bootstrap the namespace. +The @racket[#:literal-expression] (singular) argument is for backward compatibility. If the @racket[#:configure-via-first-module?] argument is specified as true, then the language of the first module in @racket[mod-list] is used to configure the run-time environment before the expressions added by @racket[#:literal-files] and @racket[#:literal-expressions] -are evaluated. See also @secref[#:doc '(lib +are evaluated, but after the expressions of @racket[#:early-literal-expressions]. See also @secref[#:doc '(lib "scribblings/reference/reference.scrbl") "configure-runtime"]. The @racket[#:cmdline] argument @racket[cmdline] contains command-line diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index 03508273d4..c79f7b7835 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -63,6 +63,7 @@ command line does not specify a @racket[require] flag @Flag{f}/@DFlag{load}, @Flag{r}/@DFlag{script}, @Flag{m}/@DFlag{main}, or @Flag{i}/@DFlag{repl}). The initialization library can be changed with the @Flag{I} @tech{configuration option}. The +@racket[configure-runtime] submodule of the initialization library or the @racket['configure-runtime] property of the initialization library's language is used before the library is instantiated; see @secref["configure-runtime"]. @@ -73,7 +74,8 @@ executed in the order that they are provided on the command line. If any raises an uncaught exception, then the remaining @racket[eval]s, @racket[load]s, and @racket[require]s are skipped. If the first @racket[require] precedes any @racket[eval] or @racket[load] so that -the initialization library is skipped, then the +the initialization library is skipped, then the @racket[configure-runtime] +submodule of the required module or the @racket['configure-runtime] property of the required module's library language is used before the module is instantiated; see @secref["configure-runtime"]. @@ -422,6 +424,14 @@ Extra arguments following the last option are available from the @guidealso["module-runtime-config"] +A module can have a @racket[configure-runtime] submodule that is +@racket[dynamic-require]d before the module itself when a module is +the main module of a program. Normally, a @racket[configure-runtime] +submodule is added to a module by the module's language (i.e., by the +@racket[#%module-begin] form among a @racket[module]'s initial +bindings). + +Alternatively or in addition, an older protocol is in place. When a module is implemented using @hash-lang{}, the language after @hash-lang{} can specify configuration actions to perform when a module using the language is the main module of a program. The diff --git a/collects/tests/racket/embed-me22.rkt b/collects/tests/racket/embed-me22.rkt new file mode 100644 index 0000000000..729a45a171 --- /dev/null +++ b/collects/tests/racket/embed-me22.rkt @@ -0,0 +1,6 @@ +#lang racket/kernel + +(printf "This is 22.\n") + +(module configure-runtime racket/kernel + (printf "Configure!\n")) diff --git a/collects/tests/racket/embed.rktl b/collects/tests/racket/embed.rktl index f84cf26392..0a2527aa46 100644 --- a/collects/tests/racket/embed.rktl +++ b/collects/tests/racket/embed.rktl @@ -304,7 +304,15 @@ (path->string (build-path (collection-path "tests" "racket") "embed-me20.rkt"))) (try-exe (mk-dest mred?) "This is 20.\n" mred?) - ;;raco exe --launcher + ;; raco exe on a module with a `configure-runtime' submodule + (system* raco + "exe" + "-o" (path->string (mk-dest mred?)) + (if mred? "--gui" "--") + (path->string (build-path (collection-path "tests" "racket") "embed-me22.rkt"))) + (try-exe (mk-dest mred?) "Configure!\nThis is 22.\n" mred?) + + ;; raco exe --launcher (system* raco "exe" "--launcher" diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index 023af1f6ff..d3f7656fc9 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -224,6 +224,44 @@ typedef void (*Repl_Proc)(Scheme_Env *, FinishArgs *f); static void configure_environment(Scheme_Object *mod) { Scheme_Object *mli, *dyreq, *a[3], *gi, *v, *vs; + Scheme_Object *submod, *cr, *mdp, *mpij; + + cr = scheme_intern_symbol("configure-runtime"); + + /* Modern style: look for `runtime-configure' submodule to initialize + the configuration: */ + + submod = scheme_intern_symbol("submod"); + cr = scheme_intern_symbol("configure-runtime"); + + if (SAME_TYPE(SCHEME_TYPE(mod), scheme_module_index_type)) { + mpij = scheme_builtin_value("module-path-index-join"); + a[0] = scheme_make_pair(submod, + scheme_make_pair(scheme_make_utf8_string("."), + scheme_make_pair(cr, scheme_make_null()))); + a[1] = mod; + submod = scheme_apply(mpij, 2, a); + } else if (SCHEME_PAIRP(mod) && SAME_OBJ(SCHEME_CAR(mod), submod)) + submod = scheme_append(mod, scheme_make_pair(cr, scheme_make_null())); + else + submod = scheme_make_pair(submod, + scheme_make_pair(mod, + scheme_make_pair(cr, scheme_make_null()))); + mdp = scheme_builtin_value("module-declared?"); + + a[0] = submod; + a[1] = scheme_make_true(); + v = scheme_apply(mdp, 2, a); + if (SCHEME_TRUEP(v)) { + dyreq = scheme_builtin_value("dynamic-require"); + + a[0] = submod; + a[1] = scheme_make_false(); + (void)scheme_apply(dyreq, 2, a); + } + + /* Old style: use `module->language-info' (after new style, for + compatibility): */ mli = scheme_builtin_value("module->language-info"); @@ -240,7 +278,7 @@ static void configure_environment(Scheme_Object *mod) a[0] = SCHEME_VEC_ELS(v)[2]; gi = scheme_apply(gi, 1, a); - a[0] = scheme_intern_symbol("configure-runtime"); + a[0] = cr; a[1] = scheme_make_null(); vs = scheme_apply(gi, 2, a); a[0] = vs;