From ddefd28d6d2bc1b5bacb7f2ef6667e90d6ba8165 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 15 May 2009 15:47:22 +0000 Subject: [PATCH] Fix handling of structs-as-functions. Subtyping should look up names in both positions. svn: r14827 --- collects/typed-scheme/typecheck/tc-app.ss | 4 ++-- collects/typed-scheme/types/subtype.ss | 6 +++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-app.ss b/collects/typed-scheme/typecheck/tc-app.ss index 6f92e70b1a..21ec4c0684 100644 --- a/collects/typed-scheme/typecheck/tc-app.ss +++ b/collects/typed-scheme/typecheck/tc-app.ss @@ -555,8 +555,8 @@ (infer/dots fixed-vars dotted-var argtys-t dom dty rng (fv rng) #:expected (and expected (tc-results->values expected)))) t argtys expected)] ;; procedural structs - [(tc-result1: (and sty (Struct: _ _ _ (? Type? proc-ty) _ _ _))) - (tc/funapp f-stx (cons (syntax/loc f-stx dummy) args-stx) (ret proc-ty) (cons sty argtys) expected)] + [((tc-result1: (and sty (Struct: _ _ _ (? Function? proc-ty) _ _ _))) _) + (tc/funapp f-stx #`(#,(syntax/loc f-stx dummy) . #,args-stx) (ret proc-ty) (cons ftype0 argtys) expected)] ;; parameters are functions too [((tc-result1: (Param: in out)) (list)) (ret out)] [((tc-result1: (Param: in out)) (list (tc-result1: t))) diff --git a/collects/typed-scheme/types/subtype.ss b/collects/typed-scheme/types/subtype.ss index 2ef1ba0b99..0a1e4768ca 100644 --- a/collects/typed-scheme/types/subtype.ss +++ b/collects/typed-scheme/types/subtype.ss @@ -303,10 +303,14 @@ v))] [(list (Name: n) other) (let ([t (lookup-type-name n)]) - ;(printf "subtype: name: ~a ~a ~a~n" (syntax-e n) t other) (if (Type? t) (subtype* A0 t other) (fail! s t)))] + [(list other (Name: n)) + (let ([t (lookup-type-name n)]) + (if (Type? t) + (subtype* A0 other t) + (fail! t s)))] ;; Promises are covariant [(list (Struct: 'Promise _ (list t) _ _ _ _) (Struct: 'Promise _ (list t*) _ _ _ _)) (subtype* A0 t t*)] ;; subtyping on values is pointwise