From b6c575441042ea827f9a510d757d99fcef85d8b8 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 2 May 2008 22:19:18 +0000 Subject: [PATCH] Fix error handling when non-poly Name is applied. svn: r9607 original commit: ac1acc7bf6534c88d8eeb889c75706b3f99f8910 --- collects/typed-scheme/private/parse-type.ss | 2 ++ collects/typed-scheme/private/subtype.ss | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/collects/typed-scheme/private/parse-type.ss b/collects/typed-scheme/private/parse-type.ss index cbc5632b..b262f0b3 100644 --- a/collects/typed-scheme/private/parse-type.ss +++ b/collects/typed-scheme/private/parse-type.ss @@ -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)) diff --git a/collects/typed-scheme/private/subtype.ss b/collects/typed-scheme/private/subtype.ss index 71e515e2..999d8936 100644 --- a/collects/typed-scheme/private/subtype.ss +++ b/collects/typed-scheme/private/subtype.ss @@ -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))]