suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/mzlib/private/unit-compiletime.ss
View File

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

3
collects/mzlib/unit.ss
View File

@ -123,7 +123,8 @@
(define-for-syntax (build-val+macro-defs sig) (define-for-syntax (build-val+macro-defs sig)
(with-syntax ([(((int-ivar . ext-ivar) ...) (with-syntax ([(((int-ivar . ext-ivar) ...)
((((int-vid . ext-vid) ...) . vbody) ...) ((((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) (map-sig (lambda (x) x)
(make-syntax-introducer) (make-syntax-introducer)
sig)]) sig)])