add `current-library-collection-links' parameter

Also, the initial value causes `curent-library-collection-paths'
before collection links files, instead of after.

pkgs/racket-pkgs/racket-doc/scribblings/reference/collects.scrbl

@@ -5,29 +5,18 @@
 @title[#:tag "collects"]{Libraries and Collections}
 
 A @deftech{library} is @racket[module] declaration for use by multiple
-programs. Racket further groups libraries into @deftech{collections}
+programs. Racket further groups libraries into @deftech{collections}.
-that can be easily distributed and added to a local Racket
+Typically, collections are added via @deftech{packages} (see
-installation. 
+@other-doc['(lib "pkg/scribblings/pkg.scrbl")]); the package manager
+works outside of the Racket core, but it configures the core run-time
+system through @tech{collection links files}.
 
-Some libraries are distributed via @|PLaneT| packages. Such libraries are
+Libraries in collections are referenced through @racket[lib] paths
-referenced through a @racket[planet] module path (see
+(see @racket[require]) or symbolic shorthands. For example, the
-@racket[require]) and are downloaded by Racket on demand.
+following module uses the @filepath{getinfo.rkt} library module from
-
+the @filepath{setup} collection, and the @filepath{cards.rkt} library
-Other collections are distributed with Racket, in which case each
+module from the @filepath{games} collection's @filepath{cards}
-collection is a directory that is located in a @filepath{collects}
+subcollection:
-directory relative to the Racket executable. A collection can also be
-installed in a user-specific directory.  More generally, the search
-path for installed collections can be configured through the
-@racket[current-library-collection-paths] parameter. Finally, the
-location of collections can be specified through the @tech{collection
-links files}; see @secref["links-file"] for more information.  In all
-of these cases, the collections are referenced through @racket[lib]
-paths (see @racket[require]) or symbolic shorthands.
-
-For example, the following module uses the @filepath{getinfo.rkt}
-library module from the @filepath{setup} collection, and the
-@filepath{cards.rkt} library module from the @filepath{games}
-collection's @filepath{cards} subcollection:
 
 @racketmod[
 racket
@@ -58,35 +47,137 @@ element that names a library file; the path elements are separated by
 @racket[_rel-string] contains @litchar{/} but does not end with a file
 suffix, then @litchar{.rkt} is implicitly appended to the path.
 
+Libraries also can be distributed via @|PLaneT| packages. Such
+libraries are referenced through a @racket[planet] module path (see
+@racket[require]) and are downloaded by Racket on demand, instead of
+referenced through @tech{collections}.
+
 The translation of a @racket[planet] or @racket[lib] path to a
 @racket[module] declaration is determined by the @tech{module name
 resolver}, as specified by the @racket[current-module-name-resolver]
 parameter.
 
+@; ----------------------------------------------------------------------
+
+@section[#:tag "collects-search"]{Collection Search Configuration}
+
 For the default @tech{module name resolver}, the search path for
-collections is determined by the content of the @tech{collection links files}
+collections is determined by the
-and the
+@racket[current-library-collection-links] parameter and the
-@racket[current-library-collection-paths] parameter. The collection
+@racket[current-library-collection-paths] parameter:
-links and then list of paths in
-@racket[current-library-collection-paths] are searched from first to
-last to locate the first that contains @racket[_rel-string]. In other
-words, the filesystem tree for each element in the link table and
-search path is spliced together with the filesystem trees of other
-path elements. Some Racket tools rely on unique resolution of module
-path names, so an installation and
-@racket[current-library-collection-paths] configuration should not
-allow multiple files to match the same collection and file name.
 
-The value of the @racket[current-library-collection-paths] parameter
+@itemlist[
-is initialized in the Racket executable to the result of
-@racket[(find-library-collection-paths)].
 
+ @item{The most primitive @tech{collection}-based modules are located
+       in @filepath{collects} directory relative to the Racket
+       executable. Libraries for a collection are grouped within a
+       directory whose name matches the collection name. The path to
+       the @filepath{collects} directory is normally included in
+       @racket[current-library-collection-paths].}
+
+ @item{Collection-based libraries also can be installed other
+       directories, perhaps user-specific, that are structured like
+       the @filepath{collects} directory. Those additional directories
+       can be included in the
+       @racket[current-library-collection-paths] parameter either
+       dynamically, through command-line arguments to @exec{racket},
+       or by setting the @envvar{PLTCOLLECTS} environment variable;
+       see @racket[find-library-collection-paths].}
+
+ @item{@tech{Collection links files} provide a mapping from top-level
+       collection names to directories, plus additional
+       @filepath{collects}-like directories (that have subdirectories
+       with names that match collection names). Each @tech{collection
+       links file} to be searched is referenced by the
+       @racket[current-library-collection-links] parameter; the parameter
+       references the file, and not the file's content, so
+       that changes to the file can be detected and affect later
+       module resolution. See also
+       @racket[find-library-collection-links].}
+
+ @item{The @racket[current-library-collection-links] parameter's value
+       can also include hash tables that provide the same content as
+       @tech{collection links files}: a mapping from collection names
+       in symbol form to a list of paths for the collection, or from
+       @racket[#f] to a list of @filepath{collects}-like paths.}
+
+ @item{Finally, the @racket[current-library-collection-links]
+       parameter's value includes @racket[#f] to indicate the point in
+       the search process at which the @tech{module-name resolver} should
+       check @racket[current-library-collection-paths] relative to the
+       files and hash tables in @racket[current-library-collection-links].}
+
+]
+
+To resolve a module reference @racket[_rel-string], the default
+@tech{module name resolver} searches collection links in
+@racket[current-library-collection-links] from first to last to locate
+the first directory that contains @racket[_rel-string], splicing a
+search through in @racket[current-library-collection-paths] where in
+@racket[current-library-collection-links] contains @racket[#f].  The
+filesystem tree for each element in the link table and search path is
+effectively spliced together with the filesystem trees of other path
+elements that correspond to the same collection. Some Racket tools
+rely on unique resolution of module path names, so an installation and
+configuration should not allow multiple files to match the same
+collection and file name.
+
+The value of the @racket[current-library-collection-links] parameter
+is initialized by the @exec{racket} executable to the result of
+@racket[(find-library-collection-links)], and the value of the
+@racket[current-library-collection-paths] parameter is initialized to
+the result of @racket[(find-library-collection-paths)].
+
+@; ----------------------------------------------------------------------
+
+@section[#:tag "links-file"]{Collection Links}
+
+@deftech{Collection links files} are used by
+@racket[collection-file-path], @racket[collection-path], and the
+default @tech{module name resolver} to locate collections before
+trying the @racket[(current-library-collection-paths)] search
+path. The @tech{collection links files} to use are determined by the
+@racket[current-library-collection-links] parameter, which is
+initialized to the result of @racket[find-library-collection-links].
+
+A @tech{collection links file} is @racket[read] with default reader
+parameter settings to obtain a list. Every element of the list must be
+a link specification with one of the forms @racket[(list _string
+_path)], @racket[(list _string _path _regexp)], @racket[(list 'root
+_path)], @racket[(list 'root _path _regexp)], @racket[(list 'static-root
+_path)], @racket[(list 'static-root _path _regexp)]. A @racket[_string] names a
+top-level @tech{collection}, in which case @racket[_path] is a path
+that can be used as the collection's path (directly, as opposed to a
+subdirectory of @racket[_path] named by @racket[_string]). A
+@racket['root] entry, in contrast, acts like an path in
+@racket[(current-library-collection-paths)].  A
+@racket['static-root] entry is like a @racket['root] entry, but
+where the immediate content of the directory is assumed not to change unless the
+@tech{collection links file} changes. If @racket[_path] is a
+relative path, it is relative to the directory containing the
+@tech{collection links file}. If @racket[_regexp] is specified in a
+link, then the link is used only if @racket[(regexp-match?  _regexp
+(version))] produces a true result.
+
+A single top-level collection can have multiple links in a
+@tech{collection links file}, and any number of @racket['root] entries
+can appear. The corresponding paths are effectively spliced together,
+since the paths are tried in order to locate a file or sub-collection.
+
+The @exec{raco link} command-link tool can display, install, and
+remove links in a @tech{collection links file}. See @secref[#:doc
+raco-doc "link"] in @other-manual[raco-doc] for more information.
+
+@; ----------------------------------------
+
+@section[#:tag "collects-api"]{Collection Paths and Parameters}
 
 @defproc[(find-library-collection-paths [pre-extras (listof path-string?) null]
                                         [post-extras (listof path-string?) null]) 
          (listof path?)]{
 
-Produces a list of paths as follows:
+Produces a list of paths, which is normally used to initialize
+@racket[current-library-collection-paths], as follows:
 
 @itemize[
 
@@ -110,9 +201,11 @@ Produces a list of paths as follows:
 
  @item{If the @indexed-envvar{PLTCOLLECTS} environment variable is
   defined, it is combined with the default list using
-  @racket[path-list-string->path-list]. If it is not defined, the
+  @racket[path-list-string->path-list], as long as the value of
-  default collection path list (as constructed by the first three
+  @racket[use-user-specific-search-paths] is true. If it is not
-  bullets above) is used directly.
+  defined or if the value @racket[use-user-specific-search-paths] is
+  @racket[#f], the default collection path list (as constructed by the
+  first three bullets above) is used directly.
 
   Note that on @|AllUnix|, paths are separated by @litchar{:}, and
   on Windows by @litchar{;}.  Also,
@@ -124,6 +217,36 @@ Produces a list of paths as follows:
 
 ]}
 
+@defproc[(find-library-collection-links) 
+         (listof (or/c #f (and/c path? complete-path?)))]{
+
+Produces a list of paths and @racket[#f], which is normally used to
+initialized @racket[current-library-collection-links], as follows:
+
+@itemlist[
+
+ @item{The list starts with @racket[#f], which causes the default
+       @tech{module name resolver}, @racket[collection-file-path],
+       and @racket[collection-path] to try paths in
+       @racket[current-library-collection-paths] before
+       @tech{collection links files}.}
+
+ @item{As long as the values of
+       @racket[use-user-specific-search-paths] and
+       @racket[use-collection-link-paths] are true, the second element
+       in the result list is the path of the user--specific
+       @tech{collection links file}, which is @racket[(build-path
+       (find-system-path 'addon-dir) (get-installation-name)
+       "links.rktd")].}
+
+ @item{As long as the value of @racket[use-collection-link-paths] is
+       true, the rest of the list contains the result of
+       @racket[get-links-search-files]. Typically, that function
+       produces a list with a single path, @racket[(build-path
+       (find-config-dir) "links.rktd")].}
+
+]}
+
 
 @defproc*[([(collection-file-path [file path-string?] [collection path-string?] ...+)
             path?]
@@ -133,7 +256,9 @@ Produces a list of paths as follows:
 
 Returns the path to the file indicated by @racket[file] in the
 collection specified by the @racket[collection]s, where the second
-@racket[collection] (if any) names a sub-collection, and so on.
+@racket[collection] (if any) names a sub-collection, and so on.  The
+search uses the values of @racket[current-library-collection-links]
+and @racket[current-library-collection-paths].
 
 If @racket[file] is not found, but @racket[file] ends in
 @filepath{.rkt} and a file with the suffix @filepath{.ss} exists, then
@@ -170,8 +295,31 @@ the file level.}
                                             (listof (and/c path? complete-path?))]{
 
 Parameter that determines a list of complete directory paths for
-library collections used by @racket[require]. See
+finding libraries (as referenced in @racket[require], for example)
-@secref["collects"] for more information.}
+through the default @tech{module name resolver} and for finding paths
+through @racket[collection-path] and
+@racket[collection-file-path]. See @secref["collects-search"] for more
+information.}
+
+
+@defparam*[current-library-collection-links paths
+                                            (listof (or/c #f
+                                                          (and/c path-string? complete-path?)
+                                                          (hash/c (or/c (and/c symbol? module-path?) #f)
+                                                          (listof (and/c path-string? complete-path?)))))
+                                            (listof (or/c #f
+                                                          (and/c path? complete-path?)
+                                                          (hash/c (or/c (and/c symbol? module-path?) #f)
+                                                          (listof (and/c path? complete-path?)))))]{
+
+
+Parameter that determines @tech{collection links files}, additional
+paths, and the relative search order of
+@racket[current-library-collection-paths] for finding libraries (as
+referenced in @racket[require], for example) through the default
+@tech{module name resolver} and for finding paths through
+@racket[collection-path] and @racket[collection-file-path]. See
+@secref["collects-search"] for more information.}
 
 
 @defboolparam[use-user-specific-search-paths on?]{
@@ -181,12 +329,17 @@ the directory produced by @racket[(find-system-path 'addon-dir)], are
 included in search paths for collections and other files. For example,
 the initial value of @racket[find-library-collection-paths] omits the
 user-specific collection directory when this parameter's value is
+@racket[#f].
+
+If @Flag{U} or @DFlag{no-user-path} argument to @exec{racket}, then
+@racket[use-user-specific-search-paths] is initialized to
 @racket[#f].}
 
+
 @defboolparam[use-collection-link-paths on?]{
 
 Parameter that determines whether @tech{collection links files} are
-used to locate collections.
+included in the result of @racket[find-library-collection-links].
 
 If this parameter's value is @racket[#f] on start-up, then
 @tech{collection links files} are effectively disabled permanently for
@@ -196,52 +349,3 @@ only is @racket[current-library-collection-paths] initialized to the
 empty list, but @racket[use-collection-link-paths] is initialized to
 @racket[#f].}
 
-@; ----------------------------------------------------------------------
-
-@section[#:tag "links-file"]{Collection Links}
-
-The @deftech{collection links files} are used by
-@racket[collection-file-path], @racket[collection-path], and the
-default @tech{module name resolver} to locate collections before
-trying the @racket[(current-library-collection-paths)] search
-path, but only if the @racket[use-collection-link-paths] parameter is set to
-@racket[#t]. Furthermore, a user-specific @tech{collection links file} takes
-precedence over an installation-wide @tech{collection links file}.
-The user-specific @tech{collection links file} is used only if the
-@racket[use-user-specific-search-paths] parameter is set to
-@racket[#t].
-
-The path of the user--specific @tech{collection links file} is
-@racket[(build-path (find-system-path 'addon-dir) (get-installation-name) "links.rktd")].
-The path of the installation-wide @tech{collection links file} is
-@racket[(build-path (find-config-dir) "links.rktd")].
-Each @tech{collection links file} is cached by Racket, but
-the file is re-read if its content changes.
-
-A @tech{collection links file} is @racket[read] with default reader
-parameter settings to obtain a list. Every element of the list must be
-a link specification with one of the forms @racket[(list _string
-_path)], @racket[(list _string _path _regexp)], @racket[(list 'root
-_path)], @racket[(list 'root _path _regexp)], @racket[(list 'static-root
-_path)], @racket[(list 'static-root _path _regexp)]. A @racket[_string] names a
-top-level @tech{collection}, in which case @racket[_path] is a path
-that can be used as the collection's path (directly, as opposed to a
-subdirectory of @racket[_path] named by @racket[_string]). A
-@racket['root] entry, in contrast, acts like an path in
-@racket[(current-library-collection-paths)].  A
-@racket['static-root] entry is like a @racket['root] entry, but
-where the immediate content of the directory is assumed not to change unless the
-@tech{collection links file} changes. If @racket[_path] is a
-relative path, it is relative to the directory containing the
-@tech{collection links file}. If @racket[_regexp] is specified in a
-link, then the link is used only if @racket[(regexp-match?  _regexp
-(version))] produces a true result.
-
-A single top-level collection can have multiple links in a
-@tech{collection links file}, and any number of @racket['root] entries
-can appear. The corresponding paths are effectively spliced together,
-since the paths are tried in order to locate a file or sub-collection.
-
-The @exec{raco link} command-link tool can display, install, and
-remove links in the @tech{collection links file}. See @secref[#:doc
-raco-doc "link"] in @other-manual[raco-doc] for more information.

pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl

@@ -80,7 +80,14 @@ when the expander encounters @racket[(require _module-path)] where
 or resolved module path. When such a @racket[require] appears within a
 module, the @deftech{module path resolver} is also given the name of
 the enclosing module, so that a relative reference can be converted to
-an absolute symbol or @tech{resolved module path}.
+an absolute symbol or @tech{resolved module path}. 
+
+The default @tech{module name resolver} uses
+@racket[collection-file-path] to convert @racket[lib] and
+symbolic-shorthand module paths to filesystem paths. The 
+@racket[collection-file-path] function, in turn, uses the
+@racket[current-library-collection-links]
+and @racket[current-library-collection-paths] parameters.
 
 A @tech{module name resolver} takes two and four arguments:
 @itemize[

pkgs/racket-pkgs/racket-test/tests/racket/collects.rktl

@@ -0,0 +1,73 @@
+
+(load-relative "loadtest.rktl")
+
+(Section 'collects)
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require racket/file)
+
+(let ()
+  (define tmp-dir (make-temporary-file "collects~a" 'directory))
+
+  (make-directory* (build-path tmp-dir "zjhyq-1"))
+  (with-output-to-file (build-path tmp-dir "zjhyq-1" "m.rkt")
+    (lambda ()
+      (displayln "#lang racket/base")
+      (displayln "(provide v)")
+      (displayln "(define v 1)")))
+  
+  (test #f collection-path "zjhyq-1" #:fail (lambda (s) #f))
+  (define (test-found)
+    (test (build-path (build-path tmp-dir "zjhyq-1"))
+          collection-path "zjhyq-1")
+    (test (build-path (build-path tmp-dir "zjhyq-1" "m.rkt"))
+          collection-file-path "m.rkt" "zjhyq-1"))
+
+  ;; Add to paths
+  (parameterize ([current-library-collection-paths
+                  (append (current-library-collection-paths)
+                          (list tmp-dir))])
+    (test-found))
+
+  ;; Add to link as hash table from #f:
+  (parameterize ([current-library-collection-links
+                  (append (current-library-collection-links)
+                          (list (hash #f (list tmp-dir))))])
+    (test-found))
+
+  ;; Add to link as hash table from 'zjhyq-1:
+  (parameterize ([current-library-collection-links
+                  (append (current-library-collection-links)
+                          (list (hash 'zjhyq-1 (list (build-path tmp-dir "zjhyq-1")))))])
+    (test-found))
+
+  (delete-directory/files tmp-dir))
+
+;; ----------------------------------------
+
+(err/rt-test (current-library-collection-paths 5))
+(err/rt-test (current-library-collection-paths (list 5)))
+(err/rt-test (current-library-collection-paths (list "relative")))
+;; strings coreced to paths:
+(test #t andmap path? (parameterize ([current-library-collection-paths (list (path->string
+                                                                              (current-directory)))])
+                        (current-library-collection-paths)))
+
+(err/rt-test (current-library-collection-links 5))
+(err/rt-test (current-library-collection-links (list 5)))
+(err/rt-test (current-library-collection-links (list #t)))
+(err/rt-test (current-library-collection-links (list "relative")))
+(err/rt-test (current-library-collection-links (list (hash 'bad! null))))
+(err/rt-test (current-library-collection-links (list (hash 'ok 5))))
+(err/rt-test (current-library-collection-links (list (hash 'ok (list 5)))))
+(err/rt-test (current-library-collection-links (list (hash 'ok (list "relative")))))
+;; strings coreced to paths:
+(test #t andmap path? (parameterize ([current-library-collection-links (list (path->string
+                                                                              (build-path (current-directory)
+                                                                                          "links.rktd")))])
+                        (current-library-collection-links)))
+
+;; ----------------------------------------
+
+(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/mz-tests.rktl

@@ -27,6 +27,7 @@
 (load-relative "prompt.rktl")
 (load-relative "will.rktl")
 (load-relative "namespac.rktl")
+(load-relative "collects.rktl")
 (load-relative "modprot.rktl")
 (load-relative "chaperone.rktl")
 (unless (or building-flat-tests? in-drscheme?)

pkgs/sandbox-lib/racket/sandbox.rkt

@@ -923,24 +923,25 @@
                      (current-library-collection-paths)))]
     [sandbox-path-permissions
      `(,@(map (lambda (p) `(read-bytecode ,p))
-              (append
+              (apply
-               (current-library-collection-paths)
+               append
-               (apply append
+               (for/list ([l (current-library-collection-links)])
-                      (for/list ([f (get-links-search-files)]
+                 (cond
-                                 #:when (file-exists? f))
+                  [(not l)
-                        (links #:root? #t #:file f)))
+                   (current-library-collection-paths)]
-               (links #:root? #t #:user? #t)
+                  [(hash? l)
-               (apply append
+                   (hash-values l)]
-                      (for/list ([f (get-links-search-files)]
+                  [else
-                                 #:when (file-exists? f))
+                   (if (file-exists? l)
-                        (map cdr (links #:file f #:with-path? #t))))
+                       (append
-               (map cdr (links #:user? #t #:with-path? #t))))
+                        (links #:root? #t #:file l)
+                        (map cdr (links #:file l #:with-path? #t)))
+                       null)]))))
+       ,@(for/list ([l (current-library-collection-links)]
+                    #:when (path? l))
+           `(read ,l))
        (read-bytecode ,(PLANET-BASE-DIR))
        (exists ,(find-system-path 'addon-dir))
-       (read ,(build-path (find-system-path 'addon-dir) "links.rktd"))
-       (read ,(build-path (find-system-path 'addon-dir) (version) "links.rktd"))
-       ,@(for/list ([f (get-links-search-files)])
-           `(read ,f))
        (read ,(find-lib-dir))
        ,@(compute-permissions allow-for-require allow-for-load)
        ,@(sandbox-path-permissions))]

pkgs/shell-completion/list-collects.rkt

@@ -9,24 +9,22 @@
         (hash-set s (path-element->string p) #t))
       s))
 
-(define (links* m root?)
-  (case m
-    [(user) (links #:user? #t #:root? root?)]
-    [else (links #:file m #:root? root?)]))
-
 (define (get-all-top-level-collections)
-  (define link-modes (list* 'user (get-links-search-files)))
+  (hash-keys
-
+   (for/fold ([s (hash)]) ([l (in-list
-  (let* ([s (hash)]
+                               (current-library-collection-links))])
-         [s (for/fold ([s s]) ([c (in-list
+     (cond
-                                   (current-library-collection-paths))])
+      [(not l)
-              (add-directory-collections c s))]
+       (for/fold ([s s]) ([c (in-list
-         [s (for*/fold ([s s]) ([m (in-list link-modes)]
+                              (current-library-collection-paths))])
-                                [l (in-list (links* m #f))])
+         (add-directory-collections c s))]
-              (hash-set s l #t))]
+      [(path? l)
-         [s (for*/fold ([s s]) ([m (in-list link-modes)]
+       (let ([s (for*/fold ([s s]) ([c (in-list (links #:file l #:root? #f))])
-                                [c (in-list (links* m #t))])
+                  (hash-set s c #t))])
-              (add-directory-collections c s))])
+         (for*/fold ([s s]) ([c (in-list (links #:file l #:root? #t))])
-    (hash-keys s)))
+           (add-directory-collections c s)))]
+      [else (error 'get-all-top-level-collections
+                   "unexpected value in `current-library-collection-links': ~e"
+                   l)]))))
 
 (for-each displayln (get-all-top-level-collections))

racket/collects/racket/HISTORY.txt

@@ -1,3 +1,11 @@
+Version 5.90.0.4
+Add current-library-collection-links, find-library-collection-links
+Changed module search to use current-library-collection-paths
+ before collection link files by default
+Changed use-user-specific-search-paths and use-collection-link-paths
+ to affect only find-library-collection-paths and
+ find-library-collection-links
+
 Version 5.90.0.3
 Base user directoy paths on an installation name instead
  of the Racket version string

racket/collects/racket/private/misc.rkt

@@ -234,6 +234,7 @@
              guard-evt channel-get channel-try-get channel-put
              port? displayln
              find-library-collection-paths
+             find-library-collection-links
              bytes-environment-variable-name?
              string-environment-variable-name?
              getenv putenv

racket/collects/setup/setup-unit.rkt

@@ -64,6 +64,8 @@
   (define main-collects-dir (simple-form-path (find-collects-dir)))
   (define main-collects-dirs (for/hash ([p (in-list (get-main-collects-search-dirs))])
                                (values (simple-form-path p) #t)))
+  (define main-links-files (for/hash ([p (in-list (get-links-search-files))])
+                             (values (simple-form-path p) #t)))
   (define mode-dir
     (if (compile-mode)
       (build-path "compiled" (compile-mode))
@@ -76,7 +78,12 @@
        p)))
 
   (current-library-collection-paths
-   (map simple-form-path (current-library-collection-paths)))
+   (if (member #f (current-library-collection-links))
+       ;; Normal case, include current library collection paths:
+       (map simple-form-path (current-library-collection-paths))
+       ;; No `#f' in links list means that we don't look at
+       ;; the current library collection paths:
+       null))
 
   (define (setup-fprintf p task s . args)
     (let ([task (if task (string-append task ": ") "")])
@@ -345,7 +352,8 @@
     ;; checkout as a collection directory
     (regexp-match? #rx"[.](git|svn)$" (path->bytes collection)))
 
-  ;; Add in all non-planet collections:
+  ;; Add in all non-planet collections, first from 
+  ;; `current-library-collection-paths':
   (for ([cp (current-library-collection-paths)]
         #:when (directory-exists? cp)
         [collection (directory-list cp)]
@@ -355,6 +363,8 @@
                     #:info-root cp
                     #:path (build-path cp collection)
                     #:main? (hash-ref main-collects-dirs cp #f)))
+  ;; Now from `current-library-collection-links' for installation-wide
+  ;; links:
   (let ()
     (define info-root (find-share-dir))
     (define info-path (build-path info-root "info-cache.rktd"))
@@ -366,7 +376,9 @@
                       #:info-path-mode 'abs-in-relative
                       #:omit-root 'dir
                       #:main? #t))
-    (for ([inst-links (in-list (get-links-search-files))])
+    (for ([inst-links (in-list (current-library-collection-links))]
+          #:when (and (path? inst-links)
+                      (hash-ref main-links-files (simple-form-path inst-links) #f)))
       (for ([c+p (in-list (links #:file inst-links #:with-path? #t))])
         (cc! (list (string->path (car c+p)))
              #:path (cdr c+p)))
@@ -377,6 +389,8 @@
             #:when (directory-exists? (build-path cp collection)))
         (cc! (list collection)
              #:path (build-path cp collection)))))
+  ;; Now from `current-library-collection-links' for user-specific
+  ;; links:
   (when (make-user)
     (define info-root (find-user-share-dir))
     (define info-path (build-path info-root "info-cache.rktd"))
@@ -387,15 +401,36 @@
                       #:info-path info-path
                       #:info-path-mode 'abs-in-relative
                       #:omit-root 'dir))
-    (for ([c+p (in-list (links #:with-path? #t))])
+    ;; A links spec in `current-library-collection-links' counts as
-      (cc! (list (string->path (car c+p)))
+    ;; user-specific when it's not in `make-links-files':
-           #:path (cdr c+p)))
+    (for ([inst-links (in-list (current-library-collection-links))]
-    (for ([cp (in-list (links #:root? #t))]
+          #:unless (and (path? inst-links)
-          #:when (directory-exists? cp)
+                        (hash-ref main-links-files (simple-form-path inst-links) #f)))
-          [collection (directory-list cp)]
+      (cond
-          #:unless (skip-collection-directory? collection)
+       [(not inst-links) ; covered by `current-library-collection-paths'
-          #:when (directory-exists? (build-path cp collection)))
+        (void)]
-      (cc! (list collection) #:path (build-path cp collection))))
+       [(path? inst-links)
+        (for ([c+p (in-list (links #:file inst-links #:with-path? #t))])
+          (cc! (list (string->path (car c+p)))
+               #:path (cdr c+p)))
+        (for ([cp (in-list (links #:file inst-links #:root? #t))]
+              #:when (directory-exists? cp)
+              [collection (directory-list cp)]
+              #:unless (skip-collection-directory? collection)
+              #:when (directory-exists? (build-path cp collection)))
+          (cc! (list collection) #:path (build-path cp collection)))]
+       [else ; must be a hash table that simulates a links file:
+        (for ([(coll-sym dir) (in-hash inst-links)])
+          (cond
+           [coll-sym
+            ;; A single collection
+            (cc! (string-split "/" (symbol->string coll-sym)) #:path dir)]
+           [(directory-exists? dir)
+            ;; A directory that holds collections:
+            (for ([collection (directory-list dir)]
+                  #:unless (skip-collection-directory? collection)
+                  #:when (directory-exists? (build-path dir collection)))
+              (cc! (list collection) #:path (build-path dir collection)))]))])))
 
   ;; `all-collections' lists all top-level collections (not from Planet):
   (define all-collections

racket/src/racket/include/scheme.h

@@ -1360,6 +1360,7 @@ enum {
   MZCONFIG_WRITE_DIRECTORY,
 
   MZCONFIG_COLLECTION_PATHS,
+  MZCONFIG_COLLECTION_LINKS,
 
   MZCONFIG_PORT_PRINT_HANDLER,
 

racket/src/racket/include/schthread.h

@@ -284,7 +284,6 @@ typedef struct Thread_Local_Variables {
   int env_uid_counter_;
   int scheme_overflow_count_;
   struct Scheme_Object *original_pwd_;
-  struct Scheme_Object *inst_links_path_;
   void *file_path_wc_buffer_;
   intptr_t scheme_hash_request_count_;
   intptr_t scheme_hash_iteration_count_;
@@ -665,7 +664,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define env_uid_counter XOA (scheme_get_thread_local_variables()->env_uid_counter_)
 #define scheme_overflow_count XOA (scheme_get_thread_local_variables()->scheme_overflow_count_)
 #define original_pwd XOA (scheme_get_thread_local_variables()->original_pwd_)
-#define inst_links_path XOA (scheme_get_thread_local_variables()->inst_links_path_)
 #define file_path_wc_buffer XOA (scheme_get_thread_local_variables()->file_path_wc_buffer_)
 #define scheme_hash_request_count XOA (scheme_get_thread_local_variables()->scheme_hash_request_count_)
 #define scheme_hash_iteration_count XOA (scheme_get_thread_local_variables()->scheme_hash_iteration_count_)

racket/src/racket/src/eval.c

@@ -5325,6 +5325,14 @@ void scheme_init_collection_paths_post(Scheme_Env *global_env, Scheme_Object *ex
   if (!scheme_setjmp(newbuf)) {
     Scheme_Object *clcp, *flcp, *a[2];
 
+    clcp = scheme_builtin_value("current-library-collection-links");
+    flcp = scheme_builtin_value("find-library-collection-links");
+
+    if (clcp && flcp) {
+      a[0] = _scheme_apply(flcp, 0, NULL);
+      _scheme_apply(clcp, 1, a);
+    }
+
     clcp = scheme_builtin_value("current-library-collection-paths");
     flcp = scheme_builtin_value("find-library-collection-paths");
 

racket/src/racket/src/file.c

@@ -201,6 +201,7 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[]);
 static Scheme_Object *file_identity(int argc, Scheme_Object *argv[]);
 static Scheme_Object *file_size(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_library_collection_paths(int argc, Scheme_Object *argv[]);
+static Scheme_Object *current_library_collection_links(int argc, Scheme_Object *argv[]);
 static Scheme_Object *use_compiled_kind(int, Scheme_Object *[]);
 static Scheme_Object *compiled_file_roots(int, Scheme_Object *[]);
 static Scheme_Object *use_user_paths(int, Scheme_Object *[]);
@@ -240,7 +241,6 @@ SHARED_OK static Scheme_Object *run_cmd;
 SHARED_OK static Scheme_Object *collects_path, *config_path;
 THREAD_LOCAL_DECL(static Scheme_Object *original_pwd);
 SHARED_OK static Scheme_Object *addon_dir;
-THREAD_LOCAL_DECL(static Scheme_Object *inst_links_path);
 
 #endif
 READ_ONLY static Scheme_Object *windows_symbol, *unix_symbol;
@@ -554,6 +554,11 @@ void scheme_init_file(Scheme_Env *env)
 						       "current-library-collection-paths",
 						       MZCONFIG_COLLECTION_PATHS),
 			     env);
+  scheme_add_global_constant("current-library-collection-links",
+			     scheme_register_parameter(current_library_collection_links,
+						       "current-library-collection-links",
+						       MZCONFIG_COLLECTION_LINKS),
+			     env);
 #endif
   scheme_add_global_constant("use-compiled-file-paths",
 			     scheme_register_parameter(use_compiled_kind,
@@ -5930,9 +5935,38 @@ static Scheme_Object *current_user_directory(int argc, Scheme_Object **argv)
 
 #endif
 
-static Scheme_Object *collpaths_gen_p(int argc, Scheme_Object **argv, int rel_ok, int abs_ok, int sym_ok)
+static Scheme_Object *check_link_key_val(Scheme_Object *key, Scheme_Object *val)
+{
+  Scheme_Object *new_val = scheme_null, *a;
+
+  if (!SCHEME_FALSEP(key)
+      && (!SCHEME_SYMBOLP(key)
+          || !scheme_is_module_path(key)))
+    return NULL;
+  
+  while (SCHEME_PAIRP(val)) {
+    a = SCHEME_CAR(val);
+    if (!SCHEME_PATH_STRINGP(a))
+      return NULL;
+    a = TO_PATH(a);
+    if (!scheme_is_complete_path(SCHEME_PATH_VAL(a),
+                                 SCHEME_PATH_LEN(a),
+                                 SCHEME_PLATFORM_PATH_KIND))
+      return NULL;
+    new_val = scheme_make_pair(a, new_val);
+    val = SCHEME_CDR(val);
+  }
+
+  if (!SCHEME_NULLP(val))
+    return NULL;
+
+  return scheme_reverse(new_val);
+}
+
+static Scheme_Object *collpaths_gen_p(int argc, Scheme_Object **argv, int rel_ok, int abs_ok, int sym_ok, int links_ok)
 {
   Scheme_Object *v = argv[0];
+  Scheme_Object *new_hts = scheme_null;
 
   if (scheme_proper_list_length(v) < 0)
     return NULL;
@@ -5945,6 +5979,36 @@ static Scheme_Object *collpaths_gen_p(int argc, Scheme_Object **argv, int rel_ok
     s = SCHEME_CAR(v);
     if (sym_ok && SAME_OBJ(s, same_symbol)) {
       /* ok */
+    } else if (links_ok && SCHEME_FALSEP(s)) {
+      /* ok */
+    } else if (links_ok && (SCHEME_CHAPERONE_HASHTP(s)
+                            || SCHEME_CHAPERONE_HASHTRP(s)
+                            || SCHEME_CHAPERONE_BUCKTP(s))) {
+      Scheme_Hash_Tree *new_ht;
+      Scheme_Object *key, *val, *idx, *a[2];
+
+      new_ht = scheme_make_hash_tree(0);
+
+      a[0] = s;
+      idx = scheme_hash_table_iterate_start(1, a);
+      while (SCHEME_TRUEP(idx)) {
+        a[0] = s;
+        a[1] = idx;
+        key = scheme_hash_table_iterate_key(2, a);
+        
+        val = scheme_chaperone_hash_get(s, key);
+        if (val) {
+          val = check_link_key_val(key, val);
+          if (!val) return NULL;
+          new_ht = scheme_hash_tree_set(new_ht, key, val);
+        }
+
+        a[0] = s;
+        a[1] = idx;
+        idx = scheme_hash_table_iterate_next(2, a);
+      }
+
+      new_hts = scheme_make_pair((Scheme_Object *)new_ht, new_hts);
     } else {
       if (!SCHEME_PATH_STRINGP(s))
         return NULL;
@@ -5964,14 +6028,24 @@ static Scheme_Object *collpaths_gen_p(int argc, Scheme_Object **argv, int rel_ok
   if (!SCHEME_NULLP(v))
     return NULL;
 
+  new_hts = scheme_reverse(new_hts);
+
   /* Convert to list of paths: */
   {
     Scheme_Object *last = NULL, *first = NULL, *p, *s;
     v = argv[0];
     while (SCHEME_PAIRP(v)) {
       s = SCHEME_CAR(v);
-      if (!SCHEME_SYMBOLP(s))
+      if (SCHEME_SYMBOLP(s)) {
+        /* ok */
+      } else if (SCHEME_FALSEP(s)) {
+        /* ok */
+      } else if (SCHEME_PATH_STRINGP(s)) {
         s = TO_PATH(s);
+      } else {
+        s = SCHEME_CAR(new_hts);
+        new_hts = SCHEME_CDR(new_hts);
+      }
       
       p = scheme_make_pair(s, scheme_null);
       if (!first)
@@ -5991,7 +6065,7 @@ static Scheme_Object *collpaths_gen_p(int argc, Scheme_Object **argv, int rel_ok
 
 static Scheme_Object *collpaths_p(int argc, Scheme_Object **argv)
 {
-  return collpaths_gen_p(argc, argv, 0, 1, 0);
+  return collpaths_gen_p(argc, argv, 0, 1, 0, 0);
 }
 
 Scheme_Object *scheme_current_library_collection_paths(int argc, Scheme_Object *argv[]) {
@@ -6006,11 +6080,32 @@ static Scheme_Object *current_library_collection_paths(int argc, Scheme_Object *
                               -1, collpaths_p, "(listof (and/c path-string? complete-path?))", 1);
 }
 
+static Scheme_Object *colllinks_p(int argc, Scheme_Object **argv)
+{
+  return collpaths_gen_p(argc, argv, 0, 1, 0, 1);
+}
+
+Scheme_Object *scheme_current_library_collection_links(int argc, Scheme_Object *argv[]) {
+  return current_library_collection_links(argc, argv);
+}
+
+static Scheme_Object *current_library_collection_links(int argc, Scheme_Object *argv[])
+{
+  return scheme_param_config2("current-library-collection-links", 
+                              scheme_make_integer(MZCONFIG_COLLECTION_LINKS),
+                              argc, argv,
+                              -1, colllinks_p, 
+                              "(listof (or/c #f (and/c path-string? complete-path?)"
+                              /**/         " (hash/c (or/c (and/c symbol? module-path?) #f)"
+                              /**/                 " (listof (and/c path-string? complete-path?)))))", 
+                              1);
+}
+
 #endif
 
 static Scheme_Object *compiled_kind_p(int argc, Scheme_Object **argv)
 {
-  return collpaths_gen_p(argc, argv, 1, 0, 0);
+  return collpaths_gen_p(argc, argv, 1, 0, 0, 0);
 }
 
 static Scheme_Object *use_compiled_kind(int argc, Scheme_Object *argv[])
@@ -6023,7 +6118,7 @@ static Scheme_Object *use_compiled_kind(int argc, Scheme_Object *argv[])
 
 static Scheme_Object *compiled_roots_p(int argc, Scheme_Object **argv)
 {
-  return collpaths_gen_p(argc, argv, 1, 1, 1);
+  return collpaths_gen_p(argc, argv, 1, 1, 1, 0);
 }
 
 Scheme_Object *scheme_compiled_file_roots(int argc, Scheme_Object *argv[])
@@ -6438,17 +6533,6 @@ void scheme_set_addon_dir(Scheme_Object *p)
   addon_dir = p;
 }
 
-Scheme_Object *scheme_find_links_path(int argc, Scheme_Object *argv[])
-{
-  if (inst_links_path)
-    return inst_links_path;
-
-  REGISTER_SO(inst_links_path);
-  inst_links_path = scheme_apply(argv[0], 0, NULL);
-
-  return inst_links_path;
-}
-
 /********************************************************************************/
 
 #ifdef DOS_FILE_SYSTEM

racket/src/racket/src/place.c

@@ -208,6 +208,7 @@ typedef struct Place_Start_Data {
   Scheme_Object *function;
   Scheme_Object *channel;
   Scheme_Object *current_library_collection_paths;
+  Scheme_Object *current_library_collection_links;
   Scheme_Object *compiled_roots;
   mzrt_sema *ready;  /* malloc'ed item */
   struct Scheme_Place_Object *place_obj;   /* malloc'ed item */
@@ -274,6 +275,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   Place_Start_Data      *place_data;
   mz_proc_thread        *proc_thread;
   Scheme_Object         *collection_paths;
+  Scheme_Object         *collection_links;
   Scheme_Place_Object   *place_obj;
   mzrt_sema             *ready;
   struct NewGC          *parent_gc;
@@ -364,6 +366,9 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   collection_paths = scheme_current_library_collection_paths(0, NULL);
   place_data->current_library_collection_paths = collection_paths;
 
+  collection_links = scheme_current_library_collection_links(0, NULL);
+  place_data->current_library_collection_links = collection_links;
+
   collection_paths = scheme_compiled_file_roots(0, NULL);
   place_data->compiled_roots = collection_paths;
 
@@ -451,6 +456,7 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   }
 
   places_prepare_direct(place_data->current_library_collection_paths);
+  places_prepare_direct(place_data->current_library_collection_links);
   places_prepare_direct(place_data->compiled_roots);
   places_prepare_direct(place_data->channel);
   places_prepare_direct(place_data->module);
@@ -2633,6 +2639,8 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
 
   a[0] = places_deep_direct_uncopy(place_data->current_library_collection_paths);
   scheme_current_library_collection_paths(1, a);
+  a[0] = places_deep_direct_uncopy(place_data->current_library_collection_links);
+  scheme_current_library_collection_links(1, a);
   a[0] = places_deep_direct_uncopy(place_data->compiled_roots);
   scheme_compiled_file_roots(1, a);
   scheme_seal_parameters();

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1109
+#define EXPECTED_PRIM_COUNT 1110
 #define EXPECTED_UNSAFE_COUNT 100
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schpriv.h

@@ -4007,6 +4007,7 @@ Scheme_Object *scheme_symbol_to_string(Scheme_Object *sym);
 #define SCHEME_SYM_WEIRDP(o) (MZ_OPT_HASH_KEY(&((Scheme_Symbol *)(o))->iso) & 0x3)
 
 Scheme_Object *scheme_current_library_collection_paths(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_current_library_collection_links(int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_compiled_file_roots(int argc, Scheme_Object *argv[]);
 
 #ifdef MZ_USE_JIT

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.90.0.3"
+#define MZSCHEME_VERSION "5.90.0.4"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 90
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 3
+#define MZSCHEME_VERSION_W 4
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/startup.inc

@@ -143,6 +143,7 @@
 " collection-path"
 " collection-file-path"
 " find-library-collection-paths"
+" find-library-collection-links"
 " path-list-string->path-list"
 " find-executable-path"
 " load/use-compiled"
@@ -428,9 +429,8 @@
 "((not(car l))(append orig-l(loop(cdr l))))"
 "(else(cons(coerce-to-path(car l))(loop(cdr l))))))"
 " orig-l))))"
-"(define-values(all-links-paths)(find-links-path!"
+"(define-values(find-library-collection-links)"
 "(lambda()"
-"(if(use-collection-link-paths)"
 "(let*((d(find-config-dir))"
 "(ht(get-config-table d))"
 "(lf(coerce-to-path"
@@ -438,21 +438,21 @@
 "(build-path(or(hash-ref ht 'share-dir #f)"
 " (build-path 'up \"share\"))"
 " \"links.rktd\")))))"
-"(cons(list->vector"
+"(append"
+"(list #f)"
+"(if(and(use-user-specific-search-paths)"
+"(use-collection-link-paths))"
+"(list(build-path(find-system-path 'addon-dir)"
+"(get-installation-name ht)"
+" \"links.rktd\"))"
+" null)"
+"(if(use-collection-link-paths)"
 "(add-config-search"
 " ht"
 " 'links-search-files"
-"(list lf)))"
+"(list lf))"
-"(build-path(find-system-path 'addon-dir)"
+" null)))))"
-"(get-installation-name ht)"
+"(define-values(links-cache)(make-weak-hash))"
-" \"links.rktd\")))"
-"(cons #() #f)))))"
-"(define-values(links-paths)(car all-links-paths))"
-"(define-values(user-links-path)(cdr all-links-paths))"
-"(define-values(user-links-cache)(make-hasheq))"
-"(define-values(user-links-stamp) #f)"
-"(define-values(links-caches)(make-vector(vector-length links-paths)(make-hasheq)))"
-"(define-values(links-stamps)(make-vector(vector-length links-paths) #f))"
 "(define-values(stamp-prompt-tag)(make-continuation-prompt-tag 'stamp))"
 "(define-values(file->stamp)"
 "(lambda(path old-stamp)"
@@ -511,7 +511,7 @@
 "(or(not a)"
 "(not(car a)))))"
 "(define-values(get-linked-collections)"
-"(lambda(user? ii)"
+"(lambda(links-path)"
 "(call/ec(lambda(esc)"
 "(define-values(make-handler)"
 "(lambda(ts)"
@@ -522,33 +522,21 @@
 "(log-message l 'error"
 "(format"
 " \"error reading collection links file ~s: ~a\""
-"(cond"
+" links-path"
-"(user? user-links-path)"
-"(else(vector-ref links-paths ii)))"
 "(exn-message exn))"
 "(current-continuation-marks))))"
 "(void))"
 "(when ts"
-"(cond"
+"(hash-set! links-cache links-path(cons #hasheq() ts)))"
-"(user?"
-"(set! user-links-cache(make-hasheq))"
-"(set! user-links-stamp ts))"
-"(else"
-"(vector-set! links-caches ii(make-hasheq))"
-"(vector-set! links-stamps ii ts))))"
 "(if(exn:fail? exn)"
 "(esc(make-hasheq))"
 " exn))))"
 "(with-continuation-mark"
 " exception-handler-key"
 "(make-handler #f)"
-"(let*((a-links-path(cond"
+"(let*((links-stamp+cache(hash-ref links-cache links-path '(#f . #hasheq())))"
-"(user? user-links-path)"
+"(a-links-stamp(car links-stamp+cache))"
-"(else(vector-ref links-paths ii))))"
+"(ts(file->stamp links-path a-links-stamp)))"
-"(a-links-stamp(cond"
-"(user? user-links-stamp)"
-"(else(vector-ref links-stamps ii))))"
-"(ts(file->stamp a-links-path a-links-stamp)))"
 "(if(not(equal? ts a-links-stamp))"
 "(with-continuation-mark"
 " exception-handler-key"
@@ -557,7 +545,7 @@
 "(lambda()"
 "(let((v(if(no-file-stamp? ts)"
 " null"
-"(let((p(open-input-file a-links-path 'binary)))"
+"(let((p(open-input-file links-path 'binary)))"
 "(dynamic-wind"
 " void"
 "(lambda() "
@@ -580,7 +568,7 @@
 " v))"
 " (error \"ill-formed content\"))"
 "(let((ht(make-hasheq))"
-"(dir(let-values(((base name dir?)(split-path a-links-path)))"
+"(dir(let-values(((base name dir?)(split-path links-path)))"
 " base)))"
 "(for-each"
 "(lambda(p)"
@@ -611,17 +599,9 @@
 "(hash-for-each"
 " ht"
 "(lambda(k v)(hash-set! ht k(reverse v))))"
-"(cond"
+"(hash-set! links-cache links-path(cons ts ht))"
-"(user?"
-"(set! user-links-cache ht)"
-"(set! user-links-stamp ts))"
-"(else"
-"(vector-set! links-caches ii ht)"
-"(vector-set! links-stamps ii ts)))"
 " ht)))))"
-"(cond"
+"(cdr links-stamp+cache))))))))"
-"(user? user-links-cache)"
-"(else(vector-ref links-caches ii))))))))))"
 "(define-values(normalize-collection-reference)"
 "(lambda(collection collection-path)"
 "(cond"
@@ -645,29 +625,28 @@
 "(lambda(fail collection collection-path file-name)"
 "(let-values(((collection collection-path)"
 "(normalize-collection-reference collection collection-path)))"
-"(let((all-paths(let((sym(string->symbol(if(path? collection)"
+"(let((all-paths(let((sym(string->symbol "
+"(if(path? collection)"
 "(path->string collection)"
-" collection)))"
+" collection))))"
-"(links?(use-collection-link-paths)))"
+"(let loop((l(current-library-collection-links)))"
+"(cond"
+"((null? l) null)"
+"((not(car l))"
+"(append "
+"(current-library-collection-paths)"
+"(loop(cdr l))))"
+"((hash?(car l))"
 "(append"
-"(if(and links? "
+"(map box(hash-ref(car l) sym null))"
-"(use-user-specific-search-paths)"
+"(hash-ref(car l) #f null)"
-" user-links-path)"
+"(loop(cdr l))))"
-"(append"
+"(else"
-"(let((ht(get-linked-collections #t 0)))"
+"(let((ht(get-linked-collections(car l))))"
-"(append(hash-ref ht sym null)"
+"(append "
-"(hash-ref ht #f null))))"
+"(hash-ref ht sym null)"
-" null)"
-"(if links?"
-"(let loop((ii 0))"
-"(if(ii . >= .(vector-length links-paths))"
-" null"
-"(let((ht(get-linked-collections #f ii)))"
-"(append(hash-ref ht sym null)"
 "(hash-ref ht #f null)"
-"(loop(add1 ii))))))"
+"(loop(cdr l))))))))))"
-" null)"
-"(current-library-collection-paths)))))"
 "(define-values(done)"
 "(lambda(p)"
 "(if file-name(build-path p file-name) p)))"

racket/src/racket/src/startup.rktl

@@ -190,6 +190,7 @@
              collection-path
              collection-file-path
              find-library-collection-paths
+             find-library-collection-links
              path-list-string->path-list
              find-executable-path
              load/use-compiled
@@ -504,42 +505,37 @@
                [else (cons (coerce-to-path (car l)) (loop (cdr l)))]))
             orig-l))))
 
-  (define-values (all-links-paths) (find-links-path!
+  (define-values (find-library-collection-links)
-                                    ;; This thunk is called once per place, and the result
+    (lambda ()
-                                    ;; is remembered for later invocations. Otherwise, the
+      (let* ([d (find-config-dir)]
-                                    ;; search for the config file can trip over filesystem
+             [ht (get-config-table d)]
-                                    ;; restrictions imposed by security guards.
+             [lf (coerce-to-path
-                                    (lambda ()
+                  (or (hash-ref ht 'links-file #f)
-                                      ;; If `use-collection-link-paths' is disabled on
+                      (build-path (or (hash-ref ht 'share-dir #f)
-                                      ;; startup, then don't try to read the configuration
+                                      (build-path 'up "share"))
-                                      ;; file, either.
+                                  "links.rktd")))])
-                                      (if (use-collection-link-paths)
+        (append
-                                          (let* ([d (find-config-dir)]
+         ;; `#f' means `current-library-collection-paths':
-                                                 [ht (get-config-table d)]
+         (list #f)
-                                                 [lf (coerce-to-path
+         ;; user-specific
-                                                      (or (hash-ref ht 'links-file #f)
+         (if (and (use-user-specific-search-paths)
-                                                          (build-path (or (hash-ref ht 'share-dir #f)
+                  (use-collection-link-paths))
-                                                                          (build-path 'up "share"))
+             (list (build-path (find-system-path 'addon-dir)
-                                                                      "links.rktd")))])
+                               (get-installation-name ht)
-                                            (cons (list->vector
+                               "links.rktd"))
-                                                   (add-config-search
+             null)
-                                                    ht
+         ;; installation-wide:
-                                                    'links-search-files
+         (if (use-collection-link-paths)
-                                                    (list lf)))
+             (add-config-search
-                                                  (build-path (find-system-path 'addon-dir)
+              ht
-                                                              (get-installation-name ht)
+              'links-search-files
-                                                              "links.rktd")))
+              (list lf))
-                                          (cons #() #f)))))
+             null)))))
 
-  (define-values (links-paths) (car all-links-paths))
+  ;; map from link-file names to cached information:
-  (define-values (user-links-path) (cdr all-links-paths))
+  (define-values (links-cache) (make-weak-hash))
-
-  (define-values (user-links-cache) (make-hasheq))
-  (define-values (user-links-stamp) #f)
-
-  (define-values (links-caches) (make-vector (vector-length links-paths) (make-hasheq)))
-  (define-values (links-stamps) (make-vector (vector-length links-paths) #f))
 
+  ;; used for low-level except abort below:
   (define-values (stamp-prompt-tag) (make-continuation-prompt-tag 'stamp))
 
   (define-values (file->stamp)
@@ -606,7 +602,9 @@
           (not (car a)))))
   
   (define-values (get-linked-collections)
-    (lambda (user? ii)
+    (lambda (links-path)
+      ;; Use/save information in `links-cache', relying on filesystem-change events
+      ;; or a copy of the file to detect when the cache is stale.
       (call/ec (lambda (esc)
                  (define-values (make-handler)
                    (lambda (ts)
@@ -617,20 +615,12 @@
                                (log-message l 'error
                                             (format
                                              "error reading collection links file ~s: ~a"
-                                             (cond
+                                             links-path
-                                              [user? user-links-path]
-                                              [else (vector-ref links-paths ii)])
                                              (exn-message exn))
                                             (current-continuation-marks))))
                            (void))
                        (when ts
-                         (cond
+                         (hash-set! links-cache links-path (cons #hasheq() ts)))
-                          [user?
-                           (set! user-links-cache (make-hasheq))
-                           (set! user-links-stamp ts)]
-                          [else
-                           (vector-set! links-caches ii (make-hasheq))
-                           (vector-set! links-stamps ii ts)]))
                        (if (exn:fail? exn)
                            (esc (make-hasheq))
                            ;; re-raise the exception (which is probably a break)
@@ -638,13 +628,9 @@
                  (with-continuation-mark
                      exception-handler-key
                      (make-handler #f)
-                   (let* ([a-links-path (cond
+                   (let* ([links-stamp+cache (hash-ref links-cache links-path '(#f . #hasheq()))]
-                                         [user? user-links-path]
+                          [a-links-stamp (car links-stamp+cache)]
-                                         [else (vector-ref links-paths ii)])]
+                          [ts (file->stamp links-path a-links-stamp)])
-                          [a-links-stamp (cond
-                                          [user? user-links-stamp]
-                                          [else (vector-ref links-stamps ii)])]
-                          [ts (file->stamp a-links-path a-links-stamp)])
                      (if (not (equal? ts a-links-stamp))
                          (with-continuation-mark
                              exception-handler-key
@@ -653,7 +639,7 @@
                             (lambda ()
                               (let ([v (if (no-file-stamp? ts)
                                            null
-                                           (let ([p (open-input-file a-links-path 'binary)])
+                                           (let ([p (open-input-file links-path 'binary)])
                                              (dynamic-wind
                                                  void
                                                  (lambda () 
@@ -676,7 +662,7 @@
                                                      v))
                                   (error "ill-formed content"))
                                 (let ([ht (make-hasheq)]
-                                      [dir (let-values ([(base name dir?) (split-path a-links-path)])
+                                      [dir (let-values ([(base name dir?) (split-path links-path)])
                                              base)])
                                   (for-each
                                    (lambda (p)
@@ -715,17 +701,9 @@
                                    ht
                                    (lambda (k v) (hash-set! ht k (reverse v))))
                                   ;; save table & file content:
-                                  (cond
+                                  (hash-set! links-cache links-path (cons ts ht))
-                                   [user?
-                                    (set! user-links-cache ht)
-                                    (set! user-links-stamp ts)]
-                                   [else
-                                    (vector-set! links-caches ii ht)
-                                    (vector-set! links-stamps ii ts)])
                                   ht)))))
-                         (cond
+                         (cdr links-stamp+cache))))))))
-                          [user? user-links-cache]
-                          [else (vector-ref links-caches ii)]))))))))
 
   (define-values (normalize-collection-reference)
     (lambda (collection collection-path)
@@ -752,32 +730,38 @@
     (lambda (fail collection collection-path file-name)
       (let-values ([(collection collection-path)
                     (normalize-collection-reference collection collection-path)])
-        (let ([all-paths (let ([sym (string->symbol (if (path? collection)
+        (let ([all-paths (let ([sym (string->symbol 
-                                                        (path->string collection)
+                                     (if (path? collection)
-                                                        collection))]
+                                         (path->string collection)
-                               [links? (use-collection-link-paths)])
+                                         collection))])
-                           (append
+                           (let loop ([l (current-library-collection-links)])
-                            ;; list of paths and (box path)s:
+                             (cond
-                            (if (and links? 
+                              [(null? l) null]
-                                     (use-user-specific-search-paths)
+                              [(not (car l))
-                                     user-links-path)
+                               ;; #f is the point where we try the old parameter:
-                                (append
+                               (append 
-                                 (let ([ht (get-linked-collections #t 0)])
+                                (current-library-collection-paths)
-                                   (append (hash-ref ht sym null)
+                                (loop (cdr l)))]
-                                           (hash-ref ht #f null))))
+                              [(hash? (car l))
-                                null)
+                               ;; A hash table maps a collection-name symbol
-                            ;; list of paths and (box path)s:
+                               ;; to a list of paths. We need to wrap each path
-                            (if links?
+                               ;; in a box, because that's how the code below
-                                (let loop ([ii 0])
+                               ;; knows that it's a single collection's directory.
-                                  (if (ii . >= . (vector-length links-paths))
+                               ;; A hash table can also map #f to a list of paths
-                                      null
+                               ;; for directories that hold collections.
-                                      (let ([ht (get-linked-collections #f ii)])
+                               (append
-                                        (append (hash-ref ht sym null)
+                                (map box (hash-ref (car l) sym null))
-                                                (hash-ref ht #f null)
+                                (hash-ref (car l) #f null)
-                                                (loop (add1 ii))))))
+                                (loop (cdr l)))]
-                                null)
+                              [else
-                            ;; list of paths:
+                               (let ([ht (get-linked-collections (car l))])
-                            (current-library-collection-paths)))])
+                                 (append 
+                                  ;; Table values are lists of paths and (box path)s,
+                                  ;; where a (box path) is a collection directory
+                                  ;; (instead of a directory containing collections).
+                                  (hash-ref ht sym null)
+                                  (hash-ref ht #f null)
+                                  (loop (cdr l))))])))])
           (define-values (done)
             (lambda (p)
               (if file-name (build-path p file-name) p)))

racket/src/racket/src/thread.c

@@ -669,7 +669,6 @@ void scheme_init_paramz(Scheme_Env *env)
   GLOBAL_PRIM_W_ARITY("check-for-break"         , check_break_now         , 0,  0, newenv);
   GLOBAL_PRIM_W_ARITY("reparameterize"          , reparameterize          , 1,  1, newenv);
   GLOBAL_PRIM_W_ARITY("make-custodian-from-main", make_custodian_from_main, 0,  0, newenv);
-  GLOBAL_PRIM_W_ARITY("find-links-path!"        , scheme_find_links_path  , 1,  1, newenv);
 
   scheme_finish_primitive_module(newenv);
   scheme_protect_primitive_provide(newenv, NULL);
@@ -7454,6 +7453,7 @@ static void make_initial_config(Scheme_Thread *p)
 							  : scheme_false));
 
   init_param(cells, paramz, MZCONFIG_COLLECTION_PATHS,  scheme_null);
+  init_param(cells, paramz, MZCONFIG_COLLECTION_LINKS,  scheme_null);
 
   {
     Scheme_Security_Guard *sg;