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:
Matthew Flatt 2015-02-06 08:54:35 +01:00
parent 53fb33144e
commit be8f70fffb
4 changed files with 123 additions and 13 deletions

View File

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

View 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)))

View File

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

View File

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