Now to move the contract info appropriately into sigs from signatures.

svn: r12712
This commit is contained in:
Stevie Strickland 2008-12-05 17:55:47 +00:00
parent 1b4d2cb7bf
commit beb5f19530
2 changed files with 19 additions and 4 deletions

View File

@ -57,8 +57,10 @@
;; - (cons identifier identifier)
;; A def is
;; - (listof (cons (listof int/ext) syntax-object))
;; A ctc-pair is
;; - (cons int/ext syntax-object)
;; A sig is
;; - (list (listof int/ext) (listof def) (listof def))
;; - (list (listof int/ext) (listof def) (listof def) (listof ctc-pair))
;; A tagged-sig is
;; - (listof (cons #f siginfo) (cons #f identifier) sig)
;; - (listof (cons symbol siginfo) (cons symbol identifier) sig)
@ -220,6 +222,7 @@
(vars (signature-vars sig))
(vals (signature-val-defs sig))
(stxs (signature-stx-defs sig))
(cps (signature-ctc-pairs sig))
(delta-introduce (if bind?
(let ([f (syntax-local-make-delta-introducer
spec)])
@ -244,7 +247,12 @@
(cons (map (λ (id) (cons id id))
(car stx))
(cdr stx)))
stxs)))))
stxs)
(map
(λ (cp)
(cons (cons (car cp) (car cp))
(cdr cp)))
cps)))))
(define (sig-names sig)
(append (car sig)
@ -265,12 +273,18 @@
(car def))
(g (cdr def))))
;; map-ctc-pair : (identifier -> identifier) (syntax-object -> syntax-object) ctc-pair -> ctc-pair
(define (map-ctc-pair f g cp)
(cons (cons (f (caar cp)) (g (cdar cp)))
(g (cdr cp))))
;; map-sig : (identifier -> identifier) (sytnax-object -> syntax-object) sig -> sig
;; applies f to the internal parts, and g to the external parts.
(define (map-sig f g sig)
(list (map (lambda (x) (cons (f (car x)) (g (cdr x)))) (car sig))
(map (lambda (x) (map-def f g x)) (cadr sig))
(map (lambda (x) (map-def f g x)) (caddr sig))))
(map (lambda (x) (map-def f g x)) (caddr sig))
(map (lambda (x) (map-ctc-pair f g x)) (cadddr sig))))
;; An import-spec is one of
;; - signature-name

View File

@ -123,7 +123,8 @@
(define-for-syntax (build-val+macro-defs sig)
(with-syntax ([(((int-ivar . ext-ivar) ...)
((((int-vid . ext-vid) ...) . vbody) ...)
((((int-sid . ext-sid) ...) . sbody) ...))
((((int-sid . ext-sid) ...) . sbody) ...)
(((int-cid . ext-cid) . cbody) ...))
(map-sig (lambda (x) x)
(make-syntax-introducer)
sig)])