add unit-static-init-dependencies

This commit is contained in:
Matthew Flatt 2015-02-06 06:58:38 +01:00
parent 7bfe2eadab
commit 53fb33144e
4 changed files with 40 additions and 3 deletions

View File

@ -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"]}

View File

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

View File

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

View File

@ -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?)))))))))
((_)