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.

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

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

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)

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

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
+copied into the executable: each element of @racket[early-literal-sexps]
-@racket[literal-files] is copied in order (with no intervening space),
+is copied in order, then
-followed by each element of @racket[literal-sexps]. The
+the content of each file in
-@racket[literal-files] files or @racket[literal-sexps] list can
+@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
+bindings; use compiled expressions to bootstrap the namespace.
-@racket[literal-sexp] is @racket[#f], no literal expression is
+The @racket[#:literal-expression]
-included in the executable. 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

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

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

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"

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;