suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2015-08-22 09:25:31 -06:00
parent f63220682b
commit a135c78baf
8 changed files with 243 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-doc/dynext/dynext.scrbl
View File

@ -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.}

78
pkgs/racket-doc/scribblings/raco/api.scrbl
View File

@ -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,
unless the provided @racket[skip-docs?] argument is a true
value.}
other module files, unless @racket[skip-docs?] 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}

8
pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -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].}
]
@; ------------------------------------------------------------------------

30
racket/collects/compiler/compiler.rkt
View File

@ -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]
#:skip-path [orig-skip-path #f]
#:skip-paths [orig-skip-paths null]
#:skip-doc-sources? [skip-docs? #f])
#:verbose verbose?
#:has-module-suffix? has-module-suffix?
#:skip-path orig-skip-path
#: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
#:verbose [verbose? #t]
(define (compile-directory 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]
@ -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?
#:managed-compile-zo managed-compile-zo))
#:skip-doc-sources? skip-docs?))
(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

58
racket/collects/compiler/module-suffix.rkt Normal file
View File

@ -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 #"|"))
#")$")))

97
racket/collects/dynext/file.rkt
View File

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

2
racket/collects/setup/getinfo.rkt
View File

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

26
racket/collects/setup/setup-core.rkt
View File

@ -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 ;;