@@ -48,8 +48,11 @@ newtype Work = Work Integer deriving (Show, Eq, Ord, Num)
4848-- return a type class dictionary reference.
4949--
5050entails :: Environment -> ModuleName -> M.Map (Maybe ModuleName) [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
51−entails env moduleName context = solve (sortedNubBy canonicalizeDictionary dictsInScope)
51+entails env moduleName context = solve
5252 where
53+ byClassName :: M.Map (Qualified ProperName) [TypeClassDictionaryInScope]
54+ byClassName = M.fromListWith (++) $ (\tcd -> (tcdClassName tcd, [tcd])) <$> sortedNubBy canonicalizeDictionary dictsInScope
55+
5356 sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
5457 sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))
5558
@@ -59,8 +62,8 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary dicts
5962 findDicts :: Maybe ModuleName -> [TypeClassDictionaryInScope]
6063 findDicts = fromMaybe [] . flip M.lookup context
6164
62− solve :: [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
63− solve context' (className, tys) trySuperclasses = do
65+ solve :: Constraint -> Bool -> Check Expr
66+ solve (className, tys) trySuperclasses = do
6467 let dicts = flip evalStateT (Work 0) $ go trySuperclasses className tys
6568 checkOverlaps dicts
6669 where
@@ -73,9 +76,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary dicts
7376 where
7477 directInstances :: StateT Work [] DictionaryValue
7578 directInstances = do
76− tcd <- lift context'
77− -- Make sure the type class name matches the one we are trying to satisfy
78− guard $ className' == tcdClassName tcd
79+ tcd <- lift . fromMaybe [] $ M.lookup className' byClassName
7980 -- Make sure the type unifies with the type in the type instance definition
8081 subst <- lift . maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)
8182 -- Solve any necessary subgoals