add collection-file-path and splace collection trees at the file level
This commit is contained in:
Matthew Flatt
parent
4359783d8b
commit
5f1aa418f3
|
|
@ -133,8 +133,7 @@
|
|||
(define (prepare-macosx-mred exec-name dest aux variant)
|
||||
(let* ([name (let-values ([(base name dir?) (split-path dest)])
|
||||
(path-replace-suffix name #""))]
|
||||
[src (build-path (collection-path "launcher")
|
||||
"Starter.app")]
|
||||
[src (collection-file-path "Starter.app" "launcher")]
|
||||
[creator (let ([c (assq 'creator aux)])
|
||||
(or (and c
|
||||
(cdr c))
|
||||
|
|
@ -919,10 +918,11 @@
|
|||
`(lib ,(car s) ,@(reverse (cdr s)))))))
|
||||
p)])
|
||||
(ss<->rkt
|
||||
(build-path (if (null? (cddr p))
|
||||
(collection-path "mzlib")
|
||||
(apply collection-path (cddr p)))
|
||||
(cadr p))))]
|
||||
(apply collection-file-path
|
||||
(cadr p)
|
||||
(if (null? (cddr p))
|
||||
(list "mzlib")
|
||||
(cddr p)))))]
|
||||
[else p])])
|
||||
(and p
|
||||
(path->bytes
|
||||
|
|
|
|||
|
|
@ -39,13 +39,7 @@
|
|||
(apply build-path p args)))
|
||||
|
||||
(define (find-library name . cp)
|
||||
(let ([dir (with-handlers ([exn:fail:filesystem? (lambda (exn) #f)])
|
||||
(if (null? cp)
|
||||
(collection-path "mzlib")
|
||||
(apply collection-path cp)))])
|
||||
(and dir
|
||||
(let ([file (build-path dir name)])
|
||||
(and (file-exists? file) file)))))
|
||||
(apply collection-file-path name cp))
|
||||
|
||||
(define (-call-with-input-file* file thunk . flags)
|
||||
(let ([p (apply mz:open-input-file file flags)])
|
||||
|
|
|
|||
|
|
@ -38,10 +38,11 @@
|
|||
"`lib' keyword is not followed by a sequence of string datums"
|
||||
stx
|
||||
fn))
|
||||
(build-path (if (null? (cdr l))
|
||||
(collection-path "mzlib")
|
||||
(apply collection-path (cdr l)))
|
||||
(car l)))]
|
||||
(apply collection-file-path
|
||||
(car l)
|
||||
(if (null? (cdr l))
|
||||
(list "mzlib")
|
||||
(cdr l))))]
|
||||
[else
|
||||
(raise-syntax-error
|
||||
#f
|
||||
|
|
|
|||
|
|
@ -78,12 +78,13 @@
|
|||
(let ([s (cadr p)])
|
||||
(if (regexp-match? #rx"[./]" s)
|
||||
s
|
||||
(string-append s "/main.rkt"))))]
|
||||
[dir (if (and (null? (cddr p))
|
||||
(null? (cdr strs)))
|
||||
(collection-path "mzlib")
|
||||
(apply collection-path (append (cddr p) (drop-right strs 1))))])
|
||||
(build-path dir (last strs)))]
|
||||
(string-append s "/main.rkt"))))])
|
||||
(apply collection-file-path
|
||||
(last strs)
|
||||
(if (and (null? (cddr p))
|
||||
(null? (cdr strs)))
|
||||
(list "mzlib")
|
||||
(append (cddr p) (drop-right strs 1)))))]
|
||||
[else (error 'runtime-path "unknown form: ~e" p)])))
|
||||
paths)))
|
||||
|
||||
|
|
|
|||
|
|
@ -164,8 +164,8 @@
|
|||
;; Last chance: check for a "defaults" collection:
|
||||
;; (error here in case there's no "defaults"
|
||||
;; bails out through above `with-handlers')
|
||||
(build-path (collection-path "defaults")
|
||||
"racket-prefs.rktd"))))))]
|
||||
(collection-file-path "racket-prefs.rktd"
|
||||
"defaults"))))))]
|
||||
[prefs (with-pref-params
|
||||
(lambda ()
|
||||
(with-input-from-file pref-file read)))])
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
;; #%misc : file utilities, etc. - remaining functions
|
||||
|
||||
(module misc '#%kernel
|
||||
(#%require '#%utils ; built into mzscheme
|
||||
(#%require '#%utils ; built into racket
|
||||
"more-scheme.rkt" "small-scheme.rkt" "define.rkt"
|
||||
(for-syntax '#%kernel "stx.rkt" "stxcase-scheme.rkt" "stxcase.rkt"))
|
||||
|
||||
|
|
@ -179,7 +179,7 @@
|
|||
load/cd
|
||||
load-relative load-relative-extension
|
||||
path-list-string->path-list find-executable-path
|
||||
collection-path load/use-compiled
|
||||
collection-path collection-file-path load/use-compiled
|
||||
guard-evt channel-get channel-try-get channel-put
|
||||
port? displayln
|
||||
find-library-collection-paths))
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
(define jfp-extras
|
||||
(let ([abs (lambda (s)
|
||||
(path->main-collects-relative
|
||||
(build-path (collection-path "scribble") "jfp" s)))])
|
||||
(collection-file-path s "scribble" "jfp")))])
|
||||
(list
|
||||
(make-css-addition (abs "jfp.css"))
|
||||
(make-tex-addition (abs "jfp.tex")))))
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@
|
|||
(define sigplan-extras
|
||||
(let ([abs (lambda (s)
|
||||
(path->main-collects-relative
|
||||
(build-path (collection-path "scribble") "sigplan" s)))])
|
||||
(collection-file-path s "scribble" "sigplan")))])
|
||||
(list
|
||||
(make-css-addition (abs "sigplan.css"))
|
||||
(make-tex-addition (abs "sigplan.tex")))))
|
||||
|
|
|
|||
|
|
@ -63,15 +63,13 @@ For the default @tech{module name resolver}, The search path for
|
|||
collections is determined by the
|
||||
@racket[current-library-collection-paths] parameter. The list of paths
|
||||
in @racket[current-library-collection-paths] is searched from first to
|
||||
last to locate the first collection in a @racket[_rel-string]. To find
|
||||
a sub-collection, the enclosing collection is first found; if the
|
||||
sub-collection is not present in the found enclosing collection, then
|
||||
the search continues by looking for another instance of the enclosing
|
||||
collection, and so on. In other words, the directory tree for each
|
||||
element in the search path is spliced together with the directory
|
||||
trees of other path elements. (The ``splicing'' of tress applies only
|
||||
to directories; a file within a collection is found only within the
|
||||
first instance of the collection.)
|
||||
last to locate the first that contains @racket[_rel-string]. In other
|
||||
words, the filesystem tree for each element in the search path is
|
||||
spliced together with the filesystem trees of other path
|
||||
elements. Some Racket tools rely on unique resolution of module path
|
||||
names, so an installation and
|
||||
@racket[current-library-collection-paths] configuration should not
|
||||
allow multiple files to match the same collection and file name.
|
||||
|
||||
The value of the @racket[current-library-collection-paths] parameter
|
||||
is initialized in the Racket executable to the result of
|
||||
|
|
@ -121,14 +119,29 @@ Produces a list of paths as follows:
|
|||
]}
|
||||
|
||||
|
||||
@defproc[(collection-path [collection string?] ...+) path?]{
|
||||
@defproc[(collection-file-path [file path-string?] [collection path-string?] ...+) path?]{
|
||||
|
||||
Returns the path to a directory containing the libraries of the
|
||||
collection indicated by @racket[collection]s, where the second
|
||||
@racket[collection] (if any) names a sub-collection, and so on. If the
|
||||
Returns the path to the file indicated by @racket[file] in the
|
||||
collection specified by the @racket[collection]s, where the second
|
||||
@racket[collection] (if any) names a sub-collection, and so on. If
|
||||
@racket[file] is not found, but @racket[file] ends in @filepath{.rkt}
|
||||
and a file with the suffix @filepath{.ss} exists, then the directory
|
||||
of the @filepath{.ss} file is used. If @racket[file] is not found and
|
||||
the @filepath{.rkt}/@filepath{.ss} conversion does not apply, but a
|
||||
directory corresponding to the @racket[collection]s is found, then a
|
||||
path using the first such directory is returned. Finally, if the
|
||||
collection is not found, the @exnraise[exn:fail:filesystem].}
|
||||
|
||||
|
||||
@defproc[(collection-path [collection path-string?] ...+) path?]{
|
||||
|
||||
Like @racket[collection-path-path], but without a specified file name,
|
||||
so that the first directory indicated by @racket[collection]s is
|
||||
returned. The @racket[collection-file-path] function normally should
|
||||
be used, instead, to support splicing of library-collection trees at
|
||||
the file level.}
|
||||
|
||||
|
||||
@defparam[current-library-collection-paths paths (listof (and/c path? complete-path?))]{
|
||||
|
||||
Parameter that determines a list of complete directory paths for
|
||||
|
|
|
|||
|
|
@ -2039,7 +2039,14 @@ Like @racket[define], except that the binding is at @tech{phase level}
|
|||
expression for the binding is also at @tech{phase level} 1. (See
|
||||
@secref["id-model"] for information on @tech{phase levels}.)
|
||||
Evaluation of @racket[expr] side is @racket[parameterize]d to set
|
||||
@racket[current-namespace] as in @racket[let-syntax].}
|
||||
@racket[current-namespace] as in @racket[let-syntax].
|
||||
|
||||
Within a module, bindings introduced by @racket[define-for-syntax]
|
||||
must appear before their uses or in the same
|
||||
@racket[define-for-syntax] form (i.e., the @racket[define-for-syntax]
|
||||
form must be expanded before the use is expanded). In particular,
|
||||
mutually recursive functions bound by @racket[define-for-syntax] must
|
||||
be defined by the same @racket[define-for-syntax] form.
|
||||
|
||||
@defexamples[#:eval (syntax-eval)
|
||||
(define-for-syntax helper 2)
|
||||
|
|
@ -2073,7 +2080,7 @@ bound (at @tech{phase level} 1).}
|
|||
(printf "foo1 is ~a foo2 is ~a\n" foo1 foo2)
|
||||
#'2)
|
||||
(bar)
|
||||
]
|
||||
]}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
(define autobib-style-extras
|
||||
(let ([abs (lambda (s)
|
||||
(path->main-collects-relative
|
||||
(build-path (collection-path "scriblib") s)))])
|
||||
(collection-file-path s "scriblib")))])
|
||||
(list
|
||||
(make-css-addition (abs "autobib.css"))
|
||||
(make-tex-addition (abs "autobib.tex")))))
|
||||
|
|
|
|||
|
|
@ -17,7 +17,8 @@
|
|||
|
||||
(define figure-style-extras
|
||||
(let ([abs (lambda (s)
|
||||
(build-path (collection-path "scriblib") s))])
|
||||
(path->main-collects-relative
|
||||
(collection-file-path s "scriblib")))])
|
||||
(list (make-css-addition (abs "figure.css"))
|
||||
(make-tex-addition (abs "figure.tex")))))
|
||||
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
scribble/html-properties
|
||||
scribble/latex-properties
|
||||
racket/promise
|
||||
setup/main-collects
|
||||
"private/counter.ss")
|
||||
|
||||
(provide note
|
||||
|
|
@ -12,7 +13,8 @@
|
|||
|
||||
(define footnote-style-extras
|
||||
(let ([abs (lambda (s)
|
||||
(build-path (collection-path "scriblib") s))])
|
||||
(path->main-collects-relative
|
||||
(collection-file-path s "scriblib")))])
|
||||
(list (make-css-addition (abs "footnote.css"))
|
||||
(make-tex-addition (abs "footnote.tex")))))
|
||||
|
||||
|
|
|
|||
|
|
@ -354,8 +354,8 @@
|
|||
(new (latex:render-mixin render%)
|
||||
[dest-dir latex-dest]
|
||||
;; Use PLT manual style:
|
||||
[prefix-file (build-path (collection-path "scribble") "manual-prefix.tex")]
|
||||
[style-file (build-path (collection-path "scribble") "manual-style.tex")])
|
||||
[prefix-file (collection-file-path "manual-prefix.tex" "scribble")]
|
||||
[style-file (collection-file-path "manual-style.tex" "scribble")])
|
||||
(let* ([flags (doc-flags doc)]
|
||||
[multi? (memq 'multi-page flags)]
|
||||
[main? (doc-under-main? doc)]
|
||||
|
|
@ -369,7 +369,7 @@
|
|||
ddir)]
|
||||
[alt-paths (if main?
|
||||
(let ([std-path (lambda (s)
|
||||
(cons (build-path (collection-path "scribble") s)
|
||||
(cons (collection-file-path s "scribble")
|
||||
(format "../~a" s)))])
|
||||
(list (std-path "scribble.css")
|
||||
(std-path "scribble-style.css")
|
||||
|
|
@ -492,8 +492,7 @@
|
|||
"latex-render.rkt"
|
||||
"html-render.rkt")
|
||||
".zo"))]
|
||||
[css-path (build-path (collection-path "scribble")
|
||||
"scribble.css")]
|
||||
[css-path (collection-file-path "scribble.css" "scribble")]
|
||||
[aux-time (max (file-or-directory-modify-seconds/stamp
|
||||
renderer-path
|
||||
stamp-time stamp-data 1
|
||||
|
|
|
|||
|
|
@ -983,7 +983,7 @@
|
|||
|
||||
(when (make-docs)
|
||||
;; Double-check that "setup/scribble" is present.
|
||||
(when (file-exists? (build-path (collection-path "setup") "scribble.rkt"))
|
||||
(when (file-exists? (collection-file-path "scribble.rkt" "setup"))
|
||||
(make-docs-step)))
|
||||
(when (doc-pdf-dest) (doc-pdf-dest-step))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
Version 5.0.1.2
|
||||
Added collection-file-path and collection splicing at the file
|
||||
level
|
||||
|
||||
Version 5.0.1, July 2010
|
||||
Continuation barriers now block only downward continuation jumps
|
||||
and allow escapes through full continuations
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.0.1.1"
|
||||
#define MZSCHEME_VERSION "5.0.1.2"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 0
|
||||
#define MZSCHEME_VERSION_Z 1
|
||||
#define MZSCHEME_VERSION_W 1
|
||||
#define MZSCHEME_VERSION_W 2
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
|
|
@ -137,8 +137,9 @@
|
|||
" normal-case-path"
|
||||
" path-replace-suffix"
|
||||
" path-add-suffix"
|
||||
" -find-col"
|
||||
" find-col-file"
|
||||
" collection-path"
|
||||
" collection-file-path"
|
||||
" find-library-collection-paths"
|
||||
" path-list-string->path-list"
|
||||
" find-executable-path"
|
||||
|
|
@ -192,28 +193,56 @@
|
|||
"(define-values(collection-path)"
|
||||
"(lambda(collection . collection-path) "
|
||||
"(-check-collection 'collection-path collection collection-path)"
|
||||
"(-find-col 'collection-path(lambda(s)"
|
||||
"(find-col-file 'collection-path(lambda(s)"
|
||||
"(raise"
|
||||
"(exn:fail:filesystem s(current-continuation-marks))))"
|
||||
" collection collection-path)))"
|
||||
"(define-values(-find-col)"
|
||||
"(lambda(who fail collection collection-path)"
|
||||
" collection collection-path"
|
||||
" #f)))"
|
||||
"(define-values(collection-file-path)"
|
||||
"(lambda(file-name collection . collection-path) "
|
||||
"(-check-relpath 'collection-file-path file-name)"
|
||||
"(-check-collection 'collection-file-path collection collection-path)"
|
||||
"(build-path"
|
||||
"(find-col-file 'collection-file-path(lambda(s)"
|
||||
"(raise"
|
||||
"(exn:fail:filesystem s(current-continuation-marks))))"
|
||||
" collection collection-path"
|
||||
" file-name)"
|
||||
" file-name)))"
|
||||
"(define-values(find-col-file)"
|
||||
"(lambda(who fail collection collection-path file-name)"
|
||||
"(let((all-paths(current-library-collection-paths)))"
|
||||
"(let cloop((paths all-paths))"
|
||||
"(let cloop((paths all-paths)(found-col #f))"
|
||||
"(if(null? paths)"
|
||||
"(if found-col"
|
||||
" found-col"
|
||||
"(fail"
|
||||
" (format \"~a: collection not found: ~s in any of: ~s\" "
|
||||
" who(if(null? collection-path)"
|
||||
" collection"
|
||||
"(apply build-path collection collection-path))"
|
||||
" all-paths))"
|
||||
" all-paths)))"
|
||||
"(let((dir(build-path(car paths) collection)))"
|
||||
"(if(directory-exists? dir)"
|
||||
"(let((cpath(apply build-path dir collection-path)))"
|
||||
"(if(directory-exists? cpath)"
|
||||
"(if file-name"
|
||||
"(if(or(file-exists?(build-path cpath file-name))"
|
||||
"(let((alt-file-name"
|
||||
"(let*((file-name(if(path? file-name)"
|
||||
"(path->string file-name)"
|
||||
" file-name))"
|
||||
"(len(string-length file-name)))"
|
||||
"(and(len . >= . 4)"
|
||||
" (string=? \".rkt\" (substring file-name (- len 4)))"
|
||||
" (string-append (substring file-name 0 (- len 4)) \".ss\")))))"
|
||||
"(and alt-file-name"
|
||||
"(file-exists?(build-path cpath alt-file-name)))))"
|
||||
" cpath"
|
||||
"(cloop(cdr paths))))"
|
||||
"(cloop(cdr paths)))))))))"
|
||||
"(cloop(cdr paths)(or found-col cpath)))"
|
||||
" cpath)"
|
||||
"(cloop(cdr paths) found-col)))"
|
||||
"(cloop(cdr paths) found-col))))))))"
|
||||
"(define-values(check-suffix-call)"
|
||||
"(lambda(s sfx who)"
|
||||
"(unless(or(path-for-some-system? s)"
|
||||
|
|
@ -616,13 +645,15 @@
|
|||
"(cons s(current-library-collection-paths))"
|
||||
" #f)"
|
||||
"(let-values(((cols file)(split-relative-string(symbol->string s) #f)))"
|
||||
"(let((p(-find-col 'standard-module-name-resolver"
|
||||
"(let*((f-file(if(null? cols)"
|
||||
" \"main.rkt\""
|
||||
" (string-append file \".rkt\")))"
|
||||
"(p(find-col-file 'standard-module-name-resolver"
|
||||
" show-collection-err"
|
||||
"(if(null? cols) file(car cols))"
|
||||
"(if(null? cols) null(cdr cols)))))"
|
||||
"(build-path p(if(null? cols)"
|
||||
" \"main.rkt\""
|
||||
" (string-append file \".rkt\")))))))"
|
||||
"(if(null? cols) null(cdr cols))"
|
||||
" f-file)))"
|
||||
"(build-path p f-file)))))"
|
||||
"((string? s)"
|
||||
"(let*((dir(get-dir)))"
|
||||
"(or(hash-ref -path-cache(cons s dir) #f)"
|
||||
|
|
@ -650,7 +681,14 @@
|
|||
"(and(null? cols)"
|
||||
" (regexp-match? #rx\"[.]\" file))"
|
||||
" #t)))"
|
||||
"(let((p(let-values(((cols)"
|
||||
"(let*((f-file(if old-style?"
|
||||
"(ss->rkt file)"
|
||||
"(if(null? cols)"
|
||||
" \"main.rkt\""
|
||||
" (if (regexp-match? #rx\"[.]\" file)"
|
||||
"(ss->rkt file)"
|
||||
" (string-append file \".rkt\")))))"
|
||||
"(p(let-values(((cols)"
|
||||
"(if old-style?"
|
||||
"(append(if(null?(cddr s))"
|
||||
" '(\"mzlib\")"
|
||||
|
|
@ -662,17 +700,12 @@
|
|||
"(if(null? cols)"
|
||||
"(list file)"
|
||||
" cols))))"
|
||||
"(-find-col 'standard-module-name-resolver"
|
||||
"(find-col-file 'standard-module-name-resolver"
|
||||
" show-collection-err"
|
||||
"(car cols)"
|
||||
"(cdr cols)))))"
|
||||
"(build-path p(if old-style?"
|
||||
"(ss->rkt file)"
|
||||
"(if(null? cols)"
|
||||
" \"main.rkt\""
|
||||
" (if (regexp-match? #rx\"[.]\" file)"
|
||||
"(ss->rkt file)"
|
||||
" (string-append file \".rkt\")))))))))"
|
||||
"(cdr cols)"
|
||||
" f-file))))"
|
||||
"(build-path p f-file)))))"
|
||||
"((eq?(car s) 'file)"
|
||||
"(path-ss->rkt "
|
||||
"(simplify-path(path->complete-path(expand-user-path(cadr s))(get-dir))))))))"
|
||||
|
|
|
|||
|
|
@ -185,8 +185,9 @@
|
|||
normal-case-path
|
||||
path-replace-suffix
|
||||
path-add-suffix
|
||||
-find-col
|
||||
find-col-file
|
||||
collection-path
|
||||
collection-file-path
|
||||
find-library-collection-paths
|
||||
path-list-string->path-list
|
||||
find-executable-path
|
||||
|
|
@ -249,31 +250,63 @@
|
|||
(define-values (collection-path)
|
||||
(lambda (collection . collection-path)
|
||||
(-check-collection 'collection-path collection collection-path)
|
||||
(-find-col 'collection-path (lambda (s)
|
||||
(raise
|
||||
(exn:fail:filesystem s (current-continuation-marks))))
|
||||
collection collection-path)))
|
||||
(find-col-file 'collection-path (lambda (s)
|
||||
(raise
|
||||
(exn:fail:filesystem s (current-continuation-marks))))
|
||||
collection collection-path
|
||||
#f)))
|
||||
|
||||
(define-values (-find-col)
|
||||
(lambda (who fail collection collection-path)
|
||||
(define-values (collection-file-path)
|
||||
(lambda (file-name collection . collection-path)
|
||||
(-check-relpath 'collection-file-path file-name)
|
||||
(-check-collection 'collection-file-path collection collection-path)
|
||||
(build-path
|
||||
(find-col-file 'collection-file-path (lambda (s)
|
||||
(raise
|
||||
(exn:fail:filesystem s (current-continuation-marks))))
|
||||
collection collection-path
|
||||
file-name)
|
||||
file-name)))
|
||||
|
||||
(define-values (find-col-file)
|
||||
(lambda (who fail collection collection-path file-name)
|
||||
(let ([all-paths (current-library-collection-paths)])
|
||||
(let cloop ([paths all-paths])
|
||||
(let cloop ([paths all-paths][found-col #f])
|
||||
(if (null? paths)
|
||||
(fail
|
||||
(format "~a: collection not found: ~s in any of: ~s"
|
||||
who (if (null? collection-path)
|
||||
collection
|
||||
(apply build-path collection collection-path))
|
||||
all-paths))
|
||||
(if found-col
|
||||
found-col
|
||||
(fail
|
||||
(format "~a: collection not found: ~s in any of: ~s"
|
||||
who (if (null? collection-path)
|
||||
collection
|
||||
(apply build-path collection collection-path))
|
||||
all-paths)))
|
||||
(let ([dir (build-path (car paths) collection)])
|
||||
(if (directory-exists? dir)
|
||||
(let ([cpath (apply build-path dir collection-path)])
|
||||
(if (directory-exists? cpath)
|
||||
cpath
|
||||
(if file-name
|
||||
(if (or (file-exists? (build-path cpath file-name))
|
||||
(let ([alt-file-name
|
||||
(let* ([file-name (if (path? file-name)
|
||||
(path->string file-name)
|
||||
file-name)]
|
||||
[len (string-length file-name)])
|
||||
(and (len . >= . 4)
|
||||
(string=? ".rkt" (substring file-name (- len 4)))
|
||||
(string-append (substring file-name 0 (- len 4)) ".ss")))])
|
||||
(and alt-file-name
|
||||
(file-exists? (build-path cpath alt-file-name)))))
|
||||
cpath
|
||||
;; Look further for specific file, but remember
|
||||
;; first found directory
|
||||
(cloop (cdr paths) (or found-col cpath)))
|
||||
;; Just looking for dir; found it:
|
||||
cpath)
|
||||
;; sub-collection not here; try next instance
|
||||
;; of the top-level collection
|
||||
(cloop (cdr paths))))
|
||||
(cloop (cdr paths)))))))))
|
||||
(cloop (cdr paths) found-col)))
|
||||
(cloop (cdr paths) found-col))))))))
|
||||
|
||||
(define-values (check-suffix-call)
|
||||
(lambda (s sfx who)
|
||||
|
|
@ -708,13 +741,15 @@
|
|||
(cons s (current-library-collection-paths))
|
||||
#f)
|
||||
(let-values ([(cols file) (split-relative-string (symbol->string s) #f)])
|
||||
(let ([p (-find-col 'standard-module-name-resolver
|
||||
show-collection-err
|
||||
(if (null? cols) file (car cols))
|
||||
(if (null? cols) null (cdr cols)))])
|
||||
(build-path p (if (null? cols)
|
||||
"main.rkt"
|
||||
(string-append file ".rkt"))))))]
|
||||
(let* ([f-file (if (null? cols)
|
||||
"main.rkt"
|
||||
(string-append file ".rkt"))]
|
||||
[p (find-col-file 'standard-module-name-resolver
|
||||
show-collection-err
|
||||
(if (null? cols) file (car cols))
|
||||
(if (null? cols) null (cdr cols))
|
||||
f-file)])
|
||||
(build-path p f-file))))]
|
||||
[(string? s)
|
||||
(let* ([dir (get-dir)])
|
||||
(or (hash-ref -path-cache (cons s dir) #f)
|
||||
|
|
@ -743,7 +778,14 @@
|
|||
(and (null? cols)
|
||||
(regexp-match? #rx"[.]" file))
|
||||
#t)])
|
||||
(let ([p (let-values ([(cols)
|
||||
(let* ([f-file (if old-style?
|
||||
(ss->rkt file)
|
||||
(if (null? cols)
|
||||
"main.rkt"
|
||||
(if (regexp-match? #rx"[.]" file)
|
||||
(ss->rkt file)
|
||||
(string-append file ".rkt"))))]
|
||||
[p (let-values ([(cols)
|
||||
(if old-style?
|
||||
(append (if (null? (cddr s))
|
||||
'("mzlib")
|
||||
|
|
@ -755,17 +797,12 @@
|
|||
(if (null? cols)
|
||||
(list file)
|
||||
cols))])
|
||||
(-find-col 'standard-module-name-resolver
|
||||
show-collection-err
|
||||
(car cols)
|
||||
(cdr cols)))])
|
||||
(build-path p (if old-style?
|
||||
(ss->rkt file)
|
||||
(if (null? cols)
|
||||
"main.rkt"
|
||||
(if (regexp-match? #rx"[.]" file)
|
||||
(ss->rkt file)
|
||||
(string-append file ".rkt"))))))))]
|
||||
(find-col-file 'standard-module-name-resolver
|
||||
show-collection-err
|
||||
(car cols)
|
||||
(cdr cols)
|
||||
f-file))])
|
||||
(build-path p f-file))))]
|
||||
[(eq? (car s) 'file)
|
||||
;; Use filesystem-sensitive `simplify-path' here:
|
||||
(path-ss->rkt
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user