merged master into late-dmdlate-dmd

8 files changed, 1107 insertions, 1312 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 69e702bb20..c4c1bcd69e 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -2,7 +2,6 @@
 --  (c) The University of Glasgow 2002-2006
 --
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -24,21 +23,15 @@ import TyCon
 import DataCon    (dataConName, dataConWorkId, dataConTyCon)
 import PrelInfo   (wiredInThings, basicKnownKeyNames)
 import Id         (idName, isDataConWorkId_maybe)
-import CoreSyn    (DFunArg(..))
-import Coercion   (LeftOrRight(..))
 import TysWiredIn
 import IfaceEnv
 import HscTypes
 import BasicTypes
-import Annotations
-import IfaceSyn
 import Module
 import Name
-import Avail
 import DynFlags
 import UniqFM
 import UniqSupply
-import CostCentre
 import Panic
 import Binary
 import SrcLoc
@@ -414,153 +407,6 @@ data BinDictionary = BinDictionary {
                                 -- indexed by FastString
   }
 
--- -----------------------------------------------------------------------------
--- All the binary instances
-
--- BasicTypes
-{-! for Fixity derive: Binary !-}
-{-! for FixityDirection derive: Binary !-}
-{-! for Boxity derive: Binary !-}
-{-! for StrictnessMark derive: Binary !-}
-{-! for Activation derive: Binary !-}
-
--- Class
-{-! for DefMeth derive: Binary !-}
-
--- HsTypes
-{-! for HsPred derive: Binary !-}
-{-! for HsType derive: Binary !-}
-{-! for TupCon derive: Binary !-}
-{-! for HsTyVarBndr derive: Binary !-}
-
--- HsCore
-{-! for UfExpr derive: Binary !-}
-{-! for UfConAlt derive: Binary !-}
-{-! for UfBinding derive: Binary !-}
-{-! for UfBinder derive: Binary !-}
-{-! for HsIdInfo derive: Binary !-}
-{-! for UfNote derive: Binary !-}
-
--- HsDecls
-{-! for ConDetails derive: Binary !-}
-{-! for BangType derive: Binary !-}
-
--- CostCentre
-{-! for IsCafCC derive: Binary !-}
-{-! for CostCentre derive: Binary !-}
-
-
-
--- ---------------------------------------------------------------------------
--- Reading a binary interface into ParsedIface
-
-instance Binary ModIface where
-   put_ bh (ModIface {
-                 mi_module    = mod,
-                 mi_boot      = is_boot,
-                 mi_iface_hash= iface_hash,
-                 mi_mod_hash  = mod_hash,
-                 mi_flag_hash = flag_hash,
-                 mi_orphan    = orphan,
-                 mi_finsts    = hasFamInsts,
-                 mi_deps      = deps,
-                 mi_usages    = usages,
-                 mi_exports   = exports,
-                 mi_exp_hash  = exp_hash,
-                 mi_used_th   = used_th,
-                 mi_fixities  = fixities,
-                 mi_warns     = warns,
-                 mi_anns      = anns,
-                 mi_decls     = decls,
-                 mi_insts     = insts,
-                 mi_fam_insts = fam_insts,
-                 mi_rules     = rules,
-                 mi_orphan_hash = orphan_hash,
-                 mi_vect_info = vect_info,
-                 mi_hpc       = hpc_info,
-                 mi_trust     = trust,
-                 mi_trust_pkg = trust_pkg }) = do
-        put_ bh mod
-        put_ bh is_boot
-        put_ bh iface_hash
-        put_ bh mod_hash
-        put_ bh flag_hash
-        put_ bh orphan
-        put_ bh hasFamInsts
-        lazyPut bh deps
-        lazyPut bh usages
-        put_ bh exports
-        put_ bh exp_hash
-        put_ bh used_th
-        put_ bh fixities
-        lazyPut bh warns
-        lazyPut bh anns
-        put_ bh decls
-        put_ bh insts
-        put_ bh fam_insts
-        lazyPut bh rules
-        put_ bh orphan_hash
-        put_ bh vect_info
-        put_ bh hpc_info
-        put_ bh trust
-        put_ bh trust_pkg
-
-   get bh = do
-        mod_name    <- get bh
-        is_boot     <- get bh
-        iface_hash  <- get bh
-        mod_hash    <- get bh
-        flag_hash   <- get bh
-        orphan      <- get bh
-        hasFamInsts <- get bh
-        deps        <- lazyGet bh
-        usages      <- {-# SCC "bin_usages" #-} lazyGet bh
-        exports     <- {-# SCC "bin_exports" #-} get bh
-        exp_hash    <- get bh
-        used_th     <- get bh
-        fixities    <- {-# SCC "bin_fixities" #-} get bh
-        warns       <- {-# SCC "bin_warns" #-} lazyGet bh
-        anns        <- {-# SCC "bin_anns" #-} lazyGet bh
-        decls       <- {-# SCC "bin_tycldecls" #-} get bh
-        insts       <- {-# SCC "bin_insts" #-} get bh
-        fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh
-        rules       <- {-# SCC "bin_rules" #-} lazyGet bh
-        orphan_hash <- get bh
-        vect_info   <- get bh
-        hpc_info    <- get bh
-        trust       <- get bh
-        trust_pkg   <- get bh
-        return (ModIface {
-                 mi_module      = mod_name,
-                 mi_boot        = is_boot,
-                 mi_iface_hash  = iface_hash,
-                 mi_mod_hash    = mod_hash,
-                 mi_flag_hash   = flag_hash,
-                 mi_orphan      = orphan,
-                 mi_finsts      = hasFamInsts,
-                 mi_deps        = deps,
-                 mi_usages      = usages,
-                 mi_exports     = exports,
-                 mi_exp_hash    = exp_hash,
-                 mi_used_th     = used_th,
-                 mi_anns        = anns,
-                 mi_fixities    = fixities,
-                 mi_warns       = warns,
-                 mi_decls       = decls,
-                 mi_globals     = Nothing,
-                 mi_insts       = insts,
-                 mi_fam_insts   = fam_insts,
-                 mi_rules       = rules,
-                 mi_orphan_hash = orphan_hash,
-                 mi_vect_info   = vect_info,
-                 mi_hpc         = hpc_info,
-                 mi_trust       = trust,
-                 mi_trust_pkg   = trust_pkg,
-                        -- And build the cached values
-                 mi_warn_fn     = mkIfaceWarnCache warns,
-                 mi_fix_fn      = mkIfaceFixCache fixities,
-                 mi_hash_fn     = mkIfaceHashCache decls })
-
 getWayDescr :: DynFlags -> String
 getWayDescr dflags
   | platformUnregisterised (targetPlatform dflags) = 'u':tag
@@ -568,926 +414,3 @@ getWayDescr dflags
   where tag = buildTag dflags
         -- if this is an unregisterised build, make sure our interfaces
         -- can't be used by a registerised build.
-
--------------------------------------------------------------------------
---              Types from: HscTypes
--------------------------------------------------------------------------
-
-instance Binary Dependencies where
-    put_ bh deps = do put_ bh (dep_mods deps)
-                      put_ bh (dep_pkgs deps)
-                      put_ bh (dep_orphs deps)
-                      put_ bh (dep_finsts deps)
-
-    get bh = do ms <- get bh 
-                ps <- get bh
-                os <- get bh
-                fis <- get bh
-                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
-                               dep_finsts = fis })
-
-instance Binary AvailInfo where
-    put_ bh (Avail aa) = do
-            putByte bh 0
-            put_ bh aa
-    put_ bh (AvailTC ab ac) = do
-            putByte bh 1
-            put_ bh ab
-            put_ bh ac
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do aa <- get bh
-                      return (Avail aa)
-              _ -> do ab <- get bh
-                      ac <- get bh
-                      return (AvailTC ab ac)
-
-instance Binary Usage where
-    put_ bh usg@UsagePackageModule{} = do 
-        putByte bh 0
-        put_ bh (usg_mod usg)
-        put_ bh (usg_mod_hash usg)
-        put_ bh (usg_safe     usg)
-
-    put_ bh usg@UsageHomeModule{} = do 
-        putByte bh 1
-        put_ bh (usg_mod_name usg)
-        put_ bh (usg_mod_hash usg)
-        put_ bh (usg_exports  usg)
-        put_ bh (usg_entities usg)
-        put_ bh (usg_safe     usg)
-
-    put_ bh usg@UsageFile{} = do 
-        putByte bh 2
-        put_ bh (usg_file_path usg)
-        put_ bh (usg_mtime     usg)
-
-    get bh = do
-        h <- getByte bh
-        case h of
-          0 -> do
-            nm    <- get bh
-            mod   <- get bh
-            safe  <- get bh
-            return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
-          1 -> do
-            nm    <- get bh
-            mod   <- get bh
-            exps  <- get bh
-            ents  <- get bh
-            safe  <- get bh
-            return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
-                     usg_exports = exps, usg_entities = ents, usg_safe = safe }
-          2 -> do
-            fp    <- get bh
-            mtime <- get bh
-            return UsageFile { usg_file_path = fp, usg_mtime = mtime }
-          i -> error ("Binary.get(Usage): " ++ show i)
-
-instance Binary Warnings where
-    put_ bh NoWarnings     = putByte bh 0
-    put_ bh (WarnAll t) = do
-            putByte bh 1
-            put_ bh t
-    put_ bh (WarnSome ts) = do
-            putByte bh 2
-            put_ bh ts
-
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> return NoWarnings
-              1 -> do aa <- get bh
-                      return (WarnAll aa)
-              _ -> do aa <- get bh
-                      return (WarnSome aa)
-
-instance Binary WarningTxt where
-    put_ bh (WarningTxt w) = do
-            putByte bh 0
-            put_ bh w
-    put_ bh (DeprecatedTxt d) = do
-            putByte bh 1
-            put_ bh d
-
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do w <- get bh
-                      return (WarningTxt w)
-              _ -> do d <- get bh
-                      return (DeprecatedTxt d)
-
--------------------------------------------------------------------------
---              Types from: BasicTypes
--------------------------------------------------------------------------
-
-instance Binary Activation where
-    put_ bh NeverActive = do
-            putByte bh 0
-    put_ bh AlwaysActive = do
-            putByte bh 1
-    put_ bh (ActiveBefore aa) = do
-            putByte bh 2
-            put_ bh aa
-    put_ bh (ActiveAfter ab) = do
-            putByte bh 3
-            put_ bh ab
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return NeverActive
-              1 -> do return AlwaysActive
-              2 -> do aa <- get bh
-                      return (ActiveBefore aa)
-              _ -> do ab <- get bh
-                      return (ActiveAfter ab)
-
-instance Binary RuleMatchInfo where
-    put_ bh FunLike = putByte bh 0
-    put_ bh ConLike = putByte bh 1
-    get bh = do
-            h <- getByte bh
-            if h == 1 then return ConLike
-                      else return FunLike
-
-instance Binary InlinePragma where
-    put_ bh (InlinePragma a b c d) = do
-            put_ bh a
-            put_ bh b
-            put_ bh c
-            put_ bh d
-
-    get bh = do
-           a <- get bh
-           b <- get bh
-           c <- get bh
-           d <- get bh
-           return (InlinePragma a b c d)
-
-instance Binary InlineSpec where
-    put_ bh EmptyInlineSpec = putByte bh 0
-    put_ bh Inline          = putByte bh 1
-    put_ bh Inlinable       = putByte bh 2
-    put_ bh NoInline        = putByte bh 3
-
-    get bh = do h <- getByte bh
-                case h of
-                  0 -> return EmptyInlineSpec
-                  1 -> return Inline
-                  2 -> return Inlinable
-                  _ -> return NoInline
-
-instance Binary IfaceBang where
-    put_ bh IfNoBang        = putByte bh 0
-    put_ bh IfStrict        = putByte bh 1
-    put_ bh IfUnpack        = putByte bh 2
-    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
-
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return IfNoBang
-              1 -> do return IfStrict
-              2 -> do return IfUnpack
-              _ -> do { a <- get bh; return (IfUnpackCo a) }
-
-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 BoxedTuple
-        1 -> do return UnboxedTuple
-        _ -> do return ConstraintTuple
-
-instance Binary RecFlag where
-    put_ bh Recursive = do
-            putByte bh 0
-    put_ bh NonRecursive = do
-            putByte bh 1
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return Recursive
-              _ -> do return NonRecursive
-
-instance Binary DefMethSpec where
-    put_ bh NoDM      = putByte bh 0
-    put_ bh VanillaDM = putByte bh 1
-    put_ bh GenericDM = putByte bh 2
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> return NoDM
-              1 -> return VanillaDM
-              _ -> return GenericDM
-
-instance Binary FixityDirection where
-    put_ bh InfixL = do
-            putByte bh 0
-    put_ bh InfixR = do
-            putByte bh 1
-    put_ bh InfixN = do
-            putByte bh 2
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return InfixL
-              1 -> do return InfixR
-              _ -> do return InfixN
-
-instance Binary Fixity where
-    put_ bh (Fixity aa ab) = do
-            put_ bh aa
-            put_ bh ab
-    get bh = do
-          aa <- get bh
-          ab <- get bh
-          return (Fixity aa ab)
-
-
--------------------------------------------------------------------------
---              Types from: CostCentre
--------------------------------------------------------------------------
-
-instance Binary IsCafCC where
-    put_ bh CafCC = do
-            putByte bh 0
-    put_ bh NotCafCC = do
-            putByte bh 1
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return CafCC
-              _ -> do return NotCafCC
-
-instance Binary CostCentre where
-    put_ bh (NormalCC aa ab ac _ad ae) = do
-            putByte bh 0
-            put_ bh aa
-            put_ bh ab
-            put_ bh ac
-            put_ bh ae
-    put_ bh (AllCafsCC ae _af) = do
-            putByte bh 1
-            put_ bh ae
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do aa <- get bh
-                      ab <- get bh
-                      ac <- get bh
-                      ae <- get bh
-                      return (NormalCC aa ab ac noSrcSpan ae)
-              _ -> do ae <- get bh
-                      return (AllCafsCC ae noSrcSpan)
-
-    -- We ignore the SrcSpans in CostCentres when we serialise them,
-    -- and set the SrcSpans to noSrcSpan when deserialising.  This is
-    -- ok, because we only need the SrcSpan when declaring the
-    -- CostCentre in the original module, it is not used by importing
-    -- modules.
-
--------------------------------------------------------------------------
---              IfaceTypes and friends
--------------------------------------------------------------------------
-
-instance Binary IfaceBndr where
-    put_ bh (IfaceIdBndr aa) = do
-            putByte bh 0
-            put_ bh aa
-    put_ bh (IfaceTvBndr ab) = do
-            putByte bh 1
-            put_ bh ab
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do aa <- get bh
-                      return (IfaceIdBndr aa)
-              _ -> do ab <- get bh
-                      return (IfaceTvBndr ab)
-
-instance Binary IfaceLetBndr where
-    put_ bh (IfLetBndr a b c) = do
-            put_ bh a
-            put_ bh b
-            put_ bh c
-    get bh = do a <- get bh
-                b <- get bh
-                c <- get bh
-                return (IfLetBndr a b c)           
-
-instance Binary IfaceType where
-    put_ bh (IfaceForAllTy aa ab) = do
-            putByte bh 0
-            put_ bh aa
-            put_ bh ab
-    put_ bh (IfaceTyVar ad) = do
-            putByte bh 1
-            put_ bh ad
-    put_ bh (IfaceAppTy ae af) = do
-            putByte bh 2
-            put_ bh ae
-            put_ bh af
-    put_ bh (IfaceFunTy ag ah) = do
-            putByte bh 3
-            put_ bh ag
-            put_ bh ah
-    put_ bh (IfaceCoConApp cc tys)
-      = do { putByte bh 4; put_ bh cc; put_ bh tys }
-    put_ bh (IfaceTyConApp tc tys)
-      = do { putByte bh 5; put_ bh tc; put_ bh tys }
-
-    put_ bh (IfaceLitTy n)
-      = do { putByte bh 30; put_ bh n }
-
-
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do aa <- get bh
-                      ab <- get bh
-                      return (IfaceForAllTy aa ab)
-              1 -> do ad <- get bh
-                      return (IfaceTyVar ad)
-              2 -> do ae <- get bh
-                      af <- get bh
-                      return (IfaceAppTy ae af)
-              3 -> do ag <- get bh
-                      ah <- get bh
-                      return (IfaceFunTy ag ah)
-              4 -> do { cc <- get bh; tys <- get bh
-                      ; return (IfaceCoConApp cc tys) }
-              5 -> do { tc <- get bh; tys <- get bh
-                      ; return (IfaceTyConApp tc tys) }
-
-              30 -> do n <- get bh
-                       return (IfaceLitTy n)
-
-              _  -> panic ("get IfaceType " ++ show h)
-
-instance Binary IfaceTyLit where
-  put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n
-  put_ bh (IfaceStrTyLit n)  = putByte bh 2 >> put_ bh n
-
-  get bh =
-    do tag <- getByte bh
-       case tag of
-         1 -> do { n <- get bh
-                 ; return (IfaceNumTyLit n) }
-         2 -> do { n <- get bh
-                 ; return (IfaceStrTyLit n) }
-         _ -> panic ("get IfaceTyLit " ++ show tag)
-
-instance Binary IfaceTyCon where
-   put_ bh (IfaceTc ext) = put_ bh ext
-   get bh = liftM IfaceTc (get bh)
-
-instance Binary LeftOrRight where
-   put_ bh CLeft  = putByte bh 0
-   put_ bh CRight = putByte bh 1
-
-   get bh = do { h <- getByte bh
-               ; case h of
-                   0 -> return CLeft
-                   _ -> return CRight }
-
-instance Binary IfaceCoCon where
-   put_ bh (IfaceCoAx n ind)   = do { putByte bh 0; put_ bh n; put_ bh ind }
-   put_ bh IfaceReflCo         = putByte bh 1
-   put_ bh IfaceUnsafeCo       = putByte bh 2
-   put_ bh IfaceSymCo          = putByte bh 3
-   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 (IfaceLRCo lr)      = do { putByte bh 7; put_ bh lr }
-
-   get bh = do
-        h <- getByte bh
-        case h of
-          0 -> do { n <- get bh; ind <- get bh; return (IfaceCoAx n ind) }
-          1 -> return IfaceReflCo 
-          2 -> return IfaceUnsafeCo
-          3 -> return IfaceSymCo
-          4 -> return IfaceTransCo
-          5 -> return IfaceInstCo
-          6 -> do { d <- get bh; return (IfaceNthCo d) }
-          7 -> do { lr <- get bh; return (IfaceLRCo lr) }
-          _ -> panic ("get IfaceCoCon " ++ show h)
-
--------------------------------------------------------------------------
---              IfaceExpr and friends
--------------------------------------------------------------------------
-
-instance Binary IfaceExpr where
-    put_ bh (IfaceLcl aa) = do
-        putByte bh 0
-        put_ bh aa
-    put_ bh (IfaceType ab) = do
-        putByte bh 1
-        put_ bh ab
-    put_ bh (IfaceCo ab) = do
-        putByte bh 2
-        put_ bh ab
-    put_ bh (IfaceTuple ac ad) = do
-        putByte bh 3
-        put_ bh ac
-        put_ bh ad
-    put_ bh (IfaceLam ae af) = do
-        putByte bh 4
-        put_ bh ae
-        put_ bh af
-    put_ bh (IfaceApp ag ah) = do
-        putByte bh 5
-        put_ bh ag
-        put_ bh ah
-    put_ bh (IfaceCase ai aj ak) = do
-        putByte bh 6
-        put_ bh ai
-        put_ bh aj
-        put_ bh ak
-    put_ bh (IfaceLet al am) = do
-        putByte bh 7
-        put_ bh al
-        put_ bh am
-    put_ bh (IfaceTick an ao) = do
-        putByte bh 8
-        put_ bh an
-        put_ bh ao
-    put_ bh (IfaceLit ap) = do
-        putByte bh 9
-        put_ bh ap
-    put_ bh (IfaceFCall as at) = do
-        putByte bh 10
-        put_ bh as
-        put_ bh at
-    put_ bh (IfaceExt aa) = do
-        putByte bh 11
-        put_ bh aa
-    put_ bh (IfaceCast ie ico) = do
-        putByte bh 12
-        put_ bh ie
-        put_ bh ico
-    put_ bh (IfaceECase a b) = do
-        putByte bh 13
-        put_ bh a
-        put_ bh b
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do aa <- get bh
-                    return (IfaceLcl aa)
-            1 -> do ab <- get bh
-                    return (IfaceType ab)
-            2 -> do ab <- get bh
-                    return (IfaceCo ab)
-            3 -> do ac <- get bh
-                    ad <- get bh
-                    return (IfaceTuple ac ad)
-            4 -> do ae <- get bh
-                    af <- get bh
-                    return (IfaceLam ae af)
-            5 -> do ag <- get bh
-                    ah <- get bh
-                    return (IfaceApp ag ah)
-            6 -> do ai <- get bh
-                    aj <- get bh
-                    ak <- get bh
-                    return (IfaceCase ai aj ak)
-            7 -> do al <- get bh
-                    am <- get bh
-                    return (IfaceLet al am)
-            8 -> do an <- get bh
-                    ao <- get bh
-                    return (IfaceTick an ao)
-            9 -> do ap <- get bh
-                    return (IfaceLit ap)
-            10 -> do as <- get bh
-                     at <- get bh
-                     return (IfaceFCall as at)
-            11 -> do aa <- get bh
-                     return (IfaceExt aa)
-            12 -> do ie <- get bh
-                     ico <- get bh
-                     return (IfaceCast ie ico)
-            13 -> do a <- get bh
-                     b <- get bh
-                     return (IfaceECase a b)
-            _ -> panic ("get IfaceExpr " ++ show h)
-
-instance Binary IfaceConAlt where
-    put_ bh IfaceDefault      = putByte bh 0
-    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
-    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IfaceDefault
-            1 -> get bh >>= (return . IfaceDataAlt)
-            _ -> get bh >>= (return . IfaceLitAlt)
-
-instance Binary IfaceBinding where
-    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
-    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
-            _ -> do { ac <- get bh; return (IfaceRec ac) }
-
-instance Binary IfaceIdDetails where
-    put_ bh IfVanillaId      = putByte bh 0
-    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
-    put_ bh (IfDFunId n)     = do { putByte bh 2; put_ bh n }
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IfVanillaId
-            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
-            _ -> do { n <- get bh; return (IfDFunId n) }
-
-instance Binary (DFunArg IfaceExpr) where
-    put_ bh (DFunPolyArg  e) = putByte bh 0 >> put_ bh e
-    put_ bh (DFunLamArg i)   = putByte bh 1 >> put_ bh i
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> do { a <- get bh; return (DFunPolyArg a) }
-                    _ -> do { a <- get bh; return (DFunLamArg a) } }
-
-instance Binary IfaceIdInfo where
-    put_ bh NoInfo      = putByte bh 0
-    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
-
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return NoInfo
-            _ -> lazyGet bh >>= (return . HasInfo)     -- NB lazyGet
-
-instance Binary IfaceInfoItem where
-    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
-    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
-    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
-    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
-    put_ bh HsNoCafRefs           = putByte bh 4
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> get bh >>= (return . HsArity)
-            1 -> get bh >>= (return . HsStrictness)
-            2 -> do lb <- get bh
-                    ad <- get bh
-                    return (HsUnfold lb ad)
-            3 -> get bh >>= (return . HsInline)
-            _ -> return HsNoCafRefs
-
-instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold s e) = do
-        putByte bh 0
-        put_ bh s
-        put_ bh e
-    put_ bh (IfInlineRule a b c d) = do
-        putByte bh 1
-        put_ bh a
-        put_ bh b
-        put_ bh c
-        put_ bh d
-    put_ bh (IfWrapper e) = do
-        putByte bh 2
-        put_ bh e
-    put_ bh (IfDFunUnfold as) = do
-        putByte bh 3
-        put_ bh as
-    put_ bh (IfCompulsory e) = do
-        putByte bh 4
-        put_ bh e
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do s <- get bh
-                    e <- get bh
-                    return (IfCoreUnfold s e)
-            1 -> do a <- get bh
-                    b <- get bh
-                    c <- get bh
-                    d <- get bh
-                    return (IfInlineRule a b c d)
-            2 -> do e <- get bh
-                    return (IfWrapper e)
-            3 -> do as <- get bh
-                    return (IfDFunUnfold as)
-            _ -> do e <- get bh
-                    return (IfCompulsory e)
-
-instance Binary IfaceTickish where
-    put_ bh (IfaceHpcTick m ix) = do
-        putByte bh 0
-        put_ bh m
-        put_ bh ix
-    put_ bh (IfaceSCC cc tick push) = do
-        putByte bh 1
-        put_ bh cc
-        put_ bh tick
-        put_ bh push
-
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do m <- get bh
-                    ix <- get bh
-                    return (IfaceHpcTick m ix)
-            1 -> do cc <- get bh
-                    tick <- get bh
-                    push <- get bh
-                    return (IfaceSCC cc tick push)
-            _ -> panic ("get IfaceTickish " ++ show h)
-
--------------------------------------------------------------------------
---              IfaceDecl and friends
--------------------------------------------------------------------------
-
--- A bit of magic going on here: there's no need to store the OccName
--- for a decl on the disk, since we can infer the namespace from the
--- context; however it is useful to have the OccName in the IfaceDecl
--- to avoid re-building it in various places.  So we build the OccName
--- when de-serialising.
-
-instance Binary IfaceDecl where
-    put_ bh (IfaceId name ty details idinfo) = do
-        putByte bh 0
-        put_ bh (occNameFS name)
-        put_ bh ty
-        put_ bh details
-        put_ bh idinfo
-
-    put_ _ (IfaceForeign _ _) = 
-        error "Binary.put_(IfaceDecl): IfaceForeign"
-
-    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
-        putByte bh 2
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-
-    put_ bh (IfaceSyn a1 a2 a3 a4) = do
-        putByte bh 3
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-
-    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
-        putByte bh 4
-        put_ bh a1
-        put_ bh (occNameFS a2)
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        
-    put_ bh (IfaceAxiom a1 a2 a3) = do
-        putByte bh 5
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do name    <- get bh
-                    ty      <- get bh
-                    details <- get bh
-                    idinfo  <- get bh
-                    occ <- return $! mkOccNameFS varName name
-                    return (IfaceId occ ty details idinfo)
-            1 -> error "Binary.get(TyClDecl): ForeignType"
-            2 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    a8 <- get bh
-                    a9 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9)
-            3 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceSyn occ a2 a3 a4)
-            4 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    occ <- return $! mkOccNameFS clsName a2
-                    return (IfaceClass a1 occ a3 a4 a5 a6 a7)
-            _ -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceAxiom occ a2 a3)
-
-instance Binary IfaceAxBranch where
-    put_ bh (IfaceAxBranch a1 a2 a3) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        return (IfaceAxBranch a1 a2 a3)
-
-instance Binary ty => Binary (SynTyConRhs ty) where
-    put_ bh (SynFamilyTyCon a b) = putByte bh 0 >> put_ bh a >> put_ bh b
-    put_ bh (SynonymTyCon ty)    = putByte bh 1 >> put_ bh ty
-
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> do { a <- get bh
-                            ; b <- get bh
-                            ; return (SynFamilyTyCon a b) }
-                    _ -> do { ty <- get bh
-                            ; return (SynonymTyCon ty) } }
-
-instance Binary IfaceClsInst where
-    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
-        put_ bh cls
-        put_ bh tys
-        put_ bh dfun
-        put_ bh flag
-        put_ bh orph
-    get bh = do
-        cls  <- get bh
-        tys  <- get bh
-        dfun <- get bh
-        flag <- get bh
-        orph <- get bh
-        return (IfaceClsInst cls tys dfun flag orph)
-
-instance Binary IfaceFamInst where
-    put_ bh (IfaceFamInst fam group tys name orph) = do
-        put_ bh fam
-        put_ bh group
-        put_ bh tys
-        put_ bh name
-        put_ bh orph
-    get bh = do
-        fam      <- get bh
-        group    <- get bh
-        tys      <- get bh
-        name     <- get bh
-        orph     <- get bh
-        return (IfaceFamInst fam group tys name orph)
-
-instance Binary OverlapFlag where
-    put_ bh (NoOverlap  b) = putByte bh 0 >> put_ bh b
-    put_ bh (OverlapOk  b) = putByte bh 1 >> put_ bh b
-    put_ bh (Incoherent b) = putByte bh 2 >> put_ bh b
-    get bh = do
-        h <- getByte bh
-        b <- get bh
-        case h of
-            0 -> return $ NoOverlap b
-            1 -> return $ OverlapOk b
-            2 -> return $ Incoherent b
-            _ -> panic ("get OverlapFlag " ++ show h)
-
-instance Binary IfaceConDecls where
-    put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
-    put_ bh IfDataFamTyCon     = putByte bh 1
-    put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
-    put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> get bh >>= (return . IfAbstractTyCon)
-            1 -> return IfDataFamTyCon
-            2 -> get bh >>= (return . IfDataTyCon)
-            _ -> get bh >>= (return . IfNewTyCon)
-
-instance Binary IfaceConDecl where
-    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-        put_ bh a10
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh          
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
-        a9 <- get bh
-        a10 <- get bh
-        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
-
-instance Binary IfaceAT where
-    put_ bh (IfaceAT dec defs) = do
-        put_ bh dec
-        put_ bh defs
-    get bh = do
-        dec  <- get bh
-        defs <- get bh
-        return (IfaceAT dec defs)
-
-instance Binary IfaceClassOp where
-    put_ bh (IfaceClassOp n def ty) = do 
-        put_ bh (occNameFS n)
-        put_ bh def     
-        put_ bh ty
-    get bh = do
-        n   <- get bh
-        def <- get bh
-        ty  <- get bh
-        occ <- return $! mkOccNameFS varName n
-        return (IfaceClassOp occ def ty)
-
-instance Binary IfaceRule where
-    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
-        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
-
-instance Binary IfaceAnnotation where
-    put_ bh (IfaceAnnotation a1 a2) = do
-        put_ bh a1
-        put_ bh a2
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        return (IfaceAnnotation a1 a2)
-
-instance Binary name => Binary (AnnTarget name) where
-    put_ bh (NamedTarget a) = do
-        putByte bh 0
-        put_ bh a
-    put_ bh (ModuleTarget a) = do
-        putByte bh 1
-        put_ bh a
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> get bh >>= (return . NamedTarget)
-            _ -> get bh >>= (return . ModuleTarget)
-
-instance Binary IfaceVectInfo where
-    put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        return (IfaceVectInfo a1 a2 a3 a4 a5)
-
-instance Binary IfaceTrustInfo where
-    put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
-    get bh = getByte bh >>= (return . numToTrustInfo)
-
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index d5e4a4a62e..20aea22e47 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -46,13 +46,13 @@ import Outputable
 
 \begin{code}
 ------------------------------------------------------
-buildSynTyCon :: Name -> [TyVar] 
-              -> SynTyConRhs Type
+buildSynTyCon :: Name -> [TyVar] -> [Role] 
+              -> SynTyConRhs
               -> Kind                   -- ^ Kind of the RHS
               -> TyConParent
               -> TcRnIf m n TyCon
-buildSynTyCon tc_name tvs rhs rhs_kind parent 
-  = return (mkSynTyCon tc_name kind tvs rhs parent)
+buildSynTyCon tc_name tvs roles rhs rhs_kind parent 
+  = return (mkSynTyCon tc_name kind tvs roles rhs parent)
   where kind = mkPiKinds tvs rhs_kind
 
 
@@ -80,7 +80,7 @@ mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
 --   because the latter is part of a knot, whereas the former is not.
 mkNewTyConRhs tycon_name tycon con 
   = do	{ co_tycon_name <- newImplicitBinder tycon_name mkNewTyCoOcc
-	; let co_tycon = mkNewTypeCo co_tycon_name tycon etad_tvs etad_rhs
+	; let co_tycon = mkNewTypeCo co_tycon_name tycon etad_tvs etad_roles etad_rhs
 	; traceIf (text "mkNewTyConRhs" <+> ppr co_tycon)
 	; return (NewTyCon { data_con    = con, 
 		       	     nt_rhs      = rhs_ty,
@@ -90,6 +90,7 @@ mkNewTyConRhs tycon_name tycon con
                              -- for nt_co, or uses explicit coercions otherwise
   where
     tvs    = tyConTyVars tycon
+    roles  = tyConRoles tycon
     inst_con_ty = applyTys (dataConUserType con) (mkTyVarTys tvs)
     rhs_ty = ASSERT( isFunTy inst_con_ty ) funArgTy inst_con_ty
 	-- Instantiate the data con with the 
@@ -101,20 +102,22 @@ mkNewTyConRhs tycon_name tycon con
   	-- has a single argument (Foo a) that is a *type class*, so
 	-- dataConInstOrigArgTys returns [].
 
-    etad_tvs :: [TyVar]	-- Matched lazily, so that mkNewTypeCo can
-    etad_rhs :: Type	-- return a TyCon without pulling on rhs_ty
-			-- See Note [Tricky iface loop] in LoadIface
-    (etad_tvs, etad_rhs) = eta_reduce (reverse tvs) rhs_ty
+    etad_tvs   :: [TyVar]  -- Matched lazily, so that mkNewTypeCo can
+    etad_roles :: [Role]   -- return a TyCon without pulling on rhs_ty
+    etad_rhs   :: Type     -- See Note [Tricky iface loop] in LoadIface
+    (etad_tvs, etad_roles, etad_rhs) = eta_reduce (reverse tvs) (reverse roles) rhs_ty
  
-    eta_reduce :: [TyVar]		-- Reversed
-	       -> Type			-- Rhs type
-	       -> ([TyVar], Type)	-- Eta-reduced version (tyvars in normal order)
-    eta_reduce (a:as) ty | Just (fun, arg) <- splitAppTy_maybe ty,
-			   Just tv <- getTyVar_maybe arg,
-			   tv == a,
-			   not (a `elemVarSet` tyVarsOfType fun)
-			 = eta_reduce as fun
-    eta_reduce tvs ty = (reverse tvs, ty)
+    eta_reduce :: [TyVar]	-- Reversed
+               -> [Role]        -- also reversed
+	       -> Type		-- Rhs type
+	       -> ([TyVar], [Role], Type)  -- Eta-reduced version
+                                           -- (tyvars in normal order)
+    eta_reduce (a:as) (_:rs) ty | Just (fun, arg) <- splitAppTy_maybe ty,
+			          Just tv <- getTyVar_maybe arg,
+			          tv == a,
+			          not (a `elemVarSet` tyVarsOfType fun)
+			        = eta_reduce as rs fun
+    eta_reduce tvs rs ty = (reverse tvs, reverse rs, ty)
 				
 
 ------------------------------------------------------
@@ -185,14 +188,14 @@ type TcMethInfo = (Name, DefMethSpec, Type)
 buildClass :: Bool		-- True <=> do not include unfoldings 
 				--	    on dict selectors
 				-- Used when importing a class without -O
-	   -> Name -> [TyVar] -> ThetaType
+	   -> Name -> [TyVar] -> [Role] -> ThetaType
 	   -> [FunDep TyVar]		   -- Functional dependencies
 	   -> [ClassATItem]		   -- Associated types
 	   -> [TcMethInfo]                 -- Method info
 	   -> RecFlag			   -- Info for type constructor
 	   -> TcRnIf m n Class
 
-buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
+buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff tc_isrec
   = fixM  $ \ rec_clas -> 	-- Only name generation inside loop
     do	{ traceIf (text "buildClass")
         ; dflags <- getDynFlags
@@ -255,7 +258,7 @@ buildClass no_unf tycon_name tvs sc_theta fds at_items sig_stuff tc_isrec
 
 	; let {	clas_kind = mkPiKinds tvs constraintKind
 
- 	      ; tycon = mkClassTyCon tycon_name clas_kind tvs
+ 	      ; tycon = mkClassTyCon tycon_name clas_kind tvs roles
  	                             rhs rec_clas tc_isrec
 		-- A class can be recursive, and in the case of newtypes 
 		-- this matters.  For example
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 20a21c3733..0441fdbf41 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -55,10 +55,27 @@ import Data.IORef    ( atomicModifyIORef, readIORef )
 %*							*
 %*********************************************************
 
+Note [The Name Cache]
+~~~~~~~~~~~~~~~~~~~~~
+The Name Cache makes sure that, during any invovcation of GHC, each
+External Name "M.x" has one, and only one globally-agreed Unique.
+
+* The first time we come across M.x we make up a Unique and record that
+  association in the Name Cache.
+
+* When we come across "M.x" again, we look it up in the Name Cache,
+  and get a hit.
+
+The functions newGlobalBinder, allocateGlobalBinder do the main work.
+When you make an External name, you should probably be calling one
+of them.
+
+
 \begin{code}
 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 -- Used for source code and interface files, to make the
 -- Name for a thing, given its Module and OccName
+-- See Note [The Name Cache]
 --
 -- The cache may already already have a binding for this thing,
 -- because we may have seen an occurrence before, but now is the
@@ -74,6 +91,7 @@ allocateGlobalBinder
   :: NameCache 
   -> Module -> OccName -> SrcSpan
   -> (NameCache, Name)
+-- See Note [The Name Cache]
 allocateGlobalBinder name_supply mod occ loc
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
         -- A hit in the cache!  We are at the binding site of the name.
@@ -171,6 +189,8 @@ lookupOrig mod occ
 %*									*
 %************************************************************************
 
+See Note [The Name Cache] above.
+
 \begin{code}
 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
 lookupOrigNameCache _ mod occ
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index dbe1dca191..8dc4188bb9 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -14,7 +14,7 @@
 module IfaceSyn (
         module IfaceType,
 
-        IfaceDecl(..), IfaceClassOp(..), IfaceAT(..), 
+        IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..), 
         IfaceConDecl(..), IfaceConDecls(..),
         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
         IfaceBinding(..), IfaceConAlt(..),
@@ -36,14 +36,13 @@ module IfaceSyn (
 
 #include "HsVersions.h"
 
-import TyCon( SynTyConRhs(..) )
 import IfaceType
-import CoreSyn( DFunArg, dfunArgExprs )
 import PprCore()            -- Printing DFunArgs
 import Demand
 import Annotations
 import Class
 import NameSet
+import CoAxiom ( BranchIndex, Role )
 import Name
 import CostCentre
 import Literal
@@ -57,6 +56,7 @@ import TysWiredIn ( eqTyConName )
 import Fingerprint
 import Binary
 
+import Control.Monad
 import System.IO.Unsafe
 
 infixl 3 &&&
@@ -79,6 +79,7 @@ data IfaceDecl
   | IfaceData { ifName       :: OccName,        -- Type constructor
                 ifCType      :: Maybe CType,    -- C type for CAPI FFI
                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
+                ifRoles      :: [Role],         -- Roles
                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
                 ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
                 ifRec        :: RecFlag,        -- Recursive or not?
@@ -91,12 +92,14 @@ data IfaceDecl
 
   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
+                ifRoles   :: [Role],            -- Roles
                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
-                ifSynRhs  :: SynTyConRhs IfaceType }
+                ifSynRhs  :: IfaceSynTyConRhs }
 
   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
                  ifName    :: OccName,          -- Name of the class TyCon
                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
+                 ifRoles   :: [Role],           -- Roles
                  ifFDs     :: [FunDep FastString], -- Functional dependencies
                  ifATs     :: [IfaceAT],      -- Associated type families
                  ifSigs    :: [IfaceClassOp],   -- Method signatures
@@ -106,6 +109,7 @@ data IfaceDecl
 
   | IfaceAxiom { ifName       :: OccName,        -- Axiom name
                  ifTyCon      :: IfaceTyCon,     -- LHS TyCon
+                 ifRole       :: Role,           -- Role of axiom
                  ifAxBranches :: [IfaceAxBranch] -- Branches
     }
 
@@ -113,23 +117,205 @@ data IfaceDecl
                                                 -- beyond .NET
                    ifExtName :: Maybe FastString }
 
+-- A bit of magic going on here: there's no need to store the OccName
+-- for a decl on the disk, since we can infer the namespace from the
+-- context; however it is useful to have the OccName in the IfaceDecl
+-- to avoid re-building it in various places.  So we build the OccName
+-- when de-serialising.
+
+instance Binary IfaceDecl where
+    put_ bh (IfaceId name ty details idinfo) = do
+        putByte bh 0
+        put_ bh (occNameFS name)
+        put_ bh ty
+        put_ bh details
+        put_ bh idinfo
+
+    put_ _ (IfaceForeign _ _) = 
+        error "Binary.put_(IfaceDecl): IfaceForeign"
+
+    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+        putByte bh 2
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+        put_ bh a10
+
+    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
+        putByte bh 3
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+
+    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8) = do
+        putByte bh 4
+        put_ bh a1
+        put_ bh (occNameFS a2)
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+
+    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
+        putByte bh 5
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do name    <- get bh
+                    ty      <- get bh
+                    details <- get bh
+                    idinfo  <- get bh
+                    occ <- return $! mkOccNameFS varName name
+                    return (IfaceId occ ty details idinfo)
+            1 -> error "Binary.get(TyClDecl): ForeignType"
+            2 -> do a1  <- get bh
+                    a2  <- get bh
+                    a3  <- get bh
+                    a4  <- get bh
+                    a5  <- get bh
+                    a6  <- get bh
+                    a7  <- get bh
+                    a8  <- get bh
+                    a9  <- get bh
+                    a10 <- get bh
+                    occ <- return $! mkOccNameFS tcName a1
+                    return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
+            3 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    a5 <- get bh
+                    occ <- return $! mkOccNameFS tcName a1
+                    return (IfaceSyn occ a2 a3 a4 a5)
+            4 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    a5 <- get bh
+                    a6 <- get bh
+                    a7 <- get bh
+                    a8 <- get bh
+                    occ <- return $! mkOccNameFS clsName a2
+                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8)
+            _ -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    occ <- return $! mkOccNameFS tcName a1
+                    return (IfaceAxiom occ a2 a3 a4)
+
+data IfaceSynTyConRhs
+  = IfaceOpenSynFamilyTyCon
+  | IfaceClosedSynFamilyTyCon IfExtName  -- name of associated axiom
+  | IfaceAbstractClosedSynFamilyTyCon
+  | IfaceSynonymTyCon IfaceType
+
+instance Binary IfaceSynTyConRhs where
+    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
+    put_ bh (IfaceClosedSynFamilyTyCon ax)    = putByte bh 1 >> put_ bh ax
+    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
+    put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
+
+    get bh = do { h <- getByte bh
+                ; case h of
+                    0 -> return IfaceOpenSynFamilyTyCon
+                    1 -> do { ax <- get bh
+                            ; return (IfaceClosedSynFamilyTyCon ax) }
+                    2 -> return IfaceAbstractClosedSynFamilyTyCon
+                    _ -> do { ty <- get bh
+                            ; return (IfaceSynonymTyCon ty) } }
+
 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
         -- Nothing    => no default method
         -- Just False => ordinary polymorphic default method
         -- Just True  => generic default method
 
+instance Binary IfaceClassOp where
+    put_ bh (IfaceClassOp n def ty) = do 
+        put_ bh (occNameFS n)
+        put_ bh def     
+        put_ bh ty
+    get bh = do
+        n   <- get bh
+        def <- get bh
+        ty  <- get bh
+        occ <- return $! mkOccNameFS varName n
+        return (IfaceClassOp occ def ty)
+
 data IfaceAT = IfaceAT IfaceDecl [IfaceAxBranch]
         -- Nothing => no default associated type instance
         -- Just ds => default associated type instance from these templates
 
+instance Binary IfaceAT where
+    put_ bh (IfaceAT dec defs) = do
+        put_ bh dec
+        put_ bh defs
+    get bh = do
+        dec  <- get bh
+        defs <- get bh
+        return (IfaceAT dec defs)
+
 instance Outputable IfaceAxBranch where
-   ppr (IfaceAxBranch { ifaxbTyVars = tvs, ifaxbLHS = pat_tys, ifaxbRHS = ty }) 
-      = ppr tvs <+> hsep (map ppr pat_tys) <+> char '=' <+> ppr ty
+  ppr = pprAxBranch Nothing
+
+pprAxBranch :: Maybe IfaceTyCon -> IfaceAxBranch -> SDoc
+pprAxBranch mtycon (IfaceAxBranch { ifaxbTyVars = tvs
+                                  , ifaxbLHS = pat_tys
+                                  , ifaxbRHS = ty
+                                  , ifaxbIncomps = incomps })
+  = ppr tvs <+> ppr_lhs <+> char '=' <+> ppr ty $+$
+    nest 4 maybe_incomps
+      where
+        ppr_lhs
+          | Just tycon <- mtycon
+          = ppr (IfaceTyConApp tycon pat_tys)
+          | otherwise
+          = hsep (map ppr pat_tys)
+
+        maybe_incomps
+          | [] <- incomps
+          = empty
+
+          | otherwise
+          = parens (ptext (sLit "incompatible indices:") <+> ppr incomps)
 
 -- this is just like CoAxBranch
-data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
-                                   , ifaxbLHS    :: [IfaceType]
-                                   , ifaxbRHS    :: IfaceType }
+data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
+                                   , ifaxbLHS     :: [IfaceType]
+                                   , ifaxbRoles   :: [Role]
+                                   , ifaxbRHS     :: IfaceType
+                                   , ifaxbIncomps :: [BranchIndex] }
+                                     -- See Note [Storing compatibility] in CoAxiom
+
+instance Binary IfaceAxBranch where
+    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        return (IfaceAxBranch a1 a2 a3 a4 a5)
 
 data IfaceConDecls
   = IfAbstractTyCon Bool        -- c.f TyCon.AbstractTyCon
@@ -137,6 +323,19 @@ data IfaceConDecls
   | IfDataTyCon [IfaceConDecl]  -- Data type decls
   | IfNewTyCon  IfaceConDecl    -- Newtype decls
 
+instance Binary IfaceConDecls where
+    put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
+    put_ bh IfDataFamTyCon     = putByte bh 1
+    put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
+    put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> liftM IfAbstractTyCon $ get bh
+            1 -> return IfDataFamTyCon
+            2 -> liftM IfDataTyCon $ get bh
+            _ -> liftM IfNewTyCon $ get bh
+
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls (IfAbstractTyCon {}) = []
 visibleIfConDecls IfDataFamTyCon      = []
@@ -150,16 +349,55 @@ data IfaceConDecl
         ifConInfix   :: Bool,                   -- True <=> declared infix
         ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
-        ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
+        ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality constraints
         ifConCtxt    :: IfaceContext,           -- Non-stupid context
         ifConArgTys  :: [IfaceType],            -- Arg types
         ifConFields  :: [OccName],              -- ...ditto... (field labels)
         ifConStricts :: [IfaceBang]}            -- Empty (meaning all lazy),
                                                 -- or 1-1 corresp with arg tys
 
+instance Binary IfaceConDecl where
+    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+        put_ bh a10
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        a6 <- get bh
+        a7 <- get bh
+        a8 <- get bh
+        a9 <- get bh
+        a10 <- get bh
+        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+
 data IfaceBang
   = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion
 
+instance Binary IfaceBang where
+    put_ bh IfNoBang        = putByte bh 0
+    put_ bh IfStrict        = putByte bh 1
+    put_ bh IfUnpack        = putByte bh 2
+    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return IfNoBang
+              1 -> do return IfStrict
+              2 -> do return IfUnpack
+              _ -> do { a <- get bh; return (IfUnpackCo a) }
+
 data IfaceClsInst
   = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
@@ -173,17 +411,43 @@ data IfaceClsInst
         -- If this instance decl is *used*, we'll record a usage on the dfun;
         -- and if the head does not change it won't be used if it wasn't before
 
+instance Binary IfaceClsInst where
+    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
+        put_ bh cls
+        put_ bh tys
+        put_ bh dfun
+        put_ bh flag
+        put_ bh orph
+    get bh = do
+        cls  <- get bh
+        tys  <- get bh
+        dfun <- get bh
+        flag <- get bh
+        orph <- get bh
+        return (IfaceClsInst cls tys dfun flag orph)
+
 -- The ifFamInstTys field of IfaceFamInst contains a list of the rough
--- match types, one per branch... but each "rough match types" is itself
--- a list of Maybe IfaceTyCon. So, we get [[Maybe IfaceTyCon]].
+-- match types
 data IfaceFamInst
-  = IfaceFamInst { ifFamInstFam   :: IfExtName            -- Family name
-                 , ifFamInstGroup :: Bool                 -- Is this a group?
-                 , ifFamInstTys   :: [[Maybe IfaceTyCon]] -- See above
-                 , ifFamInstAxiom :: IfExtName            -- The axiom
-                 , ifFamInstOrph  :: Maybe OccName        -- Just like IfaceClsInst
+  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
+                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
+                 , ifFamInstAxiom    :: IfExtName            -- The axiom
+                 , ifFamInstOrph     :: Maybe OccName        -- Just like IfaceClsInst
                  }
 
+instance Binary IfaceFamInst where
+    put_ bh (IfaceFamInst fam tys name orph) = do
+        put_ bh fam
+        put_ bh tys
+        put_ bh name
+        put_ bh orph
+    get bh = do
+        fam      <- get bh
+        tys      <- get bh
+        name     <- get bh
+        orph     <- get bh
+        return (IfaceFamInst fam tys name orph)
+
 data IfaceRule
   = IfaceRule {
         ifRuleName   :: RuleName,
@@ -196,12 +460,42 @@ data IfaceRule
         ifRuleOrph   :: Maybe OccName   -- Just like IfaceClsInst
     }
 
+instance Binary IfaceRule where
+    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        a6 <- get bh
+        a7 <- get bh
+        a8 <- get bh
+        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
+
 data IfaceAnnotation
   = IfaceAnnotation {
         ifAnnotatedTarget :: IfaceAnnTarget,
         ifAnnotatedValue :: Serialized
   }
 
+instance Binary IfaceAnnotation where
+    put_ bh (IfaceAnnotation a1 a2) = do
+        put_ bh a1
+        put_ bh a2
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        return (IfaceAnnotation a1 a2)
+
 type IfaceAnnTarget = AnnTarget OccName
 
 -- We only serialise the IdDetails of top-level Ids, and even then
@@ -214,10 +508,31 @@ data IfaceIdDetails
   | IfRecSelId IfaceTyCon Bool
   | IfDFunId Int          -- Number of silent args
 
+instance Binary IfaceIdDetails where
+    put_ bh IfVanillaId      = putByte bh 0
+    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
+    put_ bh (IfDFunId n)     = do { putByte bh 2; put_ bh n }
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfVanillaId
+            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
+            _ -> do { n <- get bh; return (IfDFunId n) }
+
 data IfaceIdInfo
   = NoInfo                      -- When writing interface file without -O
   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
 
+instance Binary IfaceIdInfo where
+    put_ bh NoInfo      = putByte bh 0
+    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return NoInfo
+            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet
+
 -- Here's a tricky case:
 --   * Compile with -O module A, and B which imports A.f
 --   * Change function f in A, and recompile without -O
@@ -236,6 +551,23 @@ data IfaceInfoItem
                     IfaceUnfolding   -- See Note [Expose recursive functions]
   | HsNoCafRefs
 
+instance Binary IfaceInfoItem where
+    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
+    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
+    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
+    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
+    put_ bh HsNoCafRefs           = putByte bh 4
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> liftM HsArity $ get bh
+            1 -> liftM HsStrictness $ get bh
+            2 -> do lb <- get bh
+                    ad <- get bh
+                    return (HsUnfold lb ad)
+            3 -> liftM HsInline $ get bh
+            _ -> return HsNoCafRefs
+
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
@@ -253,14 +585,54 @@ data IfaceUnfolding
 
   | IfWrapper IfaceExpr         -- cf TcIface's Note [wrappers in interface files]
 
-  | IfDFunUnfold [DFunArg IfaceExpr]
+  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
+
+instance Binary IfaceUnfolding where
+    put_ bh (IfCoreUnfold s e) = do
+        putByte bh 0
+        put_ bh s
+        put_ bh e
+    put_ bh (IfInlineRule a b c d) = do
+        putByte bh 1
+        put_ bh a
+        put_ bh b
+        put_ bh c
+        put_ bh d
+    put_ bh (IfWrapper e) = do
+        putByte bh 2
+        put_ bh e
+    put_ bh (IfDFunUnfold as bs) = do
+        putByte bh 3
+        put_ bh as
+        put_ bh bs
+    put_ bh (IfCompulsory e) = do
+        putByte bh 4
+        put_ bh e
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do s <- get bh
+                    e <- get bh
+                    return (IfCoreUnfold s e)
+            1 -> do a <- get bh
+                    b <- get bh
+                    c <- get bh
+                    d <- get bh
+                    return (IfInlineRule a b c d)
+            2 -> do e <- get bh
+                    return (IfWrapper e)
+            3 -> do as <- get bh
+                    bs <- get bh
+                    return (IfDFunUnfold as bs)
+            _ -> do e <- get bh
+                    return (IfCompulsory e)
 
 --------------------------------
 data IfaceExpr
   = IfaceLcl    IfLclName
   | IfaceExt    IfExtName
   | IfaceType   IfaceType
-  | IfaceCo     IfaceType		-- We re-use IfaceType for coercions
+  | IfaceCo     IfaceCoercion
   | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
   | IfaceLam 	IfaceBndr IfaceExpr
   | IfaceApp 	IfaceExpr IfaceExpr
@@ -272,11 +644,130 @@ data IfaceExpr
   | IfaceFCall  ForeignCall IfaceType
   | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
 
+instance Binary IfaceExpr where
+    put_ bh (IfaceLcl aa) = do
+        putByte bh 0
+        put_ bh aa
+    put_ bh (IfaceType ab) = do
+        putByte bh 1
+        put_ bh ab
+    put_ bh (IfaceCo ab) = do
+        putByte bh 2
+        put_ bh ab
+    put_ bh (IfaceTuple ac ad) = do
+        putByte bh 3
+        put_ bh ac
+        put_ bh ad
+    put_ bh (IfaceLam ae af) = do
+        putByte bh 4
+        put_ bh ae
+        put_ bh af
+    put_ bh (IfaceApp ag ah) = do
+        putByte bh 5
+        put_ bh ag
+        put_ bh ah
+    put_ bh (IfaceCase ai aj ak) = do
+        putByte bh 6
+        put_ bh ai
+        put_ bh aj
+        put_ bh ak
+    put_ bh (IfaceLet al am) = do
+        putByte bh 7
+        put_ bh al
+        put_ bh am
+    put_ bh (IfaceTick an ao) = do
+        putByte bh 8
+        put_ bh an
+        put_ bh ao
+    put_ bh (IfaceLit ap) = do
+        putByte bh 9
+        put_ bh ap
+    put_ bh (IfaceFCall as at) = do
+        putByte bh 10
+        put_ bh as
+        put_ bh at
+    put_ bh (IfaceExt aa) = do
+        putByte bh 11
+        put_ bh aa
+    put_ bh (IfaceCast ie ico) = do
+        putByte bh 12
+        put_ bh ie
+        put_ bh ico
+    put_ bh (IfaceECase a b) = do
+        putByte bh 13
+        put_ bh a
+        put_ bh b
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do aa <- get bh
+                    return (IfaceLcl aa)
+            1 -> do ab <- get bh
+                    return (IfaceType ab)
+            2 -> do ab <- get bh
+                    return (IfaceCo ab)
+            3 -> do ac <- get bh
+                    ad <- get bh
+                    return (IfaceTuple ac ad)
+            4 -> do ae <- get bh
+                    af <- get bh
+                    return (IfaceLam ae af)
+            5 -> do ag <- get bh
+                    ah <- get bh
+                    return (IfaceApp ag ah)
+            6 -> do ai <- get bh
+                    aj <- get bh
+                    ak <- get bh
+                    return (IfaceCase ai aj ak)
+            7 -> do al <- get bh
+                    am <- get bh
+                    return (IfaceLet al am)
+            8 -> do an <- get bh
+                    ao <- get bh
+                    return (IfaceTick an ao)
+            9 -> do ap <- get bh
+                    return (IfaceLit ap)
+            10 -> do as <- get bh
+                     at <- get bh
+                     return (IfaceFCall as at)
+            11 -> do aa <- get bh
+                     return (IfaceExt aa)
+            12 -> do ie <- get bh
+                     ico <- get bh
+                     return (IfaceCast ie ico)
+            13 -> do a <- get bh
+                     b <- get bh
+                     return (IfaceECase a b)
+            _ -> panic ("get IfaceExpr " ++ show h)
+
 data IfaceTickish
   = IfaceHpcTick Module Int                -- from HpcTick x
   | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
   -- no breakpoints: we never export these into interface files
 
+instance Binary IfaceTickish where
+    put_ bh (IfaceHpcTick m ix) = do
+        putByte bh 0
+        put_ bh m
+        put_ bh ix
+    put_ bh (IfaceSCC cc tick push) = do
+        putByte bh 1
+        put_ bh cc
+        put_ bh tick
+        put_ bh push
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do m <- get bh
+                    ix <- get bh
+                    return (IfaceHpcTick m ix)
+            1 -> do cc <- get bh
+                    tick <- get bh
+                    push <- get bh
+                    return (IfaceSCC cc tick push)
+            _ -> panic ("get IfaceTickish " ++ show h)
+
 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
         -- We reconstruct the kind/type of the thing from the context
@@ -286,14 +777,44 @@ data IfaceConAlt = IfaceDefault
                  | IfaceDataAlt IfExtName
                  | IfaceLitAlt Literal
 
+instance Binary IfaceConAlt where
+    put_ bh IfaceDefault      = putByte bh 0
+    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
+    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfaceDefault
+            1 -> liftM IfaceDataAlt $ get bh
+            _ -> liftM IfaceLitAlt  $ get bh
+
 data IfaceBinding
   = IfaceNonRec IfaceLetBndr IfaceExpr
   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
 
+instance Binary IfaceBinding where
+    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
+    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
+            _ -> do { ac <- get bh; return (IfaceRec ac) }
+
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]
 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
+
+instance Binary IfaceLetBndr where
+    put_ bh (IfLetBndr a b c) = do
+            put_ bh a
+            put_ bh b
+            put_ bh c
+    get bh = do a <- get bh
+                b <- get bh
+                c <- get bh
+                return (IfLetBndr a b c)
 \end{code}
 
 Note [Empty case alternatives]
@@ -496,21 +1017,28 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
 
 pprIfaceDecl (IfaceSyn {ifName = tycon,
                         ifTyVars = tyvars,
-                        ifSynRhs = SynonymTyCon mono_ty})
-  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
+                        ifRoles = roles,
+                        ifSynRhs = IfaceSynonymTyCon mono_ty})
+  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars roles)
        4 (vcat [equals <+> ppr mono_ty])
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
-                        ifSynRhs = SynFamilyTyCon {}, ifSynKind = kind })
-  = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifRoles = roles,
+                        ifSynRhs = IfaceOpenSynFamilyTyCon, ifSynKind = kind })
+  = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars roles)
+       4 (dcolon <+> ppr kind)
+
+-- this case handles both abstract and instantiated closed family tycons
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifRoles = roles,
+                        ifSynRhs = _closedSynFamilyTyCon, ifSynKind = kind })
+  = hang (ptext (sLit "closed type family") <+> pprIfaceDeclHead [] tycon tyvars roles)
        4 (dcolon <+> ppr kind)
 
 pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
                          ifCtxt = context,
-                         ifTyVars = tyvars, ifCons = condecls,
+                         ifTyVars = tyvars, ifRoles = roles, ifCons = condecls,
                          ifRec = isrec, ifPromotable = is_prom,
                          ifAxiom = mbAxiom})
-  = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
+  = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars roles)
        4 (vcat [ pprCType cType
                , pprRec isrec <> comma <+> pp_prom 
                , pp_condecls tycon condecls
@@ -525,19 +1053,16 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
                 IfNewTyCon _        -> ptext (sLit "newtype")
 
 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
-                          ifFDs = fds, ifATs = ats, ifSigs = sigs,
+                          ifRoles = roles, ifFDs = fds, ifATs = ats, ifSigs = sigs,
                           ifRec = isrec})
-  = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
+  = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars roles <+> pprFundeps fds)
        4 (vcat [pprRec isrec,
                 sep (map ppr ats),
                 sep (map ppr sigs)])
 
 pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branches })
   = hang (ptext (sLit "axiom") <+> ppr name <> colon)
-       2 (vcat $ map ppr_branch branches)
-  where
-     ppr_branch (IfaceAxBranch { ifaxbTyVars = tyvars, ifaxbLHS = lhs, ifaxbRHS = rhs })
-        = pprIfaceTvBndrs tyvars <> dot <+> ppr (IfaceTyConApp tycon lhs) <+> text "~#" <+> ppr rhs
+       2 (vcat $ map (pprAxBranch $ Just tycon) branches)
 
 pprCType :: Maybe CType -> SDoc
 pprCType Nothing = ptext (sLit "No C type associated")
@@ -556,10 +1081,10 @@ instance Outputable IfaceClassOp where
 instance Outputable IfaceAT where
    ppr (IfaceAT d defs) = hang (ppr d) 2 (vcat (map ppr defs))
 
-pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
-pprIfaceDeclHead context thing tyvars
+pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> [Role] -> SDoc
+pprIfaceDeclHead context thing tyvars roles
   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
-          pprIfaceTvBndrs tyvars]
+          pprIfaceTvBndrsRoles tyvars roles]
 
 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 pp_condecls _  (IfAbstractTyCon {}) = empty
@@ -589,7 +1114,7 @@ pprIfaceConDecl tc
     ppr_bang IfNoBang = char '_'        -- Want to see these
     ppr_bang IfStrict = char '!'
     ppr_bang IfUnpack = ptext (sLit "!!")
-    ppr_bang (IfUnpackCo co) = ptext (sLit "!!") <> pprParendIfaceType co
+    ppr_bang (IfUnpackCo co) = ptext (sLit "!!") <> pprParendIfaceCoercion co
 
     main_payload = ppr name <+> dcolon <+>
                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
@@ -622,10 +1147,10 @@ instance Outputable IfaceClsInst where
          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
-  ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcss,
+  ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
                      ifFamInstAxiom = tycon_ax})
     = hang (ptext (sLit "family instance") <+>
-            ppr fam <+> pprWithCommas (brackets . pprWithCommas ppr_rough) mb_tcss)
+            ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
          2 (equals <+> ppr tycon_ax)
 
 ppr_rough :: Maybe IfaceTyCon -> SDoc
@@ -654,7 +1179,7 @@ pprIfaceExpr _       (IfaceExt v)       = ppr v
 pprIfaceExpr _       (IfaceLit l)       = ppr l
 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
-pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceType co
+pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceCoercion co
 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
@@ -687,7 +1212,7 @@ pprIfaceExpr add_par (IfaceCase scrut bndr alts)
 pprIfaceExpr _       (IfaceCast expr co)
   = sep [pprParendIfaceExpr expr,
          nest 2 (ptext (sLit "`cast`")),
-         pprParendIfaceType co]
+         pprParendIfaceCoercion co]
 
 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
   = add_par (sep [ptext (sLit "let {"),
@@ -763,9 +1288,9 @@ instance Outputable IfaceUnfolding where
   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
                                             <+> ppr (a,uok,bok),
                                         pprParendIfaceExpr e]
-  ppr (IfWrapper e) = ptext (sLit "Wrapper") <+> parens (ppr e)
-  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
-                             <+> brackets (pprWithCommas ppr ns)
+  ppr (IfWrapper e) = ptext (sLit "Wrapper:") <+> parens (ppr e)
+  ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
+                                2 (sep (map pprParendIfaceExpr es))
 
 -- -----------------------------------------------------------------------------
 -- | Finding the Names in IfaceSyn
@@ -816,9 +1341,11 @@ freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
 freeNamesIfIdDetails _                 = emptyNameSet
 
 -- All other changes are handled via the version info on the tycon
-freeNamesIfSynRhs :: SynTyConRhs IfaceType -> NameSet
-freeNamesIfSynRhs (SynonymTyCon ty) = freeNamesIfType ty
-freeNamesIfSynRhs _                 = emptyNameSet
+freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
+freeNamesIfSynRhs (IfaceSynonymTyCon ty)            = freeNamesIfType ty
+freeNamesIfSynRhs IfaceOpenSynFamilyTyCon           = emptyNameSet
+freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax)    = unitNameSet ax
+freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
@@ -856,8 +1383,35 @@ freeNamesIfType (IfaceLitTy _)        = emptyNameSet
 freeNamesIfType (IfaceForAllTy tv t)  =
    freeNamesIfTvBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
-freeNamesIfType (IfaceCoConApp tc ts) = 
-   freeNamesIfCo tc &&& fnList freeNamesIfType ts
+
+freeNamesIfCoercion :: IfaceCoercion -> NameSet
+freeNamesIfCoercion (IfaceReflCo _ t) = freeNamesIfType t
+freeNamesIfCoercion (IfaceFunCo _ c1 c2)
+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
+freeNamesIfCoercion (IfaceTyConAppCo _ tc cos)
+  = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos
+freeNamesIfCoercion (IfaceAppCo c1 c2)
+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
+freeNamesIfCoercion (IfaceForAllCo tv co)
+  = freeNamesIfTvBndr tv &&& freeNamesIfCoercion co
+freeNamesIfCoercion (IfaceCoVarCo _)
+  = emptyNameSet
+freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)
+  = unitNameSet ax &&& fnList freeNamesIfCoercion cos
+freeNamesIfCoercion (IfaceUnivCo _ t1 t2)
+  = freeNamesIfType t1 &&& freeNamesIfType t2
+freeNamesIfCoercion (IfaceSymCo c)
+  = freeNamesIfCoercion c
+freeNamesIfCoercion (IfaceTransCo c1 c2)
+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
+freeNamesIfCoercion (IfaceNthCo _ co)
+  = freeNamesIfCoercion co
+freeNamesIfCoercion (IfaceLRCo _ co)
+  = freeNamesIfCoercion co
+freeNamesIfCoercion (IfaceInstCo co ty)
+  = freeNamesIfCoercion co &&& freeNamesIfType ty
+freeNamesIfCoercion (IfaceSubCo co)
+  = freeNamesIfCoercion co
 
 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
@@ -893,17 +1447,17 @@ freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfWrapper e)          = freeNamesIfExpr e
-freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
+freeNamesIfUnfold (IfDFunUnfold bs es)   = fnList freeNamesIfBndr bs &&& fnList freeNamesIfExpr es
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
-freeNamesIfExpr (IfaceCo co)      = freeNamesIfType co
+freeNamesIfExpr (IfaceCo co)      = freeNamesIfCoercion co
 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
-freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
+freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfCoercion co
 freeNamesIfExpr (IfaceTick _ e)   = freeNamesIfExpr e
 freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
 freeNamesIfExpr (IfaceCase s _ alts)
@@ -933,11 +1487,6 @@ freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 
-freeNamesIfCo :: IfaceCoCon -> NameSet
-freeNamesIfCo (IfaceCoAx tc _) = unitNameSet tc
--- ToDo: include IfaceIPCoAx? Probably not necessary.
-freeNamesIfCo _ = emptyNameSet
-
 freeNamesIfRule :: IfaceRule -> NameSet
 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
                            , ifRuleArgs = es, ifRuleRhs = rhs })
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 103d336dbb..b9d6a445cf 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -9,22 +9,24 @@ This module defines interface types and binders
 module IfaceType (
         IfExtName, IfLclName,
 
-        IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoCon(..),
+        IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoercion(..),
         IfaceTyLit(..),
-        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
+        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, 
 
         -- Conversion from Type -> IfaceType
         toIfaceType, toIfaceKind, toIfaceContext,
         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
         toIfaceTyCon, toIfaceTyCon_name,
 
-        -- Conversion from Coercion -> IfaceType
-        coToIfaceType,
+        -- Conversion from Coercion -> IfaceCoercion
+        toIfaceCoercion,
 
         -- Printing
         pprIfaceType, pprParendIfaceType, pprIfaceContext,
-        pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
-        tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
+        pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceTvBndrsRoles,
+        pprIfaceBndrs,
+        tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart,
+        pprIfaceCoercion, pprParendIfaceCoercion
 
     ) where
 
@@ -40,8 +42,11 @@ import TysPrim
 import PrelNames( funTyConKey )
 import Name
 import BasicTypes
+import Binary
 import Outputable
 import FastString
+
+import Control.Monad
 \end{code}
 
 %************************************************************************
@@ -65,16 +70,14 @@ type IfaceTvBndr  = (IfLclName, IfaceKind)
 
 -------------------------------
 type IfaceKind     = IfaceType
-type IfaceCoercion = IfaceType
 
-data IfaceType     -- A kind of universal type, used for types, kinds, and coercions
+data IfaceType     -- A kind of universal type, used for types and kinds
   = IfaceTyVar    IfLclName               -- Type/coercion variable only, not tycon
   | IfaceAppTy    IfaceType IfaceType
   | IfaceFunTy    IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
   | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
                                           -- Includes newtypes, synonyms, tuples
-  | IfaceCoConApp IfaceCoCon [IfaceType]  -- Always saturated
   | IfaceLitTy IfaceTyLit
 
 type IfacePredType = IfaceType
@@ -88,12 +91,21 @@ data IfaceTyLit
 -- coercion constructors, the lot
 newtype IfaceTyCon = IfaceTc { ifaceTyConName :: IfExtName }
 
-  -- Coercion constructors
-data IfaceCoCon
-  = IfaceCoAx IfExtName Int -- Int is 0-indexed branch number
-  | IfaceReflCo    | IfaceUnsafeCo  | IfaceSymCo
-  | IfaceTransCo   | IfaceInstCo
-  | IfaceNthCo Int | IfaceLRCo LeftOrRight
+data IfaceCoercion
+  = IfaceReflCo      Role IfaceType
+  | IfaceFunCo       Role IfaceCoercion IfaceCoercion
+  | IfaceTyConAppCo  Role IfaceTyCon [IfaceCoercion]
+  | IfaceAppCo       IfaceCoercion IfaceCoercion
+  | IfaceForAllCo    IfaceTvBndr IfaceCoercion
+  | IfaceCoVarCo     IfLclName
+  | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
+  | IfaceUnivCo      Role IfaceType IfaceType
+  | IfaceSymCo       IfaceCoercion
+  | IfaceTransCo     IfaceCoercion IfaceCoercion
+  | IfaceNthCo       Int IfaceCoercion
+  | IfaceLRCo        LeftOrRight IfaceCoercion
+  | IfaceInstCo      IfaceCoercion IfaceType
+  | IfaceSubCo       IfaceCoercion
 \end{code}
 
 %************************************************************************
@@ -173,6 +185,26 @@ pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 
 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 pprIfaceTvBndrs tyvars = sep (map pprIfaceTvBndr tyvars)
+
+pprIfaceTvBndrsRoles :: [IfaceTvBndr] -> [Role] -> SDoc
+pprIfaceTvBndrsRoles tyvars roles = sep (zipWith ppr_bndr_role tyvars roles)
+  where
+    ppr_bndr_role bndr role = pprIfaceTvBndr bndr <> char '@' <> ppr role
+
+instance Binary IfaceBndr where
+    put_ bh (IfaceIdBndr aa) = do
+            putByte bh 0
+            put_ bh aa
+    put_ bh (IfaceTvBndr ab) = do
+            putByte bh 1
+            put_ bh ab
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do aa <- get bh
+                      return (IfaceIdBndr aa)
+              _ -> do ab <- get bh
+                      return (IfaceTvBndr ab)
 \end{code}
 
 ----------------------------- Printing IfaceType ------------------------------------
@@ -193,14 +225,10 @@ isIfacePredTy _  = False
 
 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 ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ppr_ty ctxt_prec tc tys
 
 ppr_ty _ (IfaceLitTy n) = ppr_tylit n
 
-ppr_ty ctxt_prec (IfaceCoConApp tc tys)
-  = maybeParen ctxt_prec tYCON_PREC
-               (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
-
         -- Function types
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
@@ -225,7 +253,9 @@ ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
     (tvs, theta, tau) = splitIfaceSigmaTy ty
 
  -------------------
-pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
+-- needs to handle type contexts and coercion contexts, hence the
+-- generality
+pprIfaceForAllPart :: Outputable a => [IfaceTvBndr] -> [a] -> SDoc -> SDoc
 pprIfaceForAllPart tvs ctxt doc
   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
   where
@@ -233,20 +263,23 @@ pprIfaceForAllPart tvs ctxt doc
             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 
 -------------------
-ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
-ppr_tc_app _         tc          []   = ppr_tc tc
+ppr_tc_app :: (Int -> a -> SDoc) -> Int -> IfaceTyCon -> [a] -> SDoc
+ppr_tc_app _  _         tc          []   = ppr_tc tc
 
 
-ppr_tc_app _         (IfaceTc n) [ty] | n == listTyConName = brackets (pprIfaceType ty)
-ppr_tc_app _         (IfaceTc n) [ty] | n == parrTyConName = paBrackets (pprIfaceType ty)
-ppr_tc_app _         (IfaceTc n) tys
+ppr_tc_app pp _         (IfaceTc n) [ty]
+  | n == listTyConName
+  = brackets (pp tOP_PREC ty)
+  | n == parrTyConName
+  = paBrackets (pp tOP_PREC ty)
+ppr_tc_app pp _         (IfaceTc n) tys
   | Just (ATyCon tc) <- wiredInNameTyThing_maybe n
   , Just sort <- tyConTuple_maybe tc
   , tyConArity tc == length tys
-  = tupleParens sort (sep (punctuate comma (map pprIfaceType tys)))
-ppr_tc_app ctxt_prec tc tys
+  = tupleParens sort (sep (punctuate comma (map (pp tOP_PREC) tys)))
+ppr_tc_app pp ctxt_prec tc tys
   = maybeParen ctxt_prec tYCON_PREC
-               (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
+               (sep [ppr_tc tc, nest 4 (sep (map (pp tYCON_PREC) tys))])
 
 ppr_tc :: IfaceTyCon -> SDoc
 -- Wrap infix type constructors in parens
@@ -260,32 +293,255 @@ ppr_tylit :: IfaceTyLit -> SDoc
 ppr_tylit (IfaceNumTyLit n) = integer n
 ppr_tylit (IfaceStrTyLit n) = text (show n)
 
+pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
+pprIfaceCoercion = ppr_co tOP_PREC
+pprParendIfaceCoercion = ppr_co tYCON_PREC
+
+ppr_co :: Int -> IfaceCoercion -> SDoc
+ppr_co _         (IfaceReflCo r ty) = angleBrackets (ppr ty) <> ppr_role r
+ppr_co ctxt_prec (IfaceFunCo r co1 co2)
+  = maybeParen ctxt_prec fUN_PREC $
+    sep (ppr_co fUN_PREC co1 : ppr_fun_tail co2)
+  where
+    ppr_fun_tail (IfaceFunCo r co1 co2)
+      = (arrow <> ppr_role r <+> ppr_co fUN_PREC co1) : ppr_fun_tail co2
+    ppr_fun_tail other_co
+      = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
+
+ppr_co _         (IfaceTyConAppCo r tc cos)
+  = parens (ppr_tc_app ppr_co tOP_PREC tc cos) <> ppr_role r
+ppr_co ctxt_prec (IfaceAppCo co1 co2)
+  = maybeParen ctxt_prec tYCON_PREC $
+    ppr_co fUN_PREC co1 <+> pprParendIfaceCoercion co2
+ppr_co ctxt_prec co@(IfaceForAllCo _ _)
+  = maybeParen ctxt_prec fUN_PREC (sep [ppr_tvs, pprIfaceCoercion inner_co])
+  where
+    (tvs, inner_co) = split_co co
+    ppr_tvs = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
+
+    split_co (IfaceForAllCo tv co')
+      = let (tvs, co'') = split_co co' in (tv:tvs,co'')
+    split_co co' = ([], co')
+
+ppr_co _         (IfaceCoVarCo covar)       = ppr covar
+
+ppr_co ctxt_prec (IfaceUnivCo r ty1 ty2)
+  = maybeParen ctxt_prec tYCON_PREC $
+    ptext (sLit "UnivCo") <+> ppr r <+>
+    pprParendIfaceType ty1 <+> pprParendIfaceType ty2
+
+ppr_co ctxt_prec (IfaceInstCo co ty)
+  = maybeParen ctxt_prec tYCON_PREC $
+    ptext (sLit "Inst") <+> pprParendIfaceCoercion co <+> pprParendIfaceType ty
+
+ppr_co ctxt_prec co
+  = ppr_special_co ctxt_prec doc cos
+  where (doc, cos) = case co of
+                     { IfaceAxiomInstCo n i cos -> (ppr n <> brackets (ppr i), cos)
+                     ; IfaceSymCo co            -> (ptext (sLit "Sym"), [co])
+                     ; IfaceTransCo co1 co2     -> (ptext (sLit "Trans"), [co1,co2])
+                     ; IfaceNthCo d co          -> (ptext (sLit "Nth:") <> int d,
+                                                    [co])
+                     ; IfaceLRCo lr co          -> (ppr lr, [co])
+                     ; IfaceSubCo co            -> (ptext (sLit "Sub"), [co])
+                     ; _                        -> panic "pprIfaceCo" }
+
+ppr_special_co :: Int -> SDoc -> [IfaceCoercion] -> SDoc
+ppr_special_co ctxt_prec doc cos
+  = maybeParen ctxt_prec tYCON_PREC
+               (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
+
+ppr_role :: Role -> SDoc
+ppr_role r = underscore <> ppr r
+
 -------------------
 instance Outputable IfaceTyCon where
   ppr = ppr . ifaceTyConName
 
-instance Outputable IfaceCoCon where
-  ppr (IfaceCoAx n i)  = ppr n <> brackets (ppr i)
-  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 (IfaceLRCo lr)   = ppr lr
+instance Outputable IfaceCoercion where
+  ppr = pprIfaceCoercion
+
+instance Binary IfaceTyCon where
+   put_ bh (IfaceTc ext) = put_ bh ext
+   get bh = liftM IfaceTc (get bh)
 
 instance Outputable IfaceTyLit where
   ppr = ppr_tylit
 
+instance Binary IfaceTyLit where
+  put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n
+  put_ bh (IfaceStrTyLit n)  = putByte bh 2 >> put_ bh n
+
+  get bh =
+    do tag <- getByte bh
+       case tag of
+         1 -> do { n <- get bh
+                 ; return (IfaceNumTyLit n) }
+         2 -> do { n <- get bh
+                 ; return (IfaceStrTyLit n) }
+         _ -> panic ("get IfaceTyLit " ++ show tag)
+
 -------------------
-pprIfaceContext :: IfaceContext -> SDoc
+pprIfaceContext :: Outputable a => [a] -> SDoc
 -- Prints "(C a, D b) =>", including the arrow
 pprIfaceContext []    = empty
 pprIfaceContext theta = ppr_preds theta <+> darrow
 
-ppr_preds :: [IfacePredType] -> SDoc
+ppr_preds :: Outputable a => [a] -> SDoc
 ppr_preds [pred] = ppr pred    -- No parens
 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
+
+instance Binary IfaceType where
+    put_ bh (IfaceForAllTy aa ab) = do
+            putByte bh 0
+            put_ bh aa
+            put_ bh ab
+    put_ bh (IfaceTyVar ad) = do
+            putByte bh 1
+            put_ bh ad
+    put_ bh (IfaceAppTy ae af) = do
+            putByte bh 2
+            put_ bh ae
+            put_ bh af
+    put_ bh (IfaceFunTy ag ah) = do
+            putByte bh 3
+            put_ bh ag
+            put_ bh ah
+    put_ bh (IfaceTyConApp tc tys)
+      = do { putByte bh 5; put_ bh tc; put_ bh tys }
+
+    put_ bh (IfaceLitTy n)
+      = do { putByte bh 30; put_ bh n }
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do aa <- get bh
+                      ab <- get bh
+                      return (IfaceForAllTy aa ab)
+              1 -> do ad <- get bh
+                      return (IfaceTyVar ad)
+              2 -> do ae <- get bh
+                      af <- get bh
+                      return (IfaceAppTy ae af)
+              3 -> do ag <- get bh
+                      ah <- get bh
+                      return (IfaceFunTy ag ah)
+              5 -> do { tc <- get bh; tys <- get bh
+                      ; return (IfaceTyConApp tc tys) }
+
+              30 -> do n <- get bh
+                       return (IfaceLitTy n)
+
+              _  -> panic ("get IfaceType " ++ show h)
+
+instance Binary IfaceCoercion where
+  put_ bh (IfaceReflCo a b) = do
+          putByte bh 1
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceFunCo a b c) = do
+          putByte bh 2
+          put_ bh a
+          put_ bh b
+          put_ bh c
+  put_ bh (IfaceTyConAppCo a b c) = do
+          putByte bh 3
+          put_ bh a
+          put_ bh b
+          put_ bh c
+  put_ bh (IfaceAppCo a b) = do
+          putByte bh 4
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceForAllCo a b) = do
+          putByte bh 5
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceCoVarCo a) = do
+          putByte bh 6
+          put_ bh a
+  put_ bh (IfaceAxiomInstCo a b c) = do
+          putByte bh 7
+          put_ bh a
+          put_ bh b
+          put_ bh c
+  put_ bh (IfaceUnivCo a b c) = do
+          putByte bh 8
+          put_ bh a
+          put_ bh b
+          put_ bh c
+  put_ bh (IfaceSymCo a) = do
+          putByte bh 9
+          put_ bh a
+  put_ bh (IfaceTransCo a b) = do
+          putByte bh 10
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceNthCo a b) = do
+          putByte bh 11
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceLRCo a b) = do
+          putByte bh 12
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceInstCo a b) = do
+          putByte bh 13
+          put_ bh a
+          put_ bh b
+  put_ bh (IfaceSubCo a) = do
+          putByte bh 14
+          put_ bh a
+  
+  get bh = do
+      tag <- getByte bh
+      case tag of
+           1 -> do a <- get bh
+                   b <- get bh
+                   return $ IfaceReflCo a b
+           2 -> do a <- get bh
+                   b <- get bh
+                   c <- get bh
+                   return $ IfaceFunCo a b c
+           3 -> do a <- get bh
+                   b <- get bh
+                   c <- get bh
+                   return $ IfaceTyConAppCo a b c
+           4 -> do a <- get bh
+                   b <- get bh
+                   return $ IfaceAppCo a b
+           5 -> do a <- get bh
+                   b <- get bh
+                   return $ IfaceForAllCo a b
+           6 -> do a <- get bh
+                   return $ IfaceCoVarCo a
+           7 -> do a <- get bh
+                   b <- get bh
+                   c <- get bh
+                   return $ IfaceAxiomInstCo a b c
+           8 -> do a <- get bh
+                   b <- get bh
+                   c <- get bh
+                   return $ IfaceUnivCo a b c
+           9 -> do a <- get bh
+                   return $ IfaceSymCo a
+           10-> do a <- get bh
+                   b <- get bh
+                   return $ IfaceTransCo a b
+           11-> do a <- get bh
+                   b <- get bh
+                   return $ IfaceNthCo a b
+           12-> do a <- get bh
+                   b <- get bh
+                   return $ IfaceLRCo a b
+           13-> do a <- get bh
+                   b <- get bh
+                   return $ IfaceInstCo a b
+           14-> do a <- get bh
+                   return $ IfaceSubCo a
+           _ -> panic ("get IfaceCoercion " ++ show tag)             
+
 \end{code}
 
 %************************************************************************
@@ -347,38 +603,31 @@ toIfaceContext :: ThetaType -> IfaceContext
 toIfaceContext = toIfaceTypes
 
 ----------------
-coToIfaceType :: Coercion -> IfaceType
-coToIfaceType (Refl ty)             = IfaceCoConApp IfaceReflCo [toIfaceType ty]
-coToIfaceType (TyConAppCo tc cos)
+toIfaceCoercion :: Coercion -> IfaceCoercion
+toIfaceCoercion (Refl r ty)         = IfaceReflCo r (toIfaceType ty)
+toIfaceCoercion (TyConAppCo r tc cos)
   | tc `hasKey` funTyConKey
-  , [arg,res] <- cos                = IfaceFunTy (coToIfaceType arg) (coToIfaceType res)
-  | otherwise                       = IfaceTyConApp (toIfaceTyCon tc)
-                                                    (map coToIfaceType cos)
-coToIfaceType (AppCo co1 co2)       = IfaceAppTy    (coToIfaceType co1)
-                                                    (coToIfaceType co2)
-coToIfaceType (ForAllCo v co)       = IfaceForAllTy (toIfaceTvBndr v)
-                                                    (coToIfaceType co)
-coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceCoVar cv)
-coToIfaceType (AxiomInstCo con ind cos)
-                                    = IfaceCoConApp (coAxiomToIfaceType con ind)
-                                                    (map coToIfaceType cos)
-coToIfaceType (UnsafeCo ty1 ty2)    = IfaceCoConApp IfaceUnsafeCo
-                                                    [ toIfaceType ty1
-                                                    , toIfaceType ty2 ]
-coToIfaceType (SymCo co)            = IfaceCoConApp IfaceSymCo
-                                                    [ coToIfaceType co ]
-coToIfaceType (TransCo co1 co2)     = IfaceCoConApp IfaceTransCo
-                                                    [ coToIfaceType co1
-                                                    , coToIfaceType co2 ]
-coToIfaceType (NthCo d co)          = IfaceCoConApp (IfaceNthCo d)
-                                                    [ coToIfaceType co ]
-coToIfaceType (LRCo lr co)          = IfaceCoConApp (IfaceLRCo lr)
-                                                    [ coToIfaceType co ]
-coToIfaceType (InstCo co ty)        = IfaceCoConApp IfaceInstCo
-                                                    [ coToIfaceType co
-                                                    , toIfaceType ty ]
-
-coAxiomToIfaceType :: CoAxiom br -> Int -> IfaceCoCon
-coAxiomToIfaceType con ind = IfaceCoAx (coAxiomName con) ind
+  , [arg,res] <- cos                = IfaceFunCo r (toIfaceCoercion arg) (toIfaceCoercion res)
+  | otherwise                       = IfaceTyConAppCo r (toIfaceTyCon tc)
+                                                      (map toIfaceCoercion cos)
+toIfaceCoercion (AppCo co1 co2)     = IfaceAppCo  (toIfaceCoercion co1)
+                                                  (toIfaceCoercion co2)
+toIfaceCoercion (ForAllCo v co)     = IfaceForAllCo (toIfaceTvBndr v)
+                                                    (toIfaceCoercion co)
+toIfaceCoercion (CoVarCo cv)        = IfaceCoVarCo  (toIfaceCoVar cv)
+toIfaceCoercion (AxiomInstCo con ind cos)
+                                    = IfaceAxiomInstCo (coAxiomName con) ind
+                                                       (map toIfaceCoercion cos)
+toIfaceCoercion (UnivCo r ty1 ty2)  = IfaceUnivCo r (toIfaceType ty1)
+                                                  (toIfaceType ty2)
+toIfaceCoercion (SymCo co)          = IfaceSymCo (toIfaceCoercion co)
+toIfaceCoercion (TransCo co1 co2)   = IfaceTransCo (toIfaceCoercion co1)
+                                                   (toIfaceCoercion co2)
+toIfaceCoercion (NthCo d co)        = IfaceNthCo d (toIfaceCoercion co)
+toIfaceCoercion (LRCo lr co)        = IfaceLRCo lr (toIfaceCoercion co)
+toIfaceCoercion (InstCo co ty)      = IfaceInstCo (toIfaceCoercion co)
+                                                  (toIfaceType ty)
+toIfaceCoercion (SubCo co)          = IfaceSubCo (toIfaceCoercion co)
+
 \end{code}
 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 5f3b7a5aae..25044224e7 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -311,7 +311,6 @@ mkIface_ hsc_env maybe_old_fingerprint
                         mi_warn_fn     = mkIfaceWarnCache warns,
                         mi_fix_fn      = mkIfaceFixCache fixities }
                 }
-
         ; (new_iface, no_change_at_all) 
                 <- {-# SCC "versioninfo" #-}
                          addFingerprints hsc_env maybe_old_fingerprint
@@ -1442,19 +1441,40 @@ idToIfaceDecl id
 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
 -- We *do* tidy Axioms, because they are not (and cannot 
 -- conveniently be) built in tidy form
-coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches })
+coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
+                               , co_ax_role = role })
  = IfaceAxiom { ifName       = name
               , ifTyCon      = toIfaceTyCon tycon
-              , ifAxBranches = brListMap (coAxBranchToIfaceBranch emptyTidyEnv) branches }
+              , ifRole       = role
+              , ifAxBranches = brListMap (coAxBranchToIfaceBranch
+                                            emptyTidyEnv
+                                            (brListMap coAxBranchLHS branches)) branches }
  where
    name = getOccName ax
 
-
-coAxBranchToIfaceBranch :: TidyEnv -> CoAxBranch -> IfaceAxBranch
-coAxBranchToIfaceBranch env0 (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs, cab_rhs = rhs })
+-- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches
+-- to incompatible indices
+-- See [Storing compatibility] in CoAxiom
+coAxBranchToIfaceBranch :: TidyEnv -> [[Type]] -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch env0 lhs_s
+                        branch@(CoAxBranch { cab_incomps = incomps })
+  = (coAxBranchToIfaceBranch' env0 branch) { ifaxbIncomps = iface_incomps }
+  where
+    iface_incomps = map (expectJust "iface_incomps"
+                        . (flip findIndex lhs_s
+                          . eqTypes)
+                        . coAxBranchLHS) incomps
+
+-- use this one for standalone branches without incompatibles
+coAxBranchToIfaceBranch' :: TidyEnv -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch' env0
+                        (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs
+                                    , cab_roles = roles, cab_rhs = rhs })
   = IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tv_bndrs
                   , ifaxbLHS    = map (tidyToIfaceType env1) lhs
-                  , ifaxbRHS    = tidyToIfaceType env1 rhs }
+                  , ifaxbRoles  = roles
+                  , ifaxbRHS    = tidyToIfaceType env1 rhs
+                  , ifaxbIncomps = [] }
   where
     (env1, tv_bndrs) = tidyTyVarBndrs env0 tvs
 
@@ -1469,6 +1489,7 @@ tyConToIfaceDecl env tycon
   | Just syn_rhs <- synTyConRhs_maybe tycon
   = IfaceSyn {  ifName    = getOccName tycon,
                 ifTyVars  = toIfaceTvBndrs tyvars,
+                ifRoles   = tyConRoles tycon,
                 ifSynRhs  = to_ifsyn_rhs syn_rhs,
                 ifSynKind = tidyToIfaceType env1 (synTyConResKind tycon) }
 
@@ -1476,6 +1497,7 @@ tyConToIfaceDecl env tycon
   = IfaceData { ifName    = getOccName tycon,
                 ifCType   = tyConCType tycon,
                 ifTyVars  = toIfaceTvBndrs tyvars,
+                ifRoles   = tyConRoles tycon,
                 ifCtxt    = tidyToIfaceContext env1 (tyConStupidTheta tycon),
                 ifCons    = ifaceConDecls (algTyConRhs tycon),
                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
@@ -1491,8 +1513,12 @@ tyConToIfaceDecl env tycon
   where
     (env1, tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
 
-    to_ifsyn_rhs (SynFamilyTyCon a b) = SynFamilyTyCon a b
-    to_ifsyn_rhs (SynonymTyCon ty)    = SynonymTyCon (tidyToIfaceType env1 ty)
+    to_ifsyn_rhs OpenSynFamilyTyCon           = IfaceOpenSynFamilyTyCon
+    to_ifsyn_rhs (ClosedSynFamilyTyCon ax)    
+      = IfaceClosedSynFamilyTyCon (coAxiomName ax)
+    to_ifsyn_rhs AbstractClosedSynFamilyTyCon = IfaceAbstractClosedSynFamilyTyCon
+    to_ifsyn_rhs (SynonymTyCon ty)            
+      = IfaceSynonymTyCon (tidyToIfaceType env1 ty)
 
     ifaceConDecls (NewTyCon { data_con = con })     = IfNewTyCon  (ifaceConDecl con)
     ifaceConDecls (DataTyCon { data_cons = cons })  = IfDataTyCon (map ifaceConDecl cons)
@@ -1528,7 +1554,7 @@ tyConToIfaceDecl env tycon
 toIfaceBang :: TidyEnv -> HsBang -> IfaceBang
 toIfaceBang _    HsNoBang            = IfNoBang
 toIfaceBang _   (HsUnpack Nothing)   = IfUnpack
-toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (coToIfaceType (tidyCo env co))
+toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
 toIfaceBang _   HsStrict             = IfStrict
 toIfaceBang _   (HsUserBang {})      = panic "toIfaceBang"
 
@@ -1537,6 +1563,7 @@ classToIfaceDecl env clas
   = IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
                  ifName   = getOccName (classTyCon clas),
                  ifTyVars = toIfaceTvBndrs clas_tyvars',
+                 ifRoles  = tyConRoles (classTyCon clas),
                  ifFDs    = map toIfaceFD clas_fds,
                  ifATs    = map toIfaceAT clas_ats,
                  ifSigs   = map toIfaceClassOp op_stuff,
@@ -1550,7 +1577,7 @@ classToIfaceDecl env clas
     
     toIfaceAT :: ClassATItem -> IfaceAT
     toIfaceAT (tc, defs)
-      = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch env1) defs)
+      = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch' env1) defs)
 
     toIfaceClassOp (sel_id, def_meth)
         = ASSERT(sel_tyvars == clas_tyvars)
@@ -1638,19 +1665,15 @@ instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
                         (n : _) -> Just (nameOccName n)
 
 --------------------------
-famInstToIfaceFamInst :: FamInst br -> IfaceFamInst
+famInstToIfaceFamInst :: FamInst -> IfaceFamInst
 famInstToIfaceFamInst (FamInst { fi_axiom    = axiom,
-                                 fi_group    = group,
                                  fi_fam      = fam,
-                                 fi_branches = branches })
-  = IfaceFamInst { ifFamInstAxiom = coAxiomName axiom
-                 , ifFamInstFam   = fam
-                 , ifFamInstGroup = group
-                 , ifFamInstTys   = map (map do_rough) roughs
-                 , ifFamInstOrph  = orph }
+                                 fi_tcs      = roughs })
+  = IfaceFamInst { ifFamInstAxiom    = coAxiomName axiom
+                 , ifFamInstFam      = fam
+                 , ifFamInstTys      = map do_rough roughs
+                 , ifFamInstOrph     = orph }
   where
-    roughs = brListMap famInstBranchRoughMatch branches
-
     do_rough Nothing  = Nothing
     do_rough (Just n) = Just (toIfaceTyCon_name n)
 
@@ -1743,8 +1766,8 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
   where
     if_rhs = toIfaceExpr rhs
 
-toIfUnfolding lb (DFunUnfolding _ar _con ops)
-  = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))
+toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun
 
@@ -1774,7 +1797,7 @@ coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
         -- construct the same ru_rough field as we have right now;
         -- see tcIfaceRule
     do_arg (Type ty)     = IfaceType (toIfaceType (deNoteType ty))
-    do_arg (Coercion co) = IfaceCo   (coToIfaceType co)
+    do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)
     do_arg arg           = toIfaceExpr arg
 
         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
@@ -1797,14 +1820,14 @@ toIfaceExpr :: CoreExpr -> IfaceExpr
 toIfaceExpr (Var v)         = toIfaceVar v
 toIfaceExpr (Lit l)         = IfaceLit l
 toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)
-toIfaceExpr (Coercion co)   = IfaceCo   (coToIfaceType co)
+toIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)
 toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
 toIfaceExpr (App f a)       = toIfaceApp f [a]
 toIfaceExpr (Case s x ty as) 
   | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)
   | otherwise               = IfaceCase (toIfaceExpr s) (getFS x) (map toIfaceAlt as)
 toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)
-toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (coToIfaceType co)
+toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
 toIfaceExpr (Tick t e)    = IfaceTick (toIfaceTickish t) (toIfaceExpr e)
 
 ---------------------
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 2047b849ed..dffd69b9ed 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -436,7 +436,8 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
 
 tc_iface_decl parent _ (IfaceData {ifName = occ_name, 
                           ifCType = cType, 
-                          ifTyVars = tv_bndrs, 
+                          ifTyVars = tv_bndrs,
+                          ifRoles = roles,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons, 
                           ifRec = is_rec, ifPromotable = is_prom, 
@@ -447,7 +448,7 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
             { stupid_theta <- tcIfaceCtxt ctxt
             ; parent' <- tc_parent tyvars mb_axiom_name
             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
-            ; return (buildAlgTyCon tc_name tyvars cType stupid_theta 
+            ; return (buildAlgTyCon tc_name tyvars roles cType stupid_theta 
                                     cons is_rec is_prom gadt_syn parent') }
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
@@ -460,17 +461,25 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
            ; let fam_tc = coAxiomTyCon ax
                  ax_unbr = toUnbranchedAxiom ax
                  -- data families don't have branches:
-                 branch = coAxiomSingleBranch ax_unbr
-                 ax_tvs = coAxBranchTyVars branch
-                 ax_lhs = coAxBranchLHS branch
-                 subst = zipTopTvSubst ax_tvs (mkTyVarTys tyvars)
+                 branch    = coAxiomSingleBranch ax_unbr
+                 ax_tvs    = coAxBranchTyVars branch
+                 ax_lhs    = coAxBranchLHS branch
+                 tycon_tys = mkTyVarTys tyvars
+                 subst     = mkTopTvSubst (ax_tvs `zip` tycon_tys)
                             -- The subst matches the tyvar of the TyCon
                             -- with those from the CoAxiom.  They aren't
                             -- necessarily the same, since the two may be
                             -- gotten from separate interface-file declarations
-           ; return (FamInstTyCon ax_unbr fam_tc (substTys subst ax_lhs)) }
+                            -- NB: ax_tvs may be shorter because of eta-reduction
+                            -- See Note [Eta reduction for data family axioms] in TcInstDcls
+                 lhs_tys = substTys subst ax_lhs `chkAppend` 
+                           dropList ax_tvs tycon_tys
+                            -- The 'lhs_tys' should be 1-1 with the 'tyvars'
+                            -- but ax_tvs maybe shorter because of eta-reduction
+           ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
 
 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
+                                  ifRoles = roles,
                                   ifSynRhs = mb_rhs_ty,
                                   ifSynKind = kind })
    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
@@ -478,17 +487,21 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
      ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $ 
                    tc_syn_rhs mb_rhs_ty
-     ; tycon    <- buildSynTyCon tc_name tyvars rhs rhs_kind parent
+     ; tycon    <- buildSynTyCon tc_name tyvars roles rhs rhs_kind parent
      ; return (ATyCon tycon) }
    where
      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
-     tc_syn_rhs (SynFamilyTyCon a b) = return (SynFamilyTyCon a b)
-     tc_syn_rhs (SynonymTyCon ty)    = do { rhs_ty <- tcIfaceType ty
-                                          ; return (SynonymTyCon rhs_ty) }
+     tc_syn_rhs IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
+     tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name)
+       = do { ax <- tcIfaceCoAxiom ax_name
+            ; return (ClosedSynFamilyTyCon ax) }
+     tc_syn_rhs IfaceAbstractClosedSynFamilyTyCon = return AbstractClosedSynFamilyTyCon
+     tc_syn_rhs (IfaceSynonymTyCon ty)    = do { rhs_ty <- tcIfaceType ty
+                                               ; return (SynonymTyCon rhs_ty) }
 
 tc_iface_decl _parent ignore_prags
             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
-                         ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
+                         ifTyVars = tv_bndrs, ifRoles = roles, ifFDs = rdr_fds, 
                          ifATs = rdr_ats, ifSigs = rdr_sigs, 
                          ifRec = tc_isrec })
 -- ToDo: in hs-boot files we should really treat abstract classes specially,
@@ -504,7 +517,7 @@ tc_iface_decl _parent ignore_prags
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
               ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
-              ; buildClass ignore_prags tc_name tyvars ctxt fds ats sigs tc_isrec }
+              ; buildClass ignore_prags tc_name tyvars roles ctxt fds ats sigs tc_isrec }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -515,7 +528,6 @@ tc_iface_decl _parent ignore_prags
         --       data T a
         -- Here the associated type T is knot-tied with the class, and
         -- so we must not pull on T too eagerly.  See Trac #5970
-   mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
 
    tc_sig (IfaceClassOp occ dm rdr_ty)
      = do { op_name <- lookupIfaceTop occ
@@ -527,9 +539,15 @@ tc_iface_decl _parent ignore_prags
 
    tc_at cls (IfaceAT tc_decl defs_decls)
      = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
-          defs <- mapM tc_ax_branch defs_decls
+          defs <- forkM (mk_at_doc tc) $
+                  foldlM tc_ax_branches [] defs_decls
+                  -- Must be done lazily in case the RHS of the defaults mention
+                  -- the type constructor being defined here
+                  -- e.g.   type AT a; type AT b = AT [b]   Trac #8002
           return (tc, defs)
 
+   mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
+   mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
    mk_op_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
 
    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
@@ -539,28 +557,36 @@ tc_iface_decl _parent ignore_prags
 tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
   = do  { name <- lookupIfaceTop rdr_name
         ; return (ATyCon (mkForeignTyCon name ext_name 
-                                         liftedTypeKind 0)) }
+                                         liftedTypeKind)) }
 
-tc_iface_decl _ _ (IfaceAxiom {ifName = ax_occ, ifTyCon = tc, ifAxBranches = branches})
+tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
+                              , ifAxBranches = branches, ifRole = role })
   = do { tc_name     <- lookupIfaceTop ax_occ
        ; tc_tycon    <- tcIfaceTyCon tc
-       ; tc_branches <- mapM tc_ax_branch branches
-       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
+       ; tc_branches <- foldlM tc_ax_branches [] branches
+       ; let axiom = computeAxiomIncomps $
+                     CoAxiom { co_ax_unique   = nameUnique tc_name
                              , co_ax_name     = tc_name
                              , co_ax_tc       = tc_tycon
+                             , co_ax_role     = role
                              , co_ax_branches = toBranchList tc_branches
                              , co_ax_implicit = False }
        ; return (ACoAxiom axiom) }
 
-tc_ax_branch :: IfaceAxBranch -> IfL CoAxBranch
-tc_ax_branch (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs })
+tc_ax_branches :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
+tc_ax_branches prev_branches
+               (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
+                              , ifaxbRoles = roles, ifaxbIncomps = incomps })
   = bindIfaceTyVars tv_bndrs $ \ tvs -> do  -- Variables will all be fresh
     { tc_lhs <- mapM tcIfaceType lhs
     ; tc_rhs <- tcIfaceType rhs
-    ; return (CoAxBranch { cab_loc = noSrcSpan
-                         , cab_tvs = tvs
-                         , cab_lhs = tc_lhs
-                         , cab_rhs = tc_rhs } ) }
+    ; let br = CoAxBranch { cab_loc     = noSrcSpan
+                          , cab_tvs     = tvs
+                          , cab_lhs     = tc_lhs
+                          , cab_roles   = roles
+                          , cab_rhs     = tc_rhs
+                          , cab_incomps = map (prev_branches !!) incomps }
+    ; return (prev_branches ++ [br]) }
 
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
 tcIfaceDataCons tycon_name tycon _ if_cons
@@ -656,13 +682,15 @@ tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
 
-tcIfaceFamInst :: IfaceFamInst -> IfL (FamInst Branched)
-tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcss
-                             , ifFamInstGroup = group, ifFamInstAxiom = axiom_name } )
+tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
+tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
+                             , ifFamInstAxiom = axiom_name } )
     = do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
                      tcIfaceCoAxiom axiom_name
-         ; let mb_tcss' = map (map (fmap ifaceTyConName)) mb_tcss
-         ; return (mkImportedFamInst fam group mb_tcss' axiom') }
+             -- will panic if branched, but that's OK
+         ; let axiom'' = toUnbranchedAxiom axiom'
+               mb_tcs' = map (fmap ifaceTyConName) mb_tcs
+         ; return (mkImportedFamInst fam mb_tcs' axiom'') }
 \end{code}
 
 
@@ -892,7 +920,6 @@ tcIfaceType (IfaceTyConApp tc tks) = do { tc' <- tcIfaceTyCon tc
                                         ; tks' <- tcIfaceTcArgs (tyConKind tc') tks 
                                         ; return (mkTyConApp tc' tks') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
-tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
 
 tcIfaceTypes :: [IfaceType] -> IfL [Type]
 tcIfaceTypes tys = mapM tcIfaceType tys
@@ -960,28 +987,29 @@ This context business is why we need tcIfaceTcArgs.
 %************************************************************************
 
 \begin{code}
-tcIfaceCo :: IfaceType -> IfL Coercion
-tcIfaceCo (IfaceTyVar n)        = mkCoVarCo <$> tcIfaceCoVar n
-tcIfaceCo (IfaceAppTy t1 t2)    = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
-tcIfaceCo (IfaceFunTy t1 t2)    = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
-tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
-tcIfaceCo t@(IfaceLitTy _)      = mkReflCo <$> tcIfaceType t
-tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
-tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
-                                  mkForAllCo tv' <$> tcIfaceCo t
-
-tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
-tcIfaceCoApp IfaceReflCo      [t]     = Refl         <$> tcIfaceType t
-tcIfaceCoApp (IfaceCoAx n i)  ts      = AxiomInstCo  <$> tcIfaceCoAxiom n
-                                                     <*> pure i
-                                                     <*> 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 (IfaceLRCo lr)   [t]     = LRCo lr      <$> tcIfaceCo t
-tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
+tcIfaceCo :: IfaceCoercion -> IfL Coercion
+tcIfaceCo (IfaceReflCo r t)         = mkReflCo r <$> tcIfaceType t
+tcIfaceCo (IfaceFunCo r c1 c2)      = mkFunCo r <$> tcIfaceCo c1 <*> tcIfaceCo c2
+tcIfaceCo (IfaceTyConAppCo r tc cs) = mkTyConAppCo r <$> tcIfaceTyCon tc
+                                                     <*> mapM tcIfaceCo cs
+tcIfaceCo (IfaceAppCo c1 c2)        = mkAppCo <$> tcIfaceCo c1
+                                              <*> tcIfaceCo c2
+tcIfaceCo (IfaceForAllCo tv c)      = bindIfaceTyVar tv $ \ tv' ->
+                                      mkForAllCo tv' <$> tcIfaceCo c
+tcIfaceCo (IfaceCoVarCo n)          = mkCoVarCo <$> tcIfaceCoVar n
+tcIfaceCo (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n
+                                                  <*> pure i
+                                                  <*> mapM tcIfaceCo cs
+tcIfaceCo (IfaceUnivCo r t1 t2)     = UnivCo r <$> tcIfaceType t1
+                                               <*> tcIfaceType t2
+tcIfaceCo (IfaceSymCo c)            = SymCo    <$> tcIfaceCo c
+tcIfaceCo (IfaceTransCo c1 c2)      = TransCo  <$> tcIfaceCo c1
+                                               <*> tcIfaceCo c2
+tcIfaceCo (IfaceInstCo c1 t2)       = InstCo   <$> tcIfaceCo c1
+                                               <*> tcIfaceType t2
+tcIfaceCo (IfaceNthCo d c)          = NthCo d  <$> tcIfaceCo c
+tcIfaceCo (IfaceLRCo lr c)          = LRCo lr  <$> tcIfaceCo c
+tcIfaceCo (IfaceSubCo c)            = SubCo    <$> tcIfaceCo c
 
 tcIfaceCoVar :: FastString -> IfL CoVar
 tcIfaceCoVar = tcIfaceLclId
@@ -1263,15 +1291,15 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
                                                  (UnfWhen unsat_ok boring_ok))
     }
 
-tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
-  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops)
+  = bindIfaceBndrs bs $ \ bs' ->
+    do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
        ; return (case mb_ops1 of
                     Nothing   -> noUnfolding
-                    Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
+                    Just ops1 -> mkDFunUnfolding bs' (classDataCon cls) ops1) }
   where
     doc = text "Class ops for dfun" <+> ppr name
-    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
-    tc_arg (DFunLamArg i)   = return (DFunLamArg i)
+    (_, _, cls, _) = tcSplitDFunTy dfun_ty
 
 tcUnfolding name _ info (IfWrapper if_expr)
   = do  { mb_expr <- tcPragExpr name if_expr
diff --git a/compiler/iface/TcIface.lhs-boot b/compiler/iface/TcIface.lhs-boot
index 58df07cdc4..591419a251 100644
--- a/compiler/iface/TcIface.lhs-boot
+++ b/compiler/iface/TcIface.lhs-boot
@@ -5,7 +5,7 @@ import IfaceSyn    ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule, IfaceAnno
 import TypeRep     ( TyThing )
 import TcRnTypes   ( IfL )
 import InstEnv     ( ClsInst )
-import FamInstEnv  ( FamInst, Branched )
+import FamInstEnv  ( FamInst )
 import CoreSyn     ( CoreRule )
 import HscTypes    ( TypeEnv, VectInfo, IfaceVectInfo )
 import Module      ( Module )
@@ -15,7 +15,7 @@ tcIfaceDecl        :: Bool -> IfaceDecl -> IfL TyThing
 tcIfaceRules       :: Bool -> [IfaceRule] -> IfL [CoreRule]
 tcIfaceVectInfo    :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
 tcIfaceInst        :: IfaceClsInst -> IfL ClsInst
-tcIfaceFamInst     :: IfaceFamInst -> IfL (FamInst Branched)
+tcIfaceFamInst     :: IfaceFamInst -> IfL FamInst
 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
 \end{code}