From 70c763833d51a07ff37e7fe614558b990f058ac4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 25 Feb 2021 12:57:17 -0700 Subject: [PATCH] repair collection-file-path and default current-compiled-file-roots The `collection-file-path` function did not handle compiled-file root paths correctly. The problem was exposed by a recent change to the default for `current-compiled-file-roots`, which made it match the documentation, but this commit changes it back and fixes the documentation. --- .../scribblings/reference/eval.scrbl | 2 +- racket/src/bc/src/startup.inc | 18 +++++---- racket/src/cs/schemified/expander.scm | 38 ++++++++++--------- racket/src/expander/eval/collection.rkt | 12 +++--- 4 files changed, 38 insertions(+), 32 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/eval.scrbl b/pkgs/racket-doc/scribblings/reference/eval.scrbl index 27e4c24bd3..4d5c694857 100644 --- a/pkgs/racket-doc/scribblings/reference/eval.scrbl +++ b/pkgs/racket-doc/scribblings/reference/eval.scrbl @@ -416,7 +416,7 @@ 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. +@racket[(list 'same)] if not configured there. See also @racket['compiled-file-roots] in @secref[#:doc raco-doc "config-file"]. diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 95235daadd..a76540b8b6 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -24,7 +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-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)" @@ -53403,12 +53403,13 @@ static const char *startup_source = "(ormap2" "(lambda(mode_0)" "(file-exists?" -"(let-values(((p_0)(build-path dir_0 mode_0 try-path_0)))" +"(let-values(((dir_1)" "(if(eq? d_0 'same)" -"(let-values() p_0)" +"(let-values() dir_0)" "(if(relative-path? d_0)" -"(let-values()(build-path p_0 d_0))" -"(let-values()(reroot-path p_0 d_0)))))))" +"(let-values()(build-path dir_0 d_0))" +"(let-values()(reroot-path dir_0 d_0))))))" +"(build-path dir_1 mode_0 try-path_0))))" " modes_0))" " roots_0))" " #f))))))" @@ -53469,13 +53470,14 @@ static const char *startup_source = "(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)" +"(1/find-compiled-file-roots)" "(lambda()" "(begin" +" 'find-compiled-file-roots" "(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)))))))))" +"(if or-part_0 or-part_0(list 'same))))))))" "(define-values(prop:readtable prop:readtable? prop:readtable-ref)(make-struct-type-property 'readtable))" "(define-values" "(1/current-readtable)" @@ -65940,7 +65942,7 @@ static const char *startup_source = " 'find-library-collection-links" " 1/find-library-collection-links" " 'find-compiled-file-roots" -" find-compiled-file-roots" +" 1/find-compiled-file-roots" " 'current-library-collection-paths" " 1/current-library-collection-paths" " 'current-library-collection-links" diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index d230252223..6a0b461a04 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -22,7 +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-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) @@ -59919,12 +59919,13 @@ (ormap_2765 (lambda (mode_0) (file-exists? - (let ((p_0 (build-path dir_0 mode_0 try-path_1))) - (if (eq? d_0 'same) - p_0 - (if (relative-path? d_0) - (build-path p_0 d_0) - (reroot-path p_0 d_0)))))) + (let ((dir_1 + (if (eq? d_0 'same) + dir_0 + (if (relative-path? d_0) + (build-path dir_0 d_0) + (reroot-path dir_0 d_0))))) + (build-path dir_1 mode_0 try-path_1)))) modes_1)) roots_0)))))) #f))))) @@ -60000,15 +60001,18 @@ 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 1/find-compiled-file-roots + (|#%name| + find-compiled-file-roots + (lambda () + (begin + (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 'same))))))))) (define-values (prop:readtable prop:readtable? prop:readtable-ref) (make-struct-type-property 'readtable)) @@ -73410,7 +73414,7 @@ 'find-library-collection-links 1/find-library-collection-links 'find-compiled-file-roots - find-compiled-file-roots + 1/find-compiled-file-roots 'current-library-collection-paths 1/current-library-collection-paths 'current-library-collection-links diff --git a/racket/src/expander/eval/collection.rkt b/racket/src/expander/eval/collection.rkt index 2be2ada4eb..8b3fce03b6 100644 --- a/racket/src/expander/eval/collection.rkt +++ b/racket/src/expander/eval/collection.rkt @@ -459,11 +459,11 @@ (ormap (lambda (d) (ormap (lambda (mode) (file-exists? - (let ([p (build-path dir mode try-path)]) - (cond - [(eq? d 'same) p] - [(relative-path? d) (build-path p d)] - [else (reroot-path p d)])))) + (let ([dir (cond + [(eq? d 'same) dir] + [(relative-path? d) (build-path dir d)] + [else (reroot-path dir d)])]) + (build-path dir mode try-path)))) modes)) roots))))) @@ -505,4 +505,4 @@ (define paths (hash-ref ht 'compiled-file-roots #f)) (or (and (list? paths) (map coerce-to-relative-path paths)) - (list (build-path 'same)))) + (list 'same)))