original commit: abd01d08f78e53f9e6e1aca0bdc85fed3fe42574
This commit is contained in:
Matthew Flatt 2001-09-14 00:41:36 +00:00
parent 773527cc8e
commit 731053cd5f
2 changed files with 24 additions and 17 deletions

View File

@ -398,13 +398,13 @@
(caar renames)]
[else (loop (cdr renames))]))))
(define (make-struct-stx-decls sig prefix src-stx check?)
(define (make-struct-stx-decls sig prefix init-prefix? src-stx check?)
;; If check? is #f, generates a syntax definition for <name>%# for
;; each <name> struct form in `sig'. Used for imports.
;; If check? is #t, generates an empty syntax "definition" that has
;; the side-effect of checking <name>%# against its expected shape.
;; CURRENTLY, check? is always #f.
(let ([signame (and (or prefix (not check?))
(let ([signame (and init-prefix?
(signature-name sig))])
(append
(apply
@ -416,6 +416,7 @@
(or prefix "")
signame)
prefix)
#t
src-stx
check?))
(filter signature? (signature-elems sig))))
@ -630,11 +631,11 @@
(make-parse-unit imports
renames
vars
(lambda (src-stx) (apply append (map (lambda (i) (make-struct-stx-decls i #f src-stx #f)) imports)))
(lambda (src-stx) (apply append (map (lambda (i) (make-struct-stx-decls i #f #t src-stx #f)) imports)))
body
(lambda (src-stx)
;; Disabled until we have a mechanism for declaring precise information in signatures:
; (make-struct-stx-decls sig #f src-stx #t)
; (make-struct-stx-decls sig #f #f src-stx #t)
null))]
[(and (null? pre-lines) (not port) (not (pair? lines)))
(syntax-error 'unit/sig expr "improper body list form")]
@ -1134,6 +1135,7 @@
parse-unit-body
parse-unit-stx-checks
make-struct-stx-decls
verify-struct-shape
signature-vars

View File

@ -268,20 +268,25 @@
[ex-exploded (d->s ex-exploded)]
[im-explodeds (d->s im-explodeds)]
[im-flattened (d->s im-flattened)]
[formname formname])
[formname formname]
[stx-decls (if (syntax-e (syntax global?))
null
(make-struct-stx-decls ex-sig #f #f (syntax signame) #f))])
(syntax
(dv/iu
ex-flattened
(let ([unit-var unite])
(verify-linkage-signature-match
'formname
'(invoke)
(list unit-var)
'(ex-exploded)
'(im-explodeds))
(unit/sig-unit unit-var))
prefix
. im-flattened))))))))])))
(begin
(dv/iu
ex-flattened
(let ([unit-var unite])
(verify-linkage-signature-match
'formname
'(invoke)
(list unit-var)
'(ex-exploded)
'(im-explodeds))
(unit/sig-unit unit-var))
prefix
. im-flattened)
. stx-decls))))))))])))
(define-syntax define-values/invoke-unit/sig
(lambda (stx)