diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl index c8e0869277..6cbe6e2d0e 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl @@ -32,19 +32,29 @@ A structure subtype that represents a package that is installed as single-collection.} -@defproc[(path->pkg [path path-string?]) (or/c string? #f)]{ +@defproc[(path->pkg [path path-string?] + [#:cache cache (or/c #f (and/c hash? (not/c immutable?)))]) + (or/c string? #f)]{ -Returns the installed package containing @racket[path], if any.} +Returns the installed package containing @racket[path], if any. + +If @racket[cache] is not @racket[#f], then it is consulted and +modified to cache installed-package information across calls to +@racket[path->pkg] (with the assumption that the set of installed +packages does not change across calls that receive the same +@racket[cache]).} -@defproc[(path->pkg+subpath [path path-string?]) +@defproc[(path->pkg+subpath [path path-string?] + [#:cache cache (or/c #f (and/c hash? (not/c immutable?)))]) (values (or/c string? #f) (or/c path? 'same #f))]{ Like @racket[path->pkg], but returns a second value that represents the remainder of @racket[path] within the package's directory.} -@defproc[(path->pkg+subpath+collect [path path-string?]) +@defproc[(path->pkg+subpath+collect [path path-string?] + [#:cache cache (or/c #f (and/c hash? (not/c immutable?)))]) (values (or/c string? #f) (or/c path? 'same #f) (or/c string? #f))]{ Like @racket[path->pkg+subpath], but returns a third value for a diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl index f69c1ea0d5..4d1b4392db 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -28,7 +28,8 @@ (only-in ffi/unsafe ffi-lib) racket/path setup/collects - syntax/modcollapse)) + syntax/modcollapse + pkg/path)) @(define-syntax-rule (local-module mod . body) (begin @@ -1220,7 +1221,8 @@ display such paths (e.g., in error messages). @defmodule[setup/collects] -@defproc[(path->collects-relative [path path-string?]) +@defproc[(path->collects-relative [path path-string?] + [#:cache cache (or/c #f (and/c hash? (not/c immutable?)))]) (or/c path-string? (cons/c 'collects (listof bytes?)))]{ Checks whether @racket[path] (normalized by @@ -1228,7 +1230,9 @@ Checks whether @racket[path] (normalized by @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.} +byte strings. If not, the path is returned as-is. + +The @racket[cache] argument is used with @racket[path->pkg], if needed.} @defproc[(collects-relative->path [rel (or/c path-string? @@ -1239,7 +1243,8 @@ 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?]) +@defproc[(path->module-path [path path-string?] + [#:cache cache (or/c #f (and/c hash? (not/c imutable?)))]) (or/c path-string? module-path?)]{ Like @racket[path->collects-relative], but the result is either diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index 50c3bda576..b47c3af8ae 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt @@ -433,10 +433,11 @@ (doc-under-main? (info-doc d)) all-main?)) (set! added? #t) - (verbose/log - (printf "Removed Dependency for ~a: ~a" - (doc-name (info-doc info)) - (doc-name (info-doc info)))))))) + (verbose/log "Removed Dependency for ~a: ~a" + (doc-name (info-doc info)) + (if i + (doc-name (info-doc i)) + d)))))) (define (add-dependency info i) (cond [((info-start-time info) . < . (info-done-time info)) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 3d2dd7cc66..dca0c9f0a8 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -255,12 +255,14 @@ root-relative->path root-relative?) + (define path-cache (make-hash)) + (define (path->relative p) (let ([p (path->main-doc-relative p)]) (if (path? p) (let ([p (path->root-relative p)]) (if (path? p) - (let ([p (path->collects-relative p)]) + (let ([p (path->collects-relative p #:cache path-cache)]) (if (path? p) p (intern-taglet p))) diff --git a/racket/lib/collects/setup/collects.rkt b/racket/lib/collects/setup/collects.rkt index eb23cc9b01..4206e2e500 100644 --- a/racket/lib/collects/setup/collects.rkt +++ b/racket/lib/collects/setup/collects.rkt @@ -1,15 +1,38 @@ #lang racket/base (require racket/list - racket/string) + racket/string + pkg/path) (provide path->module-path path->collects-relative collects-relative->path) -(define (path->spec p who mode) +(define (path->spec p who mode cache) (unless (path-string? p) (raise-argument-error who "path-string?" p)) (define simple-p (simplify-path (path->complete-path p) #f)) + (define (make-result new-c-l file) + (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))))) + (define (try-pkg) + (define-values (pkg subpath pkg-collect) + (path->pkg+subpath+collect simple-p #:cache cache)) + (cond + [pkg + (define p-l (map path-element->string (reverse (explode-path subpath)))) + (define new-c-l (let ([l (reverse (cdr p-l))]) + (if pkg-collect + (cons pkg-collect l) + l))) + (define c-p (apply collection-file-path (car p-l) new-c-l + #:fail (lambda (msg) #f))) + (and c-p + (equal? c-p simple-p) + (make-result new-c-l (car p-l)))] + [else #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))) @@ -23,20 +46,17 @@ (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)))) + (make-result new-c-l file) (loop new-c-l (cdr p-l)))] [else #f])))) + (try-pkg) p)) -(define (path->module-path p) - (path->spec p 'path->module-path 'module-path)) +(define (path->module-path p #:cache [cache #f]) + (path->spec p 'path->module-path 'module-path cache)) -(define (path->collects-relative p) - (path->spec p 'path->collects-relative 'collects-relative)) +(define (path->collects-relative p #:cache [cache #f]) + (path->spec p 'path->collects-relative 'collects-relative cache)) (define (collects-relative->path p) (cond