@@ -376,16 +376,18 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
376376 --
377377 checkOverlaps :: [DictionaryValue] -> Check Expr
378378 checkOverlaps dicts =
379− case sortedNubBy dictTrace (chooseSimplestDictionaries dicts) of
380− [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
381− [_] -> return $ dictionaryValueToValue $ head dicts
382− (d1 : d2 : _) -> throwError . strMsg $ unlines
379+ case [ (d1, d2) | d1 <- dicts, d2 <- dicts, d1 `overlapping` d2 ] of
380+ (d1, d2) : _ -> throwError . strMsg $ unlines
383381 [ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintType tys) ++ "."
384382 , "For example:"
385383 , prettyPrintDictionaryValue d1
386384 , "and:"
387385 , prettyPrintDictionaryValue d2
388386 ]
387+ _ -> case chooseSimplestDictionaries dicts of
388+ [] -> throwError . strMsg $
389+ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
390+ d : _ -> return $ dictionaryValueToValue d
389391 -- Choose the simplest DictionaryValues from a list of candidates
390392 -- The reason for this function is as follows:
391393 -- When considering overlapping instances, we don't want to consider the same dictionary
@@ -402,13 +404,19 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt
402404 isSimpleDictionaryValue (DependentDictionaryValue _ ds) = all isSimpleDictionaryValue ds
403405 isSimpleDictionaryValue _ = True
404406 -- |
405− -- Get the "trace" of a DictionaryValue - that is, remove all SubclassDictionaryValue
406− -- data constructors
407+ -- Check if two dictionaries are overlapping
408+ --
409+ -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have
410+ -- been caught when constructing superclass dictionaries.
407411 --
408− dictTrace :: DictionaryValue -> DictionaryValue
409− dictTrace (DependentDictionaryValue fnName dicts) = DependentDictionaryValue fnName $ map dictTrace dicts
410− dictTrace (SubclassDictionaryValue dict _ _) = dictTrace dict
411− dictTrace other = other
412+ overlapping :: DictionaryValue -> DictionaryValue -> Bool
413+ overlapping (LocalDictionaryValue nm1) (LocalDictionaryValue nm2) | nm1 == nm2 = False
414+ overlapping (GlobalDictionaryValue nm1) (GlobalDictionaryValue nm2) | nm1 == nm2 = False
415+ overlapping (DependentDictionaryValue nm1 ds1) (DependentDictionaryValue nm2 ds2)
416+ | nm1 == nm2 = any id $ zipWith overlapping ds1 ds2
417+ overlapping (SubclassDictionaryValue _ _ _) _ = False
418+ overlapping _ (SubclassDictionaryValue _ _ _) = False
419+ overlapping _ _ = True
412420 -- |
413421 -- Render a DictionaryValue fit for human consumption in error messages
414422 --