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

Fix type->contract of function types.

Browse Source 
svn: r14810

original commit: d8c613494e838711d2b85cc61607238d4c36baad
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-14 14:45:24 +00:00
parent 30b3106020
commit 37d71ded6f
1 changed files with 4 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/private/type-contract.ss
View File

@ -70,18 +70,13 @@
#;(printf "~a~n" (syntax-object->datum #'cnts))
#'(or/c . cnts))]
[(Function: arrs)
(let ()
(let ()
(define (f a)
(define-values (dom* rngs* rst)
(match a
[(arr: dom (Values: rngs) #f #f '())
(values (map t->c/neg dom) (map t->c rngs) #f)]
[(arr: dom rng #f #f '())
(values (map t->c/neg dom) (list (t->c rng)) #f)]
[(arr: dom (Values: rngs) rst #f '() )
(values (map t->c/neg dom) (map t->c rngs) (t->c/neg rst))]
[(arr: dom rng rst #f '())
(values (map t->c/neg dom) (list (t->c rng)) (t->c/neg rst))]))
[(arr: dom (Values: (list (Result: rngs _ _) ...)) rst #f '())
(values (map t->c/neg dom) (map t->c rngs) (and rst (t->c/neg rst)))]
[_ (exit (fail))]))
(with-syntax
([(dom* ...) dom*]
[rng* (match rngs*