X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FInst.lhs;h=2b8f125d8a0a134db0a49ed74bd7486a6325ac8b;hb=e26b57633244b75c41f684e48f2681d25978f43f;hp=8b2058db561443ffdcf2ed3f81b27e40ecdafd83;hpb=d255dfff87648bcd4dd1d87faa8d835d358c70a2;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 8b2058d..2b8f125 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -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.