add support for indirect CM dependencies; use in lazy-require
If module M in package P imports module N from package Q, and if N has a `lazy-require` for a module in R that is triggered during the compilation of M, then P doesn't really depend on R; P depends on Q, and Q depends on R, and P shoudn't necessarily know anything about Q. At the same time, a change to the file in R means that M must be recompiled. So, continue to track the compilation dependency, but mark it as "indirect" so that the package-dependency checker can ignore the dependency.
This commit is contained in:
parent
fe9a04d1db
commit
95e85ec5bd
|
@ -550,25 +550,36 @@ field is a @racket[compile-event] as document in
|
||||||
|
|
||||||
@defmodule[compiler/cm-accomplice]
|
@defmodule[compiler/cm-accomplice]
|
||||||
|
|
||||||
@defproc[(register-external-file [file (and path? complete-path?)]) void?]{
|
@defproc[(register-external-file [file (and path? complete-path?)]
|
||||||
|
[#:indirect? indirect? any/c #f])
|
||||||
|
void?]{
|
||||||
|
|
||||||
Logs a message (see @racket[log-message]) at level @racket['info] to
|
Logs a message (see @racket[log-message]) at level @racket['info] to a
|
||||||
a logger named @racket['cm-accomplice]. The
|
logger named @racket['cm-accomplice]. The message data is a
|
||||||
message data is a @racketidfont{file-dependency} prefab structure type
|
@racketidfont{file-dependency} prefab structure type with two fields;
|
||||||
with two fields; the first field's value is @racket[file] and the second
|
the first field's value is @racket[file] and the second field's value
|
||||||
field's value is @racket[#f] (to indicate a non-module dependency).
|
is @racket[#f] (to indicate a non-module dependency). If the
|
||||||
|
@racket[indirect?] argument is true, the data is more specifically an
|
||||||
|
instance of a @racketidfont{file-dependency/indirect} prefab structure
|
||||||
|
type that is a subtype of @racketidfont{file-dependency} with no new
|
||||||
|
fields.
|
||||||
|
|
||||||
A compilation manager implemented by @racketmodname[compiler/cm] looks
|
A compilation manager implemented by @racketmodname[compiler/cm] looks
|
||||||
for such messages to register an external dependency. The compilation
|
for such messages to register an external dependency. In response, the
|
||||||
manager records (in a @filepath{.dep} file) the path as contributing
|
compilation manager records (in a @filepath{.dep} file) the path as
|
||||||
to the implementation of the module currently being
|
contributing to the implementation of the module currently being
|
||||||
compiled. Afterward, if the registered file is modified, the
|
compiled. Afterward, if the registered file is modified, the
|
||||||
compilation manager will know to recompile the module.
|
compilation manager will know to recompile the module. An ``indirect''
|
||||||
|
dependency has no effect on recompilation, but it can signal to other
|
||||||
|
tools, such as a package-dependency checker, that the dependency is
|
||||||
|
indirect (and should not imply a direct package dependency).
|
||||||
|
|
||||||
The @racket[include] macro, for example, calls this procedure with the
|
The @racket[include] macro, for example, calls this procedure with the
|
||||||
path of an included file as it expands an @racket[include] form.}
|
path of an included file as it expands an @racket[include] form.}
|
||||||
|
|
||||||
@defproc[(register-external-module [file (and path? complete-path?)]) void?]{
|
@defproc[(register-external-module [file (and path? complete-path?)]
|
||||||
|
[#:indirect? indirect? any/c #f])
|
||||||
|
void?]{
|
||||||
|
|
||||||
Like @racket[register-external-file], but logs a message with a
|
Like @racket[register-external-file], but logs a message with a
|
||||||
@racketidfont{file-dependency} prefab structure type whose second
|
@racketidfont{file-dependency} prefab structure type whose second
|
||||||
|
|
|
@ -3005,10 +3005,10 @@ submodule). Introduced submodules have the names
|
||||||
@racket[lazy-require-]@racket[_n]@racketidfont{-}@racket[_m], where
|
@racket[lazy-require-]@racket[_n]@racketidfont{-}@racket[_m], where
|
||||||
@racket[_n] is a phase-level number and @racket[_m] is a number.
|
@racket[_n] is a phase-level number and @racket[_m] is a number.
|
||||||
|
|
||||||
When the use of a lazily-required function triggers module loading,
|
When the use of a lazily-required function triggers module loading, it
|
||||||
@racket[register-external-module] declares a potential compilation
|
also triggers a use of @racket[register-external-module] to declare an
|
||||||
dependency (in case the function is used in the process of compiling a
|
indirect compilation dependency (in case the function is used in the
|
||||||
module).
|
process of compiling a module).
|
||||||
|
|
||||||
@examples[#:eval lazy-require-eval
|
@examples[#:eval lazy-require-eval
|
||||||
(lazy-require
|
(lazy-require
|
||||||
|
|
|
@ -3,16 +3,18 @@
|
||||||
(provide register-external-file
|
(provide register-external-file
|
||||||
register-external-module)
|
register-external-module)
|
||||||
|
|
||||||
(define (register-external-file f)
|
(define (register-external-file f #:indirect? [indirect? #f])
|
||||||
(register-external 'register-external-file f #f))
|
(register-external 'register-external-file f #f indirect?))
|
||||||
(define (register-external-module f)
|
(define (register-external-module f #:indirect? [indirect? #f])
|
||||||
(register-external 'register-external-module f #t))
|
(register-external 'register-external-module f #t indirect?))
|
||||||
|
|
||||||
(define (register-external who f module?)
|
(define (register-external who f module? indirect?)
|
||||||
(unless (and (path? f) (complete-path? f))
|
(unless (and (path? f) (complete-path? f))
|
||||||
(raise-type-error who "complete path" f))
|
(raise-type-error who "complete path" f))
|
||||||
(log-message (current-logger)
|
(log-message (current-logger)
|
||||||
'info
|
'info
|
||||||
'cm-accomplice
|
'cm-accomplice
|
||||||
(format "file dependency: ~s" f)
|
(format "file dependency: ~s" f)
|
||||||
`#s(file-dependency ,f ,module?)))
|
(if indirect?
|
||||||
|
`#s((file-dependency/indirect file-dependency 2) ,f ,module?)
|
||||||
|
`#s(file-dependency ,f ,module?))))
|
||||||
|
|
|
@ -231,9 +231,13 @@
|
||||||
(define (get-dep-sha1s deps up-to-date collection-cache read-src-syntax mode roots must-exist? seen)
|
(define (get-dep-sha1s deps up-to-date collection-cache read-src-syntax mode roots must-exist? seen)
|
||||||
(let ([l (for/fold ([l null]) ([dep (in-list deps)])
|
(let ([l (for/fold ([l null]) ([dep (in-list deps)])
|
||||||
(and l
|
(and l
|
||||||
|
;; (cons 'indirect dep) => indirect dependency (for pkg-dep checking)
|
||||||
;; (cons 'ext rel-path) => a non-module file, check source
|
;; (cons 'ext rel-path) => a non-module file, check source
|
||||||
;; rel-path => a module file name, check cache
|
;; rel-path => a module file name, check cache
|
||||||
(let* ([ext? (and (pair? dep) (eq? 'ext (car dep)))]
|
(let* ([dep (if (and (pair? dep) (eq? 'indirect (car dep)))
|
||||||
|
(cdr dep)
|
||||||
|
dep)]
|
||||||
|
[ext? (and (pair? dep) (eq? 'ext (car dep)))]
|
||||||
[p (collects-relative*->path (if ext? (cdr dep) dep) collection-cache)])
|
[p (collects-relative*->path (if ext? (cdr dep) dep) collection-cache)])
|
||||||
(cond
|
(cond
|
||||||
[ext? (let ([v (get-source-sha1 p)])
|
[ext? (let ([v (get-source-sha1 p)])
|
||||||
|
@ -273,12 +277,19 @@
|
||||||
external-module-deps ; can create cycles if misused!
|
external-module-deps ; can create cycles if misused!
|
||||||
reader-deps))]
|
reader-deps))]
|
||||||
[external-deps (remove-duplicates external-deps)])
|
[external-deps (remove-duplicates external-deps)])
|
||||||
|
(define (path*->collects-relative/maybe-indirect dep)
|
||||||
|
(if (and (pair? dep) (eq? 'indirect (car dep)))
|
||||||
|
(cons 'indirect (path*->collects-relative (cdr dep)))
|
||||||
|
(path*->collects-relative dep)))
|
||||||
(with-compile-output dep-path
|
(with-compile-output dep-path
|
||||||
(lambda (op tmp-path)
|
(lambda (op tmp-path)
|
||||||
(let ([deps (append
|
(let ([deps (append
|
||||||
(map path*->collects-relative deps)
|
(map path*->collects-relative/maybe-indirect deps)
|
||||||
(map (lambda (x)
|
(map (lambda (x)
|
||||||
(cons 'ext (path*->collects-relative x)))
|
(define d (path*->collects-relative/maybe-indirect x))
|
||||||
|
(if (and (pair? d) (eq? 'indirect d))
|
||||||
|
(cons 'indirect (cons 'ext (cdr d)))
|
||||||
|
(cons 'ext d)))
|
||||||
external-deps))])
|
external-deps))])
|
||||||
(write (list* (version)
|
(write (list* (version)
|
||||||
(cons (or src-sha1 (get-source-sha1 path))
|
(cons (or src-sha1 (get-source-sha1 path))
|
||||||
|
@ -311,6 +322,7 @@
|
||||||
(define-struct ext-reader-guard (proc top)
|
(define-struct ext-reader-guard (proc top)
|
||||||
#:property prop:procedure (struct-field-index proc))
|
#:property prop:procedure (struct-field-index proc))
|
||||||
(define-struct file-dependency (path module?) #:prefab)
|
(define-struct file-dependency (path module?) #:prefab)
|
||||||
|
(define-struct (file-dependency/indirect file-dependency) () #:prefab)
|
||||||
|
|
||||||
(define (compile-zo* mode roots path src-sha1 read-src-syntax zo-name up-to-date collection-cache)
|
(define (compile-zo* mode roots path src-sha1 read-src-syntax zo-name up-to-date collection-cache)
|
||||||
;; The `path' argument has been converted to .rkt or .ss form,
|
;; The `path' argument has been converted to .rkt or .ss form,
|
||||||
|
@ -322,10 +334,14 @@
|
||||||
(define reader-deps null)
|
(define reader-deps null)
|
||||||
(define deps-sema (make-semaphore 1))
|
(define deps-sema (make-semaphore 1))
|
||||||
(define done-key (gensym))
|
(define done-key (gensym))
|
||||||
(define (external-dep! p module?)
|
(define (external-dep! p module? indirect?)
|
||||||
|
(define bstr (path->bytes p))
|
||||||
|
(define dep (if indirect?
|
||||||
|
(cons 'indirect bstr)
|
||||||
|
bstr))
|
||||||
(if module?
|
(if module?
|
||||||
(set! external-module-deps (cons (path->bytes p) external-module-deps))
|
(set! external-module-deps (cons dep external-module-deps))
|
||||||
(set! external-deps (cons (path->bytes p) external-deps))))
|
(set! external-deps (cons dep external-deps))))
|
||||||
(define (reader-dep! p)
|
(define (reader-dep! p)
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
deps-sema
|
deps-sema
|
||||||
|
@ -386,7 +402,8 @@
|
||||||
(file-dependency? (vector-ref l 2))
|
(file-dependency? (vector-ref l 2))
|
||||||
(path? (file-dependency-path (vector-ref l 2))))
|
(path? (file-dependency-path (vector-ref l 2))))
|
||||||
(external-dep! (file-dependency-path (vector-ref l 2))
|
(external-dep! (file-dependency-path (vector-ref l 2))
|
||||||
(file-dependency-module? (vector-ref l 2))))
|
(file-dependency-module? (vector-ref l 2))
|
||||||
|
(file-dependency/indirect? (vector-ref l 2))))
|
||||||
(loop))))
|
(loop))))
|
||||||
|
|
||||||
;; Write the code and dependencies:
|
;; Write the code and dependencies:
|
||||||
|
@ -627,9 +644,13 @@
|
||||||
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
||||||
(maybe-compile-zo sha1-only? deps mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
(maybe-compile-zo sha1-only? deps mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
||||||
[(ormap
|
[(ormap
|
||||||
(lambda (p)
|
(lambda (raw-p)
|
||||||
|
;; (cons 'indirect dep) => indirect dependency (for pkg-dep checking)
|
||||||
;; (cons 'ext rel-path) => a non-module file (check date)
|
;; (cons 'ext rel-path) => a non-module file (check date)
|
||||||
;; rel-path => a module file name (check transitive dates)
|
;; rel-path => a module file name (check transitive dates)
|
||||||
|
(define p (if (and (pair? raw-p) (eq? 'indirect (car raw-p)))
|
||||||
|
(cdr raw-p)
|
||||||
|
raw-p))
|
||||||
(define ext? (and (pair? p) (eq? 'ext (car p))))
|
(define ext? (and (pair? p) (eq? 'ext (car p))))
|
||||||
(define d (collects-relative*->path (if ext? (cdr p) p) collection-cache))
|
(define d (collects-relative*->path (if ext? (cdr p) p) collection-cache))
|
||||||
(define t
|
(define t
|
||||||
|
|
|
@ -110,4 +110,4 @@
|
||||||
modpath
|
modpath
|
||||||
(variable-reference->resolved-module-path vr))))])
|
(variable-reference->resolved-module-path vr))))])
|
||||||
(when (path? path)
|
(when (path? path)
|
||||||
(register-external-module path))))
|
(register-external-module path #:indirect? #t))))
|
||||||
|
|
|
@ -489,6 +489,7 @@
|
||||||
;; Treat everything in ".dep" as 'build mode...
|
;; Treat everything in ".dep" as 'build mode...
|
||||||
(define deps (cddr (call-with-input-file* (build-path dir f) read)))
|
(define deps (cddr (call-with-input-file* (build-path dir f) read)))
|
||||||
(for ([dep (in-list deps)])
|
(for ([dep (in-list deps)])
|
||||||
|
;; Note: indirect dependencies (which start with 'indirect) are ignored
|
||||||
(when (and (pair? dep)
|
(when (and (pair? dep)
|
||||||
(eq? 'collects (car dep)))
|
(eq? 'collects (car dep)))
|
||||||
(define path-strs (map bytes->string/utf-8 (cdr dep)))
|
(define path-strs (map bytes->string/utf-8 (cdr dep)))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user