From 6178f2312fed1f95763e6bdec35684987fad63f1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 21 May 2013 13:58:56 -0600 Subject: [PATCH] add `setup/collects' and use it for ".dep" file paths This change makes ".dep" files more portable (in exchange for some extra path work at the point of reading or writing ".dep" files.) --- collects/compiler/cm.rkt | 24 ++++++++--- collects/scribblings/raco/setup.scrbl | 42 +++++++++++++++++-- collects/setup/collects.rkt | 58 +++++++++++++++++++++++++-- collects/setup/parallel-build.rkt | 2 +- collects/setup/private/cc-struct.rkt | 7 ++++ collects/setup/setup-unit.rkt | 2 +- doc/release-notes/racket/HISTORY.txt | 1 + 7 files changed, 120 insertions(+), 16 deletions(-) create mode 100644 collects/setup/private/cc-struct.rkt diff --git a/collects/compiler/cm.rkt b/collects/compiler/cm.rkt index 10c6bd0f61..b573bcbc0e 100644 --- a/collects/compiler/cm.rkt +++ b/collects/compiler/cm.rkt @@ -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) diff --git a/collects/scribblings/raco/setup.scrbl b/collects/scribblings/raco/setup.scrbl index a14099bb9d..e55bef452e 100644 --- a/collects/scribblings/raco/setup.scrbl +++ b/collects/scribblings/raco/setup.scrbl @@ -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] diff --git a/collects/setup/collects.rkt b/collects/setup/collects.rkt index 7fd39ee10a..40bc826caa 100644 --- a/collects/setup/collects.rkt +++ b/collects/setup/collects.rkt @@ -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)])) diff --git a/collects/setup/parallel-build.rkt b/collects/setup/parallel-build.rkt index 453c2f0c08..72099bd2e2 100644 --- a/collects/setup/parallel-build.rkt +++ b/collects/setup/parallel-build.rkt @@ -6,7 +6,7 @@ racket/path racket/fasl racket/serialize - setup/collects + "private/cc-struct.rkt" setup/parallel-do racket/class racket/future diff --git a/collects/setup/private/cc-struct.rkt b/collects/setup/private/cc-struct.rkt new file mode 100644 index 0000000000..7fd39ee10a --- /dev/null +++ b/collects/setup/private/cc-struct.rkt @@ -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) diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt index a59bb01dbf..c93e321c41 100644 --- a/collects/setup/setup-unit.rkt +++ b/collects/setup/setup-unit.rkt @@ -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) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 27836a5a82..51e6e7b9f4 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -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