+addTopIPErrs :: [Name] -> [Inst] -> TcM ()
+addTopIPErrs bndrs []
+ = return ()
+addTopIPErrs bndrs ips
+ = addErrTcM (tidy_env, mk_msg tidy_ips)
+ where
+ (tidy_env, tidy_ips) = tidyInsts ips
+ mk_msg ips = vcat [sep [ptext SLIT("Implicit parameters escape from the monomorphic top-level binding(s) of"),
+ pprBinders bndrs <> colon],
+ nest 2 (vcat (map ppr_ip ips)),
+ monomorphism_fix]
+ ppr_ip ip = pprPred (dictPred ip) <+> pprInstLoc (instLoc ip)
+
+strangeTopIPErrs :: [Inst] -> TcM ()
+strangeTopIPErrs dicts -- Strange, becuase addTopIPErrs should have caught them all
+ = groupErrs report tidy_dicts
+ where
+ (tidy_env, tidy_dicts) = tidyInsts dicts
+ report dicts = addErrTcM (tidy_env, mk_msg dicts)
+ mk_msg dicts = addInstLoc dicts (ptext SLIT("Unbound implicit parameter") <>
+ plural tidy_dicts <+> pprDictsTheta tidy_dicts)
+
+addNoInstanceErrs :: Maybe SDoc -- Nothing => top level
+ -- Just d => d describes the construct
+ -> [Inst] -- What is given by the context or type sig
+ -> [Inst] -- What is wanted
+ -> TcM ()
+addNoInstanceErrs mb_what givens []
+ = returnM ()
+addNoInstanceErrs mb_what givens dicts
+ = -- Some of the dicts are here because there is no instances
+ -- and some because there are too many instances (overlap)
+ tcGetInstEnvs `thenM` \ inst_envs ->
+ let
+ (tidy_env1, tidy_givens) = tidyInsts givens
+ (tidy_env2, tidy_dicts) = tidyMoreInsts tidy_env1 dicts
+
+ -- Run through the dicts, generating a message for each
+ -- overlapping one, but simply accumulating all the
+ -- no-instance ones so they can be reported as a group
+ (overlap_doc, no_inst_dicts) = foldl check_overlap (empty, []) tidy_dicts
+ check_overlap (overlap_doc, no_inst_dicts) dict
+ | not (isClassDict dict) = (overlap_doc, dict : no_inst_dicts)
+ | otherwise
+ = case lookupInstEnv inst_envs clas tys of
+ -- The case of exactly one match and no unifiers means
+ -- a successful lookup. That can't happen here, becuase
+ -- dicts only end up here if they didn't match in Inst.lookupInst
+#ifdef DEBUG
+ ([m],[]) -> pprPanic "addNoInstanceErrs" (ppr dict)
+#endif
+ ([], _) -> (overlap_doc, dict : no_inst_dicts) -- No match
+ res -> (mk_overlap_msg dict res $$ overlap_doc, no_inst_dicts)
+ where
+ (clas,tys) = getDictClassTys dict
+ in
+
+ -- Now generate a good message for the no-instance bunch
+ mk_probable_fix tidy_env2 no_inst_dicts `thenM` \ (tidy_env3, probable_fix) ->
+ let
+ no_inst_doc | null no_inst_dicts = empty
+ | otherwise = vcat [addInstLoc no_inst_dicts heading, probable_fix]
+ heading | null givens = ptext SLIT("No instance") <> plural no_inst_dicts <+>
+ ptext SLIT("for") <+> pprDictsTheta no_inst_dicts
+ | otherwise = sep [ptext SLIT("Could not deduce") <+> pprDictsTheta no_inst_dicts,
+ nest 2 $ ptext SLIT("from the context") <+> pprDictsTheta tidy_givens]
+ in
+ -- And emit both the non-instance and overlap messages
+ addErrTcM (tidy_env3, no_inst_doc $$ overlap_doc)
+ where
+ mk_overlap_msg dict (matches, unifiers)
+ = vcat [ addInstLoc [dict] ((ptext SLIT("Overlapping instances for")
+ <+> pprPred (dictPred dict))),
+ sep [ptext SLIT("Matching instances") <> colon,
+ nest 2 (vcat [pprInstances ispecs, pprInstances unifiers])],
+ ASSERT( not (null matches) )
+ if not (isSingleton matches)
+ then -- Two or more matches
+ empty
+ else -- One match, plus some unifiers
+ ASSERT( not (null unifiers) )
+ parens (vcat [ptext SLIT("The choice depends on the instantiation of") <+>
+ quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))),
+ ptext SLIT("Use -fallow-incoherent-instances to use the first choice above")])]
+ where
+ ispecs = [ispec | (_, ispec) <- matches]
+
+ mk_probable_fix tidy_env dicts
+ = returnM (tidy_env, sep [ptext SLIT("Probable fix:"), nest 2 (vcat fixes)])
+ where
+ fixes = add_ors (fix1 ++ fix2)
+
+ fix1 = case mb_what of
+ Nothing -> [] -- Top level
+ Just what -> -- Nested (type signatures, instance decls)
+ [ sep [ ptext SLIT("add") <+> pprDictsTheta dicts,
+ ptext SLIT("to the") <+> what] ]
+
+ fix2 | null instance_dicts = []
+ | otherwise = [ ptext SLIT("add an instance declaration for")
+ <+> pprDictsTheta instance_dicts ]
+ instance_dicts = [d | d <- dicts, isClassDict d, not (isTyVarDict d)]
+ -- Insts for which it is worth suggesting an adding an instance declaration
+ -- Exclude implicit parameters, and tyvar dicts