From f03d5c0076d9973faf57ee16bc8b3cd807817c63 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 1 Sep 2018 21:24:35 -0600 Subject: [PATCH] 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 | 2 +- pkgs/compiler-lib/compiler/commands/exe.rkt | 15 +- .../compiler/private/language.rkt | 54 ++++ .../tests/compiler/embed/embed-me32.rkt | 16 ++ .../tests/compiler/embed/embed-me33.rkt | 16 ++ .../tests/compiler/embed/test.rkt | 20 +- pkgs/racket-doc/scribblings/raco/exe.scrbl | 28 +- .../reference/module-reflect.scrbl | 16 +- .../racket-test-core/tests/racket/module.rktl | 12 + racket/src/expander/boot/handler.rkt | 272 ++++++++++-------- racket/src/racket/src/schvers.h | 4 +- racket/src/racket/src/startup.inc | 121 +++++--- 12 files changed, 404 insertions(+), 172 deletions(-) create mode 100644 pkgs/compiler-lib/compiler/private/language.rkt create mode 100644 pkgs/compiler-test/tests/compiler/embed/embed-me32.rkt create mode 100644 pkgs/compiler-test/tests/compiler/embed/embed-me33.rkt diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 0d9b5bd10c..d98699f47d 100644 --- a/pkgs/base/info.rkt +++ b/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])) diff --git a/pkgs/compiler-lib/compiler/commands/exe.rkt b/pkgs/compiler-lib/compiler/commands/exe.rkt index 15257278f2..1e182d1dfe 100644 --- a/pkgs/compiler-lib/compiler/commands/exe.rkt +++ b/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 in executable" (exe-embedded-libraries (append (exe-embedded-libraries) (list lib)))] + [("++lang") lang "Embed support for `#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)]) diff --git a/pkgs/compiler-lib/compiler/private/language.rkt b/pkgs/compiler-lib/compiler/private/language.rkt new file mode 100644 index 0000000000..95af30654a --- /dev/null +++ b/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))))) diff --git a/pkgs/compiler-test/tests/compiler/embed/embed-me32.rkt b/pkgs/compiler-test/tests/compiler/embed/embed-me32.rkt new file mode 100644 index 0000000000..9770806b4b --- /dev/null +++ b/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)) diff --git a/pkgs/compiler-test/tests/compiler/embed/embed-me33.rkt b/pkgs/compiler-test/tests/compiler/embed/embed-me33.rkt new file mode 100644 index 0000000000..b21e6be2cc --- /dev/null +++ b/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)) diff --git a/pkgs/compiler-test/tests/compiler/embed/test.rkt b/pkgs/compiler-test/tests/compiler/embed/test.rkt index 84a101e9f5..5b8ee2c34e 100644 --- a/pkgs/compiler-test/tests/compiler/embed/test.rkt +++ b/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) diff --git a/pkgs/racket-doc/scribblings/raco/exe.scrbl b/pkgs/racket-doc/scribblings/raco/exe.scrbl index 01d9c8809b..6407335716 100644 --- a/pkgs/racket-doc/scribblings/raco/exe.scrbl +++ b/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}.}] @; ---------------------------------------------------------------------- diff --git a/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl b/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl index 265e2c6fb0..9d474af1db 100644 --- a/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl +++ b/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)]{ diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index de42f5aa1f..53ac6aa3b8 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/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: diff --git a/racket/src/expander/boot/handler.rkt b/racket/src/expander/boot/handler.rkt index b7322c244f..045a04ea45 100644 --- a/racket/src/expander/boot/handler.rkt +++ b/racket/src/expander/boot/handler.rkt @@ -392,6 +392,13 @@ msg (current-continuation-marks) s)))))] + [invent-collection-dir (lambda (f-file col col-path fail) + (lambda (msg) + ;; No such module => make a module-name symbol that + ;; certainly isn't declared + (string->uninterned-symbol + (path->string + (build-path (apply build-path col col-path) f-file)))))] [ss->rkt (lambda (s) (let ([len (string-length s)]) (if (and (len . >= . 3) @@ -442,17 +449,27 @@ #f)) #f)]) (let ([s-parsed - ;; Non-string result represents an error + ;; Non-string, non-vector result represents an error, but + ;; a symbol result is a special kind of error for the purposes + ;; of dealing with a submodule path when there's no such + ;; collection (cond [(symbol? s) (or (path-cache-get (cons s (get-reg))) (let-values ([(cols file) (split-relative-string (symbol->string s) #f)]) (let* ([f-file (if (null? cols) "main.rkt" - (string-append file ".rkt"))]) - (find-col-file show-collection-err - (if (null? cols) file (car cols)) - (if (null? cols) null (cdr cols)) + (string-append file ".rkt"))] + [col (if (null? cols) file (car cols))] + [col-path (if (null? cols) null (cdr cols))]) + (find-col-file (if (not subm-path) + show-collection-err + ;; Invent a fictional collection directory, if necessary, + ;; so that we don't raise an exception: + (invent-collection-dir f-file col col-path + show-collection-err)) + col + col-path f-file #t))))] [(string? s) @@ -511,125 +528,132 @@ ;; Use filesystem-sensitive `simplify-path' here: (path-ss->rkt (simplify-path (path->complete-path (expand-user-path (cadr s)) (get-dir))))])]) - (unless (or (path? s-parsed) - (vector? s-parsed)) - (if stx - (raise-syntax-error - 'require - (format "bad module path~a" (if s-parsed - (car s-parsed) - "")) - stx) - (raise-argument-error - 'standard-module-name-resolver - "module-path?" - s))) - ;; At this point, s-parsed is a complete path (or a cached vector) - (let* ([filename (if (vector? s-parsed) - (vector-ref s-parsed 0) - (simplify-path (cleanse-path s-parsed) #f))] - [normal-filename (if (vector? s-parsed) - (vector-ref s-parsed 1) - (normal-case-path filename))]) - (let-values ([(base name dir?) (if (vector? s-parsed) - (values 'ignored (vector-ref s-parsed 2) 'ignored) - (split-path filename))]) - (let* ([no-sfx (if (vector? s-parsed) - (vector-ref s-parsed 3) - (path-replace-extension name #""))]) - (let* ([root-modname (if (vector? s-parsed) - (vector-ref s-parsed 4) - (make-resolved-module-path filename))] - [hts (or (registry-table-ref (get-reg)) - (let ([hts (cons (make-hasheq) (make-hasheq))]) - (registry-table-set! (get-reg) - hts) - hts))] - [modname (if subm-path - (make-resolved-module-path - (cons (resolved-module-path-name root-modname) - subm-path)) - root-modname)]) - ;; Loaded already? - (when load? - (let ([got (hash-ref (car hts) modname #f)]) - (unless got - ;; Currently loading? - (let ([loading - (let ([tag (if (continuation-prompt-available? -loading-prompt-tag) - -loading-prompt-tag - (default-continuation-prompt-tag))]) - (continuation-mark-set-first - #f - -loading-filename - null - tag))] - [nsr (get-reg)]) - (for-each - (lambda (s) - (when (and (equal? (cdr s) normal-filename) - (eq? (car s) nsr)) - (error - 'standard-module-name-resolver - "cycle in loading\n at path: ~a\n paths:~a" - filename - (apply string-append - (let loop ([l (reverse loading)]) - (if (null? l) - '() - (list* "\n " (path->string (cdar l)) (loop (cdr l))))))))) - loading) - ((if (continuation-prompt-available? -loading-prompt-tag) - (lambda (f) (f)) - (lambda (f) (call-with-continuation-prompt f -loading-prompt-tag))) - (lambda () - (with-continuation-mark -loading-filename (cons (cons nsr normal-filename) - loading) - (parameterize ([current-module-declare-name root-modname] - [current-module-path-for-load - ;; If `s' is an absolute module path, then - ;; keep it as-is, the better to let a tool - ;; recommend how to get an unavailable module; - ;; also, propagate the source location. - ((if stx - (lambda (p) (datum->syntax #f p stx)) - values) - (cond - [(symbol? s) s] - [(and (pair? s) (eq? (car s) 'lib)) s] - [else (if (resolved-module-path? root-modname) - (let ([src (resolved-module-path-name root-modname)]) - (if (symbol? src) - (list 'quote src) - src)) - root-modname)]))]) - ((current-load/use-compiled) - filename - (let ([sym (string->symbol (path->string no-sfx))]) - (if subm-path - (if (hash-ref (car hts) root-modname #f) - ;; Root is already loaded, so only use .zo - (cons #f subm-path) - ;; Root isn't loaded, so it's ok to load form source: - (cons sym subm-path)) - sym))))))))))) - ;; If a `lib' path, cache pathname manipulations - (when (and (not (vector? s-parsed)) - load? - (or (string? s) - (symbol? s) - (and (pair? s) - (eq? (car s) 'lib)))) - (path-cache-set! (if (string? s) - (cons s (get-dir)) - (cons s (get-reg))) - (vector filename - normal-filename - name - no-sfx - root-modname))) - ;; Result is the module name: - modname))))))])])) + (cond + [(symbol? s-parsed) + ;; Return a genenerated symnol + (make-resolved-module-path + (cons s-parsed subm-path))] + [(not (or (path? s-parsed) + (vector? s-parsed))) + (if stx + (raise-syntax-error + 'require + (format "bad module path~a" (if s-parsed + (car s-parsed) + "")) + stx) + (raise-argument-error + 'standard-module-name-resolver + "module-path?" + s))] + [else + ;; At this point, s-parsed is a complete path (or a cached vector) + (define filename (if (vector? s-parsed) + (vector-ref s-parsed 0) + (simplify-path (cleanse-path s-parsed) #f))) + (define normal-filename (if (vector? s-parsed) + (vector-ref s-parsed 1) + (normal-case-path filename))) + (define-values (base name dir?) (if (vector? s-parsed) + (values 'ignored (vector-ref s-parsed 2) 'ignored) + (split-path filename))) + (define no-sfx (if (vector? s-parsed) + (vector-ref s-parsed 3) + (path-replace-extension name #""))) + (define root-modname (if (vector? s-parsed) + (vector-ref s-parsed 4) + (make-resolved-module-path filename))) + (define hts (or (registry-table-ref (get-reg)) + (let ([hts (cons (make-hasheq) (make-hasheq))]) + (registry-table-set! (get-reg) + hts) + hts))) + (define modname (if subm-path + (make-resolved-module-path + (cons (resolved-module-path-name root-modname) + subm-path)) + root-modname)) + ;; Loaded already? + (when load? + (let ([got (hash-ref (car hts) modname #f)]) + (unless got + ;; Currently loading? + (let ([loading + (let ([tag (if (continuation-prompt-available? -loading-prompt-tag) + -loading-prompt-tag + (default-continuation-prompt-tag))]) + (continuation-mark-set-first + #f + -loading-filename + null + tag))] + [nsr (get-reg)]) + (for-each + (lambda (s) + (when (and (equal? (cdr s) normal-filename) + (eq? (car s) nsr)) + (error + 'standard-module-name-resolver + "cycle in loading\n at path: ~a\n paths:~a" + filename + (apply string-append + (let loop ([l (reverse loading)]) + (if (null? l) + '() + (list* "\n " (path->string (cdar l)) (loop (cdr l))))))))) + loading) + ((if (continuation-prompt-available? -loading-prompt-tag) + (lambda (f) (f)) + (lambda (f) (call-with-continuation-prompt f -loading-prompt-tag))) + (lambda () + (with-continuation-mark + -loading-filename (cons (cons nsr normal-filename) + loading) + (parameterize ([current-module-declare-name root-modname] + [current-module-path-for-load + ;; If `s' is an absolute module path, then + ;; keep it as-is, the better to let a tool + ;; recommend how to get an unavailable module; + ;; also, propagate the source location. + ((if stx + (lambda (p) (datum->syntax #f p stx)) + values) + (cond + [(symbol? s) s] + [(and (pair? s) (eq? (car s) 'lib)) s] + [else (if (resolved-module-path? root-modname) + (let ([src (resolved-module-path-name root-modname)]) + (if (symbol? src) + (list 'quote src) + src)) + root-modname)]))]) + ((current-load/use-compiled) + filename + (let ([sym (string->symbol (path->string no-sfx))]) + (if subm-path + (if (hash-ref (car hts) root-modname #f) + ;; Root is already loaded, so only use .zo + (cons #f subm-path) + ;; Root isn't loaded, so it's ok to load form source: + (cons sym subm-path)) + sym))))))))))) + ;; If a `lib' path, cache pathname manipulations + (when (and (not (vector? s-parsed)) + load? + (or (string? s) + (symbol? s) + (and (pair? s) + (eq? (car s) 'lib)))) + (path-cache-set! (if (string? s) + (cons s (get-dir)) + (cons s (get-reg))) + (vector filename + normal-filename + name + no-sfx + root-modname))) + ;; Result is the module name: + modname])))])])) (define default-eval-handler (lambda (s) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index f7891603b1..af8b4f1165 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "7.0.0.16" +#define MZSCHEME_VERSION "7.0.0.17" #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 16 +#define MZSCHEME_VERSION_W 17 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 16e4adfa2e..312b8cfd4d 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -60840,6 +60840,14 @@ static const char *startup_source = " msg_1" "(current-continuation-marks)" " s_0)))))))" +"((invent-collection-dir_0)" +"(lambda(f-file_0 col_0 col-path_0 fail_0)" +"(begin" +" 'invent-collection-dir" +"(lambda(msg_0)" +"(string->uninterned-symbol" +"(path->string" +"(build-path(apply build-path col_0 col-path_0) f-file_0)))))))" "((ss->rkt_0)" "(lambda(s_1)" "(begin" @@ -60908,12 +60916,20 @@ static const char *startup_source = "(if(null? cols_0)" " \"main.rkt\"" " (string-append file_0 \".rkt\"))))" +"(let-values(((col_0)(if(null? cols_0) file_0(car cols_0))))" +"(let-values(((col-path_0)(if(null? cols_0) null(cdr cols_0))))" "(find-col-file" +"(if(not subm-path_0)" " show-collection-err_0" -"(if(null? cols_0) file_0(car cols_0))" -"(if(null? cols_0) null(cdr cols_0))" +"(invent-collection-dir_0" " f-file_0" -" #t))))))" +" col_0" +" col-path_0" +" show-collection-err_0))" +" col_0" +" col-path_0" +" f-file_0" +" #t))))))))" "(if(string? s_1)" "(let-values()" "(let-values(((dir_0)(get-dir_0)))" @@ -60987,17 +61003,19 @@ static const char *startup_source = "(simplify-path" "(path->complete-path(expand-user-path(cadr s_1))(get-dir_0)))))" "(void))))))))" -"(begin" -"(if(let-values(((or-part_0)(path? s-parsed_0)))" -"(if or-part_0 or-part_0(vector? s-parsed_0)))" -"(void)" +"(if(symbol? s-parsed_0)" +"(let-values()(1/make-resolved-module-path(cons s-parsed_0 subm-path_0)))" +"(if(not" +"(let-values(((or-part_0)(path? s-parsed_0)))" +"(if or-part_0 or-part_0(vector? s-parsed_0))))" "(let-values()" "(if stx_0" "(raise-syntax-error$1" " 'require" " (format \"bad module path~a\" (if s-parsed_0 (car s-parsed_0) \"\"))" " stx_0)" -" (raise-argument-error 'standard-module-name-resolver \"module-path?\" s_1))))" +" (raise-argument-error 'standard-module-name-resolver \"module-path?\" s_1)))" +"(let-values()" "(let-values(((filename_0)" "(if(vector? s-parsed_0)" "(vector-ref s-parsed_0 0)" @@ -61013,7 +61031,7 @@ static const char *startup_source = "(let-values(((no-sfx_0)" "(if(vector? s-parsed_0)" "(vector-ref s-parsed_0 3)" -" (path-replace-extension name_0 #\"\"))))" +" (path-replace-extension name_0 #\"\"))))" "(let-values(((root-modname_0)" "(if(vector? s-parsed_0)" "(vector-ref s-parsed_0 4)" @@ -61023,7 +61041,9 @@ static const char *startup_source = "(if or-part_0" " or-part_0" "(let-values(((hts_0)(cons(make-hasheq)(make-hasheq))))" -"(begin(registry-table-set!(get-reg_0) hts_0) hts_0))))))" +"(begin" +"(registry-table-set!(get-reg_0) hts_0)" +" hts_0))))))" "(let-values(((modname_0)" "(if subm-path_0" "(1/make-resolved-module-path" @@ -61059,7 +61079,7 @@ static const char *startup_source = "(let-values()" "(error" " 'standard-module-name-resolver" -" \"cycle in loading\\n at path: ~a\\n paths:~a\"" +" \"cycle in loading\\n at path: ~a\\n paths:~a\"" " filename_0" "(apply" " string-append" @@ -61070,14 +61090,17 @@ static const char *startup_source = "(if(null? l_0)" " '()" "(list*" -" \"\\n \"" -"(path->string(cdar l_0))" -"(loop_0(cdr l_0))))))))" +" \"\\n \"" +"(path->string" +"(cdar l_0))" +"(loop_0" +"(cdr l_0))))))))" " loop_0)" "(reverse$1 loading_0)))))" "(void)))" " loading_0)" -"((if(continuation-prompt-available? -loading-prompt-tag)" +"((if(continuation-prompt-available?" +" -loading-prompt-tag)" "(lambda(f_0)(f_0))" "(lambda(f_0)" "(call-with-continuation-prompt" @@ -61090,7 +61113,9 @@ static const char *startup_source = "(with-continuation-mark" " parameterization-key" "(extend-parameterization" -"(continuation-mark-set-first #f parameterization-key)" +"(continuation-mark-set-first" +" #f" +" parameterization-key)" " 1/current-module-declare-name" " root-modname_0" " 1/current-module-path-for-load" @@ -61102,7 +61127,8 @@ static const char *startup_source = "(if(if(pair? s_1)(eq?(car s_1) 'lib) #f)" "(let-values() s_1)" "(let-values()" -"(if(1/resolved-module-path? root-modname_0)" +"(if(1/resolved-module-path?" +" root-modname_0)" "(let-values(((src_0)" "(1/resolved-module-path-name" " root-modname_0)))" @@ -61143,7 +61169,7 @@ static const char *startup_source = " no-sfx_0" " root-modname_0)))" "(void))" -" modname_0))))))))))))))))))))))))" +" modname_0))))))))))))))))))))))))))" "(define-values" "(default-eval-handler)" "(lambda(s_0)" @@ -78575,34 +78601,43 @@ static const char *startup_source = "(let-values(((obs_0)(expand-context-observer ctx_0)))" "(if obs_0(let-values()(let-values()(call-expand-observe obs_0 'prim-provide)))(void)))" " (raise-syntax-error$1 #f \"not allowed outside of a module body\" s_0)))))" -"(define-values(ns)(make-namespace))" +"(define-values" +"(namespace-init!)" +"(lambda()" +"(begin" +"(let-values(((ns_0)(make-namespace)))" "(void" "(begin" -"(declare-core-module! ns)" -"(let-values(((temp1_0) '#%read)((read-primitives2_0) read-primitives)((ns3_0) ns))" +"(declare-core-module! ns_0)" +"(let-values(((temp1_0) '#%read)((read-primitives2_0) read-primitives)((ns3_0) ns_0))" "(declare-hash-based-module!41.1 ns3_0 #f null #f #f temp1_0 read-primitives2_0))" -"(let-values(((temp4_0) '#%main)((main-primitives5_0) main-primitives)((ns6_0) ns))" +"(let-values(((temp4_0) '#%main)((main-primitives5_0) main-primitives)((ns6_0) ns_0))" "(declare-hash-based-module!41.1 ns6_0 #f null #f #f temp4_0 main-primitives5_0))" -"(let-values(((temp7_0) '#%utils)((utils-primitives8_0) utils-primitives)((ns9_0) ns))" +"(let-values(((temp7_0) '#%utils)((utils-primitives8_0) utils-primitives)((ns9_0) ns_0))" "(declare-hash-based-module!41.1 ns9_0 #f null #f #f temp7_0 utils-primitives8_0))" "(let-values(((temp10_0) '#%place-struct)" "((place-struct-primitives11_0) place-struct-primitives)" -"((ns12_0) ns)" +"((ns12_0) ns_0)" "((temp13_0) '(dynamic-place)))" "(declare-hash-based-module!41.1 ns12_0 #f temp13_0 #f #f temp10_0 place-struct-primitives11_0))" -"(let-values(((temp14_0) '#%boot)((boot-primitives15_0) boot-primitives)((ns16_0) ns))" +"(let-values(((temp14_0) '#%boot)((boot-primitives15_0) boot-primitives)((ns16_0) ns_0))" "(declare-hash-based-module!41.1 ns16_0 #f null #f #f temp14_0 boot-primitives15_0))" "(let-values(((linklet-primitives_0)" -"(hash-remove(hash-remove linklet-primitives 'variable-reference?) 'variable-reference-constant?)))" +"(hash-remove" +"(hash-remove linklet-primitives 'variable-reference?)" +" 'variable-reference-constant?)))" "(let-values(((temp17_0) '#%linklet)" "((linklet-primitives18_0) linklet-primitives_0)" -"((ns19_0) ns)" +"((ns19_0) ns_0)" "((temp20_0) #t)" "((temp21_0) #t))" "(declare-hash-based-module!41.1 ns19_0 temp20_0 null #f temp21_0 temp17_0 linklet-primitives18_0)))" -"(let-values(((temp22_0) '#%expobs)((expobs-primitives23_0) expobs-primitives)((ns24_0) ns)((temp25_0) #t))" +"(let-values(((temp22_0) '#%expobs)" +"((expobs-primitives23_0) expobs-primitives)" +"((ns24_0) ns_0)" +"((temp25_0) #t))" "(declare-hash-based-module!41.1 ns24_0 #f null temp25_0 #f temp22_0 expobs-primitives23_0))" -"(let-values(((ns26_0) ns)" +"(let-values(((ns26_0) ns_0)" "((eval27_0) 1/eval)" "((temp28_0)" "(let-values(((ht_0) main-primitives))" @@ -78623,9 +78658,13 @@ static const char *startup_source = "(let-values(((key_0 val_0)" "(let-values()" "(values" -"(let-values() name_0)" +"(let-values()" +" name_0)" " #t))))" -"(hash-set table_1 key_0 val_0)))))" +"(hash-set" +" table_1" +" key_0" +" val_0)))))" "(values table_2)))))" "(if(not #f)" "(for-loop_0 table_1(hash-iterate-next ht_0 i_0))" @@ -78653,9 +78692,13 @@ static const char *startup_source = "(let-values(((key_0 val_0)" "(let-values()" "(values" -"(let-values() name_0)" +"(let-values()" +" name_0)" " #t))))" -"(hash-set table_1 key_0 val_0)))))" +"(hash-set" +" table_1" +" key_0" +" val_0)))))" "(values table_2)))))" "(if(not #f)" "(for-loop_0 table_1(hash-iterate-next ht_0 i_0))" @@ -78685,7 +78728,7 @@ static const char *startup_source = "(begin" "(let-values()" "(let-values(((name30_0) name_0)" -"((ns31_0) ns)" +"((ns31_0) ns_0)" "((temp32_0)" "(let-values(((or-part_0)" "(eq?" @@ -78720,11 +78763,12 @@ static const char *startup_source = "(void))" "(let-values(((temp33_0) '#%builtin)" "((temp34_0)(list* '#%place-struct '#%utils '#%boot '#%expobs '#%linklet runtime-instances))" -"((ns35_0) ns)" +"((ns35_0) ns_0)" "((temp36_0) #f))" "(declare-reexporting-module!50.1 ns35_0 temp36_0 temp33_0 temp34_0))" -"(1/current-namespace ns)" -"(1/dynamic-require ''#%kernel 0)))" +"(1/current-namespace ns_0)" +"(1/dynamic-require ''#%kernel 0)))))))" +"(call-with-values(lambda()(namespace-init!)) print-values)" "(define-values(datum->kernel-syntax)(lambda(s_0)(begin(1/datum->syntax core-stx s_0))))" "(define-values" "(expander-place-init!)" @@ -78737,5 +78781,6 @@ static const char *startup_source = "(module-path-place-init!)" "(module-cache-place-init!)" "(collection-place-init!)" -"(performance-place-init!))))))" +"(performance-place-init!)" +"(namespace-init!))))))" ;