X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=5ad0bed31763bbc51a150667bb4c69903b9ea5bc;hb=1add6282808b5ae98e72ef7034634036c9b91b04;hp=1a8efe2ebf0c54a3a86500593166b520c0f710ab;hpb=e8901a971ef4fcac3e99f4069b6edbd73d42b31b;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 1a8efe2..5ad0bed 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -45,7 +45,8 @@ module Inst (
         mkIdEqInstCo, mkSymEqInstCo, mkLeftTransEqInstCo,
         mkRightTransEqInstCo, mkAppEqInstCo,
         isValidWantedEqInst,
-	eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst, finalizeEqInst, 
+	eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst,
+        wantedToLocalEqInst, finalizeEqInst, 
 	eqInstType, updateEqInstCoercion,
 	eqInstCoercion,	eqInstTys
     ) where
@@ -286,7 +287,7 @@ newDictBndr :: InstLoc -> TcPredType -> TcM Inst
 newDictBndr inst_loc pred@(EqPred ty1 ty2)
   = do { uniq <- newUnique 
 	; let name = mkPredName uniq inst_loc pred 
-	      co = mkGivenCo $ TyVarTy (Var.mkCoVar name (PredTy pred))
+	      co   = mkGivenCo $ TyVarTy (Var.mkCoVar name (PredTy pred))
 	; return (EqInst {tci_name  = name, 
 			  tci_loc   = inst_loc, 
 			  tci_left  = ty1, 
@@ -1095,6 +1096,15 @@ mkWantedEqInst pred@(EqPred ty1 ty2)
        }
 mkWantedEqInst pred = pprPanic "mkWantedEqInst" (ppr pred)
 
+-- Turn a wanted equality into a local that propagates the uninstantiated
+-- coercion variable as witness.  We need this to propagate wanted irreds into
+-- attempts to solve implication constraints.
+--
+wantedToLocalEqInst :: Inst -> Inst
+wantedToLocalEqInst eq@(EqInst {tci_co = Left cotv})
+  = eq {tci_co = Right (mkTyVarTy cotv)}
+wantedToLocalEqInst eq = eq
+
 -- Turn a wanted into a local EqInst (needed during type inference for
 -- signatures) 
 --