diff --git a/pkgs/racket-doc/scribblings/reference/units.scrbl b/pkgs/racket-doc/scribblings/reference/units.scrbl index 65ffdfcfb5..8a55ce1b9e 100644 --- a/pkgs/racket-doc/scribblings/reference/units.scrbl +++ b/pkgs/racket-doc/scribblings/reference/units.scrbl @@ -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) diff --git a/pkgs/racket-test/tests/units/test-deps.rkt b/pkgs/racket-test/tests/units/test-deps.rkt new file mode 100644 index 0000000000..1c6b91bd06 --- /dev/null +++ b/pkgs/racket-test/tests/units/test-deps.rkt @@ -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))) diff --git a/pkgs/racket-test/tests/units/test-unit.rkt b/pkgs/racket-test/tests/units/test-unit.rkt index 31b7b88f39..c2a921c39b 100644 --- a/pkgs/racket-test/tests/units/test-unit.rkt +++ b/pkgs/racket-test/tests/units/test-unit.rkt @@ -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) diff --git a/racket/collects/racket/unit.rkt b/racket/collects/racket/unit.rkt index 6583800925..01564cb593 100644 --- a/racket/collects/racket/unit.rkt +++ b/racket/collects/racket/unit.rkt @@ -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 ...))))))