pkg-directory: add #:cache argument

The cache enables multiple calls to `pkg-directory` to load
installed-package information only once.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.1.1.5")
+(define version "6.1.1.6")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -91,11 +91,20 @@ a parameter's value is @racket[#f], then the user's configuration is
 used.}
 
 
-@defproc[(pkg-directory [name string?]) (or/c path-string? #f)]{
+@defproc[(pkg-directory [name string?]
+                        [#:cache cache (or/c #f (and/c hash? (not/c immutable?))) #f])
+         (or/c path-string? #f)]{
 
 Returns the directory that holds the installation of the installed
 (in any scope) package @racket[name], or @racket[#f] if no such package
-is installed.}
+is installed.
+
+For multiple calls to @racket[pkg-directory], supply the same
+@racket[equal?]-based mutable hash table (initially empty) as the
+@racket[cache] argument. Otherwise, package-installation information
+must be re-parsed on every call to @racket[pkg-directory].
+
+@history[#:changed "6.1.1.6" @elem{Added the @racket[#:cache] argument.}]}
 
 
 @defproc[(default-pkg-scope) (or/c 'installation 'user

racket/collects/pkg/lib.rkt

@@ -63,7 +63,9 @@
   [current-pkg-download-cache-max-bytes
    (parameter/c (or/c #f real?))]
   [pkg-directory
-   (-> string? (or/c path-string? #f))]
+   (->* (string?)
+        (#:cache (or/c #f (and/c hash? (not/c immutable?))))
+        (or/c path-string? #f))]
   [rename
    pkg-desc/opt pkg-desc
    (->* (string?

racket/collects/pkg/private/pkg-db.rkt

@@ -75,8 +75,16 @@
           (and (hash-ref (read-pkgs-db (current-pkg-scope)) pkg-name #f)
                (current-pkg-scope)))]))
 
-(define (package-info pkg-name [fail? #t] #:db [given-db #f])
+(define (package-info pkg-name [fail? #t]
-  (define db (or given-db (read-pkg-db)))
+                      #:db [given-db #f]
+                      #:cache [cache #f])
+  (define db (or given-db
+                 (and cache
+                      (hash-ref cache (current-pkg-scope) #f))
+                 (let ([db (read-pkg-db)])
+                   (when cache
+                     (hash-set! cache (current-pkg-scope) db))
+                   db)))
   (define pi (hash-ref db pkg-name #f))
   (cond
     [pi
@@ -155,22 +163,26 @@
                               'installation
                               d)))))))
 
-(define (pkg-directory pkg-name)
+(define (pkg-directory pkg-name #:cache [cache #f])
   ;; Warning: takes locks individually.
   (pkg-directory** pkg-name
+                   #:cache cache
                    (lambda (f)
                      (with-pkg-lock/read-only
                       (f)))))
 
-(define (pkg-directory** pkg-name [call-with-pkg-lock (lambda (f) (f))])
+(define (pkg-directory** pkg-name [call-with-pkg-lock (lambda (f) (f))]
+                         #:cache [cache #f])
   (for/or ([scope (in-list (get-scope-list))])
     (parameterize ([current-pkg-scope scope])
       (call-with-pkg-lock
        (lambda ()
-         (pkg-directory* pkg-name))))))
+         (pkg-directory* pkg-name #:cache cache))))))
 
-(define (pkg-directory* pkg-name #:db [db #f])
+(define (pkg-directory* pkg-name
-  (define info (package-info pkg-name #f #:db db))
+                        #:db [db #f]
+                        #:cache [cache #f])
+  (define info (package-info pkg-name #f #:db db #:cache cache))
   (and info
        (let ()
          (match-define (pkg-info orig-pkg checksum _) info)

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.1.1.5"
+#define MZSCHEME_VERSION "6.1.1.6"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 1
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)