Fix error handling when non-poly Name is applied.

svn: r9607

original commit: ac1acc7bf6534c88d8eeb889c75706b3f99f8910
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-02 22:19:18 +00:00
parent 4664fc9a4f
commit b6c5754410
2 changed files with 5 additions and 1 deletions

View File

@ -162,11 +162,13 @@
[(lookup-type-alias #'id parse-type (lambda () #f))
=>
(lambda (t)
;(printf "found a type alias ~a~n" #'id)
(add-type-name-reference #'id)
t)]
;; if it's a type name, we just use the name
[(lookup-type-name #'id (lambda () #f))
(add-type-name-reference #'id)
;(printf "found a type name ~a~n" #'id)
(make-Name #'id)]
[else
(tc-error/delayed "unbound type ~a" (syntax-e #'id))

View File

@ -223,12 +223,14 @@
;(printf "subtype - hierarchy : ~a ~a ~a~n" nm parent other)
(subtype* A0 parent other)]
;; applications and names are structs too
[(list (App: (Name: n) args _) other)
[(list (App: (Name: n) args stx) other)
(let ([t (lookup-type-name n)])
(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))
(unless (Poly? t)
(tc-error/stx stx "cannot apply non-polymorphic type ~a" t))
(let ([v (subtype* A0 (instantiate-poly t args) other)])
#;(printf "val: ~a~n" v)
v))]