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

Fix handling of structs-as-functions.

Browse Source 
Subtyping should look up names in both positions.

svn: r14827
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-15 15:47:22 +00:00
parent b2cf9c0006
commit ddefd28d6d
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-scheme/typecheck/tc-app.ss
View File

@ -555,8 +555,8 @@
(infer/dots fixed-vars dotted-var argtys-t dom dty rng (fv rng) #:expected (and expected (tc-results->values expected)))) (infer/dots fixed-vars dotted-var argtys-t dom dty rng (fv rng) #:expected (and expected (tc-results->values expected))))
t argtys expected)] t argtys expected)]
;; procedural structs ;; procedural structs
[(tc-result1: (and sty (Struct: _ _ _ (? Type? proc-ty) _ _ _))) [((tc-result1: (and sty (Struct: _ _ _ (? Function? proc-ty) _ _ _))) _)
(tc/funapp f-stx (cons (syntax/loc f-stx dummy) args-stx) (ret proc-ty) (cons sty argtys) expected)] (tc/funapp f-stx #`(#,(syntax/loc f-stx dummy) . #,args-stx) (ret proc-ty) (cons ftype0 argtys) expected)]
;; parameters are functions too ;; parameters are functions too
[((tc-result1: (Param: in out)) (list)) (ret out)] [((tc-result1: (Param: in out)) (list)) (ret out)]
[((tc-result1: (Param: in out)) (list (tc-result1: t))) [((tc-result1: (Param: in out)) (list (tc-result1: t)))

6
collects/typed-scheme/types/subtype.ss
View File

@ -303,10 +303,14 @@
v))] v))]
[(list (Name: n) other) [(list (Name: n) other)
(let ([t (lookup-type-name n)]) (let ([t (lookup-type-name n)])
;(printf "subtype: name: ~a ~a ~a~n" (syntax-e n) t other)
(if (Type? t) (if (Type? t)
(subtype* A0 t other) (subtype* A0 t other)
(fail! s t)))] (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 ;; Promises are covariant
[(list (Struct: 'Promise _ (list t) _ _ _ _) (Struct: 'Promise _ (list t*) _ _ _ _)) (subtype* A0 t t*)] [(list (Struct: 'Promise _ (list t) _ _ _ _) (Struct: 'Promise _ (list t*) _ _ _ _)) (subtype* A0 t t*)]
;; subtyping on values is pointwise ;; subtyping on values is pointwise