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

Fix class type subtyping

Browse Source 
Although classes have no non-trivial subtyping relationships,
the representation I chose ends up introducing cases where two
"equal" types are not represented in the same way. This
commit fixes that by checking only the relevant parts of the
representation.

original commit: 92e34ebab960496f7b2faf6502ca895b2d2e00ae
This commit is contained in:
Asumu Takikawa 2013-06-17 17:06:59 -04:00
parent 3ce105ffde
commit 3d741fced7
1 changed files with 34 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
View File

@ -597,6 +597,40 @@
[else #f]))))
(and (subtype-clause? method-map method-map*)
(subtype-clause? field-map field-map*))]
[((Class: row inits fields methods)
(Class: row* inits* fields* methods*))
;; check that each of inits, fields, methods, etc. are
;; equal by sorting and checking type equality
(define (equal-clause? clause clause* [inits? #f])
(define (sort-clause lst)
(sort lst string<? #:key (compose symbol->string car)))
(let ([clause (sort-clause clause)]
[clause* (sort-clause clause*)])
(cond
[(not inits?)
(match-define (list (list names types) ...) clause)
(match-define (list (list names* types*) ...) clause*)
(and (= (length names) (length names*))
(andmap equal? names names*)
(andmap equal? types types*))]
[else
(match-define (list (list names types opt?) ...)
clause)
(match-define (list (list names* types* opt?*) ...)
clause*)
(and (= (length names) (length names*))
(andmap equal? names names*)
(andmap equal? types types*)
(andmap equal? opt? opt?*))])))
;; There is no non-trivial width subtyping on class types, but it's
;; possible for two "equal" class types to look different
;; in the representation. We deal with that here.
(and (or (and (or (Row? row) (not row))
(or (Row? row*) (not row*)))
(equal? row row*))
(equal-clause? inits inits* #t)
(equal-clause? fields fields*)
(equal-clause? methods methods*))]
;; otherwise, not a subtype
[(_ _) #f])))
(when (null? A)