Merge branch 'no-pred-ty'

Conflicts:
	compiler/iface/BuildTyCl.lhs
	compiler/iface/MkIface.lhs
	compiler/iface/TcIface.lhs
	compiler/typecheck/TcTyClsDecls.lhs
	compiler/types/Class.lhs
	compiler/utils/Util.lhs

7 files changed, 235 insertions, 258 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index c9c9918cdc..55ab378ea1 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -651,23 +651,16 @@ instance Binary HsBang where
 	      2 -> do return HsUnpack
 	      _ -> do return HsUnpackFailed
 
-instance Binary Boxity where
-    put_ bh Boxed   = putByte bh 0
-    put_ bh Unboxed = putByte bh 1
+instance Binary TupleSort where
+    put_ bh BoxedTuple      = putByte bh 0
+    put_ bh UnboxedTuple    = putByte bh 1
+    put_ bh ConstraintTuple = putByte bh 2
     get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return Boxed
-	      _ -> do return Unboxed
-
-instance Binary TupCon where
-    put_ bh (TupCon ab ac) = do
-	    put_ bh ab
-	    put_ bh ac
-    get bh = do
-	  ab <- get bh
-	  ac <- get bh
-	  return (TupCon ab ac)
+      h <- getByte bh
+      case h of
+        0 -> do return BoxedTuple
+        1 -> do return UnboxedTuple
+        _ -> do return ConstraintTuple
 
 instance Binary RecFlag where
     put_ bh Recursive = do
@@ -896,24 +889,22 @@ instance Binary IfaceType where
 	    putByte bh 3
 	    put_ bh ag
 	    put_ bh ah
-    put_ bh (IfacePredTy aq) = do
-	    putByte bh 5
-	    put_ bh aq
-
+    
 	-- Simple compression for common cases of TyConApp
     put_ bh (IfaceTyConApp IfaceIntTc  [])   = putByte bh 6
     put_ bh (IfaceTyConApp IfaceCharTc [])   = putByte bh 7
     put_ bh (IfaceTyConApp IfaceBoolTc [])   = putByte bh 8
     put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
 	-- Unit tuple and pairs
-    put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) 	 = putByte bh 10
-    put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
+    put_ bh (IfaceTyConApp (IfaceTupTc BoxedTuple 0) []) 	 = putByte bh 10
+    put_ bh (IfaceTyConApp (IfaceTupTc BoxedTuple 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
         -- Kind cases
     put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc [])   = putByte bh 12
     put_ bh (IfaceTyConApp IfaceOpenTypeKindTc [])     = putByte bh 13
     put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
     put_ bh (IfaceTyConApp IfaceUbxTupleKindTc [])     = putByte bh 15
     put_ bh (IfaceTyConApp IfaceArgTypeKindTc [])      = putByte bh 16
+    put_ bh (IfaceTyConApp IfaceConstraintKindTc [])   = putByte bh 21
     put_ bh (IfaceTyConApp (IfaceAnyTc k) []) 	       = do { putByte bh 17; put_ bh k }
 
 	-- Generic cases
@@ -936,21 +927,20 @@ instance Binary IfaceType where
 	      3 -> do ag <- get bh
 		      ah <- get bh
 		      return (IfaceFunTy ag ah)
-	      5 -> do ap <- get bh
-		      return (IfacePredTy ap)
-
+	      
 		-- Now the special cases for TyConApp
 	      6 -> return (IfaceTyConApp IfaceIntTc [])
 	      7 -> return (IfaceTyConApp IfaceCharTc [])
 	      8 -> return (IfaceTyConApp IfaceBoolTc [])
 	      9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
-	      10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
-	      11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
+	      10 -> return (IfaceTyConApp (IfaceTupTc BoxedTuple 0) [])
+	      11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc BoxedTuple 2) [t1,t2]) }
               12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
               13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
               14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
               15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
               16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
+              21 -> return (IfaceTyConApp IfaceConstraintKindTc [])
               17 -> do { k <- get bh; return (IfaceTyConApp (IfaceAnyTc k) []) }
 
 	      18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
@@ -969,9 +959,11 @@ instance Binary IfaceTyCon where
    put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
    put_ bh IfaceUbxTupleKindTc     = putByte bh 9
    put_ bh IfaceArgTypeKindTc      = putByte bh 10
+   put_ bh IfaceConstraintKindTc   = putByte bh 15
    put_ bh (IfaceTupTc bx ar)  = do { putByte bh 11; put_ bh bx; put_ bh ar }
    put_ bh (IfaceTc ext)       = do { putByte bh 12; put_ bh ext }
-   put_ bh (IfaceAnyTc k)      = do { putByte bh 13; put_ bh k }
+   put_ bh (IfaceIPTc n)       = do { putByte bh 13; put_ bh n }
+   put_ bh (IfaceAnyTc k)      = do { putByte bh 14; put_ bh k }
 
    get bh = do
 	h <- getByte bh
@@ -986,9 +978,11 @@ instance Binary IfaceTyCon where
           8 -> return IfaceUnliftedTypeKindTc
           9 -> return IfaceUbxTupleKindTc
           10 -> return IfaceArgTypeKindTc
+          15 -> return IfaceConstraintKindTc
 	  11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
 	  12 -> do { ext <- get bh; return (IfaceTc ext) }
-	  _ -> do { k <- get bh; return (IfaceAnyTc k) }
+	  13 -> do { n <- get bh; return (IfaceIPTc n) }
+          _  -> do { k <- get bh; return (IfaceAnyTc k) }
 
 instance Binary IfaceCoCon where
    put_ bh (IfaceCoAx n)       = do { putByte bh 0; put_ bh n }
@@ -998,6 +992,7 @@ instance Binary IfaceCoCon where
    put_ bh IfaceTransCo        = putByte bh 4
    put_ bh IfaceInstCo         = putByte bh 5
    put_ bh (IfaceNthCo d)      = do { putByte bh 6; put_ bh d }
+   put_ bh (IfaceIPCoAx ip)    = do { putByte bh 7; put_ bh ip }
   
    get bh = do
 	h <- getByte bh
@@ -1008,34 +1003,8 @@ instance Binary IfaceCoCon where
 	  3 -> return IfaceSymCo
 	  4 -> return IfaceTransCo
 	  5 -> return IfaceInstCo
-          _ -> do { d <- get bh; return (IfaceNthCo d) }
-
-instance Binary IfacePredType where
-    put_ bh (IfaceClassP aa ab) = do
-	    putByte bh 0
-	    put_ bh aa
-	    put_ bh ab
-    put_ bh (IfaceIParam ac ad) = do
-	    putByte bh 1
-	    put_ bh ac
-	    put_ bh ad
-    put_ bh (IfaceEqPred ac ad) = do
-	    putByte bh 2
-	    put_ bh ac
-	    put_ bh ad
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      ab <- get bh
-		      return (IfaceClassP aa ab)
-	      1 -> do ac <- get bh
-		      ad <- get bh
-		      return (IfaceIParam ac ad)
-	      2 -> do ac <- get bh
-		      ad <- get bh
-		      return (IfaceEqPred ac ad)
-	      _ -> panic ("get IfacePredType " ++ show h)
+          6 -> do { d <- get bh; return (IfaceNthCo d) }
+          _ -> do { ip <- get bh; return (IfaceIPCoAx ip) }
 
 -------------------------------------------------------------------------
 --		IfaceExpr and friends
@@ -1094,6 +1063,10 @@ instance Binary IfaceExpr where
             putByte bh 13
             put_ bh m
             put_ bh ix
+    put_ bh (IfaceTupId aa ab) = do
+      putByte bh 14
+      put_ bh aa
+      put_ bh ab
     get bh = do
 	    h <- getByte bh
 	    case h of
@@ -1135,6 +1108,9 @@ instance Binary IfaceExpr where
               13 -> do m <- get bh
                        ix <- get bh
                        return (IfaceTick m ix)
+              14 -> do aa <- get bh
+                       ab <- get bh
+                       return (IfaceTupId aa ab)
               _ -> panic ("get IfaceExpr " ++ show h)
 
 instance Binary IfaceConAlt where
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 98fb19eb82..7010652989 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -8,8 +8,8 @@ module BuildTyCl (
 	buildSynTyCon, 
         buildAlgTyCon, 
         buildDataCon,
-	TcMethInfo, buildClass,
-	distinctAbstractTyConRhs, totallyAbstractTyConRhs, 
+        TcMethInfo, buildClass,
+	distinctAbstractTyConRhs, totallyAbstractTyConRhs,
 	mkNewTyConRhs, mkDataTyConRhs, 
         newImplicitBinder
     ) where
@@ -216,7 +216,7 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
 
     arg_tyvars      = tyVarsOfTypes arg_tys
     in_arg_tys pred = not $ isEmptyVarSet $ 
-		      tyVarsOfPred pred `intersectVarSet` arg_tyvars
+		      tyVarsOfType pred `intersectVarSet` arg_tyvars
 \end{code}
 
 
@@ -236,10 +236,9 @@ buildClass :: Bool		-- True <=> do not include unfoldings
 	   -> RecFlag			   -- Info for type constructor
 	   -> TcRnIf m n Class
 
-buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
+buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
   = do	{ traceIf (text "buildClass")
-	; tycon_name <- newImplicitBinder class_name mkClassTyConOcc
-	; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
+	; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc
 		-- The class name is the 'parent' for this datacon, not its tycon,
 		-- because one should import the class to get the binding for 
 		-- the datacon
@@ -250,7 +249,7 @@ buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
 	  		-- Build the selector id and default method id
 
 	      -- Make selectors for the superclasses 
-	; sc_sel_names <- mapM  (newImplicitBinder class_name . mkSuperDictSelOcc) 
+	; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc) 
 				[1..length sc_theta]
         ; let sc_sel_ids = [ mkDictSelId no_unf sc_name rec_clas 
                            | sc_name <- sc_sel_names]
@@ -262,13 +261,12 @@ buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
 	      -- (We used to call them D_C, but now we can have two different
 	      --  superclasses both called C!)
 	
-	; let use_newtype = isSingleton arg_tys && not (any isEqPred sc_theta)
+	; let use_newtype = isSingleton arg_tys
 		-- Use a newtype if the data constructor 
 		--   (a) has exactly one value field
 		--       i.e. exactly one operation or superclass taken together
-                --   (b) it's of lifted type 
-		-- (NB: for (b) don't look at the classes in sc_theta, because
-		--      they are part of the knot!  Hence isEqPred.)
+                --   (b) that value is of lifted type (which they always are, because
+                --       we box equality superclasses)
 		-- See note [Class newtypes and equality predicates]
 
 		-- We treat the dictionary superclasses as ordinary arguments.  
@@ -278,7 +276,7 @@ buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
 	      args      = sc_sel_names ++ op_names
 	      op_tys	= [ty | (_,_,ty) <- sig_stuff]
 	      op_names  = [op | (op,_,_) <- sig_stuff]
-	      arg_tys   = map mkPredTy sc_theta ++ op_tys
+	      arg_tys   = sc_theta ++ op_tys
               rec_tycon = classTyCon rec_clas
                
 	; dict_con <- buildDataCon datacon_name
@@ -296,7 +294,7 @@ buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
 		 then mkNewTyConRhs tycon_name rec_tycon dict_con
 		 else return (mkDataTyConRhs [dict_con])
 
-	; let {	clas_kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
+	; let {	clas_kind = mkArrowKinds (map tyVarKind tvs) constraintKind
 
  	      ; tycon = mkClassTyCon tycon_name clas_kind tvs
  	                             rhs rec_clas tc_isrec
@@ -309,7 +307,7 @@ buildClass no_unf class_name tvs sc_theta fds at_items sig_stuff tc_isrec
 		-- newtype like a synonym, but that will lead to an infinite
 		-- type]
 
-	      ; result = mkClass class_name tvs fds 
+	      ; result = mkClass tvs fds 
 			         sc_theta sc_sel_ids at_items
 				 op_items tycon
 	      }
@@ -343,4 +341,3 @@ Moreover,
 Here we can't use a newtype either, even though there is only
 one field, because equality predicates are unboxed, and classes
 are boxed.
-
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index cf8a57ca75..0b28525148 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -2,10 +2,10 @@
 
 \begin{code}
 module IfaceEnv (
-	newGlobalBinder, newIPName, newImplicitBinder, 
+	newGlobalBinder, newImplicitBinder, 
 	lookupIfaceTop,
 	lookupOrig, lookupOrigNameCache, extendNameCache,
-	newIfaceName, newIfaceNames,
+	newIPName, newIfaceName, newIfaceNames,
 	extendIfaceIdEnv, extendIfaceTyVarEnv, 
 	tcIfaceLclId, tcIfaceTyVar, lookupIfaceTyVar,
 	tcIfaceTick,
@@ -23,6 +23,7 @@ import TcRnMonad
 import TysWiredIn
 import HscTypes
 import TyCon
+import Type
 import DataCon
 import Var
 import Name
@@ -31,9 +32,9 @@ import Module
 import UniqFM
 import FastString
 import UniqSupply
-import BasicTypes
 import SrcLoc
 import MkId
+import BasicTypes
 
 import Outputable
 import Exception     ( evaluate )
@@ -148,21 +149,19 @@ lookupOrig mod occ
                   in (name_cache{ nsUniqs = us, nsNames = new_cache }, name)
     }}}
 
-newIPName :: IPName OccName -> TcRnIf m n (IPName Name)
-newIPName occ_name_ip =
+newIPName :: FastString -> TcRnIf m n (IPName Name)
+newIPName ip =
   updNameCache $ \name_cache ->
-    let
-	ipcache = nsIPs name_cache
-        key = occ_name_ip  -- Ensures that ?x and %x get distinct Names
-    in
-    case Map.lookup key ipcache of
-      Just name_ip -> (name_cache, name_ip)
-      Nothing      -> (new_ns, name_ip)
-	  where
-	    (uniq, us') = takeUniqFromSupply (nsUniqs name_cache)
-	    name_ip     = mapIPName (mkIPName uniq) occ_name_ip
-	    new_ipcache = Map.insert key name_ip ipcache
-	    new_ns      = name_cache {nsUniqs = us', nsIPs = new_ipcache}
+    let ipcache = nsIPs name_cache
+    in case Map.lookup ip ipcache of
+         Just name_ip -> (name_cache, name_ip)
+         Nothing      -> (new_ns, name_ip)
+            where
+              (us_here, us') = splitUniqSupply (nsUniqs name_cache)
+              tycon_u:datacon_u:dc_wrk_u:co_ax_u:_ = uniqsFromSupply us_here
+              name_ip     = mkIPName ip tycon_u datacon_u dc_wrk_u co_ax_u
+              new_ipcache = Map.insert ip name_ip ipcache
+              new_ns      = name_cache {nsUniqs = us', nsIPs = new_ipcache}
 \end{code}
 
 %************************************************************************
@@ -174,16 +173,18 @@ newIPName occ_name_ip =
 \begin{code}
 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
 lookupOrigNameCache _ mod occ
+  -- Don't need to mention gHC_UNIT here because it is explicitly
+  -- included in TysWiredIn.wiredInTyCons
   | mod == gHC_TUPLE || mod == gHC_PRIM,		-- Boxed tuples from one, 
     Just tup_info <- isTupleOcc_maybe occ	-- unboxed from the other
   = 	-- Special case for tuples; there are too many
 	-- of them to pre-populate the original-name cache
     Just (mk_tup_name tup_info)
   where
-    mk_tup_name (ns, boxity, arity)
-	| ns == tcName   = tyConName (tupleTyCon boxity arity)
-	| ns == dataName = dataConName (tupleCon boxity arity)
-	| otherwise      = Var.varName (dataConWorkId (tupleCon boxity arity))
+    mk_tup_name (ns, sort, arity)
+	| ns == tcName   = tyConName (tupleTyCon sort arity)
+	| ns == dataName = dataConName (tupleCon sort arity)
+	| otherwise      = Var.varName (dataConWorkId (tupleCon sort arity))
 
 lookupOrigNameCache nc mod occ	-- The normal case
   = case lookupModuleEnv nc mod of
@@ -231,7 +232,7 @@ initNameCache :: UniqSupply -> [Name] -> NameCache
 initNameCache us names
   = NameCache { nsUniqs = us,
 		nsNames = initOrigNames names,
-		nsIPs   = Map.empty }
+                nsIPs   = Map.empty }
 
 initOrigNames :: [Name] -> OrigNameCache
 initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 9e48480766..6374ac1cd9 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -41,6 +41,7 @@ import BasicTypes
 import Outputable
 import FastString
 import Module
+import TysWiredIn ( eqTyConName )
 
 infixl 3 &&&
 \end{code}
@@ -85,7 +86,7 @@ data IfaceDecl
     }
 
   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
-                 ifName    :: OccName,          -- Name of the class
+                 ifName    :: OccName,          -- Name of the class TyCon
                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
                  ifFDs     :: [FunDep FastString], -- Functional dependencies
                  ifATs     :: [IfaceAT],      -- Associated type families
@@ -235,9 +236,10 @@ data IfaceUnfolding
 data IfaceExpr
   = IfaceLcl    IfLclName
   | IfaceExt    IfExtName
+  | IfaceTupId  TupleSort Arity
   | IfaceType   IfaceType
   | IfaceCo     IfaceType		-- We re-use IfaceType for coercions
-  | IfaceTuple 	Boxity [IfaceExpr]	-- Saturated; type arguments omitted
+  | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
   | IfaceLam 	IfaceBndr IfaceExpr
   | IfaceApp 	IfaceExpr IfaceExpr
   | IfaceCase	IfaceExpr IfLclName [IfaceAlt]
@@ -258,7 +260,7 @@ type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
 
 data IfaceConAlt = IfaceDefault
                  | IfaceDataAlt IfExtName
-                 | IfaceTupleAlt Boxity
+                 | IfaceTupleAlt TupleSort
                  | IfaceLitAlt Literal
 
 data IfaceBinding
@@ -382,12 +384,9 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
           has_wrapper = ifConWrapper con_decl     -- This is the reason for
                                                   -- having the ifConWrapper field!
 
-ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
+ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
                                ifSigs = sigs, ifATs = ats })
-  = -- dictionary datatype:
-    --   type constructor
-    tc_occ :
-    --   (possibly) newtype coercion
+  = --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)
     --    data worker (Id namespace)
@@ -396,17 +395,16 @@ ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
     -- associated types
     [ifName at | IfaceAT at _ <- ats ] ++
     -- superclass selectors
-    [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
+    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
     -- operation selectors
     [op | IfaceClassOp op  _ _ <- sigs]
   where
     n_ctxt = length sc_ctxt
     n_sigs = length sigs
-    tc_occ  = mkClassTyConOcc cls_occ
-    dc_occ  = mkClassDataConOcc cls_occ
-    co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
+    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
             | otherwise  = []
     dcww_occ = mkDataConWorkerOcc dc_occ
+    dc_occ = mkClassDataConOcc cls_tc_occ
     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 
 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
@@ -495,6 +493,9 @@ pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
                                                             (map (pprIfaceConDecl tc) cs))
 
+mkIfaceEqPred :: IfaceType -> IfaceType -> IfacePredType
+mkIfaceEqPred ty1 ty2 = IfaceTyConApp (IfaceTc eqTyConName) [ty1, ty2]
+
 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc
         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
@@ -515,7 +516,7 @@ pprIfaceConDecl tc
     main_payload = ppr name <+> dcolon <+>
                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
-    eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
+    eq_ctxt = [(mkIfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
               | (tv,ty) <- eq_spec]
 
         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
@@ -572,6 +573,7 @@ pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 
 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 pprIfaceExpr _       (IfaceExt v)       = ppr v
+pprIfaceExpr _       (IfaceTupId c n)   = tupleParens c (hcat (replicate (n - 1) (char ',')))
 pprIfaceExpr _       (IfaceLit l)       = ppr l
 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
@@ -737,7 +739,7 @@ freeNamesIfTcFam Nothing =
   emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
-freeNamesIfContext = fnList freeNamesIfPredType
+freeNamesIfContext = fnList freeNamesIfType
 
 freeNamesIfAT :: IfaceAT -> NameSet
 freeNamesIfAT (IfaceAT decl defs)
@@ -765,18 +767,9 @@ freeNamesIfConDecl c =
   fnList freeNamesIfType (ifConArgTys c) &&&
   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 
-freeNamesIfPredType :: IfacePredType -> NameSet
-freeNamesIfPredType (IfaceClassP cl tys) =
-   unitNameSet cl &&& fnList freeNamesIfType tys
-freeNamesIfPredType (IfaceIParam _n ty) =
-   freeNamesIfType ty
-freeNamesIfPredType (IfaceEqPred ty1 ty2) =
-   freeNamesIfType ty1 &&& freeNamesIfType ty2
-
 freeNamesIfType :: IfaceType -> NameSet
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
-freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 freeNamesIfType (IfaceTyConApp tc ts) =
    freeNamesIfTc tc &&& fnList freeNamesIfType ts
 freeNamesIfType (IfaceForAllTy tv t)  =
@@ -824,6 +817,7 @@ freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
+freeNamesIfExpr (IfaceTupId _ _)  = emptyNameSet
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 freeNamesIfExpr (IfaceCo co)      = freeNamesIfType co
@@ -863,6 +857,7 @@ freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfCo :: IfaceCoCon -> NameSet
 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
+-- ToDo: include IfaceIPCoAx? Probably not necessary.
 freeNamesIfCo _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 89cc755876..b9fcb8f27d 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -7,9 +7,9 @@ This module defines interface types and binders
 
 \begin{code}
 module IfaceType (
-	IfExtName, IfLclName,
+	IfExtName, IfLclName, IfIPName,
 
-        IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceCoCon(..),
+        IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoCon(..),
 	IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
 	ifaceTyConName,
 
@@ -22,7 +22,7 @@ module IfaceType (
         coToIfaceType,
 
 	-- Printing
-	pprIfaceType, pprParendIfaceType, pprIfaceContext, 
+	pprIfaceType, pprParendIfaceType, pprIfaceContext,
 	pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
 	tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
 
@@ -30,6 +30,8 @@ module IfaceType (
 
 import Coercion
 import TypeRep hiding( maybeParen )
+import Type (tyConAppTyCon_maybe)
+import IParam (ipFastString)
 import TyCon
 import Id
 import Var
@@ -53,6 +55,8 @@ type IfLclName = FastString	-- A local name in iface syntax
 type IfExtName = Name	-- An External or WiredIn Name can appear in IfaceSyn
      	       	 	-- (However Internal or System Names never should)
 
+type IfIPName = FastString -- Represent implicit parameters simply as a string
+
 data IfaceBndr 		-- Local (non-top-level) binders
   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
@@ -69,16 +73,11 @@ data IfaceType	   -- A kind of universal type, used for types, kinds, and coerci
   | IfaceAppTy    IfaceType IfaceType
   | IfaceFunTy    IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
-  | IfacePredTy   IfacePredType
   | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
 					  -- Includes newtypes, synonyms, tuples
   | IfaceCoConApp IfaceCoCon [IfaceType]  -- Always saturated
 
-data IfacePredType 	-- NewTypes are handled as ordinary TyConApps
-  = IfaceClassP IfExtName [IfaceType]
-  | IfaceIParam (IPName OccName) IfaceType
-  | IfaceEqPred IfaceType IfaceType
-
+type IfacePredType = IfaceType
 type IfaceContext = [IfacePredType]
 
 data IfaceTyCon 	-- Encodes type consructors, kind constructors
@@ -86,17 +85,19 @@ data IfaceTyCon 	-- Encodes type consructors, kind constructors
   = IfaceTc IfExtName	-- The common case
   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
   | IfaceListTc | IfacePArrTc
-  | IfaceTupTc Boxity Arity 
+  | IfaceTupTc TupleSort Arity 
+  | IfaceIPTc IfIPName       -- Used for implicit parameter TyCons
   | IfaceAnyTc IfaceKind     -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
     	       		     -- other than 'Any :: *' itself
- 
+  
   -- Kind constructors
   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
-  | IfaceUbxTupleKindTc | IfaceArgTypeKindTc 
+  | IfaceUbxTupleKindTc | IfaceArgTypeKindTc | IfaceConstraintKindTc
 
   -- Coercion constructors
 data IfaceCoCon
   = IfaceCoAx IfExtName
+  | IfaceIPCoAx FastString
   | IfaceReflCo    | IfaceUnsafeCo  | IfaceSymCo
   | IfaceTransCo   | IfaceInstCo
   | IfaceNthCo Int
@@ -113,9 +114,12 @@ ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
+ifaceTyConName IfaceConstraintKindTc   = constraintKindTyConName
 ifaceTyConName (IfaceTc ext)           = ext
-ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName" (ppr k)
+ifaceTyConName (IfaceIPTc n)           = pprPanic "ifaceTyConName:IPTc" (ppr n)
+ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName:AnyTc" (ppr k)
 	       		    	       	 -- Note [The Name of an IfaceAnyTc]
+                                         -- The same caveat applies to IfaceIPTc
 \end{code}
 
 Note [The Name of an IfaceAnyTc]
@@ -137,20 +141,20 @@ than solve this potential problem now, I'm going to defer it until it happens!
 
 
 \begin{code}
-splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
+splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], [IfacePredType], IfaceType)
 -- Mainly for printing purposes
 splitIfaceSigmaTy ty
-  = (tvs,theta,tau)
+  = (tvs, theta, tau)
   where
-    (tvs, rho)   = split_foralls ty
-    (theta, tau) = split_rho rho
+    (tvs,   rho)   = split_foralls ty
+    (theta, tau)   = split_rho rho
 
     split_foralls (IfaceForAllTy tv ty) 
 	= case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
     split_foralls rho = ([], rho)
 
-    split_rho (IfaceFunTy (IfacePredTy st) ty) 
-	= case split_rho ty of { (sts, tau) -> (st:sts, tau) }
+    split_rho (IfaceFunTy ty1 ty2)
+      | isIfacePredTy ty1 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
 \end{code}
 
@@ -218,11 +222,14 @@ pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
 pprIfaceType       = ppr_ty tOP_PREC
 pprParendIfaceType = ppr_ty tYCON_PREC
 
+isIfacePredTy :: IfaceType -> Bool
+isIfacePredTy _  = False
+-- FIXME: fix this to print iface pred tys correctly
+-- isIfacePredTy ty = ifaceTypeKind ty `eqKind` constraintKind
 
 ppr_ty :: Int -> IfaceType -> SDoc
 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
-ppr_ty _         (IfacePredTy st)       = ppr st
 
 ppr_ty ctxt_prec (IfaceCoConApp tc tys) 
   = maybeParen ctxt_prec tYCON_PREC 
@@ -234,10 +241,13 @@ ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
     maybeParen ctxt_prec fUN_PREC $
     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
   where
+    arr | isIfacePredTy ty1 = darrow
+        | otherwise         = arrow
+
     ppr_fun_tail (IfaceFunTy ty1 ty2) 
-      = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
+      = (arr <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty
-      = [arrow <+> pprIfaceType other_ty]
+      = [arr <+> pprIfaceType other_ty]
 
 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
   = maybeParen ctxt_prec tYCON_PREC $
@@ -247,14 +257,14 @@ ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
  where		
     (tvs, theta, tau) = splitIfaceSigmaTy ty
-    
--------------------
+     
+ -------------------
 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 pprIfaceForAllPart tvs ctxt doc 
   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
   where
     ppr_tvs | null tvs  = empty
-	    | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
+            | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 
 -------------------
 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
@@ -264,6 +274,7 @@ ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
 ppr_tc_app _         (IfaceTupTc bx arity) tys
   | arity == length tys 
   = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
+ppr_tc_app _         (IfaceIPTc n) [ty] = parens (ppr (IPName n) <> dcolon <> pprIfaceType ty)
 ppr_tc_app ctxt_prec tc tys 
   = maybeParen ctxt_prec tYCON_PREC 
 	       (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
@@ -274,39 +285,34 @@ ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
 ppr_tc tc		   = ppr tc
 
 -------------------
-instance Outputable IfacePredType where
-	-- Print without parens
-  ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
-  ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
-  ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
-			     <+> sep (map pprParendIfaceType ts)
-
 instance Outputable IfaceTyCon where
+  ppr (IfaceIPTc n)  = ppr (IPName n)
   ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
-      		       	     -- We can't easily get the Name of an IfaceAnyTc
+      		       	     -- We can't easily get the Name of an IfaceAnyTc/IfaceIPTc
 			     -- (see Note [The Name of an IfaceAnyTc])
 			     -- so we fake it.  It's only for debug printing!
   ppr other_tc       = ppr (ifaceTyConName other_tc)
 
 instance Outputable IfaceCoCon where
-  ppr (IfaceCoAx n)  = ppr n
-  ppr IfaceReflCo    = ptext (sLit "Refl")
-  ppr IfaceUnsafeCo  = ptext (sLit "Unsafe")
-  ppr IfaceSymCo     = ptext (sLit "Sym")
-  ppr IfaceTransCo   = ptext (sLit "Trans")
-  ppr IfaceInstCo    = ptext (sLit "Inst")
-  ppr (IfaceNthCo d) = ptext (sLit "Nth:") <> int d
+  ppr (IfaceCoAx n)    = ppr n
+  ppr (IfaceIPCoAx ip) = ppr (IPName ip)
+  ppr IfaceReflCo      = ptext (sLit "Refl")
+  ppr IfaceUnsafeCo    = ptext (sLit "Unsafe")
+  ppr IfaceSymCo       = ptext (sLit "Sym")
+  ppr IfaceTransCo     = ptext (sLit "Trans")
+  ppr IfaceInstCo      = ptext (sLit "Inst")
+  ppr (IfaceNthCo d)   = ptext (sLit "Nth:") <> int d
 
 -------------------
 pprIfaceContext :: IfaceContext -> SDoc
 -- Prints "(C a, D b) =>", including the arrow
-pprIfaceContext []     = empty
+pprIfaceContext []    = empty
 pprIfaceContext theta = ppr_preds theta <+> darrow
 
 ppr_preds :: [IfacePredType] -> SDoc
-ppr_preds [pred] = ppr pred	-- No parens
+ppr_preds [pred] = ppr pred    -- No parens
 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds))) 
-			 
+
 -------------------
 pabrackets :: SDoc -> SDoc
 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
@@ -343,7 +349,6 @@ toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
-toIfaceType (PredTy st)       = IfacePredTy (toIfacePred toIfaceType st)
 
 toIfaceTyVar :: TyVar -> FastString
 toIfaceTyVar = occNameFS . getOccName
@@ -361,9 +366,10 @@ toIfaceCoVar = occNameFS . getOccName
 
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc 
-  | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
-  | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
-  | otherwise	    = toIfaceTyCon_name (tyConName tc)
+  | isTupleTyCon tc            = IfaceTupTc (tupleTyConSort tc) (tyConArity tc)
+  | isAnyTyCon tc              = IfaceAnyTc (toIfaceKind (tyConKind tc))
+  | Just n <- tyConIP_maybe tc = IfaceIPTc (ipFastString n)
+  | otherwise	               = toIfaceTyCon_name (tyConName tc)
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
 toIfaceTyCon_name nm
@@ -374,8 +380,9 @@ toIfaceTyCon_name nm
 
 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 toIfaceWiredInTyCon tc nm
-  | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
+  | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConSort tc) (tyConArity tc)
   | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
+  | Just n <- tyConIP_maybe tc      = IfaceIPTc (ipFastString n)
   | nm == intTyConName              = IfaceIntTc
   | nm == boolTyConName             = IfaceBoolTc 
   | nm == charTyConName             = IfaceCharTc 
@@ -385,6 +392,7 @@ toIfaceWiredInTyCon tc nm
   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
+  | nm == constraintKindTyConName   = IfaceConstraintKindTc
   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
   | otherwise		            = IfaceTc nm
 
@@ -393,14 +401,8 @@ toIfaceTypes :: [Type] -> [IfaceType]
 toIfaceTypes ts = map toIfaceType ts
 
 ----------------
-toIfacePred :: (a -> IfaceType) -> Pred a -> IfacePredType
-toIfacePred to (ClassP cls ts)  = IfaceClassP (getName cls) (map to ts)
-toIfacePred to (IParam ip t)    = IfaceIParam (mapIPName getOccName ip) (to t)
-toIfacePred to (EqPred ty1 ty2) =  IfaceEqPred (to ty1) (to ty2)
-
-----------------
 toIfaceContext :: ThetaType -> IfaceContext
-toIfaceContext cs = map (toIfacePred toIfaceType) cs
+toIfaceContext = toIfaceTypes
 
 ----------------
 coToIfaceType :: Coercion -> IfaceType
@@ -412,7 +414,7 @@ coToIfaceType (AppCo co1 co2)       = IfaceAppTy    (coToIfaceType co1)
 coToIfaceType (ForAllCo v co)       = IfaceForAllTy (toIfaceTvBndr v) 
                                                     (coToIfaceType co)
 coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceCoVar cv)
-coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (IfaceCoAx (coAxiomName con))
+coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (coAxiomToIfaceType con)
                                                     (map coToIfaceType cos)
 coToIfaceType (UnsafeCo ty1 ty2)    = IfaceCoConApp IfaceUnsafeCo 
                                                     [ toIfaceType ty1
@@ -427,5 +429,13 @@ coToIfaceType (NthCo d co)          = IfaceCoConApp (IfaceNthCo d)
 coToIfaceType (InstCo co ty)        = IfaceCoConApp IfaceInstCo 
                                                     [ coToIfaceType co
                                                     , toIfaceType ty ]
+
+coAxiomToIfaceType :: CoAxiom -> IfaceCoCon
+coAxiomToIfaceType con
+  | Just tc <- tyConAppTyCon_maybe (co_ax_lhs con)
+  , Just ip <- tyConIP_maybe tc
+  = IfaceIPCoAx (ipFastString ip)
+  | otherwise
+  = IfaceCoAx (coAxiomName con)
 \end{code}
 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index b25d979970..c56e9854e0 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1326,46 +1326,10 @@ tyThingToIfaceDecl (AnId id)
 	      ifIdDetails = toIfaceIdDetails (idDetails id),
 	      ifIdInfo    = toIfaceIdInfo (idInfo id) }
 
-tyThingToIfaceDecl (AClass clas)
-  = IfaceClass { ifCtxt	  = toIfaceContext sc_theta,
-		 ifName	  = getOccName clas,
-		 ifTyVars = toIfaceTvBndrs clas_tyvars,
-		 ifFDs    = map toIfaceFD clas_fds,
-		 ifATs	  = map toIfaceAT clas_ats,
-		 ifSigs	  = map toIfaceClassOp op_stuff,
-	  	 ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
-  where
-    (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
-      = classExtraBigSig clas
-    tycon = classTyCon clas
-
-    toIfaceAT :: ClassATItem -> IfaceAT
-    toIfaceAT (tc, defs)
-      = IfaceAT (tyThingToIfaceDecl (ATyCon tc))
-                (map to_if_at_def defs)
-      where
-        to_if_at_def (ATD tvs pat_tys ty)
-          = IfaceATD (toIfaceTvBndrs tvs) (map toIfaceType pat_tys) (toIfaceType ty)
-
-    toIfaceClassOp (sel_id, def_meth)
-	= ASSERT(sel_tyvars == clas_tyvars)
-	  IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
-	where
-		-- Be careful when splitting the type, because of things
-		-- like  	class Foo a where
-		--		  op :: (?x :: String) => a -> a
-		-- and  	class Baz a where
-		--		  op :: (Ord a) => a -> a
-	  (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
-	  op_ty		       = funResultTy rho_ty
-
-    toDmSpec NoDefMeth      = NoDM
-    toDmSpec (GenDefMeth _) = GenericDM
-    toDmSpec (DefMeth _)    = VanillaDM
-
-    toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
-
 tyThingToIfaceDecl (ATyCon tycon)
+  | Just clas <- tyConClass_maybe tycon
+  = classToIfaceDecl clas
+
   | isSynTyCon tycon
   = IfaceSyn {	ifName    = getOccName tycon,
 		ifTyVars  = toIfaceTvBndrs tyvars,
@@ -1433,6 +1397,47 @@ tyThingToIfaceDecl (ADataCon dc)
  = pprPanic "toIfaceDecl" (ppr dc)	-- Should be trimmed out earlier
 
 
+classToIfaceDecl :: Class -> IfaceDecl
+classToIfaceDecl clas
+  = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
+                 ifName   = getOccName (classTyCon clas),
+                 ifTyVars = toIfaceTvBndrs clas_tyvars,
+                 ifFDs    = map toIfaceFD clas_fds,
+                 ifATs    = map toIfaceAT clas_ats,
+                 ifSigs   = map toIfaceClassOp op_stuff,
+                 ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
+  where
+    (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
+      = classExtraBigSig clas
+    tycon = classTyCon clas
+
+    toIfaceAT :: ClassATItem -> IfaceAT
+    toIfaceAT (tc, defs)
+      = IfaceAT (tyThingToIfaceDecl (ATyCon tc))
+                (map to_if_at_def defs)
+      where
+        to_if_at_def (ATD tvs pat_tys ty)
+          = IfaceATD (toIfaceTvBndrs tvs) (map toIfaceType pat_tys) (toIfaceType ty)
+
+    toIfaceClassOp (sel_id, def_meth)
+        = ASSERT(sel_tyvars == clas_tyvars)
+          IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
+        where
+                -- Be careful when splitting the type, because of things
+                -- like         class Foo a where
+                --                op :: (?x :: String) => a -> a
+                -- and          class Baz a where
+                --                op :: (Ord a) => a -> a
+          (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
+          op_ty                = funResultTy rho_ty
+
+    toDmSpec NoDefMeth      = NoDM
+    toDmSpec (GenDefMeth _) = GenericDM
+    toDmSpec (DefMeth _)    = VanillaDM
+
+    toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
+
+
 getFS :: NamedThing a => a -> FastString
 getFS x = occNameFS (getOccName x)
 
@@ -1642,8 +1647,10 @@ toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
 
 ---------------------
 toIfaceCon :: AltCon -> IfaceConAlt
-toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
-	   		| otherwise       = IfaceDataAlt (getName dc)
+toIfaceCon (DataAlt dc) | isTupleTyCon tc
+                        = IfaceTupleAlt (tupleTyConSort tc)
+                        | otherwise
+                        = IfaceDataAlt (getName dc)
 	   		where
 	   		  tc = dataConTyCon dc
 	   
@@ -1657,7 +1664,7 @@ toIfaceApp (Var v) as
   = case isDataConWorkId_maybe v of
 	-- We convert the *worker* for tuples into IfaceTuples
 	Just dc |  isTupleTyCon tc && saturated 
-		-> IfaceTuple (tupleTyConBoxity tc) tup_args
+		-> IfaceTuple (tupleTyConSort tc) tup_args
 	  where
 	    val_args  = dropWhile isTypeArg as
 	    saturated = val_args `lengthIs` idArity v
@@ -1673,13 +1680,15 @@ mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
 
 ---------------------
 toIfaceVar :: Id -> IfaceExpr
-toIfaceVar v 
-  | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
+toIfaceVar v = case isDataConWorkId_maybe v of
+    Just dc | isTupleTyCon tc -> IfaceTupId (tupleTyConSort tc) (tupleTyConArity tc)
+      where tc = dataConTyCon dc
+          -- Tuple workers also have special syntax, so we get their
+          -- Uniques right (they are wired-in but infinite)
+    _ | Just fcall <- isFCallId_maybe v            -> IfaceFCall fcall (toIfaceType (idType v))
 	  -- Foreign calls have special syntax
-  | isExternalName name		    = IfaceExt name
-  | Just (TickBox m ix) <- isTickBoxOp_maybe v
-				    = IfaceTick m ix
-  | otherwise			    = IfaceLcl (getFS name)
-  where
-    name = idName v
+      | isExternalName name		           -> IfaceExt name
+      | Just (TickBox m ix) <- isTickBoxOp_maybe v -> IfaceTick m ix
+      | otherwise			           -> IfaceLcl (getFS name)
+  where name = idName v
 \end{code}
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 9fbb59bd3e..bdf5838ff5 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -36,6 +36,7 @@ import Id
 import MkId
 import IdInfo
 import Class
+import IParam
 import TyCon
 import DataCon
 import TysWiredIn
@@ -467,21 +468,21 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
 		               ; return (SynonymTyCon rhs_ty) }
 
 tc_iface_decl _parent ignore_prags
-	    (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
-			 ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
+	    (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
+	    	 ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
 			 ifATs = rdr_ats, ifSigs = rdr_sigs, 
 			 ifRec = tc_isrec })
 -- ToDo: in hs-boot files we should really treat abstract classes specially,
 --	 as we do abstract tycons
   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-    { cls_name <- lookupIfaceTop occ_name
+    { tc_name <- lookupIfaceTop tc_occ
     ; ctxt <- tcIfaceCtxt rdr_ctxt
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
-              ; buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec }
-    ; return (AClass cls) }
+              ; buildClass ignore_prags tc_name tyvars ctxt fds ats sigs tc_isrec }
+    ; return (ATyCon (classTyCon cls)) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)
      = do { op_name <- lookupIfaceTop occ
@@ -823,24 +824,14 @@ tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceTy
 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
-tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePred tcIfaceType st; return (PredTy st') }
 tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
 
 tcIfaceTypes :: [IfaceType] -> IfL [Type]
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
-tcIfacePred :: (IfaceType -> IfL a) -> IfacePredType -> IfL (Pred a)
-tcIfacePred tc (IfaceClassP cls ts)
-  = do { cls' <- tcIfaceClass cls; ts' <- mapM tc ts; return (ClassP cls' ts') }
-tcIfacePred tc (IfaceIParam ip t)
-  = do { ip' <- newIPName ip; t' <- tc t; return (IParam ip' t') }
-tcIfacePred tc (IfaceEqPred t1 t2)
-  = do { t1' <- tc t1; t2' <- tc t2; return (EqPred t1' t2') }
-
------------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
-tcIfaceCtxt sts = mapM (tcIfacePred tcIfaceType) sts
+tcIfaceCtxt sts = mapM tcIfaceType sts
 \end{code}
 
 %************************************************************************
@@ -858,17 +849,16 @@ tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIf
 tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
 tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
                                   mkForAllCo tv' <$> tcIfaceCo t
--- tcIfaceCo (IfacePredTy co)      = mkPredCo <$> tcIfacePred tcIfaceCo co
-tcIfaceCo (IfacePredTy _)      = panic "tcIfaceCo"
 
 tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
-tcIfaceCoApp IfaceReflCo    [t]     = Refl         <$> tcIfaceType t
-tcIfaceCoApp (IfaceCoAx n)  ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
-tcIfaceCoApp IfaceUnsafeCo  [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
-tcIfaceCoApp IfaceSymCo     [t]     = SymCo        <$> tcIfaceCo t
-tcIfaceCoApp IfaceTransCo   [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
-tcIfaceCoApp IfaceInstCo    [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
-tcIfaceCoApp (IfaceNthCo d) [t]     = NthCo d      <$> tcIfaceCo t
+tcIfaceCoApp IfaceReflCo      [t]     = Refl         <$> tcIfaceType t
+tcIfaceCoApp (IfaceCoAx n)    ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
+tcIfaceCoApp (IfaceIPCoAx ip) ts      = AxiomInstCo  <$> liftM ipCoAxiom (newIPName ip) <*> mapM tcIfaceCo ts
+tcIfaceCoApp IfaceUnsafeCo    [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
+tcIfaceCoApp IfaceSymCo       [t]     = SymCo        <$> tcIfaceCo t
+tcIfaceCoApp IfaceTransCo     [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCoApp IfaceInstCo      [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
+tcIfaceCoApp (IfaceNthCo d)   [t]     = NthCo d      <$> tcIfaceCo t
 tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
 
 tcIfaceCoVar :: FastString -> IfL CoVar
@@ -902,6 +892,9 @@ tcIfaceExpr (IfaceTick modName tickNo)
 tcIfaceExpr (IfaceExt gbl)
   = Var <$> tcIfaceExtId gbl
 
+tcIfaceExpr (IfaceTupId boxity arity)
+  = return $ Var (dataConWorkId (tupleCon boxity arity))
+
 tcIfaceExpr (IfaceLit lit)
   = return (Lit lit)
 
@@ -999,9 +992,9 @@ tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
 	; when (debugIsOn && not (con `elem` tyConDataCons tycon))
 	       (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
 	; tcIfaceDataAlt con inst_tys arg_strs rhs }
-		  
+
 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
-  = ASSERT2( isTupleTyCon tycon, ppr tycon )
+  = ASSERT2( isTupleTyCon tycon && tupleTyConSort tycon == _boxity, ppr tycon )
     do	{ let [data_con] = tyConDataCons tycon
 	; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
@@ -1253,6 +1246,8 @@ tcIfaceTyCon IfaceCharTc      	= tcWiredInTyCon charTyCon
 tcIfaceTyCon IfaceListTc      	= tcWiredInTyCon listTyCon
 tcIfaceTyCon IfacePArrTc      	= tcWiredInTyCon parrTyCon
 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
+tcIfaceTyCon (IfaceIPTc n)      = do { n' <- newIPName n
+                                     ; tcWiredInTyCon (ipTyCon n') }
 tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
                                      ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
@@ -1269,6 +1264,7 @@ tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
 tcIfaceTyCon IfaceArgTypeKindTc      = return argTypeKindTyCon
 tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
+tcIfaceTyCon IfaceConstraintKindTc   = return constraintKindTyCon
 
 -- Even though we are in an interface file, we want to make
 -- sure the instances and RULES of this tycon are loaded 
@@ -1277,10 +1273,6 @@ tcWiredInTyCon :: TyCon -> IfL TyCon
 tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
 		       ; return tc }
 
-tcIfaceClass :: Name -> IfL Class
-tcIfaceClass name = do { thing <- tcIfaceGlobal name
-		       ; return (tyThingClass thing) }
-
 tcIfaceCoAxiom :: Name -> IfL CoAxiom
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
 		         ; return (tyThingCoAxiom thing) }
@@ -1347,10 +1339,7 @@ bindIfaceTyVars bndrs thing_inside
 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
 mk_iface_tyvar name ifKind
    = do { kind <- tcIfaceType ifKind
-	; if isCoercionKind kind then 
-		return (Var.mkCoVar name kind)
-	  else
-		return (Var.mkTyVar name kind) }
+	; return (Var.mkTyVar name kind) }
 
 bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 -- Used for type variable in nested associated data/type declarations