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

repair collection-file-path and default current-compiled-file-roots

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2021-02-25 12:57:17 -07:00
parent 7f34da35e7
commit 70c763833d
4 changed files with 38 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-doc/scribblings/reference/eval.scrbl
View File

@ -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"].

18
racket/src/bc/src/startup.inc
View File

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

38
racket/src/cs/schemified/expander.scm
View File

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

12
racket/src/expander/eval/collection.rkt
View File

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