add module-suffixes and doc-module-suffixes to "info.rkt"

A `module-suffixes` entry in a collection's "info.rkt" adds a
file suffix that is meant to be recognized globally (i.e., in
all collections) by all Racket tools.

The new fields are reported by `compiler/module-suffix` library, which
is (so far) used by `raco setup`.

Note that if package A includes files with a suffix that is registered
by package B, then A should have a dependency on B, but `raco setup`
cannot currently detect that such a dependency is needed. That
dependency is likely to happen, anyway, since package A is likely
using libraries form package B.

pkgs/racket-doc/dynext/dynext.scrbl

@@ -9,7 +9,8 @@
              dynext/link-unit
              dynext/link-sig
              dynext/file-unit
-             dynext/file-sig))
+             dynext/file-sig
+             compiler/module-suffix))
 
 @title{Dynext: Running a C Compiler/Linker}
 
@@ -359,7 +360,11 @@ Appends the platform-standard dynamic-extension file suffix to
          (or/c path? false/c)]{
 
 Strips the Racket file suffix from @racket[s] and returns a stripped
-path. Unlike the other functions below, when @racket[program] is not
+path. The recognized suffixes are the ones reported by
+@racket[(get-module-suffixes #:group 'libs)] when
+@racket[extract-base-filename/ss] is first called.
+
+Unlike the other functions below, when @racket[program] is not
 @racket[#f], then any suffix (including no suffix) is allowed. If
 @racket[s] is not a Racket file and @racket[program] is @racket[#f],
 @racket[#f] is returned.}

pkgs/racket-doc/scribblings/raco/api.scrbl

@@ -2,6 +2,7 @@
 
 @(require scribble/manual
           scribble/bnf
+          "common.rkt"
           (for-label scheme/gui
                      compiler/compiler
                      compiler/sig
@@ -12,7 +13,9 @@
                      dynext/compile-sig
                      dynext/link-sig
                      dynext/file-sig
-                     launcher/launcher))
+                     launcher/launcher
+                     compiler/module-suffix
+                     setup/getinfo))
 
 @title{API for Raw Compilation}
 
@@ -84,7 +87,9 @@ The @filepath{.zo} files are placed into the collection's
 
 By default, all files with the
 extension @filepath{.rkt}, @filepath{.ss}, or @filepath{.scm} in a collection are
-compiled, as are all such files within subdirectories, execept that
+compiled, as are all such files within subdirectories; the set of such suffixes
+is extensible globally as described in @racket[get-module-suffixes], and
+@racket[compile-collection-zos] recognizes suffixes from the @racket['libs] group. However,
 any file or directory whose path starts with @racket[skip-path] or an element of @racket[skip-paths] is
 skipped. (``Starts with'' means that the simplified path @racket[_p]'s
 byte-string form after @racket[(simplify-path _p #f)]starts with the
@@ -121,15 +126,16 @@ collection.  The following fields are used:
  @item{@indexed-racket[scribblings] : A list of pairs, each of which
        starts with a path for documentation source. The sources (and
        the files that they require) are compiled in the same way as
-       @filepath{.rkt}, @filepath{.ss}, and @filepath{.scm} files,
+       other module files, unless @racket[skip-docs?] is a true value.}
-       unless the provided @racket[skip-docs?] argument is a true
-       value.}
 
  @item{@indexed-racket[compile-include-files] : A list of filenames (without
        directory paths) to be compiled, in addition to files that
        are compiled based on the file's extension, being in @racket[scribblings],
        or being @racket[require]d by other compiled files.}
 
+ @item{@racket[module-suffixes] and @racket[doc-module-suffixes] ---
+       Used indirectly via @racket[get-module-suffixes].}
+
 ]
 
 @history[#:changed "6.2.900.10" @elem{Added support for @racket[compile-include-files].}]}
@@ -151,6 +157,68 @@ rather than a collection. The @racket[info] function behaves like the
 result of @racket[get-info] to supply @filepath{info.rkt} fields,
 instead of using an @filepath{info.rkt} file (if any) in the directory.}
 
+@; ----------------------------------------------------------------------
+
+@section[#:tag "module-suffix"]{Recognizing Module Suffixes}
+
+@defmodule[compiler/module-suffix]{The
+@racketmodname[compiler/module-suffix] library provides functions for
+recognizing file suffixes that correspond to Racket modules for the
+purposes of compiling files in a directory, running tests for files in
+a directory, and so on. The set of suffixes always includes
+@filepath{.rkt}, @filepath{.ss}, and @filepath{.scm}, but it can be
+extended globally by @filepath{info.rkt} configuration in collections.}
+
+@history[#:added "6.2.900.10"]
+
+@defproc[(get-module-suffixes [#:group group (or/c 'all 'libs 'docs) 'all]
+                              [#:mode mode (or/c 'preferred 'all-available 'no-planet 'no-user) 'preferred]
+                              [#:namespace namespace (or/c #f namespace?) #f])
+         (listof bytes?)]{
+
+Inspects @filepath{info.rkt} files (see @secref["info.rkt"]) of
+installed collections to produce a list of file suffixes that should
+be recognized as Racket modules. Each suffix is reported as a byte
+string that does not include the @litchar{.} that precedes a suffix.
+
+The @racket[mode] and @racket[namespace] arguments are propagated to
+@racket[find-relevant-directories] to determine which collection
+directories might configure the set of suffixes. Consequently, suffix
+registrations are found reliably only if @exec{raco setup} (or package
+installations or updates that trigger @exec{raco setup}) is run.
+
+The @racket[group] argument determines whether the result includes all
+registered suffixes, only those that are registered as general library
+suffixes, or only those that are registered as documentation suffixes.
+The set of general-library suffixes always includes @filepath{.rkt},
+@filepath{.ss}, and @filepath{.scm}. The set of documentation suffixes
+always includes @filepath{.scrbl}.
+
+The following fields in an @filepath{info.rkt} file extend the set of
+suffixes:
+
+@itemize[
+
+ @item{@indexed-racket[module-suffixes] : A list of byte strings that
+       correspond to general-library module suffixes (without the
+       @litchar{.} that must appear before the suffix). Non-lists or
+       non-byte-string elements of the list are ignored.}
+
+ @item{@indexed-racket[doc-module-suffixes] : A list of byte strings
+       as for @racket[module-suffixes], but for documentation
+       modules.}
+
+]}
+
+@defproc[(get-module-suffix-regexp [#:group group (or/c 'all 'libs 'docs) 'all]
+                                   [#:mode mode (or/c 'preferred 'all-available 'no-planet 'no-user) 'preferred]
+                                   [#:namespace namespace (or/c #f namespace?) #f])
+         byte-regexp?]{
+
+Returns a @tech[#:doc reference-doc]{regexp value} that matches paths ending
+with a suffix as reported by @racket[get-module-path-suffixes].}
+
+
 @; ----------------------------------------------------------------------
 
 @section[#:tag "api:loading"]{Loading Compiler Support}

pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -22,6 +22,7 @@
                     setup/unpack
                     setup/link
                     compiler/compiler
+                    compiler/module-suffix
                     launcher/launcher
                     compiler/sig
                     launcher/launcher-sig
@@ -759,6 +760,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by
    file, etc. Supplying a specific list of collections to @exec{raco
    setup} disables this dependency-based deletion of compiled files.}
 
+ @item{@racket[compile-omit-paths], @racket[compile-omit-files], and
+   @racket[compile-include-files] --- Used indirectly via
+   @racket[compile-collection-zos].}
+
+@item{@racket[module-suffixes] and @racket[doc-module-suffixes] ---
+   Used indirectly via @racket[get-module-suffixes].}
+
 ]
 
 @; ------------------------------------------------------------------------

racket/collects/compiler/compiler.rkt

@@ -90,10 +90,11 @@
           (compile-to-zo f zo n prefix verbose? mod?)))))
 
   (define (compile-directory-visitor dir info worker omit-root
-                                     #:verbose [verbose? #t] 
+                                     #:verbose verbose?
-                                     #:skip-path [orig-skip-path #f]
+                                     #:has-module-suffix? has-module-suffix?
-                                     #:skip-paths [orig-skip-paths null]
+                                     #:skip-path orig-skip-path
-                                     #:skip-doc-sources? [skip-docs? #f])
+                                     #:skip-paths orig-skip-paths
+                                     #:skip-doc-sources? skip-docs?)
     (define info* (or info (lambda (key mk-default) (mk-default))))
     (define omit-paths (omitted-paths dir c-get-info/full omit-root))
     (define skip-paths (for/list ([p (in-list (if orig-skip-path
@@ -128,7 +129,7 @@
                                                           (cons -inf.0 "")))))))))])
                     (let* ([sses (append
                                   ;; Find all .rkt/.ss/.scm files:
-                                  (filter extract-base-filename/ss (directory-list))
+                                  (filter has-module-suffix? (directory-list))
                                   ;; Add specified doc sources:
                                   (if skip-docs?
                                       null
@@ -155,8 +156,9 @@
                                                #:skip-doc-sources? skip-docs?)
                     init))))
           init))))
-  (define (compile-directory dir info 
+  (define (compile-directory dir info
-                             #:verbose [verbose? #t] 
+                             #:has-module-suffix? [has-module-suffix? extract-base-filename/ss]
+                             #:verbose [verbose? #t]
                              #:skip-path [orig-skip-path #f]
                              #:skip-paths [orig-skip-paths null]
                              #:skip-doc-sources? [skip-docs? #f]
@@ -166,29 +168,30 @@
     (define (worker prev sses)
       (for-each managed-compile-zo sses))
     (compile-directory-visitor dir info worker omit-root
+                               #:has-module-suffix? has-module-suffix?
                                #:verbose verbose?
                                #:skip-path orig-skip-path
                                #:skip-paths orig-skip-paths
                                #:skip-doc-sources? skip-docs?))
   
-  (define (get-compile-directory-srcs dir info 
+  (define (get-compile-directory-srcs dir info
+                                      #:has-module-suffix? [has-module-suffix? extract-base-filename/ss]
                                       #:verbose [verbose? #t] 
                                       #:skip-path [orig-skip-path #f]
                                       #:skip-paths [orig-skip-paths null]
                                       #:skip-doc-sources? [skip-docs? #f]
-                                      #:managed-compile-zo [managed-compile-zo
-                                                            (make-caching-managed-compile-zo)]
                                       #:omit-root [omit-root dir])
     (compile-directory-visitor dir info append omit-root
+                               #:has-module-suffix? has-module-suffix?
                                #:verbose verbose?
                                #:skip-path orig-skip-path
                                #:skip-paths orig-skip-paths
-                               #:skip-doc-sources? skip-docs?
+                               #:skip-doc-sources? skip-docs?))
-                               #:managed-compile-zo managed-compile-zo))
   
   (define unspec (gensym))
 
-  (define (compile-collection-zos collection 
+  (define (compile-collection-zos collection
+                                  #:has-module-suffix? [has-module-suffix? extract-base-filename/ss]
                                   #:skip-path [skip-path #f]
                                   #:skip-paths [skip-paths null]
                                   #:skip-doc-sources? [skip-docs? #f]
@@ -202,6 +205,7 @@
                        #:omit-root (if (eq? omit-root unspec)
                                        dir
                                        omit-root)
+                       #:has-module-suffix? has-module-suffix?
                        #:verbose #f
                        #:skip-path skip-path
                        #:skip-paths skip-paths

racket/collects/compiler/module-suffix.rkt

@@ -0,0 +1,58 @@
+#lang racket/base
+(require racket/list
+         racket/string
+         setup/getinfo
+         racket/contract/base)
+
+(provide
+ (contract-out
+  [get-module-suffixes (()
+                        (#:mode (or/c 'preferred 'all-available 'no-planet 'no-user)
+                         #:group (or/c 'all 'libs 'docs)
+                         #:namespace (or/c #f namespace?))
+                        . ->* .
+                        (listof bytes?))]
+  [get-module-suffix-regexp (()
+                             (#:mode (or/c 'preferred 'all-available 'no-planet 'no-user)
+                              #:group (or/c 'all 'libs 'docs)
+                              #:namespace (or/c #f namespace?))
+                             . ->* .
+                             byte-regexp?)]))
+
+(define (get-module-suffixes #:mode [key 'preferred]
+                             #:group [group 'all]
+                             #:namespace [namespace #f])
+  (define fields (case group
+                   [(all) '(module-suffixes doc-module-suffixes)]
+                   [(libs) '(module-suffixes)]
+                   [(docs) '(doc-module-suffixes)]))
+  (define dirs (find-relevant-directories fields key))
+  (define rkt-ht (if (memq 'module-suffixes fields)
+                     (hash #"rkt" #t #"ss" #t #"scm" #t)
+                     (hash)))
+  (define init-ht (if (memq 'doc-module-suffixes fields)
+                      (hash-set rkt-ht #"scrbl" #t)
+                      rkt-ht))
+  (define ht
+    (for/fold ([ht init-ht]) ([dir (in-list dirs)])
+      (define info (get-info/full dir #:namespace namespace))
+      (for/fold ([ht init-ht]) ([field (in-list fields)])
+        (define suffixes (info field (lambda () null)))
+        (cond
+         [(list? suffixes)
+          (for/fold ([ht ht]) ([suffix (in-list suffixes)])
+            (cond
+             [(bytes? suffix) (hash-set ht suffix #t)]
+             [else ht]))]))))
+  (sort (hash-keys ht) bytes<?))
+
+(define (get-module-suffix-regexp #:mode [key 'preferred]
+                                  #:group [group 'all]
+                                  #:namespace [namespace #f])
+  (define suffixes
+    (get-module-suffixes #:mode key #:group group #:namespace namespace))
+  (byte-pregexp
+   (bytes-append #"^(.*)\\.(?i:"
+                 (apply bytes-append
+                        (add-between suffixes #"|"))
+                 #")$")))

racket/collects/dynext/file.rkt

@@ -1,4 +1,6 @@
 #lang racket/base
+(require racket/promise
+         compiler/module-suffix)
 
 (provide append-zo-suffix
 	 append-c-suffix
@@ -32,39 +34,62 @@
 (define (extract-suffix appender)
   (subbytes (path->bytes (appender (bytes->path #"x"))) 1))
 
-(define-values (extract-base-filename/ss
+(define (extract-rx pat)
-		extract-base-filename/c
+  (byte-pregexp (bytes-append #"^(.*)\\.(?i:" pat #")$")))
-		extract-base-filename/kp
+
-		extract-base-filename/o
+(define (extract who s program rx kind simple)
-		extract-base-filename/ext)
+  (unless (path-string? s)
-  (let ([mk
+    (raise-argument-error who "path-string?" s))
-	 (lambda (who pat kind simple)
+  (cond
-	   (define (extract-base-filename s [p #f])
+   [(regexp-match rx (if (path? s) s (string->path s)))
-	     (define rx
+    => (lambda (m) (bytes->path (cadr m)))]
-	       (byte-pregexp (bytes-append #"^(.*)\\.(?i:" pat #")$")))
+   [program
-	     (unless (path-string? s)
+    (if simple
-		     (raise-type-error who "path or valid-path string" s))
+        (error program "not a ~a filename (doesn't end with ~a): ~a"
-	     (cond [(regexp-match
+               kind simple s)
-		     rx (path->bytes (if (path? s) s (string->path s))))
+        (path-replace-suffix s #""))]
-		    => (lambda (m) (bytes->path (cadr m)))]
+   [else #f]))
-		   [p (if simple
+
-                          (error p "not a ~a filename (doesn't end with ~a): ~a"
+(define module-suffix-regexp
-                                 kind simple s)
+  (delay (get-module-suffix-regexp #:group 'libs)))
-                          (path-replace-suffix s #""))]
+
-		   [else #f]))
+(define (extract-base-filename/ss s [program #f]
-	   extract-base-filename)])
+                                  #:module-pattern [module-pattern
-    (values
+                                                    (force module-suffix-regexp)])
-     (mk 'extract-base-filename/ss #"rkt|ss|scm" "Racket" #f)
+  (extract 'extract-base-filename/ss
-     (mk 'extract-base-filename/c
+           s program
-	 #"c|cc|cxx|cpp|c[+][+]|m" "C" ".c, .cc, .cxx, .cpp, .c++, or .m")
+           module-pattern
-     (mk 'extract-base-filename/kp #"kp" "constant pool" ".kp")
+           "Racket"
-     (mk 'extract-base-filename/o
+           #f))
-	 (case (system-type)
+
-	   [(unix beos macos macosx) #"o"]
+(define (extract-base-filename/c s [program #f])
-	   [(windows) #"obj"])
+  (extract 'extract-base-filename/c
-	 "compiled object"
+           s program
-	 (extract-suffix append-object-suffix))
+           (extract-rx #"c|cc|cxx|cpp|c[+][+]|m")
-     (mk 'extract-base-filename/ext
+           "C"
-	 (regexp-quote (subbytes (system-type 'so-suffix) 1) #f)
+           ".c, .cc, .cxx, .cpp, .c++, or .m"))
-	 "Racket extension"
+
-	 (extract-suffix append-extension-suffix)))))
+(define (extract-base-filename/kp s [program #f])
+  (extract 'extract-base-filename/kp
+           s
+           program
+           (extract-rx #"kp")
+           "constant pool"
+           ".kp"))
+
+(define (extract-base-filename/o s [program #f])
+  (extract 'extract-base-filename/o
+           s program
+           (case (system-type)
+             [(unix beos macos macosx) #"o"]
+             [(windows) #"obj"])
+           "compiled object"
+           (extract-suffix append-object-suffix)))
+  
+(define (extract-base-filename/ext s [program #f])
+  (extract 'extract-base-filename/ext
+           s
+           program
+           (regexp-quote (subbytes (system-type 'so-suffix) 1) #f)
+           "Racket extension"
+           (extract-suffix append-extension-suffix)))

racket/collects/setup/getinfo.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require racket/match 
-         racket/contract 
+         racket/contract/base 
          planet/cachepath 
          syntax/modread
          "dirs.rkt"

racket/collects/setup/setup-core.rkt

@@ -20,7 +20,7 @@
          compiler/compiler
          (prefix-in compiler:option: compiler/option)
          launcher/launcher
-         dynext/file
+         compiler/module-suffix
 
          "unpack.rkt"
          "getinfo.rkt"
@@ -508,7 +508,7 @@
             (let loop ([l collections-to-compile])
               (append-map (lambda (cc) (cons cc (loop (get-subs cc)))) l))))
 
-  (define (collection-tree-map collections-to-compile)
+  (define (collection-tree-map collections-to-compile has-module-suffix?)
     (define (build-collection-tree cc)
       (define (make-child-cc parent-cc name)
         (collection-cc! (append (cc-collection parent-cc) (list name))
@@ -540,7 +540,7 @@
              (filter-map (lambda (x) (make-child-cc cc x)) dirs)))
       (define srcs
         (append
-         (filter extract-base-filename/ss files)
+         (filter has-module-suffix? files)
          (if make-docs?
            (filter (lambda (p) (not (member p omit)))
                    (map (lambda (s) (if (string? s) (string->path s) s))
@@ -984,7 +984,7 @@
   ;; and it makes a do-nothing setup complete much faster.
   (define caching-managed-compile-zo (make-caching-managed-compile-zo))
 
-  (define (compile-cc cc gcs)
+  (define (compile-cc cc gcs has-module-suffix?)
     (parameterize ([current-namespace (make-base-empty-namespace)])
       (begin-record-error cc "making"
         (setup-printf "making" "~a" (cc-name cc))
@@ -999,6 +999,7 @@
            (define dir  (cc-path cc))
            (define info (cc-info cc))
            (compile-directory-zos dir info
+                                  #:has-module-suffix? has-module-suffix?
                                   #:omit-root (cc-omit-root cc)
                                   #:managed-compile-zo caching-managed-compile-zo
                                   #:skip-path (and (avoid-main-installation) main-collects-dir)
@@ -1025,6 +1026,14 @@
         (case where
           [(beginning) (append same diff)]
           [(end) (append diff same)])))
+    (define has-module-suffix?
+      (let ([rx (get-module-suffix-regexp
+                 #:mode (cond
+                         [(make-user) 'preferred]
+                         [else 'no-user])
+                 #:group 'libs
+                 #:namespace info-ns)])
+        (lambda (p) (regexp-match? rx p))))
     (setup-printf #f "--- compiling collections ---")
     (if ((parallel-workers) . > . 1)
       (begin
@@ -1034,24 +1043,25 @@
             (when (and (cc-main? cc)
                        (member (cc-info-root cc)
                                (current-library-collection-paths)))
-              (compile-cc cc 0))))
+              (compile-cc cc 0 has-module-suffix?))))
         (with-specified-mode
           (lambda ()
             (define cct
               (move-to 'beginning (list #rx"/compiler$" #rx"/raco$" #rx"/racket$" #rx"<pkgs>/images/")
                        (move-to 'end (list #rx"<pkgs>/drracket")
                                 (sort-collections-tree
-                                 (collection-tree-map top-level-plt-collects)))))
+                                 (collection-tree-map top-level-plt-collects
+                                                      has-module-suffix?)))))
             (iterate-cct clean-cc cct)
             (parallel-compile (parallel-workers) setup-fprintf handle-error cct)
             (for/fold ([gcs 0]) ([cc planet-dirs-to-compile])
-              (compile-cc cc gcs)))))
+              (compile-cc cc gcs has-module-suffix?)))))
       (with-specified-mode
         (lambda ()
           (for ([cc ccs-to-compile])
             (clean-cc cc))
           (for/fold ([gcs 0]) ([cc ccs-to-compile])
-            (compile-cc cc gcs))))))
+            (compile-cc cc gcs has-module-suffix?))))))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;               Info-Domain Cache               ;;