X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=c009ebe0831f496d8265086255f61803ece626c1;hb=5045af3106f3d1e3cb223c254af2de6a8a265797;hp=d839aba3519accc218f8d09390493a34e1bf184a;hpb=b7f052c4c50a5de5759a21085a12c19c65d8797c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index d839aba..c009ebe 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -44,7 +44,9 @@ module Inst (
 	isWantedCo, fromWantedCo, fromGivenCo, eqInstCoType,
         mkIdEqInstCo, mkSymEqInstCo, mkLeftTransEqInstCo,
         mkRightTransEqInstCo, mkAppEqInstCo,
-	eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst, finalizeEqInst, 
+        isValidWantedEqInst,
+	eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst,
+        wantedToLocalEqInst, finalizeEqInst, 
 	eqInstType, updateEqInstCoercion,
 	eqInstCoercion,	eqInstTys
     ) where
@@ -513,7 +515,7 @@ Zonking makes sure that the instance types are fully zonked.
 
 \begin{code}
 zonkInst :: Inst -> TcM Inst
-zonkInst dict@(Dict { tci_pred = pred}) = do
+zonkInst dict@(Dict {tci_pred = pred}) = do
     new_pred <- zonkTcPredType pred
     return (dict {tci_pred = new_pred})
 
@@ -544,7 +546,7 @@ zonkInst eqinst@(EqInst {tci_left = ty1, tci_right = ty2})
 		  (\co    -> liftM mkGivenCo $ zonkTcType co)
        ; ty1' <- zonkTcType ty1
        ; ty2' <- zonkTcType ty2
-       ; return (eqinst {tci_co = co', tci_left= ty1', tci_right = ty2' })
+       ; return (eqinst {tci_co = co', tci_left = ty1', tci_right = ty2' })
        }
 
 zonkInsts :: [Inst] -> TcRn [Inst]
@@ -1048,6 +1050,13 @@ mkAppEqInstCo (Right co) _ _
 Operations on entire EqInst.
 
 \begin{code}
+-- For debugging, make sure the cotv of a wanted is not filled.
+--
+isValidWantedEqInst :: Inst -> TcM Bool
+isValidWantedEqInst (EqInst {tci_co = Left cotv})
+  = liftM not $ isFilledMetaTyVar cotv
+isValidWantedEqInst _ = return True
+
 eitherEqInst :: Inst 	            -- given or wanted EqInst
 	     -> (TcTyVar  -> a)     -- 	result if wanted
 	     -> (Coercion -> a)     --	result if given
@@ -1087,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) 
 --