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

Handle errors in type application.

Browse Source 
svn: r9915

original commit: ac1027af8b38669bddf388951cee98e08892cb44
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-20 20:47:18 +00:00
parent 13a8c13f74
commit a525d82a8d
1 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -228,12 +228,32 @@
(unless (Type? t)
(fail! s t))
#;(printf "subtype: app-name: name: ~a type: ~a other: ~a ~ninst: ~a~n" (syntax-e n) t other
(instantiate-poly t args))
(instantiate-poly t args))
(unless (Poly? t)
(tc-error/stx stx "cannot apply non-polymorphic type ~a" t))
(let ([v (subtype* A0 (instantiate-poly t args) other)])
(tc-error/stx stx "cannot apply non-polymorphic type ~a" t))
(match t [(Poly-unsafe: n _)
(unless (= n (length args))
(tc-error/stx stx "wrong number of arguments to polymorphic type: expected ~a and got ~a"
n (length args)))])
(let ([v (subtype* A0 (instantiate-poly t args) other)])
#;(printf "val: ~a~n" v)
v))]
[(list other (App: (Name: n) args stx))
(let ([t (lookup-type-name n)])
(unless (Type? t)
(fail! s t))
#;(printf "subtype: 2 app-name: name: ~a type: ~a other: ~a ~ninst: ~a~n" (syntax-e n) t other
(instantiate-poly t args))
(unless (Poly? t)
(tc-error/stx stx "cannot apply non-polymorphic type ~a" t))
(match t [(Poly-unsafe: n _)
(unless (= n (length args))
(tc-error/stx stx "wrong number of arguments to polymorphic type: expected ~a and got ~a"
n (length args)))])
;(printf "about to call subtype with: ~a ~a ~n" other (instantiate-poly t args))
(let ([v (subtype* A0 other (instantiate-poly t args))])
#;(printf "2 val: ~a~n" v)
v))]
[(list (Name: n) other)
(let ([t (lookup-type-name n)])
;(printf "subtype: name: ~a ~a ~a~n" (syntax-e n) t other)
@ -253,7 +273,7 @@
[(list (Instance: t) (Instance: t*))
(subtype* A0 t t*)]
;; otherwise, not a subtype
[_ (fail! s t) (printf "failed")]))))))
[_ (fail! s t) #;(printf "failed")]))))))
(define (type-compare? a b)
(and (subtype a b) (subtype b a)))