racket/unit: static checking of initialization dependencies
When using `compound-unit/infer` and similar, check the `link` clause against each unit's static information for initialization dependencies. Also, propagate dependency information in `define-compount-unit`.
This commit is contained in:
parent
53fb33144e
commit
be8f70fffb
|
@ -458,6 +458,11 @@ specific bindings for some of a unit's imports. The long form need not
|
|||
name all of a unit's exports or supply all of a unit's imports if the
|
||||
remaining parts can be inferred.
|
||||
|
||||
When a unit declares initialization dependencies,
|
||||
@racket[compound-unit/infer] checks that the @racket[link] declaration
|
||||
is consistent with those dependencies, and it reports a syntax error if
|
||||
not.
|
||||
|
||||
Like @racket[compound-unit], the @racket[compound-unit/infer] form
|
||||
produces a (compound) unit without statically binding information
|
||||
about the result unit's imports and exports. That is,
|
||||
|
@ -465,7 +470,12 @@ about the result unit's imports and exports. That is,
|
|||
not generate it. Two additional forms,
|
||||
@racket[define-compound-unit] and
|
||||
@racket[define-compound-unit/infer], generate static information
|
||||
(where the former does not consume static information).}
|
||||
(where the former does not consume static information).
|
||||
|
||||
@history[#:changed "6.1.1.8" @elem{Added static checking of the @racket[link]
|
||||
clause with respect to declared
|
||||
initialization dependencies.}]}
|
||||
|
||||
|
||||
@defform[
|
||||
#:literals (import export link)
|
||||
|
@ -476,7 +486,9 @@ not generate it. Two additional forms,
|
|||
]{
|
||||
|
||||
Like @racket[compound-unit], but binds static information about the
|
||||
compound unit like @racket[define-unit].}
|
||||
compound unit like @racket[define-unit], including the propagation of
|
||||
initialization-dependency information (on remaining inports) from the
|
||||
linked units.}
|
||||
|
||||
|
||||
@defform[
|
||||
|
@ -488,7 +500,7 @@ compound unit like @racket[define-unit].}
|
|||
]{
|
||||
|
||||
Like @racket[compound-unit/infer], but binds static information about
|
||||
the compound unit like @racket[define-unit].}
|
||||
the compound unit like @racket[define-compound-unit].}
|
||||
|
||||
@defform[
|
||||
#:literals (import export)
|
||||
|
|
57
pkgs/racket-test/tests/units/test-deps.rkt
Normal file
57
pkgs/racket-test/tests/units/test-deps.rkt
Normal file
|
@ -0,0 +1,57 @@
|
|||
#lang racket/load
|
||||
|
||||
(define-signature a^ ())
|
||||
|
||||
(define-unit a
|
||||
(import)
|
||||
(export a^))
|
||||
|
||||
(define-unit u
|
||||
(import a^)
|
||||
(export)
|
||||
(init-depend a^))
|
||||
|
||||
(define later-init-exn?
|
||||
(lambda (x)
|
||||
(and (exn? x)
|
||||
(regexp-match? #rx"depends on initialization of later unit"
|
||||
(exn-message x)))))
|
||||
|
||||
|
||||
(with-handlers ([later-init-exn? void])
|
||||
(eval '(define-compound-unit/infer x
|
||||
(import)
|
||||
(export)
|
||||
(link
|
||||
(() u A)
|
||||
(([A : a^]) a)))))
|
||||
|
||||
(define-compound-unit/infer x
|
||||
(import)
|
||||
(export)
|
||||
(link
|
||||
(([A : a^]) a)
|
||||
(() u A)))
|
||||
|
||||
|
||||
|
||||
(define-compound-unit/infer uc
|
||||
(import a^)
|
||||
(export)
|
||||
(link
|
||||
(() u)))
|
||||
|
||||
(with-handlers ([later-init-exn? void])
|
||||
(eval '(define-compound-unit/infer xc
|
||||
(import)
|
||||
(export)
|
||||
(link
|
||||
(() uc A)
|
||||
(([A : a^]) a)))))
|
||||
|
||||
(define-compound-unit/infer xc
|
||||
(import)
|
||||
(export)
|
||||
(link
|
||||
(([A : a^]) a)
|
||||
(() uc A)))
|
|
@ -1410,7 +1410,7 @@
|
|||
(export s^)
|
||||
(define a 2))
|
||||
(define-values/invoke-unit/infer (export) (link v@ u@))
|
||||
(test-runtime-error exn? "define-values/invoke-unit/infer: init-depend broken"
|
||||
(test-syntax-error "define-values/invoke-unit/infer: init-depend broken"
|
||||
(define-values/invoke-unit/infer (export) (link u@ v@))))
|
||||
|
||||
(define-unit u (import x-sig) (export) x)
|
||||
|
|
|
@ -1369,13 +1369,13 @@
|
|||
(let-values (((u x y z) (build-unit/new-import-export (check-unit-syntax #'x))))
|
||||
u)))))
|
||||
|
||||
;; build-compound-unit : syntax-object ->
|
||||
;; (values syntax-object (listof identifier) (listof identifier))
|
||||
;; build-compound-unit : syntax-object [static-dep-info] ->
|
||||
;; (values syntax-object (listof identifier) (listof identifier) (listof identifier))
|
||||
;; constructs the code for a compound-unit expression. stx match the return of
|
||||
;; check-compound-syntax
|
||||
;; The two additional values are the identifiers of the compound-unit's import and export
|
||||
;; signatures
|
||||
(define-for-syntax (build-compound-unit stx)
|
||||
;; The three additional values are the identifiers of the compound-unit's import and export
|
||||
;; signatures plus identifiers for initialization dependencies
|
||||
(define-for-syntax (build-compound-unit stx [static-dep-info null])
|
||||
(define-struct lnkid-record (access-code names ctime-ids rtime-ids source-idx sigid siginfo))
|
||||
(define (lnkid-rec->keys t rec)
|
||||
(map (lambda (rid) (build-key t rid))
|
||||
|
@ -1634,7 +1634,7 @@
|
|||
(unit-export ((export-key ...) export-code) ...)))))))
|
||||
(map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))
|
||||
(map syntax-e (syntax->list #'((export-tag . export-sigid) ...)))
|
||||
'()))))))
|
||||
static-dep-info))))))
|
||||
(((i ...) (e ...) (l ...))
|
||||
(for-each check-link-line-syntax (syntax->list #'(l ...))))))
|
||||
|
||||
|
@ -1803,7 +1803,7 @@
|
|||
(begin
|
||||
(check-id #'name)
|
||||
(let-values (((exp i e d) (parameterize ([error-syntax (syntax-property (error-syntax) 'inferred-name (syntax-e #'name))])
|
||||
(build #'rest ))))
|
||||
(build #'rest))))
|
||||
(with-syntax ((((itag . isig) ...) i)
|
||||
(((etag . esig) ...) e)
|
||||
(((deptag . depsig) ...) d)
|
||||
|
@ -1823,7 +1823,7 @@
|
|||
(raise-stx-err err-msg)))))
|
||||
|
||||
;; build-define-unit : syntax-object
|
||||
;; (syntax-object -> (values syntax-object (listof identifier) (listof identifier))
|
||||
;; (syntax-object -> (values syntax-object (listof identifier) (listof identifier) (listof identifier))
|
||||
;; string ->
|
||||
;; syntax-object
|
||||
(define-for-syntax build-define-unit (build-define-unit-helper #f))
|
||||
|
@ -2122,6 +2122,46 @@
|
|||
(unprocess-tagged-id
|
||||
(cons (car tid) lnkid))]))]))
|
||||
(syntax->list #'(export ...)))])
|
||||
|
||||
(define init-deps
|
||||
(for/fold ([init-deps '()]) ([u (in-list units)]
|
||||
[sub-in (in-list sub-ins)]
|
||||
[u-pos (in-naturals)])
|
||||
(for/fold ([init-deps init-deps]) ([dep (in-list (unit-info-deps u))])
|
||||
;; Find the link for this dependency:
|
||||
(define lr
|
||||
(for/or ([lr (in-list sub-in)])
|
||||
(and (eq? (link-record-tag lr)
|
||||
(car dep))
|
||||
(free-identifier=? (link-record-sigid lr)
|
||||
(cdr dep))
|
||||
lr)))
|
||||
;; If `lr` refers to an import, then propoagate the dependency.
|
||||
;; If it refers to a linked unit, make sure that unit is earlier.
|
||||
(cond
|
||||
[(for/or ([import-sig (in-list import-sigs)])
|
||||
(and (free-identifier=? (link-record-linkid import-sig)
|
||||
(link-record-linkid lr))
|
||||
import-sig))
|
||||
;; imported
|
||||
=> (lambda (import-sig)
|
||||
(cons (cons (link-record-tag import-sig)
|
||||
(link-record-sigid import-sig))
|
||||
init-deps))]
|
||||
[(for/or ([sub-out (in-list sub-outs)]
|
||||
[i-pos (in-naturals)])
|
||||
(for/or ([olr (in-list sub-out)])
|
||||
(and (free-identifier=? (link-record-linkid olr)
|
||||
(link-record-linkid lr))
|
||||
i-pos)))
|
||||
=> (lambda (i-pos)
|
||||
(unless (i-pos . < . u-pos)
|
||||
(raise-stx-err "unit depends on initialization of later unit"
|
||||
(link-record-linkid lr)))
|
||||
init-deps)]
|
||||
[else
|
||||
(error "internal error: cannot find link source for init-dependency check")]))))
|
||||
|
||||
(with-syntax (((import ...)
|
||||
(map unprocess-link-record-bind import-sigs))
|
||||
(((out ...) ...)
|
||||
|
@ -2140,7 +2180,8 @@
|
|||
units (syntax->list #'(u ...)))))
|
||||
(build-compound-unit #`((import ...)
|
||||
#,exports
|
||||
(((out ...) unit-id in ...) ...)))))))
|
||||
(((out ...) unit-id in ...) ...))
|
||||
init-deps)))))
|
||||
(((i ...) (e ...) (l ...))
|
||||
(for-each check-link-line-syntax (syntax->list #'(l ...))))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user