@@ -266,15 +266,34 @@ replaceTypeClassDictionaries mn = everywhereM' (mkM go)
266266 entails env mn dicts constraint
267267 go other = return other
268268
269+-- |
270+-- A simplified representation of expressions which are used to represent type
271+-- class dictionaries at runtime, which can be compared for equality
272+--
273+data DictionaryValue
274+ -- |
275+ -- A dictionary which is brought into scope by a local constraint
276+ --
277+ = LocalDictionaryValue (Qualified Ident)
278+ -- |
279+ -- A dictionary which is brought into scope by an instance declaration
280+ --
281+ | GlobalDictionaryValue (Qualified Ident)
282+ -- |
283+ -- A dictionary which depends on other dictionaries
284+ --
285+ | DependentDictionaryValue (Qualified Ident) [DictionaryValue]
286+ deriving (Show, Eq)
287+
269288-- |
270289-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
271290-- return a type class dictionary reference.
272291--
273292entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Check Value
274293entails env moduleName context goal@(className, tys) = do
275− case go goal of
294+ case nub (go goal) of
276295 [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
277− [dict] -> return dict
296+ [dict] -> return (dictionaryValueToValue dict)
278297 _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
279298 where
280299 go (className', tys') =
@@ -291,16 +310,21 @@ entails env moduleName context goal@(className, tys) = do
291310 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
292311 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
293312 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
294− solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [Value]]
313+ solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]
295314 solveSubgoals _ Nothing = return Nothing
296315 solveSubgoals subst (Just subgoals) = do
297316 dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals
298317 return $ Just dict
299318 -- Make a dictionary from subgoal dictionaries by applying the correct function
300− mkDictionary :: Qualified Ident -> Maybe [Value] -> Value
301− mkDictionary fnName Nothing = Var fnName
302− mkDictionary fnName (Just []) = App (Var fnName) (ObjectLiteral [])
303− mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts
319+ mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
320+ mkDictionary fnName Nothing = LocalDictionaryValue fnName
321+ mkDictionary fnName (Just []) = GlobalDictionaryValue fnName
322+ mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts
323+ -- Turn a DictionaryValue into a Value
324+ dictionaryValueToValue :: DictionaryValue -> Value
325+ dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName
326+ dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
327+ dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
304328 -- Filter out type dictionaries which are in scope in the current module
305329 filterModule :: TypeClassDictionaryInScope -> Bool
306330 filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True