raco exe: add ++lang support

When a stand-alone executable created by `raco exe` needs to load
modules that start with a `#lang` line, there have been various
obstacles to adding the right run-time support via `++lib`. The
`++lang` flag addresses those problems and makes it easy to indicate
that enough should be embedded to support loading modules with a
specified language.

There are problems in the way that various handlers interact for the
"lang/reader.rkt" versus `(submod "." reader)` search path that
converts a language name to a reader. To accomodate the search in a
standalone executable (that does not provide access to collections in
general), the module name resolver must refrain from raising an
exception for a non-existent submodule path that refers to a
non-existent collection.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.0.0.16")
+(define version "7.0.0.17")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/compiler-lib/compiler/commands/exe.rkt

@@ -4,7 +4,8 @@
          compiler/private/embed
          launcher/launcher
          dynext/file
-         setup/dirs)
+         setup/dirs
+         "../private/language.rkt")
 
 (define verbose (make-parameter #f))
 (define very-verbose (make-parameter #f))
@@ -16,6 +17,7 @@
 (define exe-output (make-parameter #f))
 (define exe-embedded-flags (make-parameter '("-U" "--")))
 (define exe-embedded-libraries (make-parameter null))
+(define exe-embedded-languages (make-parameter null))
 (define exe-aux (make-parameter null))
 (define exe-embedded-config-path (make-parameter "etc"))
 (define exe-embedded-collects-path (make-parameter null))
@@ -69,6 +71,8 @@
       (exe-aux (append auxes (exe-aux))))]
    [("++lib") lib "Embed <lib> in executable"
     (exe-embedded-libraries (append (exe-embedded-libraries) (list lib)))]
+   [("++lang") lang "Embed support for `#lang <lang>` in executable"
+    (exe-embedded-languages (append (exe-embedded-languages) (list lang)))]
    [("++exf") flag "Add flag to embed in executable"
     (exe-embedded-flags (append (exe-embedded-flags) (list flag)))]
    [("--exf") flag "Remove flag to embed in executable"
@@ -130,8 +134,13 @@
      #:variant (variant)
      #:verbose? (very-verbose)
      #:modules (cons `(#%mzc: (file ,source-file) (main configure-runtime))
-                     (map (lambda (l) `(#t (lib ,l)))
-                          (exe-embedded-libraries)))
+                     (append
+                      (map (lambda (l) `(#t (lib ,l)))
+                           (exe-embedded-libraries))
+                      (map (lambda (mod) `(#t ,mod))
+                           (languages->libraries
+                            (exe-embedded-languages)
+                            #:who (string->symbol (short-program+command-name))))))
      #:configure-via-first-module? #t
      #:early-literal-expressions
      (parameterize ([current-namespace (make-base-namespace)])

pkgs/compiler-lib/compiler/private/language.rkt

@@ -0,0 +1,54 @@
+#lang racket/base
+(require syntax/modcollapse)
+
+(provide languages->libraries)
+
+;; Used to implement the `++lang` flag for `raco exe`
+(define (languages->libraries langs #:who who)
+  (apply
+   append
+   (for/list ([lang (in-list langs)])
+     (define in (open-input-string lang))
+     (define mod (read in))
+     (define reader-mod
+       (let ([submod (collapse-module-path-index
+                      (module-path-index-join
+                       `(submod "." reader)
+                       (module-path-index-join mod #f)))])
+         (if (module-declared? submod #t)
+             submod
+             (collapse-module-path-index
+              (module-path-index-join
+               "lang/reader.rkt"
+               (module-path-index-join mod #f))))))
+     (unless (module-declared? reader-mod #t)
+       (raise-user-error who
+                         (string-append
+                          "cannot find language module\n"
+                          "  language: ~a"
+                          "  module path: ~a")
+                         lang
+                         reader-mod))
+     (define get-info-proc (dynamic-require reader-mod 'get-info (lambda ()
+                                                                   (lambda args
+                                                                     (lambda args #f)))))
+     (define reader-mods (make-hash))
+     (hash-set! reader-mods reader-mod #t)
+     (define get-info (parameterize ([current-reader-guard
+                                      ;; Record potential chains of reader modules.
+                                      ;; For example, the `s-exp` reader chains to
+                                      ;; other reader modules.
+                                      (lambda (mod)
+                                        (hash-set! reader-mods mod #t)
+                                        mod)])
+                        (get-info-proc in #f #f #f #f)))
+     (define mod-lang-mod (get-info 'module-language #f))
+     (unless mod-lang-mod
+        (raise-user-error who
+                          (string-append
+                           "cannot extract module language\n"
+                           "  language: ~a\n"
+                           "  info field not available: 'module-language")
+                          lang))
+     (cons mod-lang-mod
+           (hash-keys reader-mods)))))

pkgs/compiler-test/tests/compiler/embed/embed-me32.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+(require syntax/modread)
+
+;; Read and run a `#lang racket/base` program
+
+(parameterize ([current-module-declare-name
+                (make-resolved-module-path 'dynamic-module)])
+  (eval
+   (check-module-form
+    (with-module-reading-parameterization
+      (lambda ()
+        (read-syntax #f (open-input-string "#lang racket/base (define x 32) (provide x)"))))
+    'ignored
+    #f)))
+
+(printf "This is ~a.\n" (dynamic-require ''dynamic-module 'x))

pkgs/compiler-test/tests/compiler/embed/embed-me33.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+(require syntax/modread)
+
+;; Read and run a `#lang at-exp racket/base` program
+
+(parameterize ([current-module-declare-name
+                (make-resolved-module-path 'dynamic-module)])
+  (eval
+   (check-module-form
+    (with-module-reading-parameterization
+      (lambda ()
+        (read-syntax #f (open-input-string "#lang at-exp racket/base @define[x]{33} (provide x)"))))
+    'ignored
+    #f)))
+
+(printf "This is ~a.\n" (dynamic-require ''dynamic-module 'x))

pkgs/compiler-test/tests/compiler/embed/test.rkt

@@ -505,7 +505,7 @@
                            ;; scope:
                            (member "compatibility-lib"
                                    (installed-pkg-names #:scope 'installation)))
-  
+
     (void)))
 
 (define (try-mzc)
@@ -629,6 +629,23 @@
 
 ;; ----------------------------------------
 
+(define (try-lang)
+  (system+ raco
+           "exe"
+           "-o" (path->string (mk-dest #f))
+           "++lang" "racket/base"
+           (path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me32.rkt")))
+  (try-exe (mk-dest #f) "This is 32.\n" #f)
+
+  (system+ raco
+           "exe"
+           "-o" (path->string (mk-dest #f))
+           "++lang" "at-exp racket/base"
+           (path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me33.rkt")))
+  (try-exe (mk-dest #f) "This is 33.\n" #f))
+
+;; ----------------------------------------
+
 (define (try-source)
   (define (try-one file submod start result)
     (define mred? #f)
@@ -731,6 +748,7 @@
   (try-extension))
 (try-gracket)
 (try-reader)
+(try-lang)
 (try-planet)
 (try-*sl)
 (try-source)

pkgs/racket-doc/scribblings/raco/exe.scrbl

@@ -50,11 +50,21 @@ created executable. Such modules can be explicitly included using the
 @racket[define-runtime-path] to embed references to the run-time files
 in the executable; the files are then copied and packaged together
 with the executable when creating a distribution (as described in
-@secref["exe-dist"]). Finally, a submodule is included if its
+@secref["exe-dist"]). A submodule is included if its
 enclosing module is included and the submodule contains a
 sub-submodule named @racketidfont{declare-preserve-for-embedding}
 (where the implementation of the sub-submodule is ignored).
 
+Language reader modules that are used only via @hash-lang[] are also
+not automatically embedded. To support dynamic use of @hash-lang[]
+with a language specifcation, supply the @DPFlag{lang} flag to
+@exec{raco exe}. The argument after @DPFlag{lang} can be a language
+name, but more generally it can be text to appear just after
+@hash-lang[]. For example, @litchar{at-exp racket/base} makes sense as
+an argument to @DPFlag{lang} to allow @racketmodname[at-exp] combined
+with @racketmodname[racket/base] as a language for dynamically loaded
+modules.
+
 Modules that are implemented directly by extensions---i.e., extensions
 that are automatically loaded from @racket[(build-path "compiled"
 "native" (system-library-subpath))] to satisfy a
@@ -169,6 +179,19 @@ The @exec{raco exe} command accepts the following command-line flags:
    in the executable, even if it is not referenced by the main program,
    so that it is available via @racket[dynamic-require].}
 
+ @item{@DPFlag{lang} @nonterm{lang} --- include modules needed to load
+   modules starting @racket[@#,hash-lang[] @#,nonterm{lang}]
+   dynamically. The @nonterm{lang} does not have to be a plain
+   language or module name; it might be a more general text sequence,
+   such as @litchar{at-exp racket/base} to support language
+   constructors like @racketmodname[at-exp].
+   The initial @racket[require] for a @racket[module] read as
+   @nonterm{lang} must be available though the language reader's
+   @racketidfont{get-info} function and the @racket['module-language]
+   key; languages implemented with
+   @racketmodname[syntax/module-reader] support that key
+   automatically.}
+
  @item{@DPFlag{exf} @nonterm{flag} --- provide the @nonterm{flag}
    command-line argument on startup to the embedded @exec{racket} or
    @exec{gracket}.}
@@ -193,7 +216,8 @@ The @exec{raco exe} command accepts the following command-line flags:
 
 @history[#:changed "6.3.0.11" @elem{Added support for
                                     @racketidfont{declare-preserve-for-embedding}.}
-         #:changed "6.90.0.23" @elem{Added @DFlag{embed-dlls}.}]
+         #:changed "6.90.0.23" @elem{Added @DFlag{embed-dlls}.}
+         #:changed "7.0.0.17" @elem{Added @DPFlag{lang}.}]
 
 @; ----------------------------------------------------------------------
 

pkgs/racket-doc/scribblings/reference/module-reflect.scrbl

@@ -163,6 +163,16 @@ the cache only when the fourth argument to the module name resolver is
 true (indicating that a module should be loaded) and only when loading
 succeeds.
 
+Finally, the default module name resolver potentially treats a
+@racket[submod] path specially. If the module path as the first
+element of the @racket[submod] form refers to non-existent collection,
+then instead of raising an exception, the default module name resolver
+synthesizes an uninterned symbol module name for the resulting
+@tech{resolved module path}. This special treatment of submodule paths
+is consistent with the special treatment of nonexistent submodules by
+the @tech{compiled-load handler}, so that @racket[module-declared?]
+can be used more readily to check for the existence of a submodule.
+
 Module loading is suppressed (i.e., @racket[#f] is supplied as a fourth
 argument to the module name resolver) when resolving module paths in
 @tech{syntax objects} (see @secref["stxobj-model"]). When a
@@ -178,7 +188,11 @@ arguments will be removed in a future version.
 
 @history[#:changed "6.0.1.12" 
          @elem{Added error logging to the default module name resolver
-               when called with three arguments.}]}
+               when called with three arguments.}
+         #:changed "7.0.0.17"
+         @elem{Added special treatment of @racket[submod] forms with a
+               nonexistent collection by the default module name
+               resolver.}]}
 
 
 @defparam[current-module-declare-name name (or/c resolved-module-path? #f)]{

pkgs/racket-test-core/tests/racket/module.rktl

@@ -647,6 +647,18 @@
       (test '#(tests/racket/lang/getinfo get-info closure-data)
             module->language-info 'tests/racket/langm))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The default module name resolver invents an uninterned symbol as a
+;; module name when resolving a submodule for a base path where the
+;; *collection* can't even be found for making a potential path name.
+
+(let ([m (module-path-index-resolve
+          (module-path-index-join '(submod no-such-collection/x nested) #f))])
+  (test #f symbol-interned? (car (resolved-module-path-name m)))
+  (test '(nested) cdr (resolved-module-path-name m)))
+
+(test #f module-declared? '(submod no-such-collection/x nested) #t)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check shadowing of initial imports: