X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcSimplify.lhs;h=b7002f83d16882a5ec7fb66d44fbea86fe8159e2;hb=370765b2f80105d7ca6e6080bab24c76970fdc4e;hp=b3bea61f6fa6157aa06b4db7d0dffe9a87c9be7c;hpb=3d4c49bb97c24b943ad7ff768dfeb23b4660568a;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index b3bea61..b7002f8 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -26,7 +26,7 @@ import TcHsSyn		( TcId, TcDictBinds, mkHsApp, mkHsTyApp, mkHsDictApp )
 
 import TcRnMonad
 import Inst		( lookupInst, LookupInstResult(..),
-			  tyVarsOfInst, fdPredsOfInsts, fdPredsOfInst, newDicts,
+			  tyVarsOfInst, fdPredsOfInsts, newDicts, 
 			  isDict, isClassDict, isLinearInst, linearInstType,
 			  isStdClassTyVarDict, isMethodFor, isMethod,
 			  instToId, tyVarsOfInsts,  cloneDict,
@@ -1530,20 +1530,23 @@ reduceContextWithoutImprovement doc try_me wanteds
 tcImprove :: Avails -> TcM Bool		-- False <=> no change
 -- Perform improvement using all the predicates in Avails
 tcImprove avails
- =  tcGetInstEnvs 			`thenM` \ (home_ie, pkg_ie) ->
+ =  tcGetInstEnvs 			`thenM` \ inst_envs -> 
     let
-	preds = [ (pred, pp_loc)
+	preds = [ (dictPred inst, pp_loc)
 		| inst <- keysFM avails,
-		  let pp_loc = pprInstLoc (instLoc inst),
-		  pred <- fdPredsOfInst inst
+		  isDict inst,
+		  let pp_loc = pprInstLoc (instLoc inst)
 		]
 		-- Avails has all the superclasses etc (good)
 		-- It also has all the intermediates of the deduction (good)
 		-- It does not have duplicates (good)
 		-- NB that (?x::t1) and (?x::t2) will be held separately in avails
 		--    so that improve will see them separate
+		--
+		-- Notice that we only look at dicts; LitInsts and Methods will have
+		-- been squished, so their dicts will be in Avails too
 	eqns = improve get_insts preds
-	get_insts clas = classInstances home_ie clas ++ classInstances pkg_ie clas
+	get_insts clas = classInstances inst_envs clas
      in
      if null eqns then
 	returnM True
@@ -1552,10 +1555,11 @@ tcImprove avails
         mappM_ unify eqns	`thenM_`
 	returnM False
   where
-    unify ((qtvs, t1, t2), doc)
+    unify ((qtvs, pairs), doc)
 	 = addErrCtxt doc				$
 	   tcInstTyVars VanillaTv (varSetElems qtvs)	`thenM` \ (_, _, tenv) ->
-	   unifyTauTy (substTy tenv t1) (substTy tenv t2)
+	   mapM_ (unif_pr tenv) pairs
+    unif_pr tenv (ty1,ty2) =  unifyTauTy (substTy tenv ty1) (substTy tenv ty2)
 \end{code}
 
 The main context-reduction function is @reduce@.  Here's its game plan.