cbcad0528c
define-unit with the application of a unit contract. So you can think of it as a define/contract for units that keeps the static info needed for link inference. svn: r13584
69 lines
2.3 KiB
Scheme
69 lines
2.3 KiB
Scheme
#lang scheme/base
|
|
|
|
(require stxclass
|
|
"unit-compiletime.ss"
|
|
(for-template "unit-keywords.ss"))
|
|
|
|
(provide import-clause/contract export-clause/contract dep-clause
|
|
import-clause/c export-clause/c)
|
|
|
|
(define-syntax-class sig-id
|
|
#:attributes ()
|
|
(pattern x
|
|
#:declare x (static-of 'signature
|
|
(λ (x)
|
|
(signature? (set!-trans-extract x))))))
|
|
|
|
(define-syntax-class sig-spec #:literals (prefix rename only except)
|
|
#:attributes ((name 0))
|
|
#:transparent
|
|
(pattern name:sig-id)
|
|
(pattern (prefix i:identifier s:sig-spec)
|
|
#:with name #'s.name)
|
|
(pattern (rename s:sig-spec [int:identifier ext:identifier] ...)
|
|
#:with name #'s.name)
|
|
(pattern (only s:sig-spec i:identifier ...)
|
|
#:with name #'s.name)
|
|
(pattern (except s:sig-spec i:identifier ...)
|
|
#:with name #'s.name))
|
|
|
|
(define-syntax-class tagged-sig-spec #:literals (tag)
|
|
#:transparent
|
|
(pattern s:sig-spec
|
|
#:with i #f)
|
|
(pattern (tag i:identifier s:sig-spec)))
|
|
|
|
(define-syntax-class tagged-sig-id #:literals (tag)
|
|
#:attributes ()
|
|
#:transparent
|
|
(pattern s:sig-id)
|
|
(pattern (tag i:identifier s:sig-id)))
|
|
|
|
(define-syntax-class unit/c-clause
|
|
#:transparent
|
|
(pattern (s:tagged-sig-id [x:identifier c:expr] ...))
|
|
(pattern s:tagged-sig-id ;; allow a non-wrapped sig, which is the same as (sig)
|
|
#:with (x ...) null
|
|
#:with (c ...) null))
|
|
(define-syntax-class import-clause/c #:literals (import)
|
|
#:transparent
|
|
(pattern (import i:unit/c-clause ...)))
|
|
(define-syntax-class export-clause/c #:literals (export)
|
|
#:transparent
|
|
(pattern (export e:unit/c-clause ...)))
|
|
|
|
(define-syntax-class unit/contract-clause
|
|
#:transparent
|
|
(pattern (s:tagged-sig-spec [x:identifier c:expr] ...))
|
|
(pattern s:tagged-sig-spec ;; allow a non-wrapped sig, which is the same as (sig)
|
|
#:with (x ...) null
|
|
#:with (c ...) null))
|
|
(define-syntax-class import-clause/contract #:literals (import)
|
|
#:transparent
|
|
(pattern (import i:unit/contract-clause ...)))
|
|
(define-syntax-class export-clause/contract #:literals (export)
|
|
#:transparent
|
|
(pattern (export e:unit/contract-clause ...)))
|
|
(define-syntax-class dep-clause #:literals (init-depend)
|
|
#:transparent
|
|
(pattern (init-depend s:tagged-sig-id ...))) |