change 'configure-runtime to produce a list of module-spcifying vectors instead of a single vector
svn: r18763
This commit is contained in:
Matthew Flatt
parent
8fbd16261f
commit
bebf513aa7
|
|
@ -781,18 +781,20 @@
|
|||
[__
|
||||
;; Load all code:
|
||||
(for-each get-code-at files collapsed-mps)]
|
||||
[config-info (and config?
|
||||
[config-infos (if config?
|
||||
(let ([a (assoc (car files) (unbox codes))])
|
||||
(let ([info (module-compiled-language-info (mod-code a))])
|
||||
(when info
|
||||
(let ([get-info ((dynamic-require (vector-ref info 0) (vector-ref info 1))
|
||||
(vector-ref info 2))])
|
||||
(get-info 'configure-runtime #f))))))])
|
||||
(get-info 'configure-runtime null)))))
|
||||
null)])
|
||||
;; Add module for runtime configuration:
|
||||
(when config-info
|
||||
(let ([mp (vector-ref config-info 0)])
|
||||
(get-code-at (resolve-one-path mp)
|
||||
(collapse-one mp))))
|
||||
(when config-infos
|
||||
(for ([config-info (in-list config-infos)])
|
||||
(let ([mp (vector-ref config-info 0)])
|
||||
(get-code-at (resolve-one-path mp)
|
||||
(collapse-one mp)))))
|
||||
;; Drop elements of `codes' that just record copied libs:
|
||||
(set-box! codes (filter mod-code (unbox codes)))
|
||||
;; Bind `module' to get started:
|
||||
|
|
@ -929,12 +931,13 @@
|
|||
(write (compile-using-kernel '(namespace-set-variable-value! 'module #f #t)) outp)
|
||||
(write (compile-using-kernel '(namespace-undefine-variable! 'module)) outp)
|
||||
(newline outp)
|
||||
(when config-info
|
||||
(let ([a (assoc (resolve-one-path (vector-ref config-info 0)) (unbox codes))])
|
||||
(write (compile-using-kernel `((dynamic-require '',(mod-full-name a)
|
||||
',(vector-ref config-info 1))
|
||||
',(vector-ref config-info 2)))
|
||||
outp)))
|
||||
(when config-infos
|
||||
(for ([config-info (in-list config-infos)])
|
||||
(let ([a (assoc (resolve-one-path (vector-ref config-info 0)) (unbox codes))])
|
||||
(write (compile-using-kernel `((dynamic-require '',(mod-full-name a)
|
||||
',(vector-ref config-info 1))
|
||||
',(vector-ref config-info 2)))
|
||||
outp))))
|
||||
(for-each (lambda (f)
|
||||
(when verbose?
|
||||
(fprintf (current-error-port) "Copying from ~s~n" f))
|
||||
|
|
|
|||
|
|
@ -322,8 +322,8 @@
|
|||
((dynamic-require (vector-ref info 0)
|
||||
(vector-ref info 1))
|
||||
(vector-ref info 2))])
|
||||
(let ([config (get-info 'configure-runtime #f)])
|
||||
(when config
|
||||
(let ([configs (get-info 'configure-runtime null)])
|
||||
(for ([config (in-list configs)])
|
||||
((dynamic-require (vector-ref config 0)
|
||||
(vector-ref config 1))
|
||||
(vector-ref config 2))))))))
|
||||
|
|
|
|||
|
|
@ -3,6 +3,6 @@
|
|||
|
||||
(define ((module-info options) key default)
|
||||
(case key
|
||||
[(configure-runtime) `#(htdp/bsl/runtime configure ,options)]
|
||||
[(configure-runtime) `(#(htdp/bsl/runtime configure ,options))]
|
||||
[else default]))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,5 +6,5 @@
|
|||
(lambda (key default)
|
||||
(case key
|
||||
[(configure-runtime)
|
||||
'#(racket/private/runtime configure #f)]
|
||||
'(#(racket/private/runtime configure #f))]
|
||||
[else default])))
|
||||
|
|
|
|||
|
|
@ -126,7 +126,8 @@ If the @scheme[#:configure-via-first-module?] argument is specified as
|
|||
true, then the language of the first module in @scheme[mod-list] is
|
||||
used to configure the run-time environment before the expressions
|
||||
added by @scheme[#:literal-files] and @scheme[#:literal-expressions]
|
||||
are evaluated.
|
||||
are evaluated. See also @secref[#:doc '(lib
|
||||
"scribblings/reference/reference.scrbl") "configure-runtime"].
|
||||
|
||||
The @scheme[#:cmdline] argument @scheme[cmdline] contains command-line
|
||||
strings that are prefixed onto any actual command-line arguments that
|
||||
|
|
|
|||
|
|
@ -387,12 +387,13 @@ language specifies run-time configuration by
|
|||
|
||||
@item{having the function indicated by the @scheme['module-language]
|
||||
@tech{syntax property} recognize the
|
||||
@scheme['configure-runtime] key, for which it returns another
|
||||
vector: @scheme[(vector _mp _name _val)] where @scheme[_mp] is
|
||||
a @tech{module path}, @scheme[_name] is a symbol, and
|
||||
@scheme[_val] is an arbitrary value; and}
|
||||
@scheme['configure-runtime] key, for which it returns a list of
|
||||
vectors; each vector must have the form @scheme[(vector _mp
|
||||
_name _val)] where @scheme[_mp] is a @tech{module path},
|
||||
@scheme[_name] is a symbol, and @scheme[_val] is an arbitrary
|
||||
value; and}
|
||||
|
||||
@item{having the function called as @scheme[((dynamic-require _mp
|
||||
@item{having each function called as @scheme[((dynamic-require _mp
|
||||
_name) _val)] configure the run-time environment, typically by
|
||||
setting parameters such as @scheme[current-print].}
|
||||
|
||||
|
|
@ -400,3 +401,11 @@ language specifies run-time configuration by
|
|||
|
||||
The @schememodname[scheme/base] and @schememodname[scheme] languages
|
||||
do not currently specify a run-time configuration action.
|
||||
|
||||
A @scheme['configure-runtime] query returns a list of vectors, instead
|
||||
of directly configuring the environment, so that the indicated modules
|
||||
to be bundled with a program when creating a stand-alone
|
||||
executable; see @secref[#:doc '(lib "scribblings/mzc/mzc.scrbl") "exe"].
|
||||
|
||||
For information on defining a new @hash-lang[] language, see
|
||||
@schememodname[syntax/module-reader].
|
||||
|
|
|
|||
|
|
@ -168,14 +168,14 @@ typedef void (*Repl_Proc)(Scheme_Env *);
|
|||
|
||||
static void configure_environment(Scheme_Object *mod)
|
||||
{
|
||||
Scheme_Object *mli, *dyreq, *a[3], *gi, *v;
|
||||
Scheme_Object *mli, *dyreq, *a[3], *gi, *v, *vs;
|
||||
|
||||
mli = scheme_builtin_value("module->language-info");
|
||||
|
||||
a[0] = mod;
|
||||
a[1] = scheme_make_true();
|
||||
v = scheme_apply(mli, 2, a);
|
||||
if (SCHEME_VECTORP(v)) {
|
||||
if (SCHEME_VECTORP(v) && SCHEME_VEC_SIZE(v) == 3) {
|
||||
dyreq = scheme_builtin_value("dynamic-require");
|
||||
|
||||
a[0] = SCHEME_VEC_ELS(v)[0];
|
||||
|
|
@ -186,23 +186,36 @@ static void configure_environment(Scheme_Object *mod)
|
|||
gi = scheme_apply(gi, 1, a);
|
||||
|
||||
a[0] = scheme_intern_symbol("configure-runtime");
|
||||
a[1] = scheme_make_false();
|
||||
v = scheme_apply(gi, 2, a);
|
||||
if (!SAME_OBJ(v, scheme_make_false())) {
|
||||
a[1] = scheme_make_null();
|
||||
vs = scheme_apply(gi, 2, a);
|
||||
a[0] = vs;
|
||||
while (SCHEME_PAIRP(vs)) {
|
||||
v = SCHEME_CAR(vs);
|
||||
vs = SCHEME_CDR(vs);
|
||||
if (SCHEME_VECTORP(v) && SCHEME_VEC_SIZE(v) == 3) {
|
||||
a[0] = SCHEME_VEC_ELS(v)[0];
|
||||
a[1] = SCHEME_VEC_ELS(v)[1];
|
||||
a[2] = SCHEME_VEC_ELS(v)[2];
|
||||
v = scheme_apply(dyreq, 2, a);
|
||||
|
||||
a[0] = a[2];
|
||||
scheme_apply_multi(v, 1, a);
|
||||
/* ok */
|
||||
} else {
|
||||
a[0] = v;
|
||||
scheme_wrong_type("current-print setup", "vector of three values",
|
||||
-1, 0, a);
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!SCHEME_NULLP(vs)) {
|
||||
scheme_wrong_type("runtime-configure", "list of vectors of three values",
|
||||
-1, 0, a);
|
||||
}
|
||||
|
||||
vs = a[0];
|
||||
while (SCHEME_PAIRP(vs)) {
|
||||
v = SCHEME_CAR(vs);
|
||||
vs = SCHEME_CDR(vs);
|
||||
|
||||
a[0] = SCHEME_VEC_ELS(v)[0];
|
||||
a[1] = SCHEME_VEC_ELS(v)[1];
|
||||
a[2] = SCHEME_VEC_ELS(v)[2];
|
||||
v = scheme_apply(dyreq, 2, a);
|
||||
|
||||
a[0] = a[2];
|
||||
scheme_apply_multi(v, 1, a);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user