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

Add new datastructures for dots work.

Browse Source 
original commit: a7c63840e4e2b80dd8007921334f7cbd245fe3de
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-09 17:07:41 -04:00
parent e52e768126
commit 69c7303342
3 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-scheme/private/subtype.ss
View File

@ -99,10 +99,10 @@
(match (list s t)
;; top for functions is above everything
[(list _ (top-arr:)) A0]
[(list (arr: s1 s2 #f thn-eff els-eff) (arr: t1 t2 #f thn-eff els-eff))
[(list (arr: s1 s2 #f #f thn-eff els-eff) (arr: t1 t2 #f #f thn-eff els-eff))
(let ([A1 (subtypes* A0 t1 s1)])
(subtype* A1 s2 t2))]
[(list (arr: s1 s2 s3 thn-eff els-eff) (arr: t1 t2 t3 thn-eff* els-eff*))
[(list (arr: s1 s2 s3 #f thn-eff els-eff) (arr: t1 t2 t3 #f thn-eff* els-eff*))
(unless
(or (and (null? thn-eff*) (null? els-eff*))
(and (effects-equal? thn-eff thn-eff*)

4
collects/typed-scheme/private/type-effect-convenience.ss
View File

@ -68,8 +68,8 @@
(define make-arr*
(case-lambda [(dom rng) (make-arr* dom rng #f (list) (list))]
[(dom rng rest) (make-arr dom rng rest (list) (list))]
[(dom rng rest eff1 eff2) (make-arr dom rng rest eff1 eff2)]))
[(dom rng rest) (make-arr dom rng rest #f (list) (list))]
[(dom rng rest eff1 eff2) (make-arr dom rng rest #f eff1 eff2)]))
(define (make-promise-ty t)
(make-Struct (string->uninterned-symbol "Promise") #f (list t) #f #f #'promise? values))

8
collects/typed-scheme/private/type-effect-printer.ss
View File

@ -46,11 +46,13 @@
(match a
[(top-arr:)
(fp "Procedure")]
[(arr: dom rng rest thn-eff els-eff)
[(arr: dom rng rest drest thn-eff els-eff)
(fp "(")
(for-each (lambda (t) (fp "~a " t)) dom)
(when rest
(fp "~a .. " rest))
(fp "~a* " rest))
(when drest
(fp "~a ..." drest))
(fp "-> ~a" rng)
(unless (and (null? thn-eff) (null? els-eff))
(fp " : ~a ~a" thn-eff els-eff))
@ -96,7 +98,7 @@
[(list) (fp "(case-lambda)")]
[(list a) (print-arr a)]
[(list a ...) (fp "(case-lambda ") (for-each print-arr a) (fp ")")]))]
[(arr: _ _ _ _ _) (print-arr c)]
[(arr: _ _ _ _ _ _) (print-arr c)]
[(Vector: e) (fp "(Vectorof ~a)" e)]
[(Box: e) (fp "(Box ~a)" e)]
[(Union: elems) (fp "~a" (cons 'U elems))]