suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco exe: add ++lang support

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2018-09-01 21:24:35 -06:00
parent 3127bc239b
commit f03d5c0076
12 changed files with 404 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

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

15
pkgs/compiler-lib/compiler/commands/exe.rkt
View File

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

54
pkgs/compiler-lib/compiler/private/language.rkt Normal file
View File

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

16
pkgs/compiler-test/tests/compiler/embed/embed-me32.rkt Normal file
View File

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

16
pkgs/compiler-test/tests/compiler/embed/embed-me33.rkt Normal file
View File

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

20
pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -505,7 +505,7 @@
;; scope: ;; scope:
(member "compatibility-lib" (member "compatibility-lib"
(installed-pkg-names #:scope 'installation))) (installed-pkg-names #:scope 'installation)))
(void))) (void)))
(define (try-mzc) (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-source)
(define (try-one file submod start result) (define (try-one file submod start result)
(define mred? #f) (define mred? #f)
@ -731,6 +748,7 @@
(try-extension)) (try-extension))
(try-gracket) (try-gracket)
(try-reader) (try-reader)
(try-lang)
(try-planet) (try-planet)
(try-*sl) (try-*sl)
(try-source) (try-source)

28
pkgs/racket-doc/scribblings/raco/exe.scrbl
View File

@ -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 @racket[define-runtime-path] to embed references to the run-time files
in the executable; the files are then copied and packaged together in the executable; the files are then copied and packaged together
with the executable when creating a distribution (as described in 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 enclosing module is included and the submodule contains a
sub-submodule named @racketidfont{declare-preserve-for-embedding} sub-submodule named @racketidfont{declare-preserve-for-embedding}
(where the implementation of the sub-submodule is ignored). (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 Modules that are implemented directly by extensions---i.e., extensions
that are automatically loaded from @racket[(build-path "compiled" that are automatically loaded from @racket[(build-path "compiled"
"native" (system-library-subpath))] to satisfy a "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, in the executable, even if it is not referenced by the main program,
so that it is available via @racket[dynamic-require].} 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} @item{@DPFlag{exf} @nonterm{flag} --- provide the @nonterm{flag}
command-line argument on startup to the embedded @exec{racket} or command-line argument on startup to the embedded @exec{racket} or
@exec{gracket}.} @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 @history[#:changed "6.3.0.11" @elem{Added support for
@racketidfont{declare-preserve-for-embedding}.} @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}.}]
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------

16
pkgs/racket-doc/scribblings/reference/module-reflect.scrbl
View File

@ -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 true (indicating that a module should be loaded) and only when loading
succeeds. 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 Module loading is suppressed (i.e., @racket[#f] is supplied as a fourth
argument to the module name resolver) when resolving module paths in argument to the module name resolver) when resolving module paths in
@tech{syntax objects} (see @secref["stxobj-model"]). When a @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" @history[#:changed "6.0.1.12"
@elem{Added error logging to the default module name resolver @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)]{ @defparam[current-module-declare-name name (or/c resolved-module-path? #f)]{

12
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -647,6 +647,18 @@
(test '#(tests/racket/lang/getinfo get-info closure-data) (test '#(tests/racket/lang/getinfo get-info closure-data)
module->language-info 'tests/racket/langm)))) 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: ;; Check shadowing of initial imports:

272
racket/src/expander/boot/handler.rkt
View File

@ -392,6 +392,13 @@
msg msg
(current-continuation-marks) (current-continuation-marks)
s)))))] 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) [ss->rkt (lambda (s)
(let ([len (string-length s)]) (let ([len (string-length s)])
(if (and (len . >= . 3) (if (and (len . >= . 3)
@ -442,17 +449,27 @@
#f)) #f))
#f)]) #f)])
(let ([s-parsed (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 (cond
[(symbol? s) [(symbol? s)
(or (path-cache-get (cons s (get-reg))) (or (path-cache-get (cons s (get-reg)))
(let-values ([(cols file) (split-relative-string (symbol->string s) #f)]) (let-values ([(cols file) (split-relative-string (symbol->string s) #f)])
(let* ([f-file (if (null? cols) (let* ([f-file (if (null? cols)
"main.rkt" "main.rkt"
(string-append file ".rkt"))]) (string-append file ".rkt"))]
(find-col-file show-collection-err [col (if (null? cols) file (car cols))]
(if (null? cols) file (car cols)) [col-path (if (null? cols) null (cdr cols))])
(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 f-file
#t))))] #t))))]
[(string? s) [(string? s)
@ -511,125 +528,132 @@
;; Use filesystem-sensitive `simplify-path' here: ;; Use filesystem-sensitive `simplify-path' here:
(path-ss->rkt (path-ss->rkt
(simplify-path (path->complete-path (expand-user-path (cadr s)) (get-dir))))])]) (simplify-path (path->complete-path (expand-user-path (cadr s)) (get-dir))))])])
(unless (or (path? s-parsed) (cond
(vector? s-parsed)) [(symbol? s-parsed)
(if stx ;; Return a genenerated symnol
(raise-syntax-error (make-resolved-module-path
'require (cons s-parsed subm-path))]
(format "bad module path~a" (if s-parsed [(not (or (path? s-parsed)
(car s-parsed) (vector? s-parsed)))
"")) (if stx
stx) (raise-syntax-error
(raise-argument-error 'require
'standard-module-name-resolver (format "bad module path~a" (if s-parsed
"module-path?" (car s-parsed)
s))) ""))
;; At this point, s-parsed is a complete path (or a cached vector) stx)
(let* ([filename (if (vector? s-parsed) (raise-argument-error
(vector-ref s-parsed 0) 'standard-module-name-resolver
(simplify-path (cleanse-path s-parsed) #f))] "module-path?"
[normal-filename (if (vector? s-parsed) s))]
(vector-ref s-parsed 1) [else
(normal-case-path filename))]) ;; At this point, s-parsed is a complete path (or a cached vector)
(let-values ([(base name dir?) (if (vector? s-parsed) (define filename (if (vector? s-parsed)
(values 'ignored (vector-ref s-parsed 2) 'ignored) (vector-ref s-parsed 0)
(split-path filename))]) (simplify-path (cleanse-path s-parsed) #f)))
(let* ([no-sfx (if (vector? s-parsed) (define normal-filename (if (vector? s-parsed)
(vector-ref s-parsed 3) (vector-ref s-parsed 1)
(path-replace-extension name #""))]) (normal-case-path filename)))
(let* ([root-modname (if (vector? s-parsed) (define-values (base name dir?) (if (vector? s-parsed)
(vector-ref s-parsed 4) (values 'ignored (vector-ref s-parsed 2) 'ignored)
(make-resolved-module-path filename))] (split-path filename)))
[hts (or (registry-table-ref (get-reg)) (define no-sfx (if (vector? s-parsed)
(let ([hts (cons (make-hasheq) (make-hasheq))]) (vector-ref s-parsed 3)
(registry-table-set! (get-reg) (path-replace-extension name #"")))
hts) (define root-modname (if (vector? s-parsed)
hts))] (vector-ref s-parsed 4)
[modname (if subm-path (make-resolved-module-path filename)))
(make-resolved-module-path (define hts (or (registry-table-ref (get-reg))
(cons (resolved-module-path-name root-modname) (let ([hts (cons (make-hasheq) (make-hasheq))])
subm-path)) (registry-table-set! (get-reg)
root-modname)]) hts)
;; Loaded already? hts)))
(when load? (define modname (if subm-path
(let ([got (hash-ref (car hts) modname #f)]) (make-resolved-module-path
(unless got (cons (resolved-module-path-name root-modname)
;; Currently loading? subm-path))
(let ([loading root-modname))
(let ([tag (if (continuation-prompt-available? -loading-prompt-tag) ;; Loaded already?
-loading-prompt-tag (when load?
(default-continuation-prompt-tag))]) (let ([got (hash-ref (car hts) modname #f)])
(continuation-mark-set-first (unless got
#f ;; Currently loading?
-loading-filename (let ([loading
null (let ([tag (if (continuation-prompt-available? -loading-prompt-tag)
tag))] -loading-prompt-tag
[nsr (get-reg)]) (default-continuation-prompt-tag))])
(for-each (continuation-mark-set-first
(lambda (s) #f
(when (and (equal? (cdr s) normal-filename) -loading-filename
(eq? (car s) nsr)) null
(error tag))]
'standard-module-name-resolver [nsr (get-reg)])
"cycle in loading\n at path: ~a\n paths:~a" (for-each
filename (lambda (s)
(apply string-append (when (and (equal? (cdr s) normal-filename)
(let loop ([l (reverse loading)]) (eq? (car s) nsr))
(if (null? l) (error
'() 'standard-module-name-resolver
(list* "\n " (path->string (cdar l)) (loop (cdr l))))))))) "cycle in loading\n at path: ~a\n paths:~a"
loading) filename
((if (continuation-prompt-available? -loading-prompt-tag) (apply string-append
(lambda (f) (f)) (let loop ([l (reverse loading)])
(lambda (f) (call-with-continuation-prompt f -loading-prompt-tag))) (if (null? l)
(lambda () '()
(with-continuation-mark -loading-filename (cons (cons nsr normal-filename) (list* "\n " (path->string (cdar l)) (loop (cdr l)))))))))
loading) loading)
(parameterize ([current-module-declare-name root-modname] ((if (continuation-prompt-available? -loading-prompt-tag)
[current-module-path-for-load (lambda (f) (f))
;; If `s' is an absolute module path, then (lambda (f) (call-with-continuation-prompt f -loading-prompt-tag)))
;; keep it as-is, the better to let a tool (lambda ()
;; recommend how to get an unavailable module; (with-continuation-mark
;; also, propagate the source location. -loading-filename (cons (cons nsr normal-filename)
((if stx loading)
(lambda (p) (datum->syntax #f p stx)) (parameterize ([current-module-declare-name root-modname]
values) [current-module-path-for-load
(cond ;; If `s' is an absolute module path, then
[(symbol? s) s] ;; keep it as-is, the better to let a tool
[(and (pair? s) (eq? (car s) 'lib)) s] ;; recommend how to get an unavailable module;
[else (if (resolved-module-path? root-modname) ;; also, propagate the source location.
(let ([src (resolved-module-path-name root-modname)]) ((if stx
(if (symbol? src) (lambda (p) (datum->syntax #f p stx))
(list 'quote src) values)
src)) (cond
root-modname)]))]) [(symbol? s) s]
((current-load/use-compiled) [(and (pair? s) (eq? (car s) 'lib)) s]
filename [else (if (resolved-module-path? root-modname)
(let ([sym (string->symbol (path->string no-sfx))]) (let ([src (resolved-module-path-name root-modname)])
(if subm-path (if (symbol? src)
(if (hash-ref (car hts) root-modname #f) (list 'quote src)
;; Root is already loaded, so only use .zo src))
(cons #f subm-path) root-modname)]))])
;; Root isn't loaded, so it's ok to load form source: ((current-load/use-compiled)
(cons sym subm-path)) filename
sym))))))))))) (let ([sym (string->symbol (path->string no-sfx))])
;; If a `lib' path, cache pathname manipulations (if subm-path
(when (and (not (vector? s-parsed)) (if (hash-ref (car hts) root-modname #f)
load? ;; Root is already loaded, so only use .zo
(or (string? s) (cons #f subm-path)
(symbol? s) ;; Root isn't loaded, so it's ok to load form source:
(and (pair? s) (cons sym subm-path))
(eq? (car s) 'lib)))) sym)))))))))))
(path-cache-set! (if (string? s) ;; If a `lib' path, cache pathname manipulations
(cons s (get-dir)) (when (and (not (vector? s-parsed))
(cons s (get-reg))) load?
(vector filename (or (string? s)
normal-filename (symbol? s)
name (and (pair? s)
no-sfx (eq? (car s) 'lib))))
root-modname))) (path-cache-set! (if (string? s)
;; Result is the module name: (cons s (get-dir))
modname))))))])])) (cons s (get-reg)))
(vector filename
normal-filename
name
no-sfx
root-modname)))
;; Result is the module name:
modname])))])]))
(define default-eval-handler (define default-eval-handler
(lambda (s) (lambda (s)

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "7.0.0.16" #define MZSCHEME_VERSION "7.0.0.17"
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

121
racket/src/racket/src/startup.inc
View File

@ -60840,6 +60840,14 @@ static const char *startup_source =
" msg_1" " msg_1"
"(current-continuation-marks)" "(current-continuation-marks)"
" s_0)))))))" " 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)" "((ss->rkt_0)"
"(lambda(s_1)" "(lambda(s_1)"
"(begin" "(begin"
@ -60908,12 +60916,20 @@ static const char *startup_source =
"(if(null? cols_0)" "(if(null? cols_0)"
" \"main.rkt\"" " \"main.rkt\""
" (string-append file_0 \".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" "(find-col-file"
"(if(not subm-path_0)"
" show-collection-err_0" " show-collection-err_0"
"(if(null? cols_0) file_0(car cols_0))" "(invent-collection-dir_0"
"(if(null? cols_0) null(cdr cols_0))"
" f-file_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)" "(if(string? s_1)"
"(let-values()" "(let-values()"
"(let-values(((dir_0)(get-dir_0)))" "(let-values(((dir_0)(get-dir_0)))"
@ -60987,17 +61003,19 @@ static const char *startup_source =
"(simplify-path" "(simplify-path"
"(path->complete-path(expand-user-path(cadr s_1))(get-dir_0)))))" "(path->complete-path(expand-user-path(cadr s_1))(get-dir_0)))))"
"(void))))))))" "(void))))))))"
"(begin" "(if(symbol? s-parsed_0)"
"(if(let-values(((or-part_0)(path? s-parsed_0)))" "(let-values()(1/make-resolved-module-path(cons s-parsed_0 subm-path_0)))"
"(if or-part_0 or-part_0(vector? s-parsed_0)))" "(if(not"
"(void)" "(let-values(((or-part_0)(path? s-parsed_0)))"
"(if or-part_0 or-part_0(vector? s-parsed_0))))"
"(let-values()" "(let-values()"
"(if stx_0" "(if stx_0"
"(raise-syntax-error$1" "(raise-syntax-error$1"
" 'require" " 'require"
" (format \"bad module path~a\" (if s-parsed_0 (car s-parsed_0) \"\"))" " (format \"bad module path~a\" (if s-parsed_0 (car s-parsed_0) \"\"))"
" stx_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)" "(let-values(((filename_0)"
"(if(vector? s-parsed_0)" "(if(vector? s-parsed_0)"
"(vector-ref s-parsed_0 0)" "(vector-ref s-parsed_0 0)"
@ -61013,7 +61031,7 @@ static const char *startup_source =
"(let-values(((no-sfx_0)" "(let-values(((no-sfx_0)"
"(if(vector? s-parsed_0)" "(if(vector? s-parsed_0)"
"(vector-ref s-parsed_0 3)" "(vector-ref s-parsed_0 3)"
" (path-replace-extension name_0 #\"\"))))" " (path-replace-extension name_0 #\"\"))))"
"(let-values(((root-modname_0)" "(let-values(((root-modname_0)"
"(if(vector? s-parsed_0)" "(if(vector? s-parsed_0)"
"(vector-ref s-parsed_0 4)" "(vector-ref s-parsed_0 4)"
@ -61023,7 +61041,9 @@ static const char *startup_source =
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(let-values(((hts_0)(cons(make-hasheq)(make-hasheq))))" "(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)" "(let-values(((modname_0)"
"(if subm-path_0" "(if subm-path_0"
"(1/make-resolved-module-path" "(1/make-resolved-module-path"
@ -61059,7 +61079,7 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(error" "(error"
" 'standard-module-name-resolver" " '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" " filename_0"
"(apply" "(apply"
" string-append" " string-append"
@ -61070,14 +61090,17 @@ static const char *startup_source =
"(if(null? l_0)" "(if(null? l_0)"
" '()" " '()"
"(list*" "(list*"
" \"\\n \"" " \"\\n \""
"(path->string(cdar l_0))" "(path->string"
"(loop_0(cdr l_0))))))))" "(cdar l_0))"
"(loop_0"
"(cdr l_0))))))))"
" loop_0)" " loop_0)"
"(reverse$1 loading_0)))))" "(reverse$1 loading_0)))))"
"(void)))" "(void)))"
" loading_0)" " loading_0)"
"((if(continuation-prompt-available? -loading-prompt-tag)" "((if(continuation-prompt-available?"
" -loading-prompt-tag)"
"(lambda(f_0)(f_0))" "(lambda(f_0)(f_0))"
"(lambda(f_0)" "(lambda(f_0)"
"(call-with-continuation-prompt" "(call-with-continuation-prompt"
@ -61090,7 +61113,9 @@ static const char *startup_source =
"(with-continuation-mark" "(with-continuation-mark"
" parameterization-key" " parameterization-key"
"(extend-parameterization" "(extend-parameterization"
"(continuation-mark-set-first #f parameterization-key)" "(continuation-mark-set-first"
" #f"
" parameterization-key)"
" 1/current-module-declare-name" " 1/current-module-declare-name"
" root-modname_0" " root-modname_0"
" 1/current-module-path-for-load" " 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)" "(if(if(pair? s_1)(eq?(car s_1) 'lib) #f)"
"(let-values() s_1)" "(let-values() s_1)"
"(let-values()" "(let-values()"
"(if(1/resolved-module-path? root-modname_0)" "(if(1/resolved-module-path?"
" root-modname_0)"
"(let-values(((src_0)" "(let-values(((src_0)"
"(1/resolved-module-path-name" "(1/resolved-module-path-name"
" root-modname_0)))" " root-modname_0)))"
@ -61143,7 +61169,7 @@ static const char *startup_source =
" no-sfx_0" " no-sfx_0"
" root-modname_0)))" " root-modname_0)))"
"(void))" "(void))"
" modname_0))))))))))))))))))))))))" " modname_0))))))))))))))))))))))))))"
"(define-values" "(define-values"
"(default-eval-handler)" "(default-eval-handler)"
"(lambda(s_0)" "(lambda(s_0)"
@ -78575,34 +78601,43 @@ static const char *startup_source =
"(let-values(((obs_0)(expand-context-observer ctx_0)))" "(let-values(((obs_0)(expand-context-observer ctx_0)))"
"(if obs_0(let-values()(let-values()(call-expand-observe obs_0 'prim-provide)))(void)))" "(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)))))" " (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" "(void"
"(begin" "(begin"
"(declare-core-module! ns)" "(declare-core-module! ns_0)"
"(let-values(((temp1_0) '#%read)((read-primitives2_0) read-primitives)((ns3_0) ns))" "(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))" "(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))" "(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))" "(declare-hash-based-module!41.1 ns9_0 #f null #f #f temp7_0 utils-primitives8_0))"
"(let-values(((temp10_0) '#%place-struct)" "(let-values(((temp10_0) '#%place-struct)"
"((place-struct-primitives11_0) place-struct-primitives)" "((place-struct-primitives11_0) place-struct-primitives)"
"((ns12_0) ns)" "((ns12_0) ns_0)"
"((temp13_0) '(dynamic-place)))" "((temp13_0) '(dynamic-place)))"
"(declare-hash-based-module!41.1 ns12_0 #f temp13_0 #f #f temp10_0 place-struct-primitives11_0))" "(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))" "(declare-hash-based-module!41.1 ns16_0 #f null #f #f temp14_0 boot-primitives15_0))"
"(let-values(((linklet-primitives_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)" "(let-values(((temp17_0) '#%linklet)"
"((linklet-primitives18_0) linklet-primitives_0)" "((linklet-primitives18_0) linklet-primitives_0)"
"((ns19_0) ns)" "((ns19_0) ns_0)"
"((temp20_0) #t)" "((temp20_0) #t)"
"((temp21_0) #t))" "((temp21_0) #t))"
"(declare-hash-based-module!41.1 ns19_0 temp20_0 null #f temp21_0 temp17_0 linklet-primitives18_0)))" "(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))" "(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)" "((eval27_0) 1/eval)"
"((temp28_0)" "((temp28_0)"
"(let-values(((ht_0) main-primitives))" "(let-values(((ht_0) main-primitives))"
@ -78623,9 +78658,13 @@ static const char *startup_source =
"(let-values(((key_0 val_0)" "(let-values(((key_0 val_0)"
"(let-values()" "(let-values()"
"(values" "(values"
"(let-values() name_0)" "(let-values()"
" name_0)"
" #t))))" " #t))))"
"(hash-set table_1 key_0 val_0)))))" "(hash-set"
" table_1"
" key_0"
" val_0)))))"
"(values table_2)))))" "(values table_2)))))"
"(if(not #f)" "(if(not #f)"
"(for-loop_0 table_1(hash-iterate-next ht_0 i_0))" "(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(((key_0 val_0)"
"(let-values()" "(let-values()"
"(values" "(values"
"(let-values() name_0)" "(let-values()"
" name_0)"
" #t))))" " #t))))"
"(hash-set table_1 key_0 val_0)))))" "(hash-set"
" table_1"
" key_0"
" val_0)))))"
"(values table_2)))))" "(values table_2)))))"
"(if(not #f)" "(if(not #f)"
"(for-loop_0 table_1(hash-iterate-next ht_0 i_0))" "(for-loop_0 table_1(hash-iterate-next ht_0 i_0))"
@ -78685,7 +78728,7 @@ static const char *startup_source =
"(begin" "(begin"
"(let-values()" "(let-values()"
"(let-values(((name30_0) name_0)" "(let-values(((name30_0) name_0)"
"((ns31_0) ns)" "((ns31_0) ns_0)"
"((temp32_0)" "((temp32_0)"
"(let-values(((or-part_0)" "(let-values(((or-part_0)"
"(eq?" "(eq?"
@ -78720,11 +78763,12 @@ static const char *startup_source =
"(void))" "(void))"
"(let-values(((temp33_0) '#%builtin)" "(let-values(((temp33_0) '#%builtin)"
"((temp34_0)(list* '#%place-struct '#%utils '#%boot '#%expobs '#%linklet runtime-instances))" "((temp34_0)(list* '#%place-struct '#%utils '#%boot '#%expobs '#%linklet runtime-instances))"
"((ns35_0) ns)" "((ns35_0) ns_0)"
"((temp36_0) #f))" "((temp36_0) #f))"
"(declare-reexporting-module!50.1 ns35_0 temp36_0 temp33_0 temp34_0))" "(declare-reexporting-module!50.1 ns35_0 temp36_0 temp33_0 temp34_0))"
"(1/current-namespace ns)" "(1/current-namespace ns_0)"
"(1/dynamic-require ''#%kernel 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(datum->kernel-syntax)(lambda(s_0)(begin(1/datum->syntax core-stx s_0))))"
"(define-values" "(define-values"
"(expander-place-init!)" "(expander-place-init!)"
@ -78737,5 +78781,6 @@ static const char *startup_source =
"(module-path-place-init!)" "(module-path-place-init!)"
"(module-cache-place-init!)" "(module-cache-place-init!)"
"(collection-place-init!)" "(collection-place-init!)"
"(performance-place-init!))))))" "(performance-place-init!)"
"(namespace-init!))))))"
; ;