Commit e26b5763 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-11-10 12:05:04 by simonpj]

Corner case fix for -fundecidable-instances
parent d255dfff
......@@ -82,7 +82,7 @@ import TysWiredIn ( floatDataCon, doubleDataCon )
import PrelNames ( integerTyConName, fromIntegerName, fromRationalName, rationalTyConName )
import BasicTypes( IPName(..), mapIPName, ipNameName )
import UniqSupply( uniqsFromSupply )
import CmdLineOpts( DynFlags )
import CmdLineOpts( DynFlags, DynFlag( Opt_AllowUndecidableInstances ), dopt )
import Maybes ( isJust )
import Outputable
\end{code}
......@@ -648,21 +648,27 @@ lookupInst inst@(LitInst u (HsFractional f from_rat_name) ty loc)
-- Dictionaries
lookupInst dict@(Dict _ pred@(ClassP clas tys) loc)
| all tcIsTyVarTy tys -- Common special case; no lookup
-- NB: tcIsTyVarTy... don't look through newtypes!
= returnM NoInstance
| otherwise
= do { pkg_ie <- loadImportedInsts clas tys
= do { dflags <- getDOpts
; if all tcIsTyVarTy tys &&
not (dopt Opt_AllowUndecidableInstances dflags)
-- Common special case; no lookup
-- NB: tcIsTyVarTy... don't look through newtypes!
-- Don't take this short cut if we allow undecidable instances
-- because we might have "instance T a where ...".
-- [That means we need -fallow-undecidable-instances in the
-- client module, as well as the module with the instance decl.]
then return NoInstance
else do
{ pkg_ie <- loadImportedInsts clas tys
-- Suck in any instance decls that may be relevant
; tcg_env <- getGblEnv
; dflags <- getDOpts
; case lookupInstEnv dflags (pkg_ie, tcg_inst_env tcg_env) clas tys of {
([(tenv, (_,_,dfun_id))], []) -> instantiate_dfun tenv dfun_id pred loc ;
(matches, unifs) -> do
{ traceTc (text "lookupInst" <+> vcat [text "matches" <+> ppr matches,
text "unifs" <+> ppr unifs])
; return NoInstance } } }
; return NoInstance } } } }
-- In the case of overlap (multiple matches) we report
-- NoInstance here. That has the effect of making the
-- context-simplifier return the dict as an irreducible one.
......
......@@ -2051,8 +2051,15 @@ addNoInstanceErrs mb_what givens dicts
| not (isClassDict dict) = (overlap_doc, dict : no_inst_dicts)
| otherwise
= case lookupInstEnv dflags inst_envs clas tys of
([], _) -> (overlap_doc, dict : no_inst_dicts) -- No matches
inst_res -> (mk_overlap_msg dict inst_res $$ overlap_doc, no_inst_dicts)
res@(ms, _)
| length ms > 1 -> (mk_overlap_msg dict res $$ overlap_doc, no_inst_dicts)
| otherwise -> (overlap_doc, dict : no_inst_dicts) -- No match
-- NB: there can be exactly one match, in the case where we have
-- instance C a where ...
-- (In this case, lookupInst doesn't bother to look up,
-- unless -fallow-undecidable-instances is set.)
-- So we report this as "no instance" rather than "overlap"; the fix is
-- to specify -fallow-undecidable-instances, but we leave that to the programmer!
where
(clas,tys) = getDictClassTys dict
in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment