@@ -283,6 +283,10 @@ data DictionaryValue
283283 -- A dictionary which depends on other dictionaries
284284 --
285285 | DependentDictionaryValue (Qualified Ident) [DictionaryValue]
286+ -- |
287+ -- A subclass dictionary
288+ --
289+ | SubclassDictionaryValue DictionaryValue Integer
286290 deriving (Show, Ord, Eq)
287291
288292-- |
@@ -315,7 +319,21 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
315319 -- Make sure the type unifies with the type in the type instance definition
316320 , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)
317321 -- Solve any necessary subgoals
318− , args <- solveSubgoals subst (tcdDependencies tcd) ]
322+ , args <- solveSubgoals subst (tcdDependencies tcd) ] ++
323+
324+ -- Look for implementations via superclasses
325+ [ SubclassDictionaryValue suDict index
326+ | tcd <- context'
327+ , (_, _, implies) <- maybeToList $ M.lookup (tcdClassName tcd) (typeClasses env)
328+ -- Try each superclass
329+ , (index, (superclass, suTyArgs)) <- zip [0..] implies
330+ -- Make sure the types unify with the types in the superclass implication
331+ , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) suTyArgs (tcdInstanceTypes tcd)
332+ -- Make sure the type class name matches the superclass name
333+ , className' == superclass
334+ -- Finally, satisfy the subclass constraint
335+ , suDict <- go (tcdClassName tcd, tys') ]
336+
319337 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
320338 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
321339 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
@@ -334,6 +352,10 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
334352 dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName
335353 dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
336354 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
355+ dictionaryValueToValue (SubclassDictionaryValue dict index) =
356+ App (App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident (C.!!))))
357+ (Accessor "__superclasses" (dictionaryValueToValue dict)))
358+ (NumericLiteral (Left index))
337359 -- Ensure that a substitution is valid
338360 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]
339361 verifySubstitution subst = do