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

add `setup/collects' and use it for ".dep" file paths

Browse Source 
This change makes ".dep" files more portable (in exchange for some
extra path work at the point of reading or writing ".dep" files.)
This commit is contained in:
Matthew Flatt 2013-05-21 13:58:56 -06:00
parent bc0b50be96
commit 6178f2312f
7 changed files with 120 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/compiler/cm.rkt
View File

@ -2,7 +2,6 @@
(require syntax/modcode
syntax/modresolve
syntax/modread
setup/main-collects
setup/dirs
unstable/file
racket/file
@ -10,7 +9,8 @@
racket/path
racket/promise
openssl/sha1
racket/place)
racket/place
setup/collects)
(provide make-compilation-manager-load/use-compiled-handler
managed-compile-zo
@ -126,6 +126,18 @@
[else
(c-loop (cdr paths))])]))]))))
(define (path*->collects-relative p)
(if (bytes? p)
(let ([q (path->collects-relative (bytes->path p))])
(if (path? q)
(path->bytes q)
q))
(path->collects-relative p)))
(define (collects-relative*->path p)
(if (bytes? p)
(bytes->path p)
(collects-relative->path p)))
(define (reroot-path* base root)
(cond
@ -279,7 +291,7 @@
;; (cons 'ext rel-path) => a non-module file, check source
;; rel-path => a module file name, check cache
(let* ([ext? (and (pair? dep) (eq? 'ext (car dep)))]
[p (main-collects-relative->path (if ext? (cdr dep) dep))])
[p (collects-relative*->path (if ext? (cdr dep) dep))])
(cond
[ext? (let ([v (get-source-sha1 p)])
(cond
@ -321,9 +333,9 @@
(with-compile-output dep-path
(lambda (op tmp-path)
(let ([deps (append
(map path->main-collects-relative deps)
(map path*->collects-relative deps)
(map (lambda (x)
(cons 'ext (path->main-collects-relative x)))
(cons 'ext (path*->collects-relative x)))
external-deps))])
(write (list* (version)
(cons (or src-sha1 (get-source-sha1 path))
@ -678,7 +690,7 @@
;; (cons 'ext rel-path) => a non-module file (check date)
;; rel-path => a module file name (check transitive dates)
(define ext? (and (pair? p) (eq? 'ext (car p))))
(define d (main-collects-relative->path (if ext? (cdr p) p)))
(define d (collects-relative*->path (if ext? (cdr p) p)))
(define t
(if ext?
(cons (try-file-time d) #f)

42
collects/scribblings/raco/setup.scrbl
View File

@ -28,7 +28,9 @@
racket/future
mrlib/terminal
(only-in ffi/unsafe ffi-lib)
racket/path))
racket/path
setup/collects
syntax/modcollapse))
@(define-syntax-rule (local-module mod . body)
(begin
@ -1160,7 +1162,37 @@ following two APIs cover two aspects of this: a way to convert a path to
a value that is relative to the @filepath{collets} tree, and a way to
display such paths (e.g., in error messages).
@subsection{Representing paths relative to @filepath{collects}}
@subsection{Representing Collection-Based Paths}
@defmodule[setup/collects]
@defproc[(path->collects-relative [path path-string?])
(or/c path-string? (cons/c 'collects (listof bytes?)))]{
Checks whether @racket[path] (normalized by
@racket[path->complete-path] and @racket[simplify-path] with
@racket[#f] as its second argument) matches the result of
@racket[collection-file-path]. If so, the result is a list starting
with @racket['collects] and containing the relevant path elements as
byte strings. If not, the path is returned as-is.}
@defproc[(collects-relative->path
[rel (or/c path-string?
(cons/c 'collects bytes? bytes? (listof bytes?)))])
path-string?]{
The inverse of @racket[path->collects-relative]: if @racket[rel]
is a pair that starts with @racket['collects], then it is converted
back to a path using @racket[collection-file-path].}
@defproc[(path->module-path [path path-string?])
(or/c path-string? module-path?)]{
Like @racket[path->collects-relative], but the result is either
@racket[path] or a normalized (in the sense of
@racket[collapse-module-path]) module path.}
@subsection{Representing Paths Relative to @filepath{collects}}
@defmodule[setup/main-collects]
@ -1178,7 +1210,9 @@ The @racket[path] argument should be a complete path. Applying
usually a good idea.
For historical reasons, @racket[path] can be a byte string, which is
converted to a path using @racket[bytes->path].}
converted to a path using @racket[bytes->path].
See also @racket[collects-relative->path].}
@defproc[(main-collects-relative->path
[rel (or/c bytes? path-string?
@ -1192,7 +1226,7 @@ back to a path relative to @racket[(find-collects-dir)].
For historical reasons, if @racket[rel] is any kind of value other
than specified in the contract above, it is returned as-is.}
@subsection{Displaying paths relative to a common root}
@subsection{Displaying Paths Relative to a Common Root}
@defmodule[setup/path-to-relative]

58
collects/setup/collects.rkt
View File

@ -1,7 +1,57 @@
#lang racket/base
(require racket/list
racket/string)
(provide (struct-out cc))
(provide path->module-path
path->collects-relative
collects-relative->path)
(define-struct cc
(collection path name info omit-root info-root info-path info-path-mode shadowing-policy main?)
#:inspector #f)
(define (path->spec p who mode)
(unless (path-string? p)
(raise-argument-error who "path-string?" p))
(define simple-p (simplify-path (path->complete-path p) #f))
(define p-l (reverse (explode-path simple-p)))
(or (and ((length p-l) . > . 2)
(regexp-match? #rx#"^[-a-zA-Z0-9_+%.]*$" (path-element->bytes (car p-l)))
(let ([file (path-element->string (car p-l))])
(let loop ([c-l null] [p-l (cdr p-l)])
(cond
[(null? p-l) #f]
[(null? (cdr p-l)) #f]
[(regexp-match? #rx#"^[-a-zA-Z0-9_+%]*$" (path-element->bytes (car p-l)))
(define new-c-l (cons (path-element->string (car p-l)) c-l))
(define c-p (apply collection-file-path file new-c-l #:fail (lambda (msg) #f)))
(if (and c-p
(equal? c-p simple-p))
(let ([norm-file (regexp-replace #rx"[.]ss$" file ".rkt")])
(if (eq? mode 'module-path)
`(lib ,(string-join (append new-c-l (list norm-file))
"/"))
`(collects ,@(map string->bytes/utf-8 new-c-l) ,(string->bytes/utf-8 norm-file))))
(loop new-c-l (cdr p-l)))]
[else #f]))))
p))
(define (path->module-path p)
(path->spec p 'path->module-path 'module-path))
(define (path->collects-relative p)
(path->spec p 'path->collects-relative 'collects-relative))
(define (collects-relative->path p)
(cond
[(and (pair? p) (list? p)
((length p) . >= . 3)
(eq? 'collects (car p))
(andmap bytes? (cdr p)))
(apply collection-file-path
(bytes->string/utf-8 (last p))
(map bytes->string/utf-8 (drop-right (cdr p) 1)))]
[(path-string? p) p]
[(bytes? p) p]
[else (raise-argument-error
'collects-relative->path
(format "~s"
'(or/c bytes? path-string?
(cons/c 'collects bytes? bytes? (listof bytes?))))
p)]))

2
collects/setup/parallel-build.rkt
View File

@ -6,7 +6,7 @@
racket/path
racket/fasl
racket/serialize
setup/collects
"private/cc-struct.rkt"
setup/parallel-do
racket/class
racket/future

7
collects/setup/private/cc-struct.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(provide (struct-out cc))
(define-struct cc
(collection path name info omit-root info-root info-path info-path-mode shadowing-policy main?)
#:inspector #f)

2
collects/setup/setup-unit.rkt
View File

@ -28,7 +28,7 @@
"path-relativize.rkt"
"private/omitted-paths.rkt"
"parallel-build.rkt"
"collects.rkt"
"private/cc-struct.rkt"
"link.rkt")
(define-namespace-anchor anchor)

1
doc/release-notes/racket/HISTORY.txt
View File

@ -3,6 +3,7 @@ Move explode-path from racket/path to racket/base
Changed read-on-demand-source to support #t
slideshow/pict: added 'outline style for text
scriblib/autobib: add #:note
setup/collects: added
Version 5.3.4.9
racket/place: allow keywords as place messages