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`.

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)

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

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)

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  -> 
+;; build-compound-unit : syntax-object [static-dep-info] -> 
-;;                      (values syntax-object (listof identifier) (listof identifier))
+;;                      (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
+;; The three additional values are the identifiers of the compound-unit's import and export
-;; signatures
+;; signatures plus identifiers for initialization dependencies
-(define-for-syntax (build-compound-unit stx)
+(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 ...))))))