From a110c58e521e6aa291895e177bd358c0cd7c623b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 20 Feb 2021 14:41:39 -0700 Subject: [PATCH] add 'compiled-file-roots to "config.rktd" --- pkgs/base/info.rkt | 2 +- pkgs/racket-doc/scribblings/raco/config.scrbl | 8 ++++ .../scribblings/reference/eval.scrbl | 26 +++++++++++-- racket/src/bc/cmdline.inc | 3 +- racket/src/bc/src/eval.c | 37 ++++++++++++------- racket/src/bc/src/startup.inc | 18 +++++++++ racket/src/cs/main.sps | 15 +++++--- racket/src/cs/schemified/expander.scm | 17 +++++++++ racket/src/expander/boot/main-primitive.rkt | 1 + racket/src/expander/eval/collection.rkt | 16 +++++++- racket/src/expander/main.rkt | 1 + racket/src/version/racket_version.h | 2 +- 12 files changed, 117 insertions(+), 29 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 9dc6b5456b..d4fe7dd00a 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "8.0.0.8") +(define version "8.0.0.9") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/raco/config.scrbl b/pkgs/racket-doc/scribblings/raco/config.scrbl index 3f97a50b03..f0b6a29727 100644 --- a/pkgs/racket-doc/scribblings/raco/config.scrbl +++ b/pkgs/racket-doc/scribblings/raco/config.scrbl @@ -95,6 +95,14 @@ directory}: @history[#:changed "7.0.0.19" @elem{Adapt the package-search path in a general way for a directory scope.}]} + @item{@indexed-racket['compiled-file-roots] --- a list of paths + and @racket['same] used to initialize @racket[current-compiled-file-roots]. + A path, which is relative or absolute, can be specified as a string + or byte string that is converted to a path with @racket[string->path] + or @racket[bytes->path], respectively. + + @history[#:added "8.0.0.9"]} + @item{@indexed-racket['bin-dir] --- a path, string, or byte string for the installation's directory containing executables. It defaults to a @filepath{bin} sibling directory of the @tech{main collection diff --git a/pkgs/racket-doc/scribblings/reference/eval.scrbl b/pkgs/racket-doc/scribblings/reference/eval.scrbl index d1ba7d7730..27e4c24bd3 100644 --- a/pkgs/racket-doc/scribblings/reference/eval.scrbl +++ b/pkgs/racket-doc/scribblings/reference/eval.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "mz.rkt") +@(require "mz.rkt" + (for-label setup/dirs)) @title[#:tag "eval"]{Evaluation and Compilation} @@ -395,17 +396,34 @@ A list of paths and @racket['same]s that is is used by the default @tech{compiled-load handler} (see @racket[current-load/use-compiled]). The parameter is normally initialized to @racket[(list 'same)], but -the parameter's initial value can be adjusted by the +the parameter's initial value can be adjusted by the installation +configuration as reported by @racket[(find-compiled-file-roots)], +and it can be further adjusted by the @as-index{@envvar{PLTCOMPILEDROOTS}} environment variable or the @DFlag{compiled} or @Flag{R} command-line flag for @exec{racket}. If the environment variable is defined and not overridden by a command-line flag, it is parsed by first replacing any @litchar["@(version)"] with the result of @racket[(version)], then using -@racket[path-list-string->path-list] with a default path list -@racket[(list (build-path 'same))] to arrive at the parameter's +@racket[path-list-string->path-list] with a path list produced by +@racket[(find-compiled-file-roots)] to arrive at the parameter's initial value.} +@defproc[(find-compiled-file-roots) + (listof (or/c path? 'same))]{ + +Produces a list of paths and @racket['same], which is normally used to +initialize @racket[current-compiled-file-roots]. The list is +determined by consulting the @filepath{config.rtkd} file in the +directory reported by @racket[(find-config-dir)], and it defaults to +@racket[(list (build-path 'same))] if not configured there. + +See also @racket['compiled-file-roots] in @secref[#:doc raco-doc +"config-file"]. + +@history[#:added "8.0.0.9"]} + + @defparam[use-compiled-file-check check (or/c 'modify-seconds 'exists)]{ A @tech{parameter} that determines how a compiled file is checked diff --git a/racket/src/bc/cmdline.inc b/racket/src/bc/cmdline.inc index b83ab54c94..8632a10479 100644 --- a/racket/src/bc/cmdline.inc +++ b/racket/src/bc/cmdline.inc @@ -1351,8 +1351,7 @@ static int run_from_cmd_line(int argc, char *_argv[], if (!skip_coll_dirs) scheme_init_collection_paths_post(global_env, collects_paths_l, collects_paths_r); - if (compiled_paths) - scheme_init_compiled_roots(global_env, compiled_paths); + scheme_init_compiled_roots(global_env, compiled_paths); scheme_seal_parameters(); diff --git a/racket/src/bc/src/eval.c b/racket/src/bc/src/eval.c index d5177bcbfe..dbcd9372b8 100644 --- a/racket/src/bc/src/eval.c +++ b/racket/src/bc/src/eval.c @@ -3831,24 +3831,33 @@ void scheme_init_compiled_roots(Scheme_Env *global_env, const char *paths) save = p->error_buf; p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { - Scheme_Object *rr, *ccfr, *pls2pl, *a[3]; + Scheme_Object *rr, *ccfr, *fcfr, *pls2pl, *a[3]; - rr = scheme_builtin_value("regexp-replace*"); + fcfr = scheme_builtin_value("find-compiled-file-roots"); ccfr = scheme_builtin_value("current-compiled-file-roots"); - pls2pl = scheme_builtin_value("path-list-string->path-list"); + if (paths) { + rr = scheme_builtin_value("regexp-replace*"); + pls2pl = scheme_builtin_value("path-list-string->path-list"); + } else + rr = pls2pl = scheme_false; - if (rr && ccfr && pls2pl) { - a[0] = scheme_make_utf8_string("@[(]version[)]"); - a[1] = scheme_make_utf8_string(paths); - a[2] = scheme_make_utf8_string(scheme_version()); - a[2] = _scheme_apply(rr, 3, a); + if (rr && fcfr && ccfr && pls2pl) { + if (paths) { + a[0] = scheme_make_utf8_string("@[(]version[)]"); + a[1] = scheme_make_utf8_string(paths); + a[2] = scheme_make_utf8_string(scheme_version()); + a[2] = _scheme_apply(rr, 3, a); + } + + a[1] = _scheme_apply(fcfr, 0, NULL); - a[0] = scheme_intern_symbol("same"); - a[1] = scheme_build_path(1, a); - - a[0] = a[2]; - a[1] = scheme_make_pair(a[1], scheme_null); - a[0] = _scheme_apply(pls2pl, 2, a); + if (paths) { + a[0] = a[2]; + a[0] = _scheme_apply(pls2pl, 2, a); + } else { + a[0] = a[1]; + } + _scheme_apply(ccfr, 1, a); } } else { diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 276f791c31..95235daadd 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -24,6 +24,7 @@ static const char *startup_source = "(eval$1 eval-top-level)" "(expand$1 expand)" "(expander-place-init! expander-place-init!)" +"(find-compiled-file-roots find-compiled-file-roots)" "(1/find-library-collection-links find-library-collection-links)" "(1/find-library-collection-paths find-library-collection-paths)" "(find-main-config find-main-config)" @@ -52940,6 +52941,13 @@ static const char *startup_source = "(get-installation-name)" "(lambda(config-table_0)(begin(hash-ref config-table_0 'installation-name(version)))))" "(define-values" +"(coerce-to-relative-path)" +"(lambda(p_0)" +"(begin" +"(if(string? p_0)" +"(let-values()(string->path p_0))" +"(if(bytes? p_0)(let-values()(bytes->path p_0))(let-values() p_0))))))" +"(define-values" "(coerce-to-path)" "(lambda(p_0)" "(begin" @@ -53460,6 +53468,14 @@ static const char *startup_source = "((extra-collects-dirs_0 post-collects-dirs2_0)" "(find-library-collection-paths_0 extra-collects-dirs_0 post-collects-dirs2_0))" "((extra-collects-dirs1_0)(find-library-collection-paths_0 extra-collects-dirs1_0 null)))))" +"(define-values" +"(find-compiled-file-roots)" +"(lambda()" +"(begin" +"(let-values(((ht_0)(get-config-table(find-main-config))))" +"(let-values(((paths_0)(hash-ref ht_0 'compiled-file-roots #f)))" +"(let-values(((or-part_0)(if(list? paths_0)(map2 coerce-to-relative-path paths_0) #f)))" +"(if or-part_0 or-part_0(list(build-path 'same)))))))))" "(define-values(prop:readtable prop:readtable? prop:readtable-ref)(make-struct-type-property 'readtable))" "(define-values" "(1/current-readtable)" @@ -65923,6 +65939,8 @@ static const char *startup_source = " 1/find-library-collection-paths" " 'find-library-collection-links" " 1/find-library-collection-links" +" 'find-compiled-file-roots" +" find-compiled-file-roots" " 'current-library-collection-paths" " 1/current-library-collection-paths" " 'current-library-collection-links" diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index 606f20e5ea..d4f75b1104 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -13,6 +13,7 @@ find-library-collection-paths use-collection-link-paths current-compiled-file-roots + find-compiled-file-roots find-main-config executable-yield-handler load-on-demand-enabled @@ -764,12 +765,14 @@ (find-library-collection-links)) (current-library-collection-paths (find-library-collection-paths collects-pre-extra (reverse rev-collects-post-extra)))) - (when compiled-roots-path-list-string - (current-compiled-file-roots - (let ([s (regexp-replace* "@[(]version[)]" - compiled-roots-path-list-string - (version))]) - (path-list-string->path-list s (list (build-path 'same))))))) + (let ([roots (find-compiled-file-roots)]) + (if compiled-roots-path-list-string + (current-compiled-file-roots + (let ([s (regexp-replace* "@[(]version[)]" + compiled-roots-path-list-string + (version))]) + (path-list-string->path-list s roots))) + (current-compiled-file-roots roots)))) ;; Called when Racket is embedded in a larger application: (define (register-embedded-entry-info! escape) diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index dba7e77c02..d230252223 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -22,6 +22,7 @@ (eval$1 eval-top-level) (expand$1 expand) (expander-place-init! expander-place-init!) + (find-compiled-file-roots find-compiled-file-roots) (1/find-library-collection-links find-library-collection-links) (1/find-library-collection-paths find-library-collection-paths) (find-main-config find-main-config) @@ -59295,6 +59296,11 @@ (define get-installation-name (lambda (config-table_0) (hash-ref config-table_0 'installation-name (version)))) +(define coerce-to-relative-path + (lambda (p_0) + (if (string? p_0) + (string->path p_0) + (if (bytes? p_0) (bytes->path p_0) p_0)))) (define coerce-to-path (lambda (p_0) (if (string? p_0) @@ -59994,6 +60000,15 @@ post-collects-dirs2_0)) ((extra-collects-dirs1_0) (find-library-collection-paths_0 extra-collects-dirs1_0 null)))))) +(define find-compiled-file-roots + (lambda () + (let ((ht_0 (get-config-table (find-main-config)))) + (let ((paths_0 (hash-ref ht_0 'compiled-file-roots #f))) + (let ((or-part_0 + (if (list? paths_0) + (map_1346 coerce-to-relative-path paths_0) + #f))) + (if or-part_0 or-part_0 (list (build-path 'same)))))))) (define-values (prop:readtable prop:readtable? prop:readtable-ref) (make-struct-type-property 'readtable)) @@ -73394,6 +73409,8 @@ 1/find-library-collection-paths 'find-library-collection-links 1/find-library-collection-links + 'find-compiled-file-roots + find-compiled-file-roots 'current-library-collection-paths 1/current-library-collection-paths 'current-library-collection-links diff --git a/racket/src/expander/boot/main-primitive.rkt b/racket/src/expander/boot/main-primitive.rkt index 4fee1a9b8d..574afeb6a4 100644 --- a/racket/src/expander/boot/main-primitive.rkt +++ b/racket/src/expander/boot/main-primitive.rkt @@ -40,6 +40,7 @@ 'collection-file-path collection-file-path 'find-library-collection-paths find-library-collection-paths 'find-library-collection-links find-library-collection-links + 'find-compiled-file-roots find-compiled-file-roots 'current-library-collection-paths current-library-collection-paths 'current-library-collection-links current-library-collection-links diff --git a/racket/src/expander/eval/collection.rkt b/racket/src/expander/eval/collection.rkt index 8898e8fa5f..2be2ada4eb 100644 --- a/racket/src/expander/eval/collection.rkt +++ b/racket/src/expander/eval/collection.rkt @@ -12,7 +12,8 @@ collection-file-path find-library-collection-paths find-library-collection-links - + find-compiled-file-roots + find-col-file collection-place-init!) @@ -70,6 +71,12 @@ 'installation-name (version))) +(define (coerce-to-relative-path p) + (cond + [(string? p) (string->path p)] + [(bytes? p) (bytes->path p)] + [else p])) + (define (coerce-to-path p) (cond [(string? p) (collects-relative-path->complete-path (string->path p))] @@ -492,3 +499,10 @@ (cons (simplify-path (path->complete-path v (current-directory))) (loop (cdr l))) (loop (cdr l))))))))))) + +(define (find-compiled-file-roots) + (define ht (get-config-table (find-main-config))) + (define paths (hash-ref ht 'compiled-file-roots #f)) + (or (and (list? paths) + (map coerce-to-relative-path paths)) + (list (build-path 'same)))) diff --git a/racket/src/expander/main.rkt b/racket/src/expander/main.rkt index 48297a4806..0d9cabeeae 100644 --- a/racket/src/expander/main.rkt +++ b/racket/src/expander/main.rkt @@ -69,6 +69,7 @@ find-library-collection-paths find-library-collection-links + find-compiled-file-roots find-main-config current-library-collection-paths diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 92384cd2b0..911bcb7e6f 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 8 +#define MZSCHEME_VERSION_W 9 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x