Fix typo that prevented zonking of rhs of EqInsts

[ghc-hetmet.git] / compiler / typecheck / Inst.lhs

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 13b8be8..66e72e4 100644 (file)
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -42,7 +42,8 @@ module Inst (
        isTyVarDict, isMethodFor, 
 
        zonkInst, zonkInsts,
-       instToId, instToVar, instType, instName,
+       instToId, instToVar, instType, instName, instToDictBind,
+       addInstToDictBind,
 
        InstOrigin(..), InstLoc, pprInstLoc,
 
@@ -91,12 +92,15 @@ import PrelNames
 import BasicTypes
 import SrcLoc
 import DynFlags
+import Bag
 import Maybes
 import Util
 import Outputable
 import Data.List
 import TypeRep
 import Class
+
+import Control.Monad ( liftM )
 \end{code}
 
 
@@ -205,6 +209,15 @@ tyVarsOfInst (EqInst {tci_left = ty1, tci_right = ty2}) = tyVarsOfType ty1 `unio
 
 tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
 tyVarsOfLIE   lie   = tyVarsOfInsts (lieToList lie)
+
+
+--------------------------
+instToDictBind :: Inst -> LHsExpr TcId -> TcDictBinds
+instToDictBind inst rhs 
+  = unitBag (L (instSpan inst) (VarBind (instToId inst) rhs))
+
+addInstToDictBind :: TcDictBinds -> Inst -> LHsExpr TcId -> TcDictBinds
+addInstToDictBind binds inst rhs = binds `unionBags` instToDictBind inst rhs
 \end{code}
 
 Predicates
@@ -544,11 +557,11 @@ zonkInst implic@(ImplicInst {})
 
 zonkInst eqinst@(EqInst {tci_left = ty1, tci_right = ty2})
   = do { co' <- eitherEqInst eqinst 
-                       (\covar -> return (mkWantedCo covar)) 
-                       (\co    -> zonkTcType co >>= \coercion -> return (mkGivenCo coercion))
+                 (\covar -> return (mkWantedCo covar)) 
+                 (\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 insts = mappM zonkInst insts
@@ -765,7 +778,7 @@ lookupSimpleInst (Method {tci_oid = id, tci_tys = tys, tci_theta = theta, tci_lo
 -- [Same shortcut as in newOverloadedLit, but we
 --  may have done some unification by now]             
 
-lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name _, tci_ty = ty, tci_loc = loc})
   | Just expr <- shortCutIntLit i ty
   = returnM (GenInst [] (noLoc expr))
   | otherwise
@@ -777,7 +790,7 @@ lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name, tci_ty = ty
                     (mkHsApp (L (instLocSpan loc)
                                 (HsVar (instToId method_inst))) integer_lit))
 
-lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name _, tci_ty = ty, tci_loc = loc})
   | Just expr <- shortCutFracLit f ty
   = returnM (GenInst [] (noLoc expr))
 
@@ -789,7 +802,7 @@ lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name, tci_ty = ty,
     returnM (GenInst [method_inst] (mkHsApp (L (instLocSpan loc) 
                                               (HsVar (instToId method_inst))) rat_lit))
 
-lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name, tci_ty = ty, tci_loc = loc})
+lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name _, tci_ty = ty, tci_loc = loc})
   | Just expr <- shortCutStringLit s ty
   = returnM (GenInst [] (noLoc expr))
   | otherwise
@@ -1005,7 +1018,7 @@ mkEqInst (EqPred ty1 ty2) co
 
 mkWantedEqInst :: PredType -> TcM Inst
 mkWantedEqInst pred@(EqPred ty1 ty2)
-  = do { cotv <- newMetaTyVar TauTv (mkCoKind ty1 ty2)
+  = do { cotv <- newMetaCoVar ty1 ty2
        ; mkEqInst pred (Left cotv)
        }