add path-extension, path-has-extension? and path-{add,replace}-extension
Provide a cleaned-up set up path-extension functions. In contrast
to `path-{add,replace}-suffix` and `filename-extension`, a dot
at the beginning of a path element is not treated as an extension
separator. Also, `path-extension` returns an extension including
its separator, which is more consistent with other extension
functions.
The new `path-has-extension?` function replaces many uses of
regexp matching in the base collections.
Closes #1307
This commit is contained in:
Matthew Flatt
parent
1e597a885c
commit
4d9427af44
|
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "6.5.0.2")
|
||||
(define version "6.5.0.3")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -527,29 +527,73 @@ proportional to the length of @racket[path] (unlike a loop in that
|
|||
uses @racket[split-path], which must allocate intermediate paths).}
|
||||
|
||||
|
||||
@defproc[(path-replace-suffix [path (or/c path-string? path-for-some-system?)]
|
||||
[suffix (or/c string? bytes?)])
|
||||
@defproc[(path-replace-extension [path (or/c path-string? path-for-some-system?)]
|
||||
[ext (or/c string? bytes?)])
|
||||
path-for-some-system?]{
|
||||
|
||||
Returns a path that is the same as @racket[path], except that the
|
||||
suffix for the last element of the path is changed to
|
||||
@racket[suffix]. If the last element of @racket[path] has no suffix,
|
||||
then @racket[suffix] is added to the path. A suffix is defined as a
|
||||
@litchar{.} followed by any number of non-@litchar{.} characters/bytes
|
||||
at the end of the @tech{path element}, as long as the path element is not
|
||||
@racket[".."] or @racket["."]. The @racket[path] argument can be a
|
||||
path for any platform, and the result is for the same platform. If
|
||||
@racket[path] represents a root, the @exnraise[exn:fail:contract].}
|
||||
extension for the last element of the path (including the extension
|
||||
separator) is changed to @racket[ext]. If the last element of
|
||||
@racket[path] has no extension, then @racket[ext] is added to the
|
||||
path.
|
||||
|
||||
@defproc[(path-add-suffix [path (or/c path-string? path-for-some-system?)]
|
||||
[suffix (or/c string? bytes?)])
|
||||
An extension is defined as a @litchar{.} that is not at the start of
|
||||
the path element followed by any number of non-@litchar{.}
|
||||
characters/bytes at the end of the @tech{path element}, as long as the
|
||||
path element is not a directory indicator like @racket[".."].
|
||||
|
||||
The @racket[path] argument can be a path for any platform, and the
|
||||
result is for the same platform. If @racket[path] represents a root,
|
||||
the @exnraise[exn:fail:contract]. The given @racket[ext] typically
|
||||
starts with @litchar{.}, but it is not required to start with an
|
||||
extension separator.
|
||||
|
||||
@examples[
|
||||
(path-replace-extension "x/y.ss" #".rkt")
|
||||
(path-replace-extension "x/y.ss" #"")
|
||||
(path-replace-extension "x/y" #".rkt")
|
||||
(path-replace-extension "x/y.tar.gz" #".rkt")
|
||||
(path-replace-extension "x/.racketrc" #".rkt")
|
||||
]
|
||||
|
||||
@history[#:added "6.5.0.3"]}
|
||||
|
||||
|
||||
@defproc[(path-add-extension [path (or/c path-string? path-for-some-system?)]
|
||||
[ext (or/c string? bytes?)])
|
||||
path-for-some-system?]{
|
||||
|
||||
Similar to @racket[path-replace-suffix], but any existing suffix on
|
||||
@racket[path] is preserved by replacing the @litchar{.} before the suffix
|
||||
with @litchar{_}, and then the @racket[suffix] is added
|
||||
to the end.}
|
||||
Similar to @racket[path-replace-extension], but any existing extension on
|
||||
@racket[path] is preserved by replacing the @litchar{.} before the extension
|
||||
with @litchar{_}, and then the @racket[ext] is added
|
||||
to the end.
|
||||
|
||||
@examples[
|
||||
(path-add-extension "x/y.ss" #".rkt")
|
||||
(path-add-extension "x/y" #".rkt")
|
||||
(path-add-extension "x/y.tar.gz" #".rkt")
|
||||
(path-add-extension "x/.racketrc" #".rkt")
|
||||
]
|
||||
|
||||
@history[#:added "6.5.0.3"]}
|
||||
|
||||
|
||||
@defproc[(path-replace-suffix [path (or/c path-string? path-for-some-system?)]
|
||||
[ext (or/c string? bytes?)])
|
||||
path-for-some-system?]{
|
||||
@deprecated[#:what "function" @racket[path-replace-extension]]
|
||||
|
||||
Like @racket[path-replace-extension], but treats a leading @litchar{.}
|
||||
in a path element as an extension separator.}
|
||||
|
||||
@defproc[(path-add-suffix [path (or/c path-string? path-for-some-system?)]
|
||||
[ext (or/c string? bytes?)])
|
||||
path-for-some-system?]{
|
||||
|
||||
@deprecated[#:what "function" @racket[path-add-extension]]
|
||||
|
||||
Like @racket[path-add-extension], but treats a leading @litchar{.}
|
||||
in a path element as an extension separator.}
|
||||
|
||||
@defproc[(reroot-path [path (or/c path-string? path-for-some-system?)]
|
||||
[root-path (or/c path-string? path-for-some-system?)])
|
||||
|
|
@ -590,14 +634,60 @@ Returns the last element of @racket[path]. If @racket[path] is
|
|||
syntactically a directory path (see @racket[split-path]), then the
|
||||
result is @racket[#f].}
|
||||
|
||||
|
||||
@defproc[(path-extension [path (or/c path-string? path-for-some-system?)])
|
||||
(or/c bytes? #f)]{
|
||||
|
||||
Returns a byte string that is the extension part of the filename in
|
||||
@racket[path], including the @litchar{.} separator. If the path has no
|
||||
extension, @racket[#f] is returned.
|
||||
|
||||
See @racket[path-replace-extension] for the definition of a filename
|
||||
extension.
|
||||
|
||||
@examples[#:eval path-eval
|
||||
(path-extension "x/y.rkt")
|
||||
(path-extension "x/y")
|
||||
(path-extension "x/y.tar.gz")
|
||||
(path-extension "x/.racketrc")
|
||||
]
|
||||
|
||||
@history[#:added "6.5.0.3"]}
|
||||
|
||||
|
||||
@defproc[(path-has-extension? [path (or/c path-string? path-for-some-system?)]
|
||||
[ext (or/c bytes? string?)])
|
||||
(or/c bytes? #f)]{
|
||||
|
||||
Determines whether the last element of @racket[path] ends with
|
||||
@racket[ext] but is not exactly the same as @racket[ext].
|
||||
|
||||
If @racket[ext] is a @tech{byte string} with the shape of an extension
|
||||
(i.e., starting with @litchar{.}), this check is equivalent to
|
||||
checking whether @racket[(path-extension path)] produces @racket[ext].
|
||||
|
||||
@examples[#:eval path-eval
|
||||
(path-has-extension? "x/y.rkt" #".rkt")
|
||||
(path-has-extension? "x/y.ss" #".rkt")
|
||||
(path-has-extension? "x/y" #".rkt")
|
||||
(path-has-extension? "x/.racketrc" #".racketrc")
|
||||
(path-has-extension? "x/compiled/y_rkt.zo" #"_rkt.zo")
|
||||
]
|
||||
|
||||
@history[#:added "6.5.0.3"]}
|
||||
|
||||
|
||||
@defproc[(filename-extension [path (or/c path-string? path-for-some-system?)])
|
||||
(or/c bytes? #f)]{
|
||||
|
||||
@deprecated[#:what "function" @racket[path-extension]]
|
||||
|
||||
Returns a byte string that is the extension part of the filename in
|
||||
@racket[path] without the @litchar{.} separator. If @racket[path] is
|
||||
syntactically a directory (see @racket[split-path]) or if the path has
|
||||
no extension, @racket[#f] is returned.}
|
||||
|
||||
|
||||
@defproc[(find-relative-path [base (or/c path-string? path-for-some-system?)]
|
||||
[path (or/c path-string? path-for-some-system?)]
|
||||
[#:more-than-root? more-than-root? any/c #f])
|
||||
|
|
|
|||
|
|
@ -12,24 +12,47 @@
|
|||
(test #t path<? (bytes->path #"a") (bytes->path #"aa"))
|
||||
(test #f path<? (bytes->path #"aa") (bytes->path #"a"))
|
||||
|
||||
(test (string->path "x.zo") path-replace-suffix "x.rkt" ".zo")
|
||||
(test (string->path "x.zo") path-replace-suffix "x.rkt" #".zo")
|
||||
(test (string->path "x.zo") path-replace-suffix "x" #".zo")
|
||||
(test (string->path "x.o.zo") path-replace-suffix "x.o.rkt" #".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'unix)
|
||||
path-replace-suffix (string->some-system-path "p/x.rkt" 'unix) ".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'windows)
|
||||
path-replace-suffix (string->some-system-path "p/x.rkt" 'windows) ".zo")
|
||||
(test (string->path "x_rkt.zo") path-add-suffix "x.rkt" ".zo")
|
||||
(test (string->path "x_rkt.zo") path-add-suffix "x.rkt" #".zo")
|
||||
(test (string->path "x.zo") path-add-suffix "x" #".zo")
|
||||
(test (string->path "x.o_rkt.zo") path-add-suffix "x.o.rkt" #".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'unix)
|
||||
path-add-suffix (string->some-system-path "p/x" 'unix) ".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'windows)
|
||||
path-add-suffix (string->some-system-path "p/x" 'windows) ".zo")
|
||||
(define (test-basic-extension path-replace-extension
|
||||
path-add-extension)
|
||||
(test (string->path "x.zo") path-replace-extension "x.rkt" ".zo")
|
||||
(test (string->path "x.zo") path-replace-extension "x.rkt" #".zo")
|
||||
(test (string->path "x.zo") path-replace-extension "x" #".zo")
|
||||
(test (string->path "x.o.zo") path-replace-extension "x.o.rkt" #".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'unix)
|
||||
path-replace-extension (string->some-system-path "p/x.rkt" 'unix) ".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'windows)
|
||||
path-replace-extension (string->some-system-path "p/x.rkt" 'windows) ".zo")
|
||||
(test (string->path "x_rkt.zo") path-add-extension "x.rkt" ".zo")
|
||||
(test (string->path "x_rkt.zo") path-add-extension "x.rkt" #".zo")
|
||||
(test (string->path "x.zo") path-add-extension "x" #".zo")
|
||||
(test (string->path "x.o_rkt.zo") path-add-extension "x.o.rkt" #".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'unix)
|
||||
path-add-extension (string->some-system-path "p/x" 'unix) ".zo")
|
||||
(test (string->some-system-path "p/x.zo" 'windows)
|
||||
path-add-extension (string->some-system-path "p/x" 'windows) ".zo"))
|
||||
|
||||
(test-basic-extension path-replace-extension
|
||||
path-add-extension)
|
||||
(test-basic-extension path-replace-suffix
|
||||
path-add-suffix)
|
||||
|
||||
(test (string->path ".zo.y") path-replace-extension ".zo" ".y")
|
||||
(test (string->path ".zo.y") path-replace-extension ".zo" #".y")
|
||||
(test (string->path ".zo") path-replace-extension ".zo" "")
|
||||
(test (string->path ".zo") path-replace-extension ".zo" #"")
|
||||
(test (string->path ".zo.y") path-add-extension ".zo" ".y")
|
||||
(test (string->path ".zo.y") path-add-extension ".zo" #".y")
|
||||
(test (string->path ".tar_gz.y") path-add-extension ".tar.gz" ".y")
|
||||
(test (string->path ".tar_gz.y") path-add-extension ".tar.gz" #".y")
|
||||
|
||||
(test (string->path ".y") path-replace-suffix ".zo" ".y")
|
||||
(test (string->path ".y") path-replace-suffix ".zo" #".y")
|
||||
(test (string->path "_zo.y") path-add-suffix ".zo" ".y")
|
||||
(test (string->path "_zo.y") path-add-suffix ".zo" #".y")
|
||||
(err/rt-test (path-replace-suffix ".zo" ""))
|
||||
(err/rt-test (path-replace-suffix ".zo" #""))
|
||||
(test (string->path ".tar_gz.y") path-add-suffix ".tar.gz" ".y")
|
||||
(test (string->path ".tar_gz.y") path-add-suffix ".tar.gz" #".y")
|
||||
|
||||
(define (make-/tf p exn?)
|
||||
(lambda args
|
||||
|
|
|
|||
|
|
@ -52,10 +52,23 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(rtest path-extension "a" #f)
|
||||
(rtest path-extension "a.sls" #".sls")
|
||||
(rtest path-extension (bytes->path #"b/a.sls" 'unix) #".sls")
|
||||
(rtest path-extension (bytes->path #"b\\a.sls" 'windows) #".sls")
|
||||
(rtest path-extension ".sls" #f)
|
||||
|
||||
(test #t path-has-extension? "a.sls" #".sls")
|
||||
(test #t path-has-extension? "a.sls" ".sls")
|
||||
(test #f path-has-extension? ".sls" #".sls")
|
||||
(test #t path-has-extension? "a_sls" #"_sls")
|
||||
(test #t path-has-extension? "x/a.sls/" #".sls")
|
||||
|
||||
(rtest filename-extension "a" #f)
|
||||
(rtest filename-extension "a.sls" #"sls")
|
||||
(rtest filename-extension (bytes->path #"b/a.sls" 'unix) #"sls")
|
||||
(rtest filename-extension (bytes->path #"b\\a.sls" 'windows) #"sls")
|
||||
(rtest filename-extension ".sls" #"sls")
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -116,7 +116,7 @@
|
|||
(build-path
|
||||
(reroot-path* base root)
|
||||
mode
|
||||
(path-add-suffix name #".zo"))
|
||||
(path-add-extension name #".zo"))
|
||||
#f
|
||||
(lambda () #f))])
|
||||
(and v (list* v mode root))))
|
||||
|
|
@ -134,10 +134,10 @@
|
|||
[get-zo-path (lambda ()
|
||||
(let-values ([(name mode root)
|
||||
(if main-zo-date+mode
|
||||
(values (path-add-suffix name #".zo")
|
||||
(values (path-add-extension name #".zo")
|
||||
(cadr main-zo-date+mode)
|
||||
(cddr main-zo-date+mode))
|
||||
(values (path-add-suffix (rkt->ss name) #".zo")
|
||||
(values (path-add-extension (rkt->ss name) #".zo")
|
||||
(cadr alt-zo-date+mode)
|
||||
(cddr alt-zo-date+mode)))])
|
||||
(build-path (reroot-path* base root) mode name)))])
|
||||
|
|
@ -262,8 +262,8 @@
|
|||
|
||||
(define (get-source-sha1 p)
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (exn)
|
||||
(and (regexp-match? #rx#"[.]rkt$" p)
|
||||
(get-source-sha1 (path-replace-suffix p #".ss"))))])
|
||||
(and (path-has-extension? p #".rkt")
|
||||
(get-source-sha1 (path-replace-extension p #".ss"))))])
|
||||
(call-with-input-file* p sha1)))
|
||||
|
||||
(define (get-dep-sha1s deps up-to-date collection-cache read-src-syntax path->mode roots must-exist? seen)
|
||||
|
|
@ -304,7 +304,7 @@
|
|||
(define (write-deps code path->mode roots path src-sha1
|
||||
external-deps external-module-deps reader-deps
|
||||
up-to-date collection-cache read-src-syntax)
|
||||
(let ([dep-path (path-add-suffix (get-compilation-path path->mode roots path) #".dep")]
|
||||
(let ([dep-path (path-add-extension (get-compilation-path path->mode roots path) #".dep")]
|
||||
[deps (remove-duplicates (append (get-deps code path)
|
||||
external-module-deps ; can create cycles if misused!
|
||||
reader-deps))]
|
||||
|
|
@ -539,7 +539,7 @@
|
|||
(trace-printf "maybe-compile-zo starting ~a" actual-path))
|
||||
(begin0
|
||||
(parameterize ([indent (+ 2 (indent))])
|
||||
(let* ([zo-name (path-add-suffix (get-compilation-path path->mode roots path) #".zo")]
|
||||
(let* ([zo-name (path-add-extension (get-compilation-path path->mode roots path) #".zo")]
|
||||
[zo-exists? (file-exists? zo-name)])
|
||||
(if (and zo-exists? (trust-existing-zos))
|
||||
(begin
|
||||
|
|
@ -593,9 +593,9 @@
|
|||
(define (get-compiled-time path->mode roots path)
|
||||
(define-values (dir name) (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots roots))
|
||||
(or (try-file-time (build-path dir "native" (system-library-subpath)
|
||||
(path-add-suffix name (system-type
|
||||
'so-suffix))))
|
||||
(try-file-time (build-path dir (path-add-suffix name #".zo")))))
|
||||
(path-add-extension name (system-type
|
||||
'so-suffix))))
|
||||
(try-file-time (build-path dir (path-add-extension name #".zo")))))
|
||||
|
||||
(define (try-file-sha1 path dep-path)
|
||||
(with-module-reading-parameterization
|
||||
|
|
@ -608,18 +608,18 @@
|
|||
|
||||
(define (get-compiled-sha1 path->mode roots path)
|
||||
(define-values (dir name) (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots roots))
|
||||
(let ([dep-path (build-path dir (path-add-suffix name #".dep"))])
|
||||
(let ([dep-path (build-path dir (path-add-extension name #".dep"))])
|
||||
(or (try-file-sha1 (build-path dir "native" (system-library-subpath)
|
||||
(path-add-suffix name (system-type
|
||||
'so-suffix)))
|
||||
(path-add-extension name (system-type
|
||||
'so-suffix)))
|
||||
dep-path)
|
||||
(try-file-sha1 (build-path dir (path-add-suffix name #".zo"))
|
||||
(try-file-sha1 (build-path dir (path-add-extension name #".zo"))
|
||||
dep-path)
|
||||
"")))
|
||||
|
||||
(define (rkt->ss p)
|
||||
(if (regexp-match? #rx#"[.]rkt$" p)
|
||||
(path-replace-suffix p #".ss")
|
||||
(if (path-has-extension? p #".rkt")
|
||||
(path-replace-extension p #".ss")
|
||||
p))
|
||||
|
||||
(define (compile-root path->mode roots path0 up-to-date collection-cache read-src-syntax sha1-only? seen)
|
||||
|
|
@ -629,7 +629,7 @@
|
|||
(with-module-reading-parameterization
|
||||
(lambda ()
|
||||
(call-with-input-file
|
||||
(path-add-suffix (get-compilation-path path->mode roots path) #".dep")
|
||||
(path-add-extension (get-compilation-path path->mode roots path) #".dep")
|
||||
read)))))
|
||||
(define (do-check)
|
||||
(let* ([main-path orig-path]
|
||||
|
|
@ -776,7 +776,7 @@
|
|||
(file-exists? p2)))))
|
||||
(trace-printf "skipping: ~a file does not exist" path)
|
||||
(when delete-zos-when-rkt-file-does-not-exist?
|
||||
(define to-delete (path-add-suffix (get-compilation-path path->mode roots path) #".zo"))
|
||||
(define to-delete (path-add-extension (get-compilation-path path->mode roots path) #".zo"))
|
||||
(when (file-exists? to-delete)
|
||||
(trace-printf "deleting: ~s" to-delete)
|
||||
(with-compiler-security-guard (delete-file to-delete))))]
|
||||
|
|
@ -827,7 +827,7 @@
|
|||
|
||||
;; Exported:
|
||||
(define (get-compiled-file-sha1 path)
|
||||
(try-file-sha1 path (path-replace-suffix path #".dep")))
|
||||
(try-file-sha1 path (path-replace-extension path #".dep")))
|
||||
|
||||
(define (get-file-sha1 path)
|
||||
(get-source-sha1 path))
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@
|
|||
"generic"
|
||||
(let-values ([(base name dir?)
|
||||
(split-path (car binaries))])
|
||||
(path-replace-suffix name #""))))]
|
||||
(path-replace-extension name #""))))]
|
||||
[relative-collects-dir
|
||||
(or collects-path
|
||||
(build-path specific-lib-dir
|
||||
|
|
@ -702,6 +702,6 @@
|
|||
b))))
|
||||
(let ([no-app
|
||||
(let-values ([(base name dir?) (split-path b)])
|
||||
(path-replace-suffix name #""))])
|
||||
(path-replace-extension name #""))])
|
||||
(build-path b "Contents" "MacOS" no-app))
|
||||
b)))
|
||||
|
|
|
|||
|
|
@ -103,11 +103,11 @@
|
|||
[fixup (lambda (re sfx)
|
||||
(if (regexp-match re (path->bytes path))
|
||||
path
|
||||
(path-replace-suffix path sfx)))])
|
||||
(path-replace-extension path sfx)))])
|
||||
(case (cross-system-type)
|
||||
[(windows) (fixup #rx#"[.][eE][xX][eE]$" #".exe")]
|
||||
[(windows) (fixup #rx#".[.][eE][xX][eE]$" #".exe")]
|
||||
[(macosx) (if mred?
|
||||
(fixup #rx#"[.][aA][pP][pP]$" #".app")
|
||||
(fixup #rx#".[.][aA][pP][pP]$" #".app")
|
||||
path)]
|
||||
[else path])))
|
||||
|
||||
|
|
@ -116,7 +116,7 @@
|
|||
(let-values ([(base name dir?) (split-path dest)])
|
||||
(build-path dest
|
||||
"Contents" "MacOS"
|
||||
(path-replace-suffix name #"")))
|
||||
(path-replace-extension name #"")))
|
||||
dest))
|
||||
|
||||
(define exe-suffix?
|
||||
|
|
@ -149,7 +149,7 @@
|
|||
|
||||
(define (prepare-macosx-mred exec-name dest aux variant)
|
||||
(let* ([name (let-values ([(base name dir?) (split-path dest)])
|
||||
(path-replace-suffix name #""))]
|
||||
(path-replace-extension name #""))]
|
||||
[src (build-path (find-lib-dir) "Starter.app")]
|
||||
[creator (let ([c (assq 'creator aux)])
|
||||
(or (and c
|
||||
|
|
@ -383,16 +383,16 @@
|
|||
(values (reverse dirs) (car l))
|
||||
(loop (cdr l) (cons (car l) dirs)))))
|
||||
|
||||
(define (adjust-ss/rkt-suffix path)
|
||||
(define (adjust-ss/rkt-extension path)
|
||||
(cond
|
||||
[(file-exists? path) path]
|
||||
[(regexp-match? #rx"[.]ss$" path)
|
||||
(define rkt-path (path-replace-suffix path #".rkt"))
|
||||
[(path-has-extension? path #".ss")
|
||||
(define rkt-path (path-replace-extension path #".rkt"))
|
||||
(if (file-exists? rkt-path)
|
||||
rkt-path
|
||||
path)]
|
||||
[(regexp-match? #rx"[.]rkt$" path)
|
||||
(define ss-path (path-replace-suffix path #".ss"))
|
||||
[(path-has-extension? path #".rkt")
|
||||
(define ss-path (path-replace-extension path #".ss"))
|
||||
(if (file-exists? ss-path)
|
||||
ss-path
|
||||
path)]
|
||||
|
|
@ -405,7 +405,7 @@
|
|||
(let ([p (build-path collects-dest
|
||||
(apply build-path dir)
|
||||
"compiled"
|
||||
(path-add-suffix file #".zo"))])
|
||||
(path-add-extension file #".zo"))])
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(make-directory* base)
|
||||
p))))
|
||||
|
|
@ -426,7 +426,7 @@
|
|||
;; main module even if a submodule is include in `filename`.
|
||||
[use-source?
|
||||
(and (not a)
|
||||
(src-filter (adjust-ss/rkt-suffix (strip-submod filename))))]
|
||||
(src-filter (adjust-ss/rkt-extension (strip-submod filename))))]
|
||||
;; When using source or writing to collects, keep full modules:
|
||||
[keep-full? (or use-source? collects-dest)]
|
||||
;; When keeping a full module, strip away submodule paths:
|
||||
|
|
@ -467,9 +467,9 @@
|
|||
null)]
|
||||
[just-filename (strip-submod filename)]
|
||||
[root-module-path (strip-submod module-path)]
|
||||
[actual-filename just-filename] ; `set!'ed below to adjust file suffix
|
||||
[actual-filename just-filename] ; `set!'ed below to adjust file extension
|
||||
[name (let-values ([(base name dir?) (split-path just-filename)])
|
||||
(path->string (path-replace-suffix name #"")))]
|
||||
(path->string (path-replace-extension name #"")))]
|
||||
[prefix (let ([a (assoc just-filename prefixes)])
|
||||
(if a
|
||||
(cdr a)
|
||||
|
|
@ -785,7 +785,7 @@
|
|||
(if (regexp-match #rx"^[^/.]*$" (cadr path))
|
||||
(string-append (cadr path) "/main.ss")
|
||||
(if (regexp-match #rx"^[^.]*$" (cadr path))
|
||||
;; need a suffix:
|
||||
;; need an extension:
|
||||
(string-append (cadr path) ".ss")
|
||||
(cadr path))))]
|
||||
[else
|
||||
|
|
@ -898,7 +898,7 @@
|
|||
(if (regexp-match #rx"^[^/.]*$" (cadr name))
|
||||
(string-append (cadr name) "/main.rkt")
|
||||
(if (regexp-match #rx"^[^.]*$" (cadr name))
|
||||
;; need a suffix:
|
||||
;; need an extension:
|
||||
(string-append (cadr name) ".rkt")
|
||||
(ss->rkt (cadr name)))))
|
||||
;; old-style multi-string
|
||||
|
|
@ -909,7 +909,7 @@
|
|||
(ss->rkt (cadr name))))
|
||||
(if (eq? 'planet (car name))
|
||||
(letrec-values ([(split)
|
||||
(lambda (s rx suffix-after)
|
||||
(lambda (s rx extension-after)
|
||||
(let-values ([(m) (regexp-match-positions
|
||||
rx
|
||||
s)])
|
||||
|
|
@ -917,9 +917,9 @@
|
|||
(cons (substring s 0 (caar m))
|
||||
(split (substring s (cdar m))
|
||||
rx
|
||||
(- suffix-after 1)))
|
||||
(- extension-after 1)))
|
||||
(list
|
||||
(if (suffix-after . <= . 0)
|
||||
(if (extension-after . <= . 0)
|
||||
(if (regexp-match? #rx"[.]" s)
|
||||
s
|
||||
(string-append s ".rkt"))
|
||||
|
|
@ -1098,13 +1098,13 @@
|
|||
|
||||
(define (ss<->rkt path mk-full)
|
||||
(cond
|
||||
[(regexp-match? #rx#"[.]ss$" path)
|
||||
(ss<->rkt (path-replace-suffix path #".rkt") mk-full)]
|
||||
[(regexp-match? #rx#"[.]rkt$" path)
|
||||
[(path-has-extension? path #".ss")
|
||||
(ss<->rkt (path-replace-extension path #".rkt") mk-full)]
|
||||
[(path-has-extension? path #".rkt")
|
||||
(define full-path (mk-full path))
|
||||
(if (file-exists? full-path)
|
||||
full-path
|
||||
(let ([p2 (mk-full (path-replace-suffix path #".ss"))])
|
||||
(let ([p2 (mk-full (path-replace-extension path #".ss"))])
|
||||
(if (file-exists? p2)
|
||||
p2
|
||||
full-path)))]
|
||||
|
|
|
|||
|
|
@ -36,8 +36,8 @@
|
|||
|
||||
(define source-is-c++? (regexp-match #rx"([.]cc$)|([.]cxx$)" file-in))
|
||||
|
||||
(define (change-suffix filename new)
|
||||
(path-replace-suffix filename new))
|
||||
(define (change-extension filename new)
|
||||
(path-replace-extension filename new))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; "AST" structures
|
||||
|
|
@ -488,10 +488,10 @@
|
|||
|
||||
(define recorded-cpp-out
|
||||
(and precompiling-header?
|
||||
(open-output-file (change-suffix file-out #".e") #:exists 'truncate)))
|
||||
(open-output-file (change-extension file-out #".e") #:exists 'truncate)))
|
||||
(define recorded-cpp-in
|
||||
(and precompiled-header
|
||||
(open-input-file (change-suffix precompiled-header #".e"))))
|
||||
(open-input-file (change-extension precompiled-header #".e"))))
|
||||
(define re:boring #rx#"^(?:(?:[ \t]*)|(?:# .*)|(?:#line .*)|(?:#pragma implementation.*)|(?:#pragma interface.*)|(?:#pragma once)|(?:#pragma warning.*)|(?:#ident.*))$")
|
||||
(define re:uninteresting #rx#"^(?:(?:[ \t]*)|(?:# .*)|(?:#line .*)|(?:#pragma implementation.*)|(?:#pragma interface.*)|(?:#pragma once)|(?:#pragma GCC diagnostic.*)|(?:#pragma warning.*)|(?:#ident.*))$")
|
||||
(define (skip-to-interesting-line p)
|
||||
|
|
@ -1111,7 +1111,7 @@
|
|||
(namespace-set-variable-value! (car v) (cdr v))))
|
||||
(namespace-set-variable-value! 'make-short-tok make-short-tok)
|
||||
;; Load the pre-compiled-header-as-.zo:
|
||||
(let ([l (load (change-suffix precompiled-header #".zo"))])
|
||||
(let ([l (load (change-extension precompiled-header #".zo"))])
|
||||
(for-each (lambda (x)
|
||||
(hash-set! used-symbols (car x)
|
||||
(+
|
||||
|
|
@ -4168,7 +4168,7 @@
|
|||
non-gcing-functions
|
||||
non-aliasing-functions
|
||||
(list 'quote gc-var-stack-mode))])
|
||||
(with-output-to-file (change-suffix file-out #".zo")
|
||||
(with-output-to-file (change-extension file-out #".zo")
|
||||
(lambda ()
|
||||
(let ([orig (current-namespace)])
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
|
|
@ -4194,7 +4194,7 @@
|
|||
(error 'xform "Errors converting"))
|
||||
|
||||
(when output-depends-info?
|
||||
(with-output-to-file (change-suffix file-out #".sdep")
|
||||
(with-output-to-file (change-extension file-out #".sdep")
|
||||
(lambda ()
|
||||
(write (hash-map depends-files (lambda (k v) k)))
|
||||
(newline))
|
||||
|
|
|
|||
|
|
@ -15,21 +15,21 @@
|
|||
extract-base-filename/ext)
|
||||
|
||||
(define (append-zo-suffix s)
|
||||
(path-add-suffix s #".zo"))
|
||||
(path-add-extension s #".zo"))
|
||||
|
||||
(define (append-c-suffix s)
|
||||
(path-add-suffix s #".c"))
|
||||
(path-add-extension s #".c"))
|
||||
|
||||
(define (append-constant-pool-suffix s)
|
||||
(path-add-suffix s #".kp"))
|
||||
(path-add-extension s #".kp"))
|
||||
|
||||
(define (append-object-suffix s)
|
||||
(path-add-suffix s (case (system-type)
|
||||
[(unix macosx) #".o"]
|
||||
[(windows) #".obj"])))
|
||||
(path-add-extension s (case (system-type)
|
||||
[(unix macosx) #".o"]
|
||||
[(windows) #".obj"])))
|
||||
|
||||
(define (append-extension-suffix s)
|
||||
(path-add-suffix s (system-type 'so-suffix)))
|
||||
(path-add-extension s (system-type 'so-suffix)))
|
||||
|
||||
(define (extract-suffix appender)
|
||||
(subbytes (path->bytes (appender (bytes->path #"x"))) 1))
|
||||
|
|
@ -47,7 +47,7 @@
|
|||
(if simple
|
||||
(error program "not a ~a filename (doesn't end with ~a): ~a"
|
||||
kind simple s)
|
||||
(path-replace-suffix s #""))]
|
||||
(path-replace-extension s #""))]
|
||||
[else #f]))
|
||||
|
||||
(define module-suffix-regexp
|
||||
|
|
|
|||
|
|
@ -174,13 +174,13 @@
|
|||
[(macosx) (and mred? (not (script-variant? variant)))]))])
|
||||
(if (string=? "" s)
|
||||
path
|
||||
(path-replace-suffix
|
||||
(path-replace-extension
|
||||
path
|
||||
(string->bytes/utf-8
|
||||
(if (and (eq? 'windows (cross-system-type))
|
||||
(regexp-match #rx#"[.]exe$" (path->bytes path)))
|
||||
(format "~a.exe" s)
|
||||
s))))))
|
||||
(path-has-extension? path #".exe"))
|
||||
(format "~a.exe" s)
|
||||
s))))))
|
||||
|
||||
(define (string-append/spaces f flags)
|
||||
(string-append* (append-map (lambda (x) (list (f x) " ")) flags)))
|
||||
|
|
@ -515,8 +515,8 @@
|
|||
(define dir (if user?
|
||||
(find-user-apps-dir)
|
||||
(find-apps-dir)))
|
||||
(path-replace-suffix (build-path dir (file-name-from-path dest))
|
||||
#".desktop"))
|
||||
(path-replace-extension (build-path dir (file-name-from-path dest))
|
||||
#".desktop"))
|
||||
|
||||
(define (installed-desktop-path->icon-path dest user? extension)
|
||||
;; We put icons files in "share" so that `setup/unixstyle-install'
|
||||
|
|
@ -532,7 +532,7 @@
|
|||
(build-path (if user?
|
||||
(find-user-share-dir)
|
||||
(find-share-dir))
|
||||
(path-replace-suffix
|
||||
(path-replace-extension
|
||||
(file-name-from-path dest)
|
||||
(bytes-append
|
||||
#"-exe-icon."
|
||||
|
|
@ -770,7 +770,7 @@
|
|||
[else flags]))
|
||||
|
||||
(define (strip-suffix s)
|
||||
(path-replace-suffix s #""))
|
||||
(path-replace-extension s #""))
|
||||
|
||||
(define (extract-aux-from-path path)
|
||||
(define path-bytes (path->bytes (if (string? path)
|
||||
|
|
@ -879,7 +879,7 @@
|
|||
(define (build-aux-from-path aux-root)
|
||||
(let ([aux-root (if (string? aux-root) (string->path aux-root) aux-root)])
|
||||
(define (try suffix)
|
||||
(let ([p (path-replace-suffix aux-root suffix)])
|
||||
(let ([p (path-replace-extension aux-root suffix)])
|
||||
(if (file-exists? p)
|
||||
(extract-aux-from-path p)
|
||||
null)))
|
||||
|
|
@ -950,7 +950,7 @@
|
|||
mred?)])
|
||||
(if (and (eq? (cross-system-type) 'macosx)
|
||||
(not (script-variant? variant)))
|
||||
(path-replace-suffix p #".app")
|
||||
(path-replace-extension p #".app")
|
||||
p))))
|
||||
|
||||
(define (gracket-program-launcher-path name #:user? [user? #f] #:tethered? [tethered? #f])
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
racket/contract
|
||||
racket/format
|
||||
racket/string
|
||||
racket/path
|
||||
net/url)
|
||||
|
||||
(provide
|
||||
|
|
@ -45,9 +46,9 @@
|
|||
(validate-name
|
||||
(and name+ext
|
||||
(path->string
|
||||
(if (regexp-match #rx#"[.]tar[.]gz$" name+ext)
|
||||
(path-replace-suffix (path-replace-suffix name+ext #"") #"")
|
||||
(path-replace-suffix name+ext #""))))
|
||||
(if (path-has-extension? name+ext #".tar.gz")
|
||||
(path-replace-extension (path-replace-extension name+ext #"") #"")
|
||||
(path-replace-extension name+ext #""))))
|
||||
complain
|
||||
#t))
|
||||
|
||||
|
|
@ -102,7 +103,7 @@
|
|||
(and (cor (path-string? s)
|
||||
(complain "ill-formed path"))
|
||||
(cor (regexp-match rx:archive s)
|
||||
(complain "path does not end with a recognized archive suffix"))
|
||||
(complain "path does not end with a recognized archive extension"))
|
||||
(let ()
|
||||
(define-values (base name+ext dir?) (if (path-string? s)
|
||||
(split-path s)
|
||||
|
|
@ -231,7 +232,7 @@
|
|||
(and (cor (pair? p)
|
||||
(complain "URL path is empty"))
|
||||
(cor (string-and-regexp-match? rx:archive (path/param-path (last p)))
|
||||
(complain "URL does not end with a recognized archive suffix"))
|
||||
(complain "URL does not end with a recognized archive extension"))
|
||||
(extract-archive-name (last-non-empty p) complain-name)))
|
||||
(values name 'file-url)]
|
||||
[(if type
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@
|
|||
(string-foldcase
|
||||
(if ((length doc) . < . 4)
|
||||
(let-values ([(base name dir?) (split-path (car doc))])
|
||||
(path->string (path-replace-suffix name #"")))
|
||||
(path->string (path-replace-extension name #"")))
|
||||
(list-ref doc 3))))]))))
|
||||
(define (extract-paths i tag keys)
|
||||
(define (get k)
|
||||
|
|
|
|||
|
|
@ -123,7 +123,7 @@
|
|||
(match-define (pkg-info _ checksum _) pkg-i)
|
||||
(with-handlers ([exn:fail? (λ (exn) (package-exn-handler name exn))])
|
||||
(define pkg-file (build-path dest-dir "pkgs" (format "~a.zip" name)))
|
||||
(define pkg-checksum-file (path-replace-suffix pkg-file #".zip.CHECKSUM"))
|
||||
(define pkg-checksum-file (path-replace-extension pkg-file #".zip.CHECKSUM"))
|
||||
(define pkg-dir (pkg-directory name))
|
||||
|
||||
(unless pkg-dir
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@
|
|||
(and (= 1 (length l))
|
||||
(db:pkg-checksum (car l))))))
|
||||
(define pkg-file (build-path dest-dir "pkgs" (format "~a.zip" name)))
|
||||
(define pkg-checksum-file (path-replace-suffix pkg-file #".zip.CHECKSUM"))
|
||||
(define pkg-checksum-file (path-replace-extension pkg-file #".zip.CHECKSUM"))
|
||||
(unless (and current-checksum
|
||||
(equal? current-checksum (db:pkg-checksum pkg))
|
||||
(file-exists? pkg-file)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
db-path?)
|
||||
|
||||
(define (db-path? p)
|
||||
(regexp-match? #rx"[.]sqlite$" (path->bytes p)))
|
||||
(path-has-extension? p #".sqlite"))
|
||||
|
||||
(define (catalog-dispatch i server db dir)
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -26,9 +26,9 @@
|
|||
#:deleted-result [deleted-result #f])
|
||||
(define v
|
||||
(or (file-exists? f)
|
||||
(file-exists? (path-replace-suffix f #".ss"))
|
||||
(file-exists? (path-replace-extension f #".ss"))
|
||||
(and (or (file-exists? (get-compilation-bytecode-file f))
|
||||
(file-exists? (get-compilation-bytecode-file (path-replace-suffix f #".ss"))))
|
||||
(file-exists? (get-compilation-bytecode-file (path-replace-extension f #".ss"))))
|
||||
;; found bytecode; make sure it won't be deleted by `raco setup`
|
||||
(or (bytecode-will-stick-around? f mp metadata-ns)
|
||||
deleted-result))))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base
|
||||
racket/path
|
||||
syntax/path-spec
|
||||
"private/increader.rkt"
|
||||
compiler/cm-accomplice))
|
||||
|
|
@ -20,10 +21,9 @@
|
|||
[reader (syntax reader)]
|
||||
[orig-stx (syntax orig-stx)]
|
||||
[rkt->ss (lambda (p)
|
||||
(let ([b (path->bytes p)])
|
||||
(if (regexp-match? #rx#"[.]rkt$" b)
|
||||
(path-replace-suffix p #".ss")
|
||||
p)))])
|
||||
(if (path-has-extension? p #".rkt")
|
||||
(path-replace-extension p #".ss")
|
||||
p))])
|
||||
|
||||
(let ([c-file (if (file-exists? orig-c-file)
|
||||
orig-c-file
|
||||
|
|
|
|||
|
|
@ -3,6 +3,8 @@
|
|||
(provide find-relative-path
|
||||
simple-form-path
|
||||
normalize-path
|
||||
path-has-extension?
|
||||
path-extension
|
||||
filename-extension
|
||||
file-name-from-path
|
||||
path-only
|
||||
|
|
@ -163,7 +165,28 @@
|
|||
[(path-for-some-system? base) base]
|
||||
[else #f])))
|
||||
|
||||
;; name can be any string; we just look for a dot
|
||||
(define (path-has-extension? name sfx)
|
||||
(unless (path-string? name)
|
||||
(raise-argument-error 'path-extension=? "path-string?" name))
|
||||
(unless (or (bytes? sfx) (string? sfx))
|
||||
(raise-argument-error 'path-extension=? "(or/c bytes? string?)" name))
|
||||
(let-values ([(base file dir?) (split-path name)])
|
||||
(and base
|
||||
(path? file)
|
||||
(let* ([bs (path-element->bytes file)]
|
||||
[sfx (if (bytes? sfx) sfx (string->bytes/utf-8 sfx))]
|
||||
[len (bytes-length bs)]
|
||||
[slen (bytes-length sfx)])
|
||||
(and (len . > . slen)
|
||||
(bytes=? sfx (subbytes bs (- len slen))))))))
|
||||
|
||||
(define (path-extension name)
|
||||
(let* ([name (file-name 'filename-extension name)]
|
||||
[name (and name (path->bytes name))])
|
||||
(cond [(and name (regexp-match #rx#"(?<=.)([.][^.]+)$" name)) => cadr]
|
||||
[else #f])))
|
||||
|
||||
;; This old variant doesn't correctly handle filenames that start with ".":
|
||||
(define (filename-extension name)
|
||||
(let* ([name (file-name 'filename-extension name)]
|
||||
[name (and name (path->bytes name))])
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(module misc '#%kernel
|
||||
(#%require '#%utils ; built into racket
|
||||
"small-scheme.rkt" "define.rkt"
|
||||
"small-scheme.rkt" "define.rkt" "path.rkt"
|
||||
(for-syntax '#%kernel "qq-and-or.rkt" "stx.rkt" "stxcase-scheme.rkt" "stxcase.rkt"))
|
||||
|
||||
;; -------------------------------------------------------------------------
|
||||
|
|
@ -245,7 +245,9 @@
|
|||
|
||||
(#%provide define-syntax-rule
|
||||
rationalize
|
||||
path-string? path-replace-suffix path-add-suffix
|
||||
path-string?
|
||||
path-replace-suffix path-add-suffix
|
||||
path-replace-extension path-add-extension
|
||||
normal-case-path reroot-path
|
||||
read-eval-print-loop
|
||||
load/cd
|
||||
|
|
|
|||
70
racket/collects/racket/private/path.rkt
Normal file
70
racket/collects/racket/private/path.rkt
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
;; Old variants of `path-replace-extension` and
|
||||
;; `path-add-extension` that do the wrong thing with
|
||||
;; file names that start "."
|
||||
(module path '#%kernel
|
||||
(#%require '#%min-stx)
|
||||
|
||||
(#%provide path-replace-suffix
|
||||
path-add-suffix)
|
||||
|
||||
(define-values (path-string?)
|
||||
(lambda (s)
|
||||
(or (path? s)
|
||||
(and (string? s)
|
||||
(or (relative-path? s)
|
||||
(absolute-path? s))))))
|
||||
|
||||
(define-values (check-suffix-call)
|
||||
(lambda (s sfx who)
|
||||
(unless (or (path-for-some-system? s)
|
||||
(path-string? s))
|
||||
(raise-argument-error who "(or/c path-for-some-system? path-string?)" 0 s sfx))
|
||||
(unless (or (string? sfx) (bytes? sfx))
|
||||
(raise-argument-error who "(or/c string? bytes?)" 1 s sfx))
|
||||
(let-values ([(base name dir?) (split-path s)])
|
||||
(when (not base)
|
||||
(raise-mismatch-error who "cannot add a suffix to a root path: " s))
|
||||
(values base name))))
|
||||
|
||||
(define-values (path-adjust-suffix)
|
||||
(lambda (name sep rest-bytes s sfx)
|
||||
(let-values ([(base name) (check-suffix-call s sfx name)])
|
||||
(define bs (path-element->bytes name))
|
||||
(define finish
|
||||
(lambda (i sep i2)
|
||||
(bytes->path-element
|
||||
(let ([res (bytes-append
|
||||
(subbytes bs 0 i)
|
||||
sep
|
||||
(rest-bytes bs i2)
|
||||
(if (string? sfx)
|
||||
(string->bytes/locale sfx (char->integer #\?))
|
||||
sfx))])
|
||||
(if (zero? (bytes-length res))
|
||||
(raise-arguments-error 'path-replace-suffix
|
||||
"removing suffix makes path element empty"
|
||||
"given path" s)
|
||||
res))
|
||||
(if (path-for-some-system? s)
|
||||
(path-convention-type s)
|
||||
(system-path-convention-type)))))
|
||||
(let ([new-name (letrec-values ([(loop)
|
||||
(lambda (i)
|
||||
(if (zero? i)
|
||||
(finish (bytes-length bs) #"" (bytes-length bs))
|
||||
(let-values ([(i) (sub1 i)])
|
||||
(if (eq? (char->integer #\.) (bytes-ref bs i))
|
||||
(finish i sep (add1 i))
|
||||
(loop i)))))])
|
||||
(loop (bytes-length bs)))])
|
||||
(if (path-for-some-system? base)
|
||||
(build-path base new-name)
|
||||
new-name)))))
|
||||
|
||||
(define-values (path-replace-suffix)
|
||||
(lambda (s sfx)
|
||||
(path-adjust-suffix 'path-replace-suffix #"" (lambda (bs i) #"") s sfx)))
|
||||
|
||||
(define-values (path-add-suffix)
|
||||
(lambda (s sfx)
|
||||
(path-adjust-suffix 'path-add-suffix #"_" subbytes s sfx))))
|
||||
|
|
@ -159,7 +159,7 @@
|
|||
collection
|
||||
#:check-compiled? [check-compiled?
|
||||
(and (path-string? file-name)
|
||||
(regexp-match? #rx"[.]rkt$" file-name))]
|
||||
(regexp-match? #rx".[.]rkt$" file-name))]
|
||||
#:fail [fail (lambda (s)
|
||||
(raise
|
||||
(exn:fail:filesystem
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require syntax/modcode)
|
||||
(require syntax/modcode
|
||||
racket/path)
|
||||
|
||||
(provide dynamic-rerequire)
|
||||
|
||||
|
|
@ -76,8 +77,8 @@
|
|||
(let ([ts (file-or-directory-modify-seconds path #f (lambda () #f))])
|
||||
(if ts
|
||||
(values ts path)
|
||||
(if (regexp-match? #rx#"[.]rkt$" (path->bytes path))
|
||||
(let* ([alt-path (path-replace-suffix path #".ss")]
|
||||
(if (path-has-extension? path #".rkt")
|
||||
(let* ([alt-path (path-replace-extension path #".ss")]
|
||||
[ts (file-or-directory-modify-seconds alt-path #f (lambda () #f))])
|
||||
(if ts
|
||||
(values ts alt-path)
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@
|
|||
(append (cddr p) (drop-right strs 1)))])
|
||||
(let ([file (if (regexp-match? #rx#"[.]ss$" file)
|
||||
;; normalize to ".rkt":
|
||||
(path-replace-suffix file #".rkt")
|
||||
(path-replace-extension file #".rkt")
|
||||
file)])
|
||||
(let ([p (apply collection-file-path
|
||||
file
|
||||
|
|
@ -124,7 +124,7 @@
|
|||
;; Try ".ss":
|
||||
(define p2 (apply collection-file-path
|
||||
#:check-compiled? #f
|
||||
(path-replace-suffix file #".ss")
|
||||
(path-replace-extension file #".ss")
|
||||
coll))
|
||||
(if (file-exists? p2)
|
||||
p2
|
||||
|
|
|
|||
|
|
@ -146,7 +146,7 @@
|
|||
;; We do not currently support "external" dependencies
|
||||
;; (via cm-accomplice) during bootstrap.
|
||||
(let ([deps (with-input-from-file
|
||||
(bytes->path (regexp-replace #"[.]zo$" (path->bytes path) #".dep"))
|
||||
(path-replace-extension path #".dep")
|
||||
read)])
|
||||
(for-each (lambda (dep)
|
||||
(let ([dep
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
(lambda ()
|
||||
(let-values ([(p) (find-system-path 'run-file)])
|
||||
(let-values ([(p) (if (eq? (system-type) 'windows)
|
||||
(path-replace-suffix p #"")
|
||||
(path-replace-extension p #"")
|
||||
p)])
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(if (current-command-name)
|
||||
|
|
|
|||
|
|
@ -307,7 +307,7 @@
|
|||
'core))
|
||||
(when src-pkg
|
||||
(unless (check-dep! pkg src-pkg mode)
|
||||
(define key (list pkg src-pkg (path-replace-suffix f #"") mod))
|
||||
(define key (list pkg src-pkg (path-replace-extension f #"") mod))
|
||||
(unless (hash-ref reported key #f)
|
||||
(hash-set! reported key #t)
|
||||
(setup-fprintf* (current-error-port) #f
|
||||
|
|
@ -360,7 +360,7 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
(define (check-bytecode-deps f dir coll-path pkg)
|
||||
(define zo-f (path-replace-suffix f #".zo"))
|
||||
(define zo-f (path-replace-extension f #".zo"))
|
||||
(when (file-exists? (build-path dir zo-f))
|
||||
(define base (let ([m (regexp-match #rx#"^(.*)_[a-z]+[.]zo$"
|
||||
(path-element->bytes zo-f))])
|
||||
|
|
@ -426,7 +426,7 @@
|
|||
(define name (if ((length s) . > . 3)
|
||||
(list-ref s 3)
|
||||
(path-element->string
|
||||
(path-replace-suffix (file-name-from-path src) #""))))
|
||||
(path-replace-extension (file-name-from-path src) #""))))
|
||||
(define dest-dir (if main?
|
||||
(build-path (find-doc-dir) name)
|
||||
(build-path path "doc" name)))
|
||||
|
|
@ -477,11 +477,11 @@
|
|||
(not (hash-ref skip-pkgs pkg #f)))
|
||||
(for ([f (directory-list dir)])
|
||||
;; A ".dep" file triggers a check:
|
||||
(when (regexp-match? #rx#"[.]dep$" (path-element->bytes f))
|
||||
(when (path-has-extension? f #".dep")
|
||||
;; Decide whether the file is inherently 'build or 'run mode:
|
||||
(define mode
|
||||
(if (or (eq? coll-mode 'build)
|
||||
(regexp-match? #rx#"_scrbl[.]dep$" (path-element->bytes f)))
|
||||
(path-has-extension? f #"_scrbl.dep"))
|
||||
'build
|
||||
'run))
|
||||
;; Look at the actual module for 'run mode (dropping
|
||||
|
|
|
|||
|
|
@ -731,7 +731,7 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (delete-file/record-dependency path dependencies)
|
||||
(when (regexp-match-positions #rx"[.]dep$" (path->bytes path))
|
||||
(when (path-has-extension? path #".dep")
|
||||
(define deps
|
||||
(with-handlers ([exn:fail? (lambda (x) null)])
|
||||
(with-input-from-file path read)))
|
||||
|
|
@ -828,8 +828,8 @@
|
|||
old-dependencies
|
||||
(lambda (file _)
|
||||
(define-values [dir name dir?] (split-path file))
|
||||
(define zo (build-path dir mode-dir (path-add-suffix name #".zo")))
|
||||
(define dep (build-path dir mode-dir (path-add-suffix name #".dep")))
|
||||
(define zo (build-path dir mode-dir (path-add-extension name #".zo")))
|
||||
(define dep (build-path dir mode-dir (path-add-extension name #".dep")))
|
||||
(when (and (file-exists? dep) (file-exists? zo))
|
||||
(set! did-something? #t)
|
||||
(setup-printf "deleting" "~a" (path->relative-string/setup zo #:cache pkg-path-cache))
|
||||
|
|
@ -991,13 +991,13 @@
|
|||
;; appear in a "compiled" directory:
|
||||
(make-immutable-hash
|
||||
(map (lambda (p)
|
||||
(cons (path-add-suffix p #".zo") #t))
|
||||
(cons (path-add-extension p #".zo") #t))
|
||||
(append (directory-list dir)
|
||||
(info 'virtual-sources (lambda () null))))))])
|
||||
;; Check each file in `c` to see whether it can stay:
|
||||
(for ([p (directory-list c)])
|
||||
(when (and (regexp-match #rx#".(zo|dep)$" (path-element->bytes p))
|
||||
(not (hash-ref ok-zo-files (path-replace-suffix p #".zo") #f)))
|
||||
(when (and (regexp-match? #rx#".[.](zo|dep)$" (path-element->bytes p))
|
||||
(not (hash-ref ok-zo-files (path-replace-extension p #".zo") #f)))
|
||||
(setup-fprintf (current-error-port) #f " deleting ~a" (build-path c p))
|
||||
(delete-file (build-path c p))))
|
||||
ok-zo-files)]
|
||||
|
|
@ -1371,7 +1371,7 @@
|
|||
(doc:setup-scribblings tmp-dir #f)
|
||||
(parameterize ([current-directory tmp-dir])
|
||||
(for ([f (directory-list)]
|
||||
#:when (regexp-match? #rx#"[.]tex$" (path-element->bytes f)))
|
||||
#:when (path-has-extension? f #".tex"))
|
||||
(define pdf (scr:call 'run-pdflatex f
|
||||
(lambda (fmt . xs)
|
||||
(apply setup-printf #f fmt xs))))
|
||||
|
|
@ -1468,7 +1468,7 @@
|
|||
(if (cc-main? cc) 'main 'user)))
|
||||
,@(build-aux-from-path
|
||||
(build-path (cc-path cc)
|
||||
(path-replace-suffix (or mzll mzln) #""))))))
|
||||
(path-replace-extension (or mzll mzln) #""))))))
|
||||
(unless (up-to-date? p aux)
|
||||
(setup-printf
|
||||
"launcher"
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@
|
|||
(error 'read-one "empty file; expected a module declaration in: ~a" path))
|
||||
(define sym
|
||||
(string->symbol
|
||||
(bytes->string/utf-8 (path->bytes (path-replace-suffix name #"")) #\?)))
|
||||
(bytes->string/utf-8 (path->bytes (path-replace-extension name #"")) #\?)))
|
||||
(define checked-v (check-module-form unchecked-v sym path))
|
||||
(unless (eof-object? (read p))
|
||||
(error 'read-one
|
||||
|
|
@ -156,18 +156,18 @@
|
|||
sub-path
|
||||
"native"
|
||||
(system-library-subpath)
|
||||
(path-add-suffix file (system-type 'so-suffix))))
|
||||
(path-add-extension file (system-type 'so-suffix))))
|
||||
(define zo
|
||||
(get-metadata-path #:roots roots
|
||||
path0-base
|
||||
sub-path
|
||||
(path-add-suffix src-file #".zo")))
|
||||
(path-add-extension src-file #".zo")))
|
||||
(define alt-zo
|
||||
(and try-alt?
|
||||
(get-metadata-path #:roots roots
|
||||
path0-base
|
||||
sub-path
|
||||
(path-add-suffix alt-src-file #".zo"))))
|
||||
(path-add-extension alt-src-file #".zo"))))
|
||||
(define so (get-so src-file))
|
||||
(define alt-so (and try-alt? (get-so alt-src-file)))
|
||||
(define prefer (choose src-path zo so))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
(require racket/contract/base
|
||||
racket/path
|
||||
"private/modhelp.rkt")
|
||||
|
||||
(define (force-relto relto dir? #:path? [path? #t])
|
||||
|
|
@ -34,11 +35,9 @@
|
|||
[else (values (and path? (current-directory)) submod)])))
|
||||
|
||||
(define (path-ss->rkt p)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(if (and (path? name)
|
||||
(regexp-match #rx"[.]ss$" (path->bytes name)))
|
||||
(path-replace-suffix p #".rkt")
|
||||
p)))
|
||||
(if (path-has-extension? p #".ss")
|
||||
(path-replace-extension p #".rkt")
|
||||
p))
|
||||
|
||||
(define (combine-submod v p)
|
||||
(if (null? p)
|
||||
|
|
|
|||
|
|
@ -202,7 +202,7 @@
|
|||
[name (if (path? p-name)
|
||||
(let-values ([(base name dir?) (split-path p-name)])
|
||||
(string->symbol
|
||||
(path->string (path-replace-suffix name #""))))
|
||||
(path->string (path-replace-extension name #""))))
|
||||
'anonymous-module)]
|
||||
[tag-src (lambda (v)
|
||||
(if stx?
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ Use syntax/modcollapse instead.
|
|||
|
||||
(require racket/string
|
||||
racket/list
|
||||
racket/path
|
||||
"modhelp.rkt")
|
||||
|
||||
(define (collapse-module-path s relto-mp)
|
||||
|
|
@ -54,16 +55,15 @@ Use syntax/modcollapse instead.
|
|||
|
||||
(define (ss->rkt s)
|
||||
(let ([len (string-length s)])
|
||||
(if (and (len . >= . 3)
|
||||
(if (and (len . > . 3)
|
||||
(string=? ".ss" (substring s (- len 3))))
|
||||
(string-append (substring s 0 (- len 3)) ".rkt")
|
||||
s)))
|
||||
|
||||
(define (path-ss->rkt p)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(if (regexp-match #rx"[.]ss$" (path->bytes name))
|
||||
(path-replace-suffix p #".rkt")
|
||||
p)))
|
||||
(if (path-has-extension? p #".ss")
|
||||
(path-replace-extension p #".rkt")
|
||||
p))
|
||||
|
||||
(define (flatten-relto-mp!)
|
||||
(when (procedure? relto-mp) (set! relto-mp (relto-mp)))
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
(cond
|
||||
[(regexp-match? #rx"[.][ch]$" path)
|
||||
(define-values (ts) (file-or-directory-modify-seconds path))
|
||||
(define-values (sdep) (path-replace-suffix path ".sdep"))
|
||||
(define-values (sdep) (path-replace-extension path ".sdep"))
|
||||
(call-with-escape-continuation
|
||||
(lambda (esc)
|
||||
(with-continuation-mark
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "6.5.0.2"
|
||||
#define MZSCHEME_VERSION "6.5.0.3"
|
||||
|
||||
#define MZSCHEME_VERSION_X 6
|
||||
#define MZSCHEME_VERSION_Y 5
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 2
|
||||
#define MZSCHEME_VERSION_W 3
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
|
|
@ -147,8 +147,8 @@
|
|||
"(#%require '#%min-stx '#%paramz)"
|
||||
"(#%provide path-string?"
|
||||
" normal-case-path"
|
||||
" path-replace-suffix"
|
||||
" path-add-suffix"
|
||||
" path-replace-extension"
|
||||
" path-add-extension"
|
||||
" reroot-path"
|
||||
" find-col-file"
|
||||
" collection-path"
|
||||
|
|
@ -754,7 +754,7 @@
|
|||
"(lambda(dir path check-compiled?)"
|
||||
"(or(file-exists?(build-path dir path))"
|
||||
"(and check-compiled?"
|
||||
" (let ((try-path (path-add-suffix path #\".zo\"))"
|
||||
" (let ((try-path (path-add-extension path #\".zo\"))"
|
||||
"(modes(use-compiled-file-paths))"
|
||||
"(roots(current-compiled-file-roots)))"
|
||||
"(ormap(lambda(d)"
|
||||
|
|
@ -767,7 +767,7 @@
|
|||
"(else(reroot-path p d))))))"
|
||||
" modes))"
|
||||
" roots))))))"
|
||||
"(define-values(check-suffix-call)"
|
||||
"(define-values(check-extension-call)"
|
||||
"(lambda(s sfx who)"
|
||||
"(unless(or(path-for-some-system? s)"
|
||||
"(path-string? s))"
|
||||
|
|
@ -776,27 +776,22 @@
|
|||
" (raise-argument-error who \"(or/c string? bytes?)\" 1 s sfx))"
|
||||
"(let-values(((base name dir?)(split-path s)))"
|
||||
"(when(not base)"
|
||||
" (raise-mismatch-error who \"cannot add a suffix to a root path: \" s))"
|
||||
" (raise-mismatch-error who \"cannot add an extension to a root path: \" s))"
|
||||
"(values base name))))"
|
||||
"(define-values(path-adjust-suffix)"
|
||||
"(define-values(path-adjust-extension)"
|
||||
"(lambda(name sep rest-bytes s sfx)"
|
||||
"(let-values(((base name)(check-suffix-call s sfx name)))"
|
||||
"(let-values(((base name)(check-extension-call s sfx name)))"
|
||||
"(define bs(path-element->bytes name))"
|
||||
"(define finish"
|
||||
"(lambda(i sep i2)"
|
||||
"(bytes->path-element"
|
||||
"(let((res(bytes-append"
|
||||
"(bytes-append"
|
||||
"(subbytes bs 0 i)"
|
||||
" sep"
|
||||
"(rest-bytes bs i2)"
|
||||
"(if(string? sfx)"
|
||||
"(string->bytes/locale sfx(char->integer #\\?))"
|
||||
" sfx))))"
|
||||
"(if(zero?(bytes-length res))"
|
||||
"(raise-arguments-error 'path-replace-suffix"
|
||||
" \"removing suffix makes path element empty\""
|
||||
" \"given path\" s)"
|
||||
" res))"
|
||||
" sfx))"
|
||||
"(if(path-for-some-system? s)"
|
||||
"(path-convention-type s)"
|
||||
"(system-path-convention-type)))))"
|
||||
|
|
@ -805,19 +800,20 @@
|
|||
"(if(zero? i)"
|
||||
" (finish (bytes-length bs) #\"\" (bytes-length bs))"
|
||||
"(let-values(((i)(sub1 i)))"
|
||||
"(if(eq?(char->integer #\\.)(bytes-ref bs i))"
|
||||
"(if(and(not(zero? i))"
|
||||
"(eq?(char->integer #\\.)(bytes-ref bs i)))"
|
||||
"(finish i sep(add1 i))"
|
||||
"(loop i)))))))"
|
||||
"(loop(bytes-length bs)))))"
|
||||
"(if(path-for-some-system? base)"
|
||||
"(build-path base new-name)"
|
||||
" new-name)))))"
|
||||
"(define-values(path-replace-suffix)"
|
||||
"(define-values(path-replace-extension)"
|
||||
"(lambda(s sfx)"
|
||||
" (path-adjust-suffix 'path-replace-suffix #\"\" (lambda (bs i) #\"\") s sfx)))"
|
||||
"(define-values(path-add-suffix)"
|
||||
" (path-adjust-extension 'path-replace-extension #\"\" (lambda (bs i) #\"\") s sfx)))"
|
||||
"(define-values(path-add-extension)"
|
||||
"(lambda(s sfx)"
|
||||
" (path-adjust-suffix 'path-replace-suffix #\"_\" subbytes s sfx)))"
|
||||
" (path-adjust-extension 'path-add-extension #\"_\" subbytes s sfx)))"
|
||||
"(define-values(load/use-compiled)"
|
||||
"(lambda(f)((current-load/use-compiled) f #f)))"
|
||||
"(define-values(find-library-collection-paths)"
|
||||
|
|
@ -990,18 +986,18 @@
|
|||
" \"native\""
|
||||
"(system-library-subpath)"
|
||||
"(if rep-sfx?"
|
||||
"(path-add-suffix"
|
||||
"(path-add-extension"
|
||||
" file"
|
||||
" dll-suffix)"
|
||||
" file)))))"
|
||||
"(zo(lambda(root-dir compiled-dir)"
|
||||
"(build-path(reroot base root-dir)"
|
||||
" compiled-dir"
|
||||
" (path-add-suffix file #\".zo\"))))"
|
||||
" (path-add-extension file #\".zo\"))))"
|
||||
"(alt-zo(lambda(root-dir compiled-dir)"
|
||||
"(build-path(reroot base root-dir)"
|
||||
" compiled-dir"
|
||||
" (path-add-suffix alt-file #\".zo\"))))"
|
||||
" (path-add-extension alt-file #\".zo\"))))"
|
||||
"(so(get-so file #t))"
|
||||
"(alt-so(get-so alt-file #t))"
|
||||
"(try-main?(or main-path-d(not alt-path-d)))"
|
||||
|
|
@ -1251,7 +1247,7 @@
|
|||
"(path-ss->rkt(lambda(p)"
|
||||
"(let-values(((base name dir?)(split-path p)))"
|
||||
" (if (regexp-match #rx\"[.]ss$\" (path->bytes name))"
|
||||
" (path-replace-suffix p #\".rkt\")"
|
||||
" (path-replace-extension p #\".rkt\")"
|
||||
" p))))"
|
||||
"(s(if(and(pair? s)(eq? 'submod(car s)))"
|
||||
"(let((v(cadr s)))"
|
||||
|
|
@ -1377,7 +1373,7 @@
|
|||
"(split-path filename))))"
|
||||
"(let*((no-sfx(if(vector? s-parsed)"
|
||||
"(vector-ref s-parsed 3)"
|
||||
" (path-replace-suffix name #\"\"))))"
|
||||
" (path-replace-extension name #\"\"))))"
|
||||
"(let*((root-modname(if(vector? s-parsed)"
|
||||
"(vector-ref s-parsed 4)"
|
||||
"(make-resolved-module-path filename)))"
|
||||
|
|
|
|||
|
|
@ -195,8 +195,8 @@
|
|||
|
||||
(#%provide path-string?
|
||||
normal-case-path
|
||||
path-replace-suffix
|
||||
path-add-suffix
|
||||
path-replace-extension
|
||||
path-add-extension
|
||||
reroot-path
|
||||
find-col-file
|
||||
collection-path
|
||||
|
|
@ -886,7 +886,7 @@
|
|||
(lambda (dir path check-compiled?)
|
||||
(or (file-exists? (build-path dir path))
|
||||
(and check-compiled?
|
||||
(let ([try-path (path-add-suffix path #".zo")]
|
||||
(let ([try-path (path-add-extension path #".zo")]
|
||||
[modes (use-compiled-file-paths)]
|
||||
[roots (current-compiled-file-roots)])
|
||||
(ormap (lambda (d)
|
||||
|
|
@ -900,7 +900,7 @@
|
|||
modes))
|
||||
roots))))))
|
||||
|
||||
(define-values (check-suffix-call)
|
||||
(define-values (check-extension-call)
|
||||
(lambda (s sfx who)
|
||||
(unless (or (path-for-some-system? s)
|
||||
(path-string? s))
|
||||
|
|
@ -909,28 +909,23 @@
|
|||
(raise-argument-error who "(or/c string? bytes?)" 1 s sfx))
|
||||
(let-values ([(base name dir?) (split-path s)])
|
||||
(when (not base)
|
||||
(raise-mismatch-error who "cannot add a suffix to a root path: " s))
|
||||
(raise-mismatch-error who "cannot add an extension to a root path: " s))
|
||||
(values base name))))
|
||||
|
||||
(define-values (path-adjust-suffix)
|
||||
(define-values (path-adjust-extension)
|
||||
(lambda (name sep rest-bytes s sfx)
|
||||
(let-values ([(base name) (check-suffix-call s sfx name)])
|
||||
(let-values ([(base name) (check-extension-call s sfx name)])
|
||||
(define bs (path-element->bytes name))
|
||||
(define finish
|
||||
(lambda (i sep i2)
|
||||
(bytes->path-element
|
||||
(let ([res (bytes-append
|
||||
(subbytes bs 0 i)
|
||||
sep
|
||||
(rest-bytes bs i2)
|
||||
(if (string? sfx)
|
||||
(string->bytes/locale sfx (char->integer #\?))
|
||||
sfx))])
|
||||
(if (zero? (bytes-length res))
|
||||
(raise-arguments-error 'path-replace-suffix
|
||||
"removing suffix makes path element empty"
|
||||
"given path" s)
|
||||
res))
|
||||
(bytes-append
|
||||
(subbytes bs 0 i)
|
||||
sep
|
||||
(rest-bytes bs i2)
|
||||
(if (string? sfx)
|
||||
(string->bytes/locale sfx (char->integer #\?))
|
||||
sfx))
|
||||
(if (path-for-some-system? s)
|
||||
(path-convention-type s)
|
||||
(system-path-convention-type)))))
|
||||
|
|
@ -939,7 +934,8 @@
|
|||
(if (zero? i)
|
||||
(finish (bytes-length bs) #"" (bytes-length bs))
|
||||
(let-values ([(i) (sub1 i)])
|
||||
(if (eq? (char->integer #\.) (bytes-ref bs i))
|
||||
(if (and (not (zero? i))
|
||||
(eq? (char->integer #\.) (bytes-ref bs i)))
|
||||
(finish i sep (add1 i))
|
||||
(loop i)))))])
|
||||
(loop (bytes-length bs)))])
|
||||
|
|
@ -947,13 +943,13 @@
|
|||
(build-path base new-name)
|
||||
new-name)))))
|
||||
|
||||
(define-values (path-replace-suffix)
|
||||
(define-values (path-replace-extension)
|
||||
(lambda (s sfx)
|
||||
(path-adjust-suffix 'path-replace-suffix #"" (lambda (bs i) #"") s sfx)))
|
||||
(path-adjust-extension 'path-replace-extension #"" (lambda (bs i) #"") s sfx)))
|
||||
|
||||
(define-values (path-add-suffix)
|
||||
(define-values (path-add-extension)
|
||||
(lambda (s sfx)
|
||||
(path-adjust-suffix 'path-replace-suffix #"_" subbytes s sfx)))
|
||||
(path-adjust-extension 'path-add-extension #"_" subbytes s sfx)))
|
||||
|
||||
(define-values (load/use-compiled)
|
||||
(lambda (f) ((current-load/use-compiled) f #f)))
|
||||
|
|
@ -1146,18 +1142,18 @@
|
|||
"native"
|
||||
(system-library-subpath)
|
||||
(if rep-sfx?
|
||||
(path-add-suffix
|
||||
(path-add-extension
|
||||
file
|
||||
dll-suffix)
|
||||
file))))]
|
||||
[zo (lambda (root-dir compiled-dir)
|
||||
(build-path (reroot base root-dir)
|
||||
compiled-dir
|
||||
(path-add-suffix file #".zo")))]
|
||||
(path-add-extension file #".zo")))]
|
||||
[alt-zo (lambda (root-dir compiled-dir)
|
||||
(build-path (reroot base root-dir)
|
||||
compiled-dir
|
||||
(path-add-suffix alt-file #".zo")))]
|
||||
(path-add-extension alt-file #".zo")))]
|
||||
[so (get-so file #t)]
|
||||
[alt-so (get-so alt-file #t)]
|
||||
[try-main? (or main-path-d (not alt-path-d))]
|
||||
|
|
@ -1427,7 +1423,7 @@
|
|||
[path-ss->rkt (lambda (p)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(if (regexp-match #rx"[.]ss$" (path->bytes name))
|
||||
(path-replace-suffix p #".rkt")
|
||||
(path-replace-extension p #".rkt")
|
||||
p)))]
|
||||
[s (if (and (pair? s) (eq? 'submod (car s)))
|
||||
(let ([v (cadr s)])
|
||||
|
|
@ -1559,7 +1555,7 @@
|
|||
(split-path filename))])
|
||||
(let* ([no-sfx (if (vector? s-parsed)
|
||||
(vector-ref s-parsed 3)
|
||||
(path-replace-suffix name #""))])
|
||||
(path-replace-extension name #""))])
|
||||
(let* ([root-modname (if (vector? s-parsed)
|
||||
(vector-ref s-parsed 4)
|
||||
(make-resolved-module-path filename))]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user