From bebf513aa7c8be0a8b66de28e3b33a7e51f8b917 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 8 Apr 2010 19:11:50 +0000 Subject: [PATCH] change 'configure-runtime to produce a list of module-spcifying vectors instead of a single vector svn: r18763 --- collects/compiler/embed-unit.ss | 27 ++++++------ collects/drscheme/private/module-language.ss | 4 +- collects/htdp/bsl/module-info.ss | 2 +- collects/racket/private/get-info.ss | 2 +- collects/scribblings/mzc/exe-api.scrbl | 3 +- collects/scribblings/reference/startup.scrbl | 19 ++++++--- src/mzscheme/cmdline.inc | 43 +++++++++++++------- 7 files changed, 63 insertions(+), 37 deletions(-) diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss index ed52b0d693..13773ce4d5 100644 --- a/collects/compiler/embed-unit.ss +++ b/collects/compiler/embed-unit.ss @@ -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)) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index e255e71869..ef1add3dc0 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -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)))))))) diff --git a/collects/htdp/bsl/module-info.ss b/collects/htdp/bsl/module-info.ss index 9ae64a2b7e..6c0a487e12 100644 --- a/collects/htdp/bsl/module-info.ss +++ b/collects/htdp/bsl/module-info.ss @@ -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])) diff --git a/collects/racket/private/get-info.ss b/collects/racket/private/get-info.ss index 2f82482a07..76270ec870 100644 --- a/collects/racket/private/get-info.ss +++ b/collects/racket/private/get-info.ss @@ -6,5 +6,5 @@ (lambda (key default) (case key [(configure-runtime) - '#(racket/private/runtime configure #f)] + '(#(racket/private/runtime configure #f))] [else default]))) diff --git a/collects/scribblings/mzc/exe-api.scrbl b/collects/scribblings/mzc/exe-api.scrbl index 745d1bf86d..2724264d69 100644 --- a/collects/scribblings/mzc/exe-api.scrbl +++ b/collects/scribblings/mzc/exe-api.scrbl @@ -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 diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index a29b1618d7..5253636d7b 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -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]. diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 638047fd86..b3f8166f63 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -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); + } } }