X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSMonad.lhs;h=0992fb971e6d8e6d49be73ca66afce68cb1462fe;hp=8a63e86d0f6a300575776d608c40aad6cf9cde11;hb=febf1ced754a3996ac1a5877dcded87828560d1c;hpb=9591547fbbdf12728884e125f8ba08b0e6e69f82

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 8a63e86..0992fb9 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -86,6 +86,7 @@ import qualified TcRnMonad as TcM
 import qualified TcMType as TcM
 import qualified TcEnv as TcM 
        ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
+import Kind
 import TcType
 import DynFlags
 
@@ -101,6 +102,7 @@ import Outputable
 import Bag
 import MonadUtils
 import VarSet
+import Pair
 import FastString
 
 import HsBinds               -- for TcEvBinds stuff 
@@ -213,9 +215,9 @@ instance Outputable CanonicalCt where
   ppr (CIPCan ip fl ip_nm ty)     
       = ppr fl <+> ppr ip <+> dcolon <+> parens (ppr ip_nm <> dcolon <> ppr ty)
   ppr (CTyEqCan co fl tv ty)      
-      = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (mkTyVarTy tv, ty)
+      = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (Pair (mkTyVarTy tv) ty)
   ppr (CFunEqCan co fl tc tys ty) 
-      = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (mkTyConApp tc tys, ty)
+      = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (Pair (mkTyConApp tc tys) ty)
   ppr (CFrozenErr co fl)
       = ppr fl <+> pprEvVarWithType co
 \end{code}
@@ -447,12 +449,12 @@ emptyFlatCache
 newtype FunEqHead = FunEqHead (TyCon,[Xi])
 
 instance Eq FunEqHead where
-  FunEqHead (tc1,xis1) == FunEqHead (tc2,xis2) = tc1 == tc2 && tcEqTypes xis1 xis2
+  FunEqHead (tc1,xis1) == FunEqHead (tc2,xis2) = tc1 == tc2 && eqTypes xis1 xis2
 
 instance Ord FunEqHead where
   FunEqHead (tc1,xis1) `compare` FunEqHead (tc2,xis2) 
     = case compare tc1 tc2 of 
-        EQ    -> tcCmpTypes xis1 xis2
+        EQ    -> cmpTypes xis1 xis2
         other -> other
 
 type TcsUntouchables = (Untouchables,TcTyVarSet)
@@ -595,7 +597,9 @@ nestImplicTcS ref (inner_range, inner_tcs) (TcS thing_inside)
 		   -- outer ones!
 
        ; orig_flat_cache <- TcM.readTcRef orig_flat_cache_var
-       ; flat_cache_var  <- TcM.newTcRef orig_flat_cache -- emptyFlatCache
+       ; flat_cache_var  <- TcM.newTcRef orig_flat_cache
+       -- One could be more conservative as well: 
+       -- ; flat_cache_var  <- TcM.newTcRef emptyFlatCache 
 
                             -- Consider copying the results the tcs_flat_map of the 
                             -- incomping constraint, but we must make sure that we
@@ -767,7 +771,7 @@ checkWellStagedDFun pred dfun_id loc
     bind_lvl = TcM.topIdLvl dfun_id
 
 pprEq :: TcType -> TcType -> SDoc
-pprEq ty1 ty2 = pprPred $ mkEqPred (ty1,ty2)
+pprEq ty1 ty2 = pprPredTy $ mkEqPred (ty1,ty2)
 
 isTouchableMetaTyVar :: TcTyVar -> TcS Bool
 isTouchableMetaTyVar tv