add `configure-runtime' submodule support
A language can now introduce a `configure-runtime' submodule that is `dynamic-require'd before the enclosing module. This new submodule protocol provides a more general and easier-to-understand way of configuring the run-time environment for a module's language, as compared to the `module->language-info' path (through a `get-info' function, via a 'configure-runtime value, and finally loading the specified module). The `module->language-info' path remains in place, and it is checked after a `configure-runtime' submodule is run, since that order is likely to be the most backward compatible.
This commit is contained in:
Matthew Flatt
parent
34d0037b37
commit
27f1b39294
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
6
collects/tests/racket/embed-me22.rkt
Normal file
6
collects/tests/racket/embed-me22.rkt
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
#lang racket/kernel
|
||||
|
||||
(printf "This is 22.\n")
|
||||
|
||||
(module configure-runtime racket/kernel
|
||||
(printf "Configure!\n"))
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user