path->collects-path: repair for single-collection packages

Added an optional `#:cache' argument that is propagated to
`path->pkg', if necessary.

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

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

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))

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)))

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