From 92e34ebab960496f7b2faf6502ca895b2d2e00ae Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Mon, 17 Jun 2013 17:06:59 -0400
Subject: [PATCH] Fix class type subtyping

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.
---
 .../typed-racket/types/subtype.rkt            | 34 +++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
index dcb99a67cc..5276777469 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
@@ -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)