add unit-static-init-dependencies
This commit is contained in:
parent
7bfe2eadab
commit
53fb33144e
|
@ -844,3 +844,24 @@ If @racket[sig-identifier] is not bound to a signature, then the
|
|||
@exnraise[exn:fail:syntax]. In that case, the given
|
||||
@racket[err-syntax] argument is used as the source of the error, where
|
||||
@racket[sig-identifier] is used as the detail source location.}
|
||||
|
||||
|
||||
@defproc[(unit-static-init-dependencies [unit-identifier identifier?]
|
||||
[err-syntax syntax?])
|
||||
(list/c (cons/c (or/c symbol? #f)
|
||||
identifier?))]{
|
||||
|
||||
If @racket[unit-identifier] is bound to static unit information via
|
||||
@racket[define-unit] (or other such forms), the result is a list of
|
||||
pairs. Each pair combines a tag (or @racket[#f] for no tag) and a
|
||||
signature name, indicating an initialization dependency of the unit on
|
||||
the specified import (i.e., the same tag and signature are included in
|
||||
the first result from @racket[unit-static-signatures]).
|
||||
|
||||
If @racket[unit-identifier] is not bound to static unit information,
|
||||
then the @exnraise[exn:fail:syntax]. In that case, the given
|
||||
@racket[err-syntax] argument is used as the source of the error, where
|
||||
@racket[unit-identifier] is used as the detail source location.
|
||||
|
||||
@history[#:added "6.1.1.8"]}
|
||||
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
#lang racket/load
|
||||
|
||||
(require (for-syntax mzlib/unit-exptime))
|
||||
(require (for-syntax racket/unit-exptime))
|
||||
(require "test-harness.rkt"
|
||||
mzlib/unit)
|
||||
racket/unit)
|
||||
|
||||
(define-signature one^ (one-a one-b))
|
||||
(define-signature two^ (two-a
|
||||
|
@ -14,11 +14,13 @@
|
|||
(define-unit one@
|
||||
(import one^ three^)
|
||||
(export two^)
|
||||
(init-depend one^)
|
||||
(define two-a 10))
|
||||
|
||||
(define-unit two@
|
||||
(import (tag Four four^))
|
||||
(export (tag One one^))
|
||||
(init-depend (tag Four four^))
|
||||
(define one-a 10)
|
||||
(define one-b 20))
|
||||
|
||||
|
@ -34,6 +36,11 @@
|
|||
(signature-members #'id stx)])
|
||||
#`(k (#,super #,vars #,def-vars #,def-macs)))]))
|
||||
|
||||
(define-syntax (unit-dep-info stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id k) (let ([deps (unit-static-init-dependencies #'id stx)])
|
||||
#`(k #,deps))]))
|
||||
|
||||
(test '(#f (one-a one-b) () ()) (sig-info one^ quote))
|
||||
(test '(#f (two-a) (two-v1 two-v2) (m)) (sig-info two^ quote))
|
||||
(test '(#f () () ()) (sig-info three^ quote))
|
||||
|
@ -42,4 +49,7 @@
|
|||
(test '(((#f . one^) (#f . three^)) ((#f . two^))) (unit-info one@ quote))
|
||||
(test '(((Four . four^)) ((One . one^))) (unit-info two@ quote))
|
||||
|
||||
(test '((#f . one^)) (unit-dep-info one@ quote))
|
||||
(test '((Four . four^)) (unit-dep-info two@ quote))
|
||||
|
||||
(displayln "tests passed")
|
||||
|
|
|
@ -4,6 +4,7 @@
|
|||
"private/unit-compiletime.rkt")
|
||||
|
||||
(provide unit-static-signatures
|
||||
unit-static-init-dependencies
|
||||
signature-members)
|
||||
|
||||
(define (unit-static-signatures name err-stx)
|
||||
|
@ -12,6 +13,11 @@
|
|||
(values (apply list (unit-info-import-sig-ids ui))
|
||||
(apply list (unit-info-export-sig-ids ui))))))
|
||||
|
||||
(define (unit-static-init-dependencies name err-stx)
|
||||
(parameterize ((error-syntax err-stx))
|
||||
(let ((ui (lookup-def-unit name)))
|
||||
(unit-info-deps ui))))
|
||||
|
||||
(define (signature-members name err-stx)
|
||||
(parameterize ((error-syntax err-stx))
|
||||
(let ([s (lookup-signature name)])
|
||||
|
|
|
@ -1816,7 +1816,7 @@
|
|||
(make-unit-info (quote-syntax u)
|
||||
(list (cons 'itag (quote-syntax isig)) ...)
|
||||
(list (cons 'etag (quote-syntax esig)) ...)
|
||||
(list (cons 'deptag (quote-syntax deptag)) ...)
|
||||
(list (cons 'deptag (quote-syntax depsig)) ...)
|
||||
(quote-syntax name)
|
||||
contracted?)))))))))
|
||||
((_)
|
||||
|
|
Loading…
Reference in New Issue
Block a user