X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=0af5ceb0a163b375dd4929671bbc68c2575f06e1;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hp=d0bdb69ea3ec5250ce034c12fe103595dc864863;hpb=b5a8dd88e3939cf547be50ab62bae84f5bf0398d;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index d0bdb69..0af5ceb 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -64,7 +64,9 @@ import Util
 import UniqSet
 import SrcLoc
 import DynFlags
+import FastString
 
+import Control.Monad
 import Data.List
 \end{code}
 
@@ -1149,7 +1151,7 @@ Given the FD of Modular in this example, class improvement will instantiate
 t_a to 'a', where 'a' is the skolem from test5's signatures (due to the
 Modular s a predicate in that signature).  If we don't zonk (Modular s t_a) in
 the givens, we will get into a loop as improveOne uses the unification engine
-TcGadt.tcUnifyTys, which doesn't know about mutable type variables.
+Unify.tcUnifyTys, which doesn't know about mutable type variables.
 
 
 Note [LOOP]
@@ -1905,12 +1907,9 @@ reduceList :: RedEnv -> [Inst] -> Avails -> TcM Avails
 reduceList env@(RedEnv {red_stack = (n,stk)}) wanteds state
   = do	{ traceTc (text "reduceList " <+> (ppr wanteds $$ ppr state))
 	; dopts <- getDOpts
-#ifdef DEBUG
-	; if n > 8 then
+	; when (debugIsOn && (n > 8)) $ do
 		dumpTcRn (hang (ptext SLIT("Interesting! Context reduction stack depth") <+> int n) 
 			     2 (ifPprDebug (nest 2 (pprStack stk))))
-	  else return ()
-#endif
 	; if n >= ctxtStkDepth dopts then
 	    failWithTc (reduceDepthErr n stk)
 	  else
@@ -2927,14 +2926,13 @@ report_no_instances tidy_env mb_what insts
 	| not (isClassDict wanted) = Left wanted
 	| otherwise
 	= case lookupInstEnv inst_envs clas tys of
+		([], _) -> Left wanted		-- No match
 		-- The case of exactly one match and no unifiers means a
 		-- successful lookup.  That can't happen here, because dicts
 		-- only end up here if they didn't match in Inst.lookupInst
-#ifdef DEBUG
-		([m],[]) -> pprPanic "reportNoInstance" (ppr wanted)
-#endif
-		([], _)  -> Left wanted		-- No match
-		res	 -> Right (mk_overlap_msg wanted res)
+		([m],[])
+		 | debugIsOn -> pprPanic "reportNoInstance" (ppr wanted)
+		res -> Right (mk_overlap_msg wanted res)
 	  where
 	    (clas,tys) = getDictClassTys wanted