@@ -68,6 +68,7 @@ import Control.Arrow (Arrow(..))
6868
6969import qualified Data.Map as M
7070import Data.Function (on)
71+import Data.Ord (comparing)
7172
7273instance Partial Type where
7374 unknown = TUnknown
@@ -1012,6 +1013,27 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
10121013 Just moduleName <- checkCurrentModule <$> get
10131014 _ <- subsumes' Nothing ty1 ty2
10141015 return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))
1016+subsumes' val (Object r1) (Object r2) = do
1017+ let
1018+ (ts1, r1') = rowToList r1
1019+ (ts2, r2') = rowToList r2
1020+ ts1' = sortBy (comparing fst) ts1
1021+ ts2' = sortBy (comparing fst) ts2
1022+ go ts1' ts2' r1' r2'
1023+ return val
1024+ where
1025+ go [] ts2 r1 r2 = r1 =?= rowFromList (ts2, r2)
1026+ go ts1 [] r1 r2 = r2 =?= rowFromList (ts1, r1)
1027+ go ((p1, ty1) : ts1) ((p2, ty2) : ts2) r1 r2
1028+ | p1 == p2 = do subsumes Nothing ty1 ty2
1029+ go ts1 ts2 r1 r2
1030+ | p1 < p2 = do rest <- fresh
1031+ r2 =?= RCons p1 ty1 rest
1032+ go ts1 ((p2, ty2) : ts2) r1 rest
1033+ | p1 > p2 = do rest <- fresh
1034+ r1 =?= RCons p2 ty2 rest
1035+ go ((p1, ty1) : ts1) ts2 rest r2
1036+subsumes' val ty1 ty2@(Object _) = subsumes val ty2 ty1
10151037subsumes' val ty1 ty2 = do
10161038 ty1 =?= ty2
10171039 return val