Merge branch 'master' into wip/ext-solverwip/ext-solver

8 files changed, 1822 insertions, 1276 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 9fd0c33423..9dd95fc0f2 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 --
 --  (c) The University of Glasgow 2002-2006
 --
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index e412d7ef30..f2d6f7e39a 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -15,7 +16,7 @@ module BuildTyCl (
         buildSynTyCon,
         buildAlgTyCon, 
         buildDataCon,
-        buildPatSyn, mkPatSynMatcherId, mkPatSynWrapperId,
+        buildPatSyn,
         TcMethInfo, buildClass,
         distinctAbstractTyConRhs, totallyAbstractTyConRhs,
         mkNewTyConRhs, mkDataTyConRhs, 
@@ -36,10 +37,9 @@ import MkId
 import Class
 import TyCon
 import Type
-import TypeRep
-import TcType
 import Id
 import Coercion
+import TcType
 
 import DynFlags
 import TcRnMonad
@@ -184,67 +184,34 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
 
 
 ------------------------------------------------------
-buildPatSyn :: Name -> Bool -> Bool
-            -> [Var]
+buildPatSyn :: Name -> Bool
+            -> Id -> Maybe Id
+            -> [Type]
             -> [TyVar] -> [TyVar]     -- Univ and ext
             -> ThetaType -> ThetaType -- Prov and req
             -> Type                  -- Result type
-            -> TyVar
-            -> TcRnIf m n PatSyn
-buildPatSyn src_name declared_infix has_wrapper args univ_tvs ex_tvs prov_theta req_theta pat_ty tv
-  = do	{ (matcher, _, _) <- mkPatSynMatcherId src_name args
-                                              univ_tvs ex_tvs
-                                              prov_theta req_theta
-                                              pat_ty tv
-        ; wrapper <- case has_wrapper of
-            False -> return Nothing
-            True -> fmap Just $
-                    mkPatSynWrapperId src_name args
-                                      (univ_tvs ++ ex_tvs) (prov_theta ++ req_theta)
-                                      pat_ty
-        ; return $ mkPatSyn src_name declared_infix
-                            args
-                            univ_tvs ex_tvs
-                            prov_theta req_theta
-                            pat_ty
-                            matcher
-                            wrapper }
-
-mkPatSynMatcherId :: Name
-                  -> [Var]
-                  -> [TyVar]
-                  -> [TyVar]
-                  -> ThetaType -> ThetaType
-                  -> Type
-                  -> TyVar
-                  -> TcRnIf n m (Id, Type, Type)
-mkPatSynMatcherId name args univ_tvs ex_tvs prov_theta req_theta pat_ty res_tv
-  = do { matcher_name <- newImplicitBinder name mkMatcherOcc
-
-       ; let res_ty = TyVarTy res_tv
-             cont_ty = mkSigmaTy ex_tvs prov_theta $
-                       mkFunTys (map varType args) res_ty
-
-       ; let matcher_tau = mkFunTys [pat_ty, cont_ty, res_ty] res_ty
-             matcher_sigma = mkSigmaTy (res_tv:univ_tvs) req_theta matcher_tau
-             matcher_id = mkVanillaGlobal matcher_name matcher_sigma
-       ; return (matcher_id, res_ty, cont_ty) }
-
-mkPatSynWrapperId :: Name
-                  -> [Var]
-                  -> [TyVar]
-                  -> ThetaType
-                  -> Type
-                  -> TcRnIf n m Id
-mkPatSynWrapperId name args qtvs theta pat_ty
-  = do { wrapper_name <- newImplicitBinder name mkDataConWrapperOcc
-
-       ; let wrapper_tau = mkFunTys (map varType args) pat_ty
-             wrapper_sigma = mkSigmaTy qtvs theta wrapper_tau
-
-       ; let wrapper_id = mkVanillaGlobal wrapper_name wrapper_sigma
-       ; return wrapper_id }
-
+            -> PatSyn
+buildPatSyn src_name declared_infix matcher wrapper
+            args univ_tvs ex_tvs prov_theta req_theta pat_ty
+  = ASSERT((and [ univ_tvs == univ_tvs'
+                , ex_tvs == ex_tvs'
+                , pat_ty `eqType` pat_ty'
+                , prov_theta `eqTypes` prov_theta'
+                , req_theta `eqTypes` req_theta'
+                , args `eqTypes` args'
+                ]))
+    mkPatSyn src_name declared_infix
+             args
+             univ_tvs ex_tvs
+             prov_theta req_theta
+             pat_ty
+             matcher
+             wrapper
+  where
+    ((_:univ_tvs'), req_theta', tau) = tcSplitSigmaTy $ idType matcher
+    ([pat_ty', cont_sigma, _], _) = tcSplitFunTys tau
+    (ex_tvs', prov_theta', cont_tau) = tcSplitSigmaTy cont_sigma
+    (args', _) = tcSplitFunTys cont_tau
 \end{code}
 
 
@@ -254,10 +221,7 @@ type TcMethInfo = (Name, DefMethSpec, Type)
         -- A temporary intermediate, to communicate between 
         -- tcClassSigs and buildClass.
 
-buildClass :: Bool		-- True <=> do not include unfoldings 
-				--	    on dict selectors
-				-- Used when importing a class without -O
-	   -> Name -> [TyVar] -> [Role] -> ThetaType
+buildClass :: Name -> [TyVar] -> [Role] -> ThetaType
 	   -> [FunDep TyVar]		   -- Functional dependencies
 	   -> [ClassATItem]		   -- Associated types
 	   -> [TcMethInfo]                 -- Method info
@@ -265,10 +229,9 @@ buildClass :: Bool		-- True <=> do not include unfoldings
 	   -> RecFlag			   -- Info for type constructor
 	   -> TcRnIf m n Class
 
-buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
+buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
   = fixM  $ \ rec_clas -> 	-- Only name generation inside loop
     do	{ traceIf (text "buildClass")
-        ; dflags <- getDynFlags
 
 	; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc
 		-- The class name is the 'parent' for this datacon, not its tycon,
@@ -282,7 +245,7 @@ buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc
 	      -- Make selectors for the superclasses 
 	; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc) 
 				[1..length sc_theta]
-        ; let sc_sel_ids = [ mkDictSelId dflags no_unf sc_name rec_clas 
+        ; let sc_sel_ids = [ mkDictSelId sc_name rec_clas 
                            | sc_name <- sc_sel_names]
 	      -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we 
 	      -- can construct names for the selectors. Thus
@@ -348,14 +311,13 @@ buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc
   where
     mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem
     mk_op_item rec_clas (op_name, dm_spec, _) 
-      = do { dflags <- getDynFlags
-           ; dm_info <- case dm_spec of
+      = do { dm_info <- case dm_spec of
                           NoDM      -> return NoDefMeth
                           GenericDM -> do { dm_name <- newImplicitBinder op_name mkGenDefMethodOcc
 			  	          ; return (GenDefMeth dm_name) }
                           VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc
 			  	          ; return (DefMeth dm_name) }
-           ; return (mkDictSelId dflags no_unf op_name rec_clas, dm_info) }
+           ; return (mkDictSelId op_name rec_clas, dm_info) }
 \end{code}
 
 Note [Class newtypes and equality predicates]
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 4a00c91381..c29778dc23 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -1,7 +1,8 @@
 (c) The University of Glasgow 2002-2006
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 1283b095fd..935b8eda93 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -15,13 +16,14 @@ module IfaceSyn (
         module IfaceType,
 
         IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..), 
-        IfaceConDecl(..), IfaceConDecls(..),
+        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
         IfaceBinding(..), IfaceConAlt(..),
         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), 
         IfaceBang(..), IfaceAxBranch(..),
+        IfaceTyConParent(..),
 
         -- Misc
         ifaceDeclImplicitBndrs, visibleIfConDecls,
@@ -31,7 +33,9 @@ module IfaceSyn (
         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
 
         -- Pretty printing
-        pprIfaceExpr
+        pprIfaceExpr,
+        pprIfaceDecl,
+        ShowSub(..), ShowHowMuch(..)
     ) where
 
 #include "HsVersions.h"
@@ -51,14 +55,17 @@ import BasicTypes
 import Outputable
 import FastString
 import Module
-import TysWiredIn ( eqTyConName )
 import Fingerprint
 import Binary
 import BooleanFormula ( BooleanFormula )
 import HsBinds
+import TyCon (Role (..))
+import StaticFlags (opt_PprStyle_Debug)
+import Util( filterOut )
 
 import Control.Monad
 import System.IO.Unsafe
+import Data.Maybe (isJust)
 
 infixl 3 &&&
 \end{code}
@@ -66,18 +73,27 @@ infixl 3 &&&
 
 %************************************************************************
 %*                                                                      *
-    Data type declarations
+                    Declarations
 %*                                                                      *
 %************************************************************************
 
 \begin{code}
+type IfaceTopBndr = OccName
+  -- It's convenient to have an OccName in the IfaceSyn, altough in each
+  -- case the namespace is implied by the context. However, having an
+  -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
+  -- very convenient. 
+  --   
+  -- We don't serialise the namespace onto the disk though; rather we 
+  -- drop it when serialising and add it back in when deserialising.
+
 data IfaceDecl
-  = IfaceId { ifName      :: OccName,
+  = IfaceId { ifName      :: IfaceTopBndr,
               ifType      :: IfaceType,
               ifIdDetails :: IfaceIdDetails,
               ifIdInfo    :: IfaceIdInfo }
 
-  | IfaceData { ifName       :: OccName,        -- Type constructor
+  | IfaceData { ifName       :: IfaceTopBndr,        -- Type constructor
                 ifCType      :: Maybe CType,    -- C type for CAPI FFI
                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
                 ifRoles      :: [Role],         -- Roles
@@ -87,355 +103,115 @@ data IfaceDecl
                 ifPromotable :: Bool,           -- Promotable to kind level?
                 ifGadtSyntax :: Bool,           -- True <=> declared using
                                                 -- GADT syntax
-                ifAxiom      :: Maybe IfExtName -- The axiom, for a newtype, 
-                                                -- or data/newtype family instance
+                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
+                                                 -- or data/newtype family instance
     }
 
-  | IfaceSyn  { ifName    :: OccName,           -- Type constructor
+  | IfaceSyn  { ifName    :: IfaceTopBndr,           -- Type constructor
                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
                 ifRoles   :: [Role],            -- Roles
                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
                 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
-                 ifMinDef  :: BooleanFormula OccName, -- Minimal complete definition
-                 ifRec     :: RecFlag           -- Is newtype/datatype associated
-                                                --   with the class recursive?
+  | IfaceClass { ifCtxt    :: IfaceContext,          	-- Context...
+                 ifName    :: IfaceTopBndr,          	-- 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
+                 ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
+                 ifRec     :: RecFlag           	-- Is newtype/datatype associated
+                                                	--   with the class recursive?
     }
 
-  | IfaceAxiom { ifName       :: OccName,        -- Axiom name
+  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
                  ifTyCon      :: IfaceTyCon,     -- LHS TyCon
                  ifRole       :: Role,           -- Role of axiom
                  ifAxBranches :: [IfaceAxBranch] -- Branches
     }
 
-  | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
+  | IfaceForeign { ifName :: IfaceTopBndr,           -- Needs expanding when we move
                                                 -- beyond .NET
                    ifExtName :: Maybe FastString }
 
-  | IfacePatSyn { ifName          :: OccName,           -- Name of the pattern synonym
-                  ifPatHasWrapper :: Bool,
+  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
                   ifPatIsInfix    :: Bool,
+                  ifPatMatcher    :: IfExtName,
+                  ifPatWrapper    :: Maybe IfExtName,
+                  -- Everything below is redundant,
+                  -- but needed to implement pprIfaceDecl
                   ifPatUnivTvs    :: [IfaceTvBndr],
                   ifPatExTvs      :: [IfaceTvBndr],
                   ifPatProvCtxt   :: IfaceContext,
                   ifPatReqCtxt    :: IfaceContext,
-                  ifPatArgs       :: [IfaceIdBndr],
+                  ifPatArgs       :: [IfaceType],
                   ifPatTy         :: IfaceType }
 
--- 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 a9) = 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 a9
-
-    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
-        putByte bh 5
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
 
-    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9) = do
-        putByte bh 6
-        put_ bh (occNameFS name)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-
-    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
-                    a9 <- get bh
-                    occ <- return $! mkOccNameFS clsName a2
-                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
-            5 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceAxiom occ a2 a3 a4)
-            6 -> 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 dataName a1
-                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9)
-            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
+data IfaceTyConParent
+  = IfNoParent
+  | IfDataInstance IfExtName
+                   IfaceTyCon
+                   IfaceTcArgs
 
 data IfaceSynTyConRhs
   = IfaceOpenSynFamilyTyCon
-  | IfaceClosedSynFamilyTyCon IfExtName  -- name of associated axiom
+  | IfaceClosedSynFamilyTyCon IfExtName       -- name of associated axiom
+                              [IfaceAxBranch] -- for pretty printing purposes only
   | IfaceAbstractClosedSynFamilyTyCon
   | IfaceSynonymTyCon IfaceType
+  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
 
-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
+data IfaceClassOp = IfaceClassOp IfaceTopBndr 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  -- See Class.ClassATItem
+                  IfaceDecl          -- The associated type declaration
+                  (Maybe IfaceType)  -- Default associated type instance, if any
 
-data IfaceAT = IfaceAT
-                  IfaceDecl        -- The associated type declaration
-                  [IfaceAxBranch]  -- Default associated type instances, if any
 
-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 = 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 2 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
+-- This is just like CoAxBranch
 data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
-                                   , ifaxbLHS     :: [IfaceType]
+                                   , ifaxbLHS     :: IfaceTcArgs
                                    , 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
   | IfDataFamTyCon              -- Data family
   | 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      = []
-visibleIfConDecls (IfDataTyCon cs)     = cs
-visibleIfConDecls (IfNewTyCon c)       = [c]
-
 data IfaceConDecl
   = IfCon {
-        ifConOcc     :: OccName,                -- Constructor name
+        ifConOcc     :: IfaceTopBndr,                -- Constructor name
         ifConWrapper :: Bool,                   -- True <=> has a wrapper
         ifConInfix   :: Bool,                   -- True <=> declared infix
-        ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
+
+        -- The universal type variables are precisely those
+        -- of the type constructor of this data constructor
+        -- This is *easy* to guarantee when creating the IfCon
+        -- but it's not so easy for the original TyCon/DataCon
+        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon
+
         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
-        ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality constraints
+        ifConEqSpec  :: IfaceEqSpec,            -- Equality constraints
         ifConCtxt    :: IfaceContext,           -- Non-stupid context
         ifConArgTys  :: [IfaceType],            -- Arg types
-        ifConFields  :: [OccName],              -- ...ditto... (field labels)
+        ifConFields  :: [IfaceTopBndr],         -- ...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)
+type IfaceEqSpec = [(IfLclName,IfaceType)]
 
 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
@@ -449,21 +225,6 @@ 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
 data IfaceFamInst
@@ -473,19 +234,6 @@ data IfaceFamInst
                  , 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,
@@ -498,82 +246,14 @@ 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  :: AnnPayload
   }
 
-instance Outputable IfaceAnnotation where
-  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
-
-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
--- we only need a very limited selection.  Notably, none of the
--- implicit ones are needed here, because they are not put it
--- interface files
-
-data IfaceIdDetails
-  = IfVanillaId
-  | 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
@@ -584,6 +264,10 @@ instance Binary IfaceIdInfo where
 --   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
 --      and so gives a new version.
 
+data IfaceIdInfo
+  = NoInfo                      -- When writing interface file without -O
+  | HasInfo [IfaceInfoItem]     -- Has info, and here it is
+
 data IfaceInfoItem
   = HsArity         Arity
   | HsStrictness    StrictSig
@@ -592,23 +276,6 @@ 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.
 
@@ -626,253 +293,18 @@ data IfaceUnfolding
 
   | 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 (IfDFunUnfold as bs) = do
-        putByte bh 2
-        put_ bh as
-        put_ bh bs
-    put_ bh (IfCompulsory e) = do
-        putByte bh 3
-        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 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     IfaceCoercion
-  | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
-  | IfaceLam 	IfaceBndr IfaceExpr
-  | IfaceApp 	IfaceExpr IfaceExpr
-  | IfaceCase	IfaceExpr IfLclName [IfaceAlt]
-  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
-  | IfaceLet	IfaceBinding  IfaceExpr
-  | IfaceCast   IfaceExpr IfaceCoercion
-  | IfaceLit    Literal
-  | 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
-        -- thus saving bulk in interface files
-
-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
+-- We only serialise the IdDetails of top-level Ids, and even then
+-- we only need a very limited selection.  Notably, none of the
+-- implicit ones are needed here, because they are not put it
+-- interface files
 
-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)
+data IfaceIdDetails
+  = IfVanillaId
+  | IfRecSelId IfaceTyCon Bool
+  | IfDFunId Int          -- Number of silent args
 \end{code}
 
-Note [Empty case alternatives]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In IfaceSyn an IfaceCase does not record the types of the alternatives,
-unlike CorSyn Case.  But we need this type if the alternatives are empty.
-Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.
-
-Note [Expose recursive functions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For supercompilation we want to put *all* unfoldings in the interface
-file, even for functions that are recursive (or big).  So we need to
-know when an unfolding belongs to a loop-breaker so that we can refrain
-from inlining it (except during supercompilation).
-
-Note [IdInfo on nested let-bindings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Occasionally we want to preserve IdInfo on nested let bindings. The one
-that came up was a NOINLINE pragma on a let-binding inside an INLINE
-function.  The user (Duncan Coutts) really wanted the NOINLINE control
-to cross the separate compilation boundary.
-
-In general we retain all info that is left by CoreTidy.tidyLetBndr, since
-that is what is seen by importing module with --make
 
 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -949,10 +381,22 @@ Note [Versioning of instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
 
+
+%************************************************************************
+%*                                                                      *
+                Functions over declarations
+%*                                                                      *
+%************************************************************************
+
 \begin{code}
--- -----------------------------------------------------------------------------
--- Utils on IfaceSyn
+visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
+visibleIfConDecls (IfAbstractTyCon {}) = []
+visibleIfConDecls IfDataFamTyCon       = []
+visibleIfConDecls (IfDataTyCon cs)     = cs
+visibleIfConDecls (IfNewTyCon c)       = [c]
+\end{code}
 
+\begin{code}
 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 -- Deeply revolting, because it has to predict what gets bound,
@@ -1015,11 +459,6 @@ ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
     dc_occ = mkClassDataConOcc cls_tc_occ
     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 
-ifaceDeclImplicitBndrs (IfacePatSyn{ ifName = ps_occ, ifPatHasWrapper = has_wrapper })
-  = [wrap_occ | has_wrapper]
-  where
-    wrap_occ = mkDataConWrapperOcc ps_occ  -- Id namespace
-
 ifaceDeclImplicitBndrs _ = []
 
 -- -----------------------------------------------------------------------------
@@ -1038,80 +477,308 @@ ifaceDeclFingerprints hash decl
      computeFingerprint' =
        unsafeDupablePerformIO
         . computeFingerprint (panic "ifaceDeclFingerprints")
+\end{code}
 
------------------------------ Printing IfaceDecl ------------------------------
+%************************************************************************
+%*                                                                      *
+                Expressions
+%*                                                                      *
+%************************************************************************
 
-instance Outputable IfaceDecl where
-  ppr = pprIfaceDecl
+\begin{code}
+data IfaceExpr
+  = IfaceLcl    IfLclName
+  | IfaceExt    IfExtName
+  | IfaceType   IfaceType
+  | IfaceCo     IfaceCoercion
+  | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
+  | IfaceLam 	IfaceBndr IfaceExpr
+  | IfaceApp 	IfaceExpr IfaceExpr
+  | IfaceCase	IfaceExpr IfLclName [IfaceAlt]
+  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
+  | IfaceLet	IfaceBinding  IfaceExpr
+  | IfaceCast   IfaceExpr IfaceCoercion
+  | IfaceLit    Literal
+  | IfaceFCall  ForeignCall IfaceType
+  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
+
+data IfaceTickish
+  = IfaceHpcTick Module Int                -- from HpcTick x
+  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
+  -- no breakpoints: we never export these into interface files
+
+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
+        -- thus saving bulk in interface files
 
-pprIfaceDecl :: IfaceDecl -> SDoc
-pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
-                       ifIdDetails = details, ifIdInfo = info})
-  = sep [ pprPrefixOcc var <+> dcolon <+> ppr ty,
-          nest 2 (ppr details),
-          nest 2 (ppr info) ]
+data IfaceConAlt = IfaceDefault
+                 | IfaceDataAlt IfExtName
+                 | IfaceLitAlt Literal
 
-pprIfaceDecl (IfaceForeign {ifName = tycon})
-  = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
+data IfaceBinding
+  = IfaceNonRec IfaceLetBndr IfaceExpr
+  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
+
+-- 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
+\end{code}
+
+Note [Empty case alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In IfaceSyn an IfaceCase does not record the types of the alternatives,
+unlike CorSyn Case.  But we need this type if the alternatives are empty.
+Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.
+
+Note [Expose recursive functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For supercompilation we want to put *all* unfoldings in the interface
+file, even for functions that are recursive (or big).  So we need to
+know when an unfolding belongs to a loop-breaker so that we can refrain
+from inlining it (except during supercompilation).
+
+Note [IdInfo on nested let-bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Occasionally we want to preserve IdInfo on nested let bindings. The one
+that came up was a NOINLINE pragma on a let-binding inside an INLINE
+function.  The user (Duncan Coutts) really wanted the NOINLINE control
+to cross the separate compilation boundary.
 
-pprIfaceDecl (IfaceSyn {ifName = tycon,
-                        ifTyVars = tyvars,
-                        ifSynRhs = IfaceSynonymTyCon mono_ty})
-  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
-       2 (vcat [equals <+> ppr mono_ty])
+In general we retain all info that is left by CoreTidy.tidyLetBndr, since
+that is what is seen by importing module with --make
+
+
+%************************************************************************
+%*                                                                      *
+              Printing IfaceDecl
+%*                                                                      *
+%************************************************************************
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
-                        ifSynRhs = rhs, ifSynKind = kind })
-  = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
-       2 (sep [dcolon <+> ppr kind, parens (pp_rhs rhs)])
+\begin{code}
+pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
+-- The TyCon might be local (just an OccName), or this might
+-- be a branch for an imported TyCon, so it would be an ExtName
+-- So it's easier to take an SDoc here
+pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
+                                  , ifaxbLHS = pat_tys
+                                  , ifaxbRHS = rhs
+                                  , ifaxbIncomps = incomps })
+  = hang (pprUserIfaceForAll tvs)
+       2 (hang pp_lhs 2 (equals <+> ppr rhs))
+    $+$
+    nest 2 maybe_incomps
   where
-    pp_rhs IfaceOpenSynFamilyTyCon           = ptext (sLit "open")
-    pp_rhs (IfaceClosedSynFamilyTyCon ax)    = ptext (sLit "closed, axiom") <+> ppr ax
-    pp_rhs IfaceAbstractClosedSynFamilyTyCon = ptext (sLit "closed, abstract")
-    pp_rhs _ = panic "pprIfaceDecl syn"
+    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
+    maybe_incomps = ppUnless (null incomps) $ parens $
+                    ptext (sLit "incompatible indices:") <+> ppr incomps
+
+instance Outputable IfaceAnnotation where
+  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
+
+instance HasOccName IfaceClassOp where
+  occName (IfaceClassOp n _ _) = n
+
+instance HasOccName IfaceConDecl where
+  occName = ifConOcc
 
-pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
-                         ifCtxt = context,
-                         ifTyVars = tyvars, ifRoles = roles, ifCons = condecls,
-                         ifRec = isrec, ifPromotable = is_prom,
-                         ifAxiom = mbAxiom})
-  = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       2 (vcat [ pprCType cType
-               , pprRoles roles
-               , pprRec isrec <> comma <+> pp_prom
-               , pp_condecls tycon condecls
-               , pprAxiom mbAxiom])
+instance HasOccName IfaceDecl where
+  occName = ifName
+
+instance Outputable IfaceDecl where
+  ppr = pprIfaceDecl showAll
+
+data ShowSub
+  = ShowSub
+      { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
+                                        -- See Note [Printing IfaceDecl binders]
+      , ss_how_much :: ShowHowMuch }
+
+data ShowHowMuch
+  = ShowHeader   -- Header information only, not rhs
+  | ShowSome [OccName]    -- []     <=> Print all sub-components
+                          -- (n:ns) <=> print sub-component 'n' with ShowSub=ns
+                          --            elide other sub-components to "..."
+                          -- May 14: the list is max 1 element long at the moment
+  | ShowIface    -- Everything including GHC-internal information (used in --show-iface)
+
+showAll :: ShowSub
+showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }
+
+ppShowIface :: ShowSub -> SDoc -> SDoc
+ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
+ppShowIface _                                     _   = empty
+
+ppShowRhs :: ShowSub -> SDoc -> SDoc
+ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = empty
+ppShowRhs _                                      doc = doc
+
+showSub :: HasOccName n => ShowSub -> n -> Bool
+showSub (ShowSub { ss_how_much = ShowHeader })     _     = False
+showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
+showSub (ShowSub { ss_how_much = _ })              _     = True
+\end{code}
+
+Note [Printing IfaceDecl binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The binders in an IfaceDecl are just OccNames, so we don't know what module they
+come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
+(see PprTyThing), the TyThing may come from some other module so we really need
+the module qualifier.  We solve this by passing in a pretty-printer for the
+binders.
+
+When printing an interface file (--show-iface), we want to print
+everything unqualified, so we can just print the OccName directly.
+
+\begin{code}
+ppr_trim :: [Maybe SDoc] -> [SDoc]
+-- Collapse a group of Nothings to a single "..."
+ppr_trim xs
+  = snd (foldr go (False, []) xs)
   where
-    pp_prom | is_prom   = ptext (sLit "Promotable")
-            | otherwise = ptext (sLit "Not promotable")
+    go (Just doc) (_,     so_far) = (False, doc : so_far)
+    go Nothing    (True,  so_far) = (True, so_far)
+    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)
+
+isIfaceDataInstance :: IfaceTyConParent -> Bool
+isIfaceDataInstance IfNoParent = False
+isIfaceDataInstance _          = True
+
+pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
+-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
+--     See Note [Pretty-printing TyThings] in PprTyThing
+pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
+                             ifCtxt = context, ifTyVars = tc_tyvars,
+                             ifRoles = roles, ifCons = condecls,
+                             ifParent = parent, ifRec = isrec,
+                             ifGadtSyntax = gadt,
+                             ifPromotable = is_prom })
+
+  | gadt_style = vcat [ pp_roles
+                      , pp_nd <+> pp_lhs <+> pp_where
+                      , nest 2 (vcat pp_cons)
+                      , nest 2 $ ppShowIface ss pp_extra ]
+  | otherwise  = vcat [ pp_roles
+                      , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
+                      , nest 2 $ ppShowIface ss pp_extra ]
+  where
+    is_data_instance = isIfaceDataInstance parent
+
+    gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
+    cons       = visibleIfConDecls condecls
+    pp_where   = ppWhen (gadt_style && not (null cons)) $ ptext (sLit "where")
+    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
+
+    pp_lhs = case parent of
+               IfNoParent -> pprIfaceDeclHead context ss tycon tc_tyvars
+               _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent
+
+    pp_roles
+      | is_data_instance = empty
+      | otherwise        = pprRoles (== Representational) (pprPrefixIfDeclBndr ss tycon) 
+                                    tc_tyvars roles
+            -- Don't display roles for data family instances (yet)
+            -- See discussion on Trac #8672.
+
+    add_bars []     = empty
+    add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs)
+
+    ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc)
+
+    show_con dc
+      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style mk_user_con_res_ty dc
+      | otherwise = Nothing
+
+    mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
+    -- See Note [Result type of a data family GADT]
+    mk_user_con_res_ty eq_spec
+      | IfDataInstance _ tc tys <- parent
+      = (con_univ_tvs, pprIfaceType (IfaceTyConApp tc (substIfaceTcArgs gadt_subst tys)))
+      | otherwise
+      = (con_univ_tvs, sdocWithDynFlags (ppr_tc_app gadt_subst))
+      where
+        gadt_subst = mkFsEnv eq_spec
+        done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_subst tv)
+        con_univ_tvs = filterOut done_univ_tv tc_tyvars
+
+    ppr_tc_app gadt_subst dflags
+       = pprPrefixIfDeclBndr ss tycon
+         <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
+                 | (tv,_kind) <- stripIfaceKindVars dflags tc_tyvars ]
+
     pp_nd = case condecls of
-                IfAbstractTyCon dis -> ptext (sLit "abstract") <> parens (ppr dis)
-                IfDataFamTyCon     -> ptext (sLit "data family")
-                IfDataTyCon _       -> ptext (sLit "data")
-                IfNewTyCon _        -> ptext (sLit "newtype")
-
-pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
-                          ifRoles = roles, ifFDs = fds, ifATs = ats, ifSigs = sigs,
-                          ifRec = isrec})
-  = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
-       2 (vcat [pprRoles roles,
-                pprRec isrec,
-                sep (map ppr ats),
-                sep (map ppr sigs)])
-
-pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branches })
-  = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
-       2 (vcat $ map (pprAxBranch $ Just tycon) branches)
-
-pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
-                            ifPatIsInfix = is_infix,
-                            ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
-                            ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
-                            ifPatArgs = args,
-                            ifPatTy = ty })
+              IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
+              IfDataFamTyCon    -> ptext (sLit "data family")
+              IfDataTyCon _     -> ptext (sLit "data")
+              IfNewTyCon _      -> ptext (sLit "newtype")
+
+    pp_extra = vcat [pprCType ctype, pprRec isrec, pp_prom]
+
+    pp_prom | is_prom   = ptext (sLit "Promotable")
+            | otherwise = empty
+
+
+pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
+                            , ifCtxt   = context, ifName  = clas
+                            , ifTyVars = tyvars,  ifRoles = roles
+                            , ifFDs    = fds })
+  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
+         , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
+                                <+> pprFundeps fds <+> pp_where
+         , nest 2 (vcat [vcat asocs, vcat dsigs, pprec])]
+    where
+      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
+
+      asocs = ppr_trim $ map maybeShowAssoc ats
+      dsigs = ppr_trim $ map maybeShowSig sigs
+      pprec = ppShowIface ss (pprRec isrec)
+
+      maybeShowAssoc :: IfaceAT -> Maybe SDoc
+      maybeShowAssoc asc@(IfaceAT d _)
+        | showSub ss d = Just $ pprIfaceAT ss asc
+        | otherwise    = Nothing
+
+      maybeShowSig :: IfaceClassOp -> Maybe SDoc
+      maybeShowSig sg
+        | showSub ss sg = Just $  pprIfaceClassOp ss sg
+        | otherwise     = Nothing
+
+pprIfaceDecl ss (IfaceSyn { ifName   = tc
+                          , ifTyVars = tv
+                          , ifSynRhs = IfaceSynonymTyCon mono_ty })
+  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc tv <+> equals)
+       2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
+  where
+    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
+
+pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
+                          , ifSynRhs = rhs, ifSynKind = kind })
+  = vcat [ hang (text "type family" <+> pprIfaceDeclHead [] ss tycon tyvars <+> dcolon)
+              2 (ppr kind <+> ppShowRhs ss (pp_rhs rhs))
+         , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
+  where
+    pp_rhs IfaceOpenSynFamilyTyCon             = ppShowIface ss (ptext (sLit "open"))
+    pp_rhs IfaceAbstractClosedSynFamilyTyCon   = ppShowIface ss (ptext (sLit "closed, abstract"))
+    pp_rhs (IfaceClosedSynFamilyTyCon _ (_:_)) = ptext (sLit "where")
+    pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in"))
+    pp_rhs _ = panic "pprIfaceDecl syn"
+
+    pp_branches (IfaceClosedSynFamilyTyCon ax brs)
+      = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
+        $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax)
+    pp_branches _ = empty
+
+pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper,
+                              ifPatIsInfix = is_infix,
+                              ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
+                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
+                              ifPatArgs = args,
+                              ifPatTy = ty })
   = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
   where
-    args' = case (is_infix, map snd args) of
+    has_wrap = isJust wrapper
+    args' = case (is_infix, args) of
         (True, [left_ty, right_ty]) ->
             InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty)
         (_, tys) ->
@@ -1122,70 +789,105 @@ pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
     pprCtxt [] = Nothing
     pprCtxt ctxt = Just $ pprIfaceContext ctxt
 
+pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
+                              ifIdDetails = details, ifIdInfo = info })
+  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
+              2 (pprIfaceSigmaType ty)
+         , ppShowIface ss (ppr details)
+         , ppShowIface ss (ppr info) ]
+
+pprIfaceDecl _ (IfaceForeign {ifName = tycon})
+  = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
+
+pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
+                           , ifAxBranches = branches })
+  = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
+       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)
+
+
 pprCType :: Maybe CType -> SDoc
-pprCType Nothing = ptext (sLit "No C type associated")
+pprCType Nothing      = empty
 pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType
 
-pprRoles :: [Role] -> SDoc
-pprRoles []    = empty
-pprRoles roles = text "Roles:" <+> ppr roles
+-- if, for each role, suppress_if role is True, then suppress the role
+-- output
+pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTvBndr] -> [Role] -> SDoc
+pprRoles suppress_if tyCon tyvars roles
+  = sdocWithDynFlags $ \dflags ->
+      let froles = suppressIfaceKinds dflags tyvars roles
+      in ppUnless (all suppress_if roles || null froles) $
+         ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
 
 pprRec :: RecFlag -> SDoc
-pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
+pprRec NonRecursive = empty
+pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
 
-pprAxiom :: Maybe Name -> SDoc
-pprAxiom Nothing   = ptext (sLit "FamilyInstance: none")
-pprAxiom (Just ax) = ptext (sLit "FamilyInstance:") <+> ppr ax
+pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
+pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ 
+  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
+pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
+  = parenSymOcc occ (ppr_bndr occ)
 
 instance Outputable IfaceClassOp where
-   ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
+   ppr = pprIfaceClassOp showAll
+
+pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
+pprIfaceClassOp ss (IfaceClassOp n dm ty) = hang opHdr 2 (pprIfaceSigmaType ty)
+  where opHdr = pprPrefixIfDeclBndr ss n
+                <+> ppShowIface ss (ppr dm) <+> dcolon
 
 instance Outputable IfaceAT where
-   ppr (IfaceAT d defs) 
-      = vcat [ ppr d
-             , ppUnless (null defs) $ nest 2 $
-               ptext (sLit "Defaults:") <+> vcat (map ppr defs) ]
-
-pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
-pprIfaceDeclHead context thing tyvars
-  = hsep [pprIfaceContextArr context, parenSymOcc thing (ppr thing),
-          pprIfaceTvBndrs tyvars]
-
-pp_condecls :: OccName -> IfaceConDecls -> SDoc
-pp_condecls _  (IfAbstractTyCon {}) = empty
-pp_condecls _  IfDataFamTyCon      = empty
-pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
-pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
-                                                            (map (pprIfaceConDecl tc) cs))
-
-mkIfaceEqPred :: IfaceType -> IfaceType -> IfacePredType
--- IA0_NOTE: This is wrong, but only used for pretty-printing.
-mkIfaceEqPred ty1 ty2 = IfaceTyConApp (IfaceTc eqTyConName) [ty1, ty2]
-
-pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
-pprIfaceConDecl tc
-        (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
-                 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
+   ppr = pprIfaceAT showAll
+
+pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
+pprIfaceAT ss (IfaceAT d mb_def)
+  = vcat [ pprIfaceDecl ss d
+         , case mb_def of
+              Nothing  -> empty
+              Just rhs -> nest 2 $
+                          ptext (sLit "Default:") <+> ppr rhs ]
+
+instance Outputable IfaceTyConParent where
+  ppr p = pprIfaceTyConParent p
+
+pprIfaceTyConParent :: IfaceTyConParent -> SDoc
+pprIfaceTyConParent IfNoParent
+  = empty
+pprIfaceTyConParent (IfDataInstance _ tc tys)
+  = sdocWithDynFlags $ \dflags ->
+    let ftys = stripKindArgs dflags tys
+    in pprIfaceTypeApp tc ftys
+
+pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName -> [IfaceTvBndr] -> SDoc
+pprIfaceDeclHead context ss tc_occ tv_bndrs
+  = sdocWithDynFlags $ \ dflags ->
+    sep [ pprIfaceContextArr context
+        , pprPrefixIfDeclBndr ss tc_occ
+          <+> pprIfaceTvBndrs (stripIfaceKindVars dflags tv_bndrs) ]
+
+isVanillaIfaceConDecl :: IfaceConDecl -> Bool
+isVanillaIfaceConDecl (IfCon { ifConExTvs  = ex_tvs
+                             , ifConEqSpec = eq_spec
+                             , ifConCtxt   = ctxt })
+  = (null ex_tvs) && (null eq_spec) && (null ctxt)
+
+pprIfaceConDecl :: ShowSub -> Bool
+                -> (IfaceEqSpec -> ([IfaceTvBndr], SDoc))
+                -> IfaceConDecl -> SDoc
+pprIfaceConDecl ss gadt_style mk_user_con_res_ty
+        (IfCon { ifConOcc = name, ifConInfix = is_infix,
+                 ifConExTvs = ex_tvs,
                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
-                 ifConStricts = strs, ifConFields = fields })
-  = sep [main_payload,
-         if is_infix then ptext (sLit "Infix") else empty,
-         if has_wrap then ptext (sLit "HasWrapper") else empty,
-         ppUnless (null strs) $
-            nest 2 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
-         ppUnless (null fields) $
-            nest 2 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
+                 ifConStricts = stricts, ifConFields = labels })
+  | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty
+  | otherwise  = ppr_fields tys_w_strs
   where
-    ppr_bang IfNoBang = char '_'        -- Want to see these
-    ppr_bang IfStrict = char '!'
-    ppr_bang IfUnpack = ptext (sLit "!!")
-    ppr_bang (IfUnpackCo co) = ptext (sLit "!!") <> pprParendIfaceCoercion co
-
-    main_payload = ppr name <+> dcolon <+>
-                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
+    tys_w_strs :: [(IfaceBang, IfaceType)]
+    tys_w_strs = zip stricts arg_tys
+    pp_prefix_con = pprPrefixIfDeclBndr ss name
 
-    eq_ctxt = [(mkIfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
-              | (tv,ty) <- eq_spec]
+    (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
+    ppr_ty = pprIfaceForAllPart (univ_tvs ++ ex_tvs) ctxt pp_tau
 
         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
         -- because we don't have a Name for the tycon, only an OccName
@@ -1193,7 +895,26 @@ pprIfaceConDecl tc
                 (t:ts) -> fsep (t : map (arrow <+>) ts)
                 []     -> panic "pp_con_taus"
 
-    pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
+    ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_'
+    ppr_bang IfStrict = char '!'
+    ppr_bang IfUnpack = ptext (sLit "{-# UNPACK #-}")
+    ppr_bang (IfUnpackCo co) = ptext (sLit "! {-# UNPACK #-}") <>
+                               pprParendIfaceCoercion co
+
+    pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
+    pprBangTy       (bang, ty) = ppr_bang bang <> ppr ty
+
+    maybe_show_label (lbl,bty)
+      | showSub ss lbl = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
+      | otherwise      = Nothing
+
+    ppr_fields [ty1, ty2]
+      | is_infix && null labels
+      = sep [pprParendBangTy ty1, pprInfixIfDeclBndr ss name, pprParendBangTy ty2]
+    ppr_fields fields
+      | null labels = pp_prefix_con <+> sep (map pprParendBangTy fields)
+      | otherwise   = pp_prefix_con <+> (braces $ sep $ punctuate comma $ ppr_trim $
+                                    map maybe_show_label (zip labels fields))
 
 instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
@@ -1205,15 +926,15 @@ instance Outputable IfaceRule where
       ]
 
 instance Outputable IfaceClsInst where
-  ppr (IfaceClsInst {ifDFun = dfun_id, ifOFlag = flag,
-                  ifInstCls = cls, ifInstTys = mb_tcs})
+  ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
+                    , ifInstCls = cls, ifInstTys = mb_tcs})
     = hang (ptext (sLit "instance") <+> ppr flag
                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
-  ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
-                     ifFamInstAxiom = tycon_ax})
+  ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
+                    , ifFamInstAxiom = tycon_ax})
     = hang (ptext (sLit "family instance") <+>
             ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
          2 (equals <+> ppr tycon_ax)
@@ -1223,6 +944,26 @@ ppr_rough Nothing   = dot
 ppr_rough (Just tc) = ppr tc
 \end{code}
 
+Note [Result type of a data family GADT]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider 
+   data family T a
+   data instance T (p,q) where
+      T1 :: T (Int, Maybe c)
+      T2 :: T (Bool, q)
+
+The IfaceDecl actually looks like 
+
+   data TPr p q where
+      T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q
+      T2 :: forall p q. (p~Bool) => TPr p q
+
+To reconstruct the result types for T1 and T2 that we
+want to pretty print, we substitute the eq-spec 
+[p->Int, q->Maybe c] in the arg pattern (p,q) to give
+   T (Int, Maybe c)
+Remember that in IfaceSyn, the TyCon and DataCon share the same
+universal type variables.
 
 ----------------------------- Printing IfaceExpr ------------------------------------
 
@@ -1230,6 +971,9 @@ ppr_rough (Just tc) = ppr tc
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 
+noParens :: SDoc -> SDoc
+noParens pp = pp
+
 pprParendIfaceExpr :: IfaceExpr -> SDoc
 pprParendIfaceExpr = pprIfaceExpr parens
 
@@ -1355,17 +1099,22 @@ instance Outputable IfaceUnfolding where
                                         pprParendIfaceExpr e]
   ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
                                 2 (sep (map pprParendIfaceExpr es))
+\end{code}
 
--- -----------------------------------------------------------------------------
--- | Finding the Names in IfaceSyn
+%************************************************************************
+%*                                                                      *
+              Finding the Names in IfaceSyn
+%*                                                                      *
+%************************************************************************
 
--- This is used for dependency analysis in MkIface, so that we
--- fingerprint a declaration before the things that depend on it.  It
--- is specific to interface-file fingerprinting in the sense that we
--- don't collect *all* Names: for example, the DFun of an instance is
--- recorded textually rather than by its fingerprint when
--- fingerprinting the instance, so DFuns are not dependencies.
+This is used for dependency analysis in MkIface, so that we
+fingerprint a declaration before the things that depend on it.  It
+is specific to interface-file fingerprinting in the sense that we
+don't collect *all* Names: for example, the DFun of an instance is
+recorded textually rather than by its fingerprint when
+fingerprinting the instance, so DFuns are not dependencies.
 
+\begin{code}
 freeNamesIfDecl :: IfaceDecl -> NameSet
 freeNamesIfDecl (IfaceId _s t d i) =
   freeNamesIfType t &&&
@@ -1375,7 +1124,7 @@ freeNamesIfDecl IfaceForeign{} =
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
-  maybe emptyNameSet unitNameSet (ifAxiom d) &&&
+  freeNamesIfaceTyConParent (ifParent d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
@@ -1392,11 +1141,13 @@ freeNamesIfDecl d@IfaceAxiom{} =
   freeNamesIfTc (ifTyCon d) &&&
   fnList freeNamesIfAxBranch (ifAxBranches d)
 freeNamesIfDecl d@IfacePatSyn{} =
+  unitNameSet (ifPatMatcher d) &&&
+  maybe emptyNameSet unitNameSet (ifPatWrapper d) &&&
   freeNamesIfTvBndrs (ifPatUnivTvs d) &&&
   freeNamesIfTvBndrs (ifPatExTvs d) &&&
   freeNamesIfContext (ifPatProvCtxt d) &&&
   freeNamesIfContext (ifPatReqCtxt d) &&&
-  fnList freeNamesIfType (map snd (ifPatArgs d)) &&&
+  fnList freeNamesIfType (ifPatArgs d) &&&
   freeNamesIfType (ifPatTy d)
 
 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
@@ -1404,7 +1155,7 @@ freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars = tyvars
                                    , ifaxbLHS    = lhs
                                    , ifaxbRHS    = rhs }) =
   freeNamesIfTvBndrs tyvars &&&
-  fnList freeNamesIfType lhs &&&
+  freeNamesIfTcArgs lhs &&&
   freeNamesIfType rhs
 
 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
@@ -1415,16 +1166,20 @@ freeNamesIfIdDetails _                 = emptyNameSet
 freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
 freeNamesIfSynRhs (IfaceSynonymTyCon ty)            = freeNamesIfType ty
 freeNamesIfSynRhs IfaceOpenSynFamilyTyCon           = emptyNameSet
-freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax)    = unitNameSet ax
+freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br)
+  = unitNameSet ax &&& fnList freeNamesIfAxBranch br
 freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
+freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
 
 freeNamesIfAT :: IfaceAT -> NameSet
-freeNamesIfAT (IfaceAT decl defs)
+freeNamesIfAT (IfaceAT decl mb_def)
   = freeNamesIfDecl decl &&&
-    fnList freeNamesIfAxBranch defs
+    case mb_def of
+      Nothing  -> emptyNameSet
+      Just rhs -> freeNamesIfType rhs
 
 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
@@ -1435,25 +1190,30 @@ freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 freeNamesIfConDecls _               = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
-freeNamesIfConDecl c =
-  freeNamesIfTvBndrs (ifConUnivTvs c) &&&
-  freeNamesIfTvBndrs (ifConExTvs c) &&&
-  freeNamesIfContext (ifConCtxt c) &&&
-  fnList freeNamesIfType (ifConArgTys c) &&&
-  fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
+freeNamesIfConDecl c
+  = freeNamesIfTvBndrs (ifConExTvs c) &&&
+    freeNamesIfContext (ifConCtxt c) &&&
+    fnList freeNamesIfType (ifConArgTys c) &&&
+    fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 
 freeNamesIfKind :: IfaceType -> NameSet
 freeNamesIfKind = freeNamesIfType
 
+freeNamesIfTcArgs :: IfaceTcArgs -> NameSet
+freeNamesIfTcArgs (ITC_Type t ts) = freeNamesIfType t &&& freeNamesIfTcArgs ts
+freeNamesIfTcArgs (ITC_Kind k ks) = freeNamesIfKind k &&& freeNamesIfTcArgs ks
+freeNamesIfTcArgs ITC_Nil         = emptyNameSet
+
 freeNamesIfType :: IfaceType -> NameSet
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceTyConApp tc ts) =
-   freeNamesIfTc tc &&& fnList freeNamesIfType ts
+   freeNamesIfTc tc &&& freeNamesIfTcArgs ts
 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
 freeNamesIfType (IfaceForAllTy tv t)  =
    freeNamesIfTvBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
 
 freeNamesIfCoercion :: IfaceCoercion -> NameSet
 freeNamesIfCoercion (IfaceReflCo _ t) = freeNamesIfType t
@@ -1535,8 +1295,7 @@ 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)
-  = freeNamesIfExpr s 
-    &&& fnList fn_alt alts &&& fn_cons alts
+  = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts
   where
     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 
@@ -1558,7 +1317,7 @@ freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 freeNamesIfExpr _ = emptyNameSet
 
 freeNamesIfTc :: IfaceTyCon -> NameSet
-freeNamesIfTc (IfaceTc tc) = unitNameSet tc
+freeNamesIfTc tc = unitNameSet (ifaceTyConName tc)
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 
 freeNamesIfRule :: IfaceRule -> NameSet
@@ -1568,13 +1327,18 @@ freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
     fnList freeNamesIfBndr bs &&&
     fnList freeNamesIfExpr es &&&
     freeNamesIfExpr rhs
-    
+
 freeNamesIfFamInst :: IfaceFamInst -> NameSet
 freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName
                                  , ifFamInstAxiom = axName })
   = unitNameSet famName &&&
     unitNameSet axName
 
+freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
+freeNamesIfaceTyConParent IfNoParent = emptyNameSet
+freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
+  = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfTcArgs tys
+
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet
 (&&&) = unionNameSets
@@ -1608,3 +1372,538 @@ Now, lookupModule depends on DynFlags, but the transitive dependency
 on the *locally-defined* type PackageState is not visible. We need
 to take account of the use of the data constructor PS in the pattern match.
 
+
+%************************************************************************
+%*                                                                      *
+                Binary instances
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+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 a9) = 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 a9
+
+    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
+        putByte bh 5
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+
+    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+        putByte bh 6
+        put_ bh (occNameFS name)
+        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
+        h <- getByte bh
+        case h of
+            0 -> do name    <- get bh
+                    ty      <- get bh
+                    details <- get bh
+                    idinfo  <- get bh
+                    occ <- return $! mkVarOccFS 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 $! mkTcOccFS 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 $! mkTcOccFS 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
+                    a9 <- get bh
+                    occ <- return $! mkClsOccFS a2
+                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
+            5 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    occ <- return $! mkTcOccFS a1
+                    return (IfaceAxiom occ a2 a3 a4)
+            6 -> 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 $! mkDataOccFS a1
+                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
+            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
+
+instance Binary IfaceSynTyConRhs where
+    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
+    put_ bh (IfaceClosedSynFamilyTyCon ax br) = putByte bh 1 >> put_ bh ax
+                                                             >> put_ bh br
+    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
+    put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
+    put_ _ IfaceBuiltInSynFamTyCon
+        = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty
+
+    get bh = do { h <- getByte bh
+                ; case h of
+                    0 -> return IfaceOpenSynFamilyTyCon
+                    1 -> do { ax <- get bh
+                            ; br <- get bh
+                            ; return (IfaceClosedSynFamilyTyCon ax br) }
+                    2 -> return IfaceAbstractClosedSynFamilyTyCon
+                    _ -> do { ty <- get bh
+                            ; return (IfaceSynonymTyCon ty) } }
+
+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 $! mkVarOccFS n
+        return (IfaceClassOp occ def ty)
+
+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 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)
+
+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
+
+instance Binary IfaceConDecl where
+    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = 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
+    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
+        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
+
+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 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 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)
+
+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 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 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
+
+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
+
+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 (IfDFunUnfold as bs) = do
+        putByte bh 2
+        put_ bh as
+        put_ bh bs
+    put_ bh (IfCompulsory e) = do
+        putByte bh 3
+        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 as <- get bh
+                    bs <- get bh
+                    return (IfDFunUnfold as bs)
+            _ -> do e <- get bh
+                    return (IfCompulsory 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)
+
+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)
+
+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
+
+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 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 IfaceTyConParent where
+    put_ bh IfNoParent = putByte bh 0
+    put_ bh (IfDataInstance ax pr ty) = do
+        putByte bh 1
+        put_ bh ax
+        put_ bh pr
+        put_ bh ty
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfNoParent
+            _ -> do
+                ax <- get bh
+                pr <- get bh
+                ty <- get bh
+                return $ IfDataInstance ax pr ty
+\end{code}
\ No newline at end of file
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index e4a789f0f5..c55edc6185 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -6,17 +6,22 @@
 This module defines interface types and binders
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 module IfaceType (
         IfExtName, IfLclName,
 
         IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoercion(..),
-        IfaceTyLit(..),
-        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, 
+        IfaceTyLit(..), IfaceTcArgs(..),
+        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
 
         -- Conversion from Type -> IfaceType
-        toIfaceType, toIfaceKind, toIfaceContext,
-        toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
-        toIfaceTyCon, toIfaceTyCon_name,
+        toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar,
+        toIfaceContext, toIfaceBndr, toIfaceIdBndr,
+        toIfaceTvBndrs, toIfaceTyCon, toIfaceTyCon_name,
+        toIfaceTcArgs,
+
+        -- Conversion from IfaceTcArgs -> IfaceType
+        tcArgsIfaceTypes,
 
         -- Conversion from Coercion -> IfaceCoercion
         toIfaceCoercion,
@@ -24,31 +29,40 @@ module IfaceType (
         -- Printing
         pprIfaceType, pprParendIfaceType, pprIfaceContext, pprIfaceContextArr,
         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs,
-        pprIfaceBndrs,
-        tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart,
-        pprIfaceCoercion, pprParendIfaceCoercion
-
+        pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
+        pprIfaceForAllPart, pprIfaceForAll, pprIfaceSigmaType,
+        pprIfaceCoercion, pprParendIfaceCoercion,
+        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
+
+        suppressIfaceKinds,
+        stripIfaceKindVars,
+        stripKindArgs,
+        substIfaceType, substIfaceTyVar, substIfaceTcArgs, mkIfaceTySubst
     ) where
 
+#include "HsVersions.h"
+
 import Coercion
+import DataCon ( dataConTyCon )
 import TcType
 import DynFlags
-import TypeRep hiding( maybeParen )
+import TypeRep
 import Unique( hasKey )
-import TyCon
+import Util ( filterOut, lengthIs, zipWithEqual )
+import TyCon hiding ( pprPromotionQuote )
 import CoAxiom
 import Id
 import Var
+-- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
 import TysWiredIn
 import TysPrim
-import PrelNames( funTyConKey )
+import PrelNames( funTyConKey, ipClassName )
 import Name
 import BasicTypes
 import Binary
 import Outputable
 import FastString
-
-import Control.Monad
+import UniqSet
 \end{code}
 
 %************************************************************************
@@ -77,8 +91,9 @@ 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
+  | IfaceDFunTy   IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
-  | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
+  | IfaceTyConApp IfaceTyCon IfaceTcArgs  -- Not necessarily saturated
                                           -- Includes newtypes, synonyms, tuples
   | IfaceLitTy IfaceTyLit
 
@@ -89,9 +104,24 @@ data IfaceTyLit
   = IfaceNumTyLit Integer
   | IfaceStrTyLit FastString
 
--- Encodes type constructors, kind constructors
--- coercion constructors, the lot
-newtype IfaceTyCon = IfaceTc { ifaceTyConName :: IfExtName }
+-- See Note [Suppressing kinds]
+-- We use a new list type (rather than [(IfaceType,Bool)], because
+-- it'll be more compact and faster to parse in interface
+-- files. Rather than two bytes and two decisions (nil/cons, and
+-- type/kind) there'll just be one.
+data IfaceTcArgs
+  = ITC_Nil
+  | ITC_Type IfaceType IfaceTcArgs
+  | ITC_Kind IfaceKind IfaceTcArgs
+
+-- Encodes type constructors, kind constructors,
+-- coercion constructors, the lot.
+-- We have to tag them in order to pretty print them
+-- properly.
+data IfaceTyCon
+  = IfaceTc              { ifaceTyConName :: IfExtName }
+  | IfacePromotedDataCon { ifaceTyConName :: IfExtName }
+  | IfacePromotedTyCon   { ifaceTyConName :: IfExtName }
 
 data IfaceCoercion
   = IfaceReflCo      Role IfaceType
@@ -131,40 +161,167 @@ splitIfaceSigmaTy ty
         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
     split_foralls rho = ([], rho)
 
-    split_rho (IfaceFunTy ty1 ty2)
-      | isIfacePredTy ty1 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
+    split_rho (IfaceDFunTy ty1 ty2)
+        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
+
+suppressIfaceKinds :: DynFlags -> [IfaceTvBndr] -> [a] -> [a]
+suppressIfaceKinds dflags tys xs
+  | gopt Opt_PrintExplicitKinds dflags = xs
+  | otherwise = suppress tys xs
+    where
+      suppress _       []      = []
+      suppress []      a       = a
+      suppress (k:ks) a@(_:xs)
+        | isIfaceKindVar k = suppress ks xs
+        | otherwise        = a
+
+stripIfaceKindVars :: DynFlags -> [IfaceTvBndr] -> [IfaceTvBndr]
+stripIfaceKindVars dflags tyvars
+  | gopt Opt_PrintExplicitKinds dflags = tyvars
+  | otherwise = filterOut isIfaceKindVar tyvars
+
+isIfaceKindVar :: IfaceTvBndr -> Bool
+isIfaceKindVar (_, IfaceTyConApp tc _) = ifaceTyConName tc == superKindTyConName
+isIfaceKindVar _                       = False
+
+ifTyVarsOfType :: IfaceType -> UniqSet IfLclName
+ifTyVarsOfType ty
+  = case ty of
+      IfaceTyVar v -> unitUniqSet v
+      IfaceAppTy fun arg
+        -> ifTyVarsOfType fun `unionUniqSets` ifTyVarsOfType arg
+      IfaceFunTy arg res
+        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
+      IfaceDFunTy arg res
+        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
+      IfaceForAllTy (var,t) ty
+        -> delOneFromUniqSet (ifTyVarsOfType ty) var `unionUniqSets`
+           ifTyVarsOfType t
+      IfaceTyConApp _ args -> ifTyVarsOfArgs args
+      IfaceLitTy    _      -> emptyUniqSet
+
+ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
+ifTyVarsOfArgs args = argv emptyUniqSet args
+   where
+     argv vs (ITC_Type t ts) = argv (vs `unionUniqSets` (ifTyVarsOfType t)) ts
+     argv vs (ITC_Kind k ks) = argv (vs `unionUniqSets` (ifTyVarsOfType k)) ks
+     argv vs ITC_Nil         = vs
+\end{code}
+
+Substitutions on IfaceType. This is only used during pretty-printing to construct
+the result type of a GADT, and does not deal with binders (eg IfaceForAll), so
+it doesn't need fancy capture stuff.
+
+\begin{code}
+type IfaceTySubst = FastStringEnv IfaceType
+
+mkIfaceTySubst :: [IfaceTvBndr] -> [IfaceType] -> IfaceTySubst
+mkIfaceTySubst tvs tys = mkFsEnv $ zipWithEqual "mkIfaceTySubst" (\(fs,_) ty -> (fs,ty)) tvs tys
+
+substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
+substIfaceType env ty
+  = go ty
+  where
+    go (IfaceTyVar tv)        = substIfaceTyVar env tv
+    go (IfaceAppTy  t1 t2)    = IfaceAppTy  (go t1) (go t2)
+    go (IfaceFunTy  t1 t2)    = IfaceFunTy  (go t1) (go t2)
+    go (IfaceDFunTy t1 t2)    = IfaceDFunTy (go t1) (go t2)
+    go ty@(IfaceLitTy {})     = ty
+    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
+    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
+
+substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
+substIfaceTcArgs env args
+  = go args
+  where
+    go ITC_Nil           = ITC_Nil
+    go (ITC_Type ty tys) = ITC_Type (substIfaceType env ty) (go tys)
+    go (ITC_Kind ty tys) = ITC_Kind (substIfaceType env ty) (go tys)
+
+substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
+substIfaceTyVar env tv
+  | Just ty <- lookupFsEnv env tv = ty
+  | otherwise                     = IfaceTyVar tv
 \end{code}
 
 %************************************************************************
 %*                                                                      *
-                Pretty-printing
+                Functions over IFaceTcArgs
+%*                                                                      *
+%************************************************************************
+
+
+\begin{code}
+stripKindArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
+stripKindArgs dflags tys
+  | gopt Opt_PrintExplicitKinds dflags = tys
+  | otherwise = suppressKinds tys
+    where
+      suppressKinds c
+        = case c of
+            ITC_Kind _ ts -> suppressKinds ts
+            _ -> c
+
+toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
+-- See Note [Suppressing kinds]
+toIfaceTcArgs tc ty_args
+  = go (tyConKind tc) ty_args
+  where
+    go _                []     = ITC_Nil
+    go (ForAllTy _ res) (t:ts) = ITC_Kind (toIfaceKind t) (go res ts)
+    go (FunTy _ res)    (t:ts) = ITC_Type (toIfaceType t) (go res ts)
+    go kind             (t:ts) = WARN( True, ppr tc $$ ppr (tyConKind tc) $$ ppr ty_args )
+                                 ITC_Type (toIfaceType t) (go kind ts) -- Ill-kinded
+
+tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
+tcArgsIfaceTypes ITC_Nil = []
+tcArgsIfaceTypes (ITC_Kind t ts) = t : tcArgsIfaceTypes ts
+tcArgsIfaceTypes (ITC_Type t ts) = t : tcArgsIfaceTypes ts
+\end{code}
+
+Note [Suppressing kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We use the IfaceTcArgs to specify which of the arguments to a type
+constructor instantiate a for-all, and which are regular kind args.
+This in turn used to control kind-suppression when printing types,
+under the control of -fprint-explicit-kinds.  See also TypeRep.suppressKinds.
+For example, given
+    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
+    'Just :: forall k. k -> 'Maybe k   -- Promoted
+we want
+  T * Tree Int    prints as    T Tree Int
+  'Just *         prints as    Just *
+
+
+%************************************************************************
+%*                                                                      *
+                Functions over IFaceTyCon
 %*                                                                      *
 %************************************************************************
 
-Precedence
-~~~~~~~~~~
-@ppr_ty@ takes an @Int@ that is the precedence of the context.
-The precedence levels are:
-\begin{description}
-\item[tOP_PREC]   No parens required.
-\item[fUN_PREC]   Left hand argument of a function arrow.
-\item[tYCON_PREC] Argument of a type constructor.
-\end{description}
+\begin{code}
+--isPromotedIfaceTyCon :: IfaceTyCon -> Bool
+--isPromotedIfaceTyCon (IfacePromotedTyCon _) = True
+--isPromotedIfaceTyCon _ = False
+\end{code}
+%************************************************************************
+%*                                                                      *
+                Pretty-printing
+%*                                                                      *
+%************************************************************************
 
 \begin{code}
-tOP_PREC, fUN_PREC, tYCON_PREC :: Int
-tOP_PREC    = 0 -- type   in ParseIface.y
-fUN_PREC    = 1 -- btype  in ParseIface.y
-tYCON_PREC  = 2 -- atype  in ParseIface.y
-
-noParens :: SDoc -> SDoc
-noParens pp = pp
-
-maybeParen :: Int -> Int -> SDoc -> SDoc
-maybeParen ctxt_prec inner_prec pretty
-  | ctxt_prec < inner_prec = pretty
-  | otherwise              = parens pretty
+pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
+pprIfaceInfixApp pp p pp_tc ty1 ty2
+  = maybeParen p FunPrec $
+    sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2]
+
+pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
+pprIfacePrefixApp p pp_fun pp_tys
+  | null pp_tys = pp_fun
+  | otherwise   = maybeParen p TyConPrec $
+                  hang pp_fun 2 (sep pp_tys)
 \end{code}
 
 
@@ -182,9 +339,9 @@ pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 
 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
-pprIfaceTvBndr (tv, IfaceTyConApp tc [])
+pprIfaceTvBndr (tv, IfaceTyConApp tc ITC_Nil)
   | ifaceTyConName tc == liftedTypeKindTyConName = ppr tv
-pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
+pprIfaceTvBndr (tv, kind) = parens (ppr tv <+> dcolon <+> ppr kind)
 
 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 pprIfaceTvBndrs tyvars = sep (map pprIfaceTvBndr tyvars)
@@ -213,109 +370,200 @@ instance Outputable IfaceType where
   ppr ty = pprIfaceType ty
 
 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
-pprIfaceType       = ppr_ty tOP_PREC
-pprParendIfaceType = ppr_ty tYCON_PREC
-
-isIfacePredTy :: IfaceType -> Bool
-isIfacePredTy _  = False
--- FIXME: fix this to print iface pred tys correctly
--- isIfacePredTy ty = isConstraintKind (ifaceTypeKind ty)
+pprIfaceType       = ppr_ty TopPrec
+pprParendIfaceType = ppr_ty TyConPrec
 
-ppr_ty :: Int -> IfaceType -> SDoc
+ppr_ty :: TyPrec -> IfaceType -> SDoc
 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
-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 (IfaceTyConApp tc tys) = sdocWithDynFlags (pprTyTcApp ctxt_prec tc tys)
+ppr_ty _         (IfaceLitTy n)         = ppr_tylit n
         -- Function types
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
-    maybeParen ctxt_prec fUN_PREC $
-    sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
+    maybeParen ctxt_prec FunPrec $
+    sep [ppr_ty FunPrec ty1, sep (ppr_fun_tail ty2)]
   where
-    arr | isIfacePredTy ty1 = darrow
-        | otherwise         = arrow
-
     ppr_fun_tail (IfaceFunTy ty1 ty2)
-      = (arr <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
+      = (arrow <+> ppr_ty FunPrec ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty
-      = [arr <+> pprIfaceType other_ty]
+      = [arrow <+> pprIfaceType other_ty]
 
 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
-  = maybeParen ctxt_prec tYCON_PREC $
-    ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
+  = maybeParen ctxt_prec TyConPrec $
+    ppr_ty FunPrec ty1 <+> pprParendIfaceType ty2
 
-ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
-  = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
- where
-    (tvs, theta, tau) = splitIfaceSigmaTy ty
+ppr_ty ctxt_prec ty
+  = maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)
+
+instance Outputable IfaceTcArgs where
+  ppr tca = pprIfaceTcArgs tca
+
+pprIfaceTcArgs, pprParendIfaceTcArgs :: IfaceTcArgs -> SDoc
+pprIfaceTcArgs  = ppr_tc_args TopPrec
+pprParendIfaceTcArgs = ppr_tc_args TyConPrec
+
+ppr_tc_args :: TyPrec -> IfaceTcArgs -> SDoc
+ppr_tc_args ctx_prec args
+ = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
+   in case args of
+        ITC_Nil       -> empty
+        ITC_Type t ts -> pprTys t ts
+        ITC_Kind t ts -> pprTys t ts
 
 -------------------
--- 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, pprIfaceContextArr ctxt, doc]
+ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
+ppr_iface_sigma_type show_foralls_unconditionally ty
+  = ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
   where
-    ppr_tvs | null tvs  = empty
-            | otherwise = sdocWithDynFlags $ \ dflags ->
-            if gopt Opt_PrintExplicitForalls dflags
-            then ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
-            else empty
+    (tvs, theta, tau) = splitIfaceSigmaTy ty
 
+pprIfaceForAllPart :: Outputable a => [IfaceTvBndr] -> [a] -> SDoc -> SDoc
+pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
+
+ppr_iface_forall_part :: Outputable a
+                      => Bool -> [IfaceTvBndr] -> [a] -> SDoc -> SDoc
+ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
+  = sep [ if show_foralls_unconditionally
+          then pprIfaceForAll tvs
+          else pprUserIfaceForAll tvs
+        , pprIfaceContextArr ctxt
+        , sdoc]
+
+pprIfaceForAll :: [IfaceTvBndr] -> SDoc
+pprIfaceForAll []  = empty
+pprIfaceForAll tvs = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
+
+pprIfaceSigmaType :: IfaceType -> SDoc
+pprIfaceSigmaType ty = ppr_iface_sigma_type False ty
+
+pprUserIfaceForAll :: [IfaceTvBndr] -> SDoc
+pprUserIfaceForAll tvs
+   = sdocWithDynFlags $ \dflags ->
+     ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
+     pprIfaceForAll tvs
+   where
+     tv_has_kind_var (_,t) = not (isEmptyUniqSet (ifTyVarsOfType t))
 -------------------
-ppr_tc_app :: (Int -> a -> SDoc) -> Int -> IfaceTyCon -> [a] -> SDoc
-ppr_tc_app _  _         tc          []   = ppr_tc tc
-
-
-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 (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 (pp tYCON_PREC) tys))])
-
-ppr_tc :: IfaceTyCon -> SDoc
--- Wrap infix type constructors in parens
-ppr_tc tc = wrap (ifaceTyConName tc) (ppr tc)
+
+-- See equivalent function in TypeRep.lhs
+pprIfaceTyList :: TyPrec -> IfaceType -> IfaceType -> SDoc
+-- Given a type-level list (t1 ': t2), see if we can print
+-- it in list notation [t1, ...].
+-- Precondition: Opt_PrintExplicitKinds is off
+pprIfaceTyList ctxt_prec ty1 ty2
+  = case gather ty2 of
+      (arg_tys, Nothing)
+        -> char '\'' <> brackets (fsep (punctuate comma
+                        (map (ppr_ty TopPrec) (ty1:arg_tys))))
+      (arg_tys, Just tl)
+        -> maybeParen ctxt_prec FunPrec $ hang (ppr_ty FunPrec ty1)
+           2 (fsep [ colon <+> ppr_ty FunPrec ty | ty <- arg_tys ++ [tl]])
+  where
+    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
+     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
+     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
+    gather (IfaceTyConApp tc tys)
+      | tcname == consDataConName
+      , (ITC_Kind _ (ITC_Type ty1 (ITC_Type ty2 ITC_Nil))) <- tys
+      , (args, tl) <- gather ty2
+      = (ty1:args, tl)
+      | tcname == nilDataConName
+      = ([], Nothing)
+      where tcname = ifaceTyConName tc
+    gather ty = ([], Just ty)
+
+pprIfaceTypeApp :: IfaceTyCon -> IfaceTcArgs -> SDoc
+pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)
+
+pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
+pprTyTcApp ctxt_prec tc tys dflags
+  | ifaceTyConName tc == ipClassName
+  , ITC_Type (IfaceLitTy (IfaceStrTyLit n)) (ITC_Type ty ITC_Nil) <- tys
+  = char '?' <> ftext n <> ptext (sLit "::") <> ppr_ty TopPrec ty
+
+  | ifaceTyConName tc == consDataConName
+  , not (gopt Opt_PrintExplicitKinds dflags)
+  , ITC_Kind _ (ITC_Type ty1 (ITC_Type ty2 ITC_Nil)) <- tys
+  = pprIfaceTyList ctxt_prec ty1 ty2
+
+  | otherwise
+  = ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
+  where
+    tys_wo_kinds = tcArgsIfaceTypes $ stripKindArgs dflags tys
+
+pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
+pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
+
+ppr_iface_tc_app :: (TyPrec -> a -> SDoc) -> TyPrec -> IfaceTyCon -> [a] -> SDoc
+ppr_iface_tc_app pp _ tc [ty]
+  | n == listTyConName = pprPromotionQuote tc <> brackets (pp TopPrec ty)
+  | n == parrTyConName = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
+  where
+    n = ifaceTyConName tc
+
+ppr_iface_tc_app pp ctxt_prec tc tys
+  | Just (tup_sort, tup_args) <- is_tuple
+  = pprPromotionQuote tc <>
+    tupleParens tup_sort (sep (punctuate comma (map (pp TopPrec) tup_args)))
+
+  | not (isSymOcc (nameOccName tc_name))
+  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
+
+  | [ty1,ty2] <- tys  -- Infix, two arguments;
+                      -- we know nothing of precedence though
+  = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2
+
+  | tc_name == liftedTypeKindTyConName || tc_name == unliftedTypeKindTyConName
+  = ppr tc   -- Do not wrap *, # in parens
+
+  | otherwise
+  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys)
   where
-  -- The kind * does not get wrapped in parens.
-  wrap name | name == liftedTypeKindTyConName = id
-  wrap name                                   = parenSymOcc (getOccName name)
+    tc_name = ifaceTyConName tc
+
+    is_tuple = case wiredInNameTyThing_maybe tc_name of
+                 Just (ATyCon tc)
+                   | Just sort <- tyConTuple_maybe tc
+                   , tyConArity tc == length tys
+                   -> Just (sort, tys)
+
+                   | Just dc <- isPromotedDataCon_maybe tc
+                   , let dc_tc = dataConTyCon dc
+                   , isTupleTyCon dc_tc
+                   , let arity = tyConArity dc_tc
+                         ty_args = drop arity tys
+                   , ty_args `lengthIs` arity
+                   -> Just (tupleTyConSort tc, ty_args)
+
+                 _ -> Nothing
+
 
 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
+pprIfaceCoercion = ppr_co TopPrec
+pprParendIfaceCoercion = ppr_co TyConPrec
 
-ppr_co :: Int -> IfaceCoercion -> SDoc
+ppr_co :: TyPrec -> 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)
+  = maybeParen ctxt_prec FunPrec $
+    sep (ppr_co FunPrec 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
+      = (arrow <> ppr_role r <+> ppr_co FunPrec 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
+  = parens (pprIfaceCoTcApp TopPrec tc cos) <> ppr_role r
 ppr_co ctxt_prec (IfaceAppCo co1 co2)
-  = maybeParen ctxt_prec tYCON_PREC $
-    ppr_co fUN_PREC co1 <+> pprParendIfaceCoercion co2
+  = maybeParen ctxt_prec TyConPrec $
+    ppr_co FunPrec co1 <+> pprParendIfaceCoercion co2
 ppr_co ctxt_prec co@(IfaceForAllCo _ _)
-  = maybeParen ctxt_prec fUN_PREC (sep [ppr_tvs, pprIfaceCoercion inner_co])
+  = maybeParen ctxt_prec FunPrec (sep [ppr_tvs, pprIfaceCoercion inner_co])
   where
     (tvs, inner_co) = split_co co
     ppr_tvs = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
@@ -327,16 +575,16 @@ ppr_co ctxt_prec co@(IfaceForAllCo _ _)
 ppr_co _         (IfaceCoVarCo covar)       = ppr covar
 
 ppr_co ctxt_prec (IfaceUnivCo r ty1 ty2)
-  = maybeParen ctxt_prec tYCON_PREC $
+  = maybeParen ctxt_prec TyConPrec $
     ptext (sLit "UnivCo") <+> ppr r <+>
     pprParendIfaceType ty1 <+> pprParendIfaceType ty2
 
 ppr_co ctxt_prec (IfaceInstCo co ty)
-  = maybeParen ctxt_prec tYCON_PREC $
+  = maybeParen ctxt_prec TyConPrec $
     ptext (sLit "Inst") <+> pprParendIfaceCoercion co <+> pprParendIfaceType ty
 
 ppr_co ctxt_prec (IfaceAxiomRuleCo tc tys cos)
-  = maybeParen ctxt_prec tYCON_PREC
+  = maybeParen ctxt_prec TyConPrec
                (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys ++ map pprParendIfaceCoercion cos))])
 
 ppr_co ctxt_prec co
@@ -351,9 +599,9 @@ ppr_co ctxt_prec co
                      ; IfaceSubCo co            -> (ptext (sLit "Sub"), [co])
                      ; _                        -> panic "pprIfaceCo" }
 
-ppr_special_co :: Int -> SDoc -> [IfaceCoercion] -> SDoc
+ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc
 ppr_special_co ctxt_prec doc cos
-  = maybeParen ctxt_prec tYCON_PREC
+  = maybeParen ctxt_prec TyConPrec
                (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
 
 ppr_role :: Role -> SDoc
@@ -365,14 +613,30 @@ ppr_role r = underscore <> pp_role
 
 -------------------
 instance Outputable IfaceTyCon where
-  ppr = ppr . ifaceTyConName
+  ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
+
+pprPromotionQuote :: IfaceTyCon -> SDoc
+pprPromotionQuote (IfacePromotedDataCon _ ) = char '\''
+pprPromotionQuote (IfacePromotedTyCon _)    = ifPprDebug (char '\'')
+pprPromotionQuote _                         = empty
 
 instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
 
 instance Binary IfaceTyCon where
-   put_ bh (IfaceTc ext) = put_ bh ext
-   get bh = liftM IfaceTc (get bh)
+   put_ bh tc =
+     case tc of
+       IfaceTc n              -> putByte bh 0 >> put_ bh n
+       IfacePromotedDataCon n -> putByte bh 1 >> put_ bh n
+       IfacePromotedTyCon   n -> putByte bh 2 >> put_ bh n
+
+   get bh =
+     do tc <- getByte bh
+        case tc of
+          0 -> get bh >>= return . IfaceTc
+          1 -> get bh >>= return . IfacePromotedDataCon
+          2 -> get bh >>= return . IfacePromotedTyCon
+          _ -> panic ("get IfaceTyCon " ++ show tc)
 
 instance Outputable IfaceTyLit where
   ppr = ppr_tylit
@@ -390,6 +654,27 @@ instance Binary IfaceTyLit where
                  ; return (IfaceStrTyLit n) }
          _ -> panic ("get IfaceTyLit " ++ show tag)
 
+instance Binary IfaceTcArgs where
+  put_ bh tk =
+    case tk of
+      ITC_Type t ts -> putByte bh 0 >> put_ bh t >> put_ bh ts
+      ITC_Kind t ts -> putByte bh 1 >> put_ bh t >> put_ bh ts
+      ITC_Nil       -> putByte bh 2
+
+  get bh =
+    do c <- getByte bh
+       case c of
+         0 -> do
+           t  <- get bh
+           ts <- get bh
+           return $! ITC_Type t ts
+         1 -> do
+           t  <- get bh
+           ts <- get bh
+           return $! ITC_Kind t ts
+         2 -> return ITC_Nil
+         _ -> panic ("get IfaceTcArgs " ++ show c)
+
 -------------------
 pprIfaceContextArr :: Outputable a => [a] -> SDoc
 -- Prints "(C a, D b) =>", including the arrow
@@ -398,7 +683,7 @@ pprIfaceContextArr theta = pprIfaceContext theta <+> darrow
 
 pprIfaceContext :: Outputable a => [a] -> SDoc
 pprIfaceContext [pred] = ppr pred    -- No parens
-pprIfaceContext preds  = parens (sep (punctuate comma (map ppr preds)))
+pprIfaceContext preds  = parens (fsep (punctuate comma (map ppr preds)))
 
 instance Binary IfaceType where
     put_ bh (IfaceForAllTy aa ab) = do
@@ -416,6 +701,10 @@ instance Binary IfaceType where
             putByte bh 3
             put_ bh ag
             put_ bh ah
+    put_ bh (IfaceDFunTy ag ah) = do
+            putByte bh 4
+            put_ bh ag
+            put_ bh ah
     put_ bh (IfaceTyConApp tc tys)
       = do { putByte bh 5; put_ bh tc; put_ bh tys }
 
@@ -436,9 +725,11 @@ instance Binary IfaceType where
               3 -> do ag <- get bh
                       ah <- get bh
                       return (IfaceFunTy ag ah)
+              4 -> do ag <- get bh
+                      ah <- get bh
+                      return (IfaceDFunTy ag ah)
               5 -> do { tc <- get bh; tys <- get bh
                       ; return (IfaceTyConApp tc tys) }
-
               30 -> do n <- get bh
                        return (IfaceLitTy n)
 
@@ -558,7 +849,7 @@ instance Binary IfaceCoercion where
                    b <- get bh
                    c <- get bh
                    return $ IfaceAxiomRuleCo a b c
-           _ -> panic ("get IfaceCoercion " ++ show tag)             
+           _ -> panic ("get IfaceCoercion " ++ show tag)
 
 \end{code}
 
@@ -590,8 +881,10 @@ toIfaceType :: Type -> IfaceType
 -- Synonyms are retained in the interface type
 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
+toIfaceType (FunTy t1 t2)
+  | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
+  | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
+toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
 toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 
@@ -603,7 +896,11 @@ toIfaceCoVar = occNameFS . getOccName
 
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
-toIfaceTyCon = toIfaceTyCon_name . tyConName
+toIfaceTyCon tc
+  | isPromotedDataCon tc = IfacePromotedDataCon tc_name
+  | isPromotedTyCon tc   = IfacePromotedTyCon tc_name
+  | otherwise            = IfaceTc tc_name
+    where tc_name = tyConName tc
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
 toIfaceTyCon_name = IfaceTc
@@ -652,4 +949,3 @@ toIfaceCoercion (AxiomRuleCo co ts cs) = IfaceAxiomRuleCo
                                           (map toIfaceType ts)
                                           (map toIfaceCoercion cs)
 \end{code}
-
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index d787794326..03ce53fff8 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -6,6 +6,7 @@
 Loading interface files
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module LoadIface (
         -- RnM/TcM functions
@@ -391,7 +392,7 @@ compiler expects.
 -- the declaration itself, will find the fully-glorious Name
 --
 -- We handle ATs specially.  They are not main declarations, but also not
--- implict things (in particular, adding them to `implicitTyThings' would mess
+-- implicit things (in particular, adding them to `implicitTyThings' would mess
 -- things up in the renaming/type checking of source programs).
 -----------------------------------------------------
 
@@ -416,7 +417,6 @@ loadDecl ignore_prags mod (_version, decl)
   = do  {       -- Populate the name cache with final versions of all 
                 -- the names associated with the decl
           main_name      <- lookupOrig mod (ifName decl)
---        ; traceIf (text "Loading decl for " <> ppr main_name)
 
         -- Typecheck the thing, lazily
         -- NB. Firstly, the laziness is there in case we never need the
@@ -445,11 +445,11 @@ loadDecl ignore_prags mod (_version, decl)
         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
         -- (where the "MkT" is the *Name* associated with MkT, etc.)
         --
-        -- We do this by mapping the implict_names to the associated
+        -- We do this by mapping the implicit_names to the associated
         -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
         -- implicitTyThings, we can use getOccName on the implicit
         -- TyThings to make this association: each Name's OccName should
-        -- be the OccName of exactly one implictTyThing.  So the key is
+        -- be the OccName of exactly one implicitTyThing.  So the key is
         -- to define a "mini-env"
         --
         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
@@ -457,7 +457,7 @@ loadDecl ignore_prags mod (_version, decl)
         --
         -- However, there is a subtlety: due to how type checking needs
         -- to be staged, we can't poke on the forkM'd thunks inside the
-        -- implictTyThings while building this mini-env.  
+        -- implicitTyThings while building this mini-env.  
         -- If we poke these thunks too early, two problems could happen:
         --    (1) When processing mutually recursive modules across
         --        hs-boot boundaries, poking too early will do the
@@ -490,9 +490,11 @@ loadDecl ignore_prags mod (_version, decl)
                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
 
         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
+
+--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
         ; return $ (main_name, thing) :
                       -- uses the invariant that implicit_names and
-                      -- implictTyThings are bijective
+                      -- implicitTyThings are bijective
                       [(n, lookup n) | n <- implicit_names]
         }
   where
@@ -751,7 +753,7 @@ pprModIface iface
         , vcat (map pprUsage (mi_usages iface))
         , vcat (map pprIfaceAnnotation (mi_anns iface))
         , pprFixities (mi_fixities iface)
-        , vcat (map pprIfaceDecl (mi_decls iface))
+        , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
         , vcat (map ppr (mi_insts iface))
         , vcat (map ppr (mi_fam_insts iface))
         , vcat (map ppr (mi_rules iface))
@@ -817,10 +819,6 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
     ppr_boot True  = text "[boot]"
     ppr_boot False = empty
 
-pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
-pprIfaceDecl (ver, decl)
-  = ppr ver $$ nest 2 (ppr decl)
-
 pprFixities :: [(OccName, Fixity)] -> SDoc
 pprFixities []    = empty
 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index bb51cdae9d..460c6076ba 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -4,6 +4,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 -- | Module for constructing @ModIface@ values (interface files),
 -- writing them to disk and comparing two versions to see if
 -- recompilation is required.
@@ -78,6 +80,7 @@ import DataCon
 import PatSyn
 import Type
 import TcType
+import TysPrim ( alphaTyVars )
 import InstEnv
 import FamInstEnv
 import TcRnMonad
@@ -876,6 +879,13 @@ instOrphWarn :: DynFlags -> PrintUnqualified -> ClsInst -> WarnMsg
 instOrphWarn dflags unqual inst
   = mkWarnMsg dflags (getSrcSpan inst) unqual $
     hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
+    $$ text "To avoid this"
+    $$ nest 4 (vcat possibilities)
+  where
+    possibilities =
+      text "move the instance declaration to the module of the class or of the type, or" :
+      text "wrap the type with a newtype and declare the instance on the new type." :
+      []
 
 ruleOrphWarn :: DynFlags -> PrintUnqualified -> Module -> IfaceRule -> WarnMsg
 ruleOrphWarn dflags unqual mod rule
@@ -1131,27 +1141,35 @@ recompileRequired _ = True
 -- first element is a bool saying if we should recompile the object file
 -- and the second is maybe the interface file, where Nothng means to
 -- rebuild the interface file not use the exisitng one.
-checkOldIface :: HscEnv
-              -> ModSummary
-              -> SourceModified
-              -> Maybe ModIface         -- Old interface from compilation manager, if any
-              -> IO (RecompileRequired, Maybe ModIface)
+checkOldIface
+  :: HscEnv
+  -> ModSummary
+  -> SourceModified
+  -> Maybe ModIface         -- Old interface from compilation manager, if any
+  -> IO (RecompileRequired, Maybe ModIface)
 
 checkOldIface hsc_env mod_summary source_modified maybe_iface
   = do  let dflags = hsc_dflags hsc_env
         showPass dflags $
-            "Checking old interface for " ++ (showPpr dflags $ ms_mod mod_summary)
+            "Checking old interface for " ++
+              (showPpr dflags $ ms_mod mod_summary)
         initIfaceCheck hsc_env $
             check_old_iface hsc_env mod_summary source_modified maybe_iface
 
-check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
-                -> IfG (RecompileRequired, Maybe ModIface)
+check_old_iface
+  :: HscEnv
+  -> ModSummary
+  -> SourceModified
+  -> Maybe ModIface
+  -> IfG (RecompileRequired, Maybe ModIface)
+
 check_old_iface hsc_env mod_summary src_modified maybe_iface
   = let dflags = hsc_dflags hsc_env
         getIface =
             case maybe_iface of
                 Just _  -> do
-                    traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
+                    traceIf (text "We already have the old interface for" <+>
+                      ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> loadIface
 
@@ -1458,7 +1476,7 @@ checkList (check:checks) = do recompile <- check
 \begin{code}
 tyThingToIfaceDecl :: TyThing -> IfaceDecl
 tyThingToIfaceDecl (AnId id)      = idToIfaceDecl id
-tyThingToIfaceDecl (ATyCon tycon) = tyConToIfaceDecl emptyTidyEnv tycon
+tyThingToIfaceDecl (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
 tyThingToIfaceDecl (ACoAxiom ax)  = coAxiomToIfaceDecl ax
 tyThingToIfaceDecl (AConLike cl)  = case cl of
     RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only
@@ -1488,25 +1506,24 @@ dataConToIfaceDecl dataCon
 patSynToIfaceDecl :: PatSyn -> IfaceDecl
 patSynToIfaceDecl ps
   = IfacePatSyn { ifName          = getOccName . getName $ ps
-                , ifPatHasWrapper = isJust $ patSynWrapper ps
+                , ifPatMatcher    = matcher
+                , ifPatWrapper    = wrapper
                 , ifPatIsInfix    = patSynIsInfix ps
                 , ifPatUnivTvs    = toIfaceTvBndrs univ_tvs'
                 , ifPatExTvs      = toIfaceTvBndrs ex_tvs'
                 , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
                 , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
-                , ifPatArgs       = map toIfaceArg args
+                , ifPatArgs       = map (tidyToIfaceType env2) args
                 , ifPatTy         = tidyToIfaceType env2 rhs_ty
                 }
   where
-    toIfaceArg var = (occNameFS (getOccName var),
-                      tidyToIfaceType env2 (varType var))
-
-    (univ_tvs, ex_tvs, (prov_theta, req_theta)) = patSynSig ps
-    args = patSynArgs ps
-    rhs_ty = patSynType ps
+    (univ_tvs, ex_tvs, prov_theta, req_theta, args, rhs_ty) = patSynSig ps
     (env1, univ_tvs') = tidyTyVarBndrs emptyTidyEnv univ_tvs
     (env2, ex_tvs')   = tidyTyVarBndrs env1 ex_tvs
 
+    matcher = idName (patSynMatcher ps)
+    wrapper = fmap idName (patSynWrapper ps)
+
 
 --------------------------
 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
@@ -1517,19 +1534,19 @@ coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
  = IfaceAxiom { ifName       = name
               , ifTyCon      = toIfaceTyCon tycon
               , ifRole       = role
-              , ifAxBranches = brListMap (coAxBranchToIfaceBranch
-                                            emptyTidyEnv
-                                            (brListMap coAxBranchLHS branches)) branches }
+              , ifAxBranches = brListMap (coAxBranchToIfaceBranch tycon
+                                            (brListMap coAxBranchLHS branches))
+                                         branches }
  where
    name = getOccName ax
 
 -- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches
 -- to incompatible indices
 -- See Note [Storing compatibility] in CoAxiom
-coAxBranchToIfaceBranch :: TidyEnv -> [[Type]] -> CoAxBranch -> IfaceAxBranch
-coAxBranchToIfaceBranch env0 lhs_s
+coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch tc lhs_s
                         branch@(CoAxBranch { cab_incomps = incomps })
-  = (coAxBranchToIfaceBranch' env0 branch) { ifaxbIncomps = iface_incomps }
+  = (coAxBranchToIfaceBranch' tc branch) { ifaxbIncomps = iface_incomps }
   where
     iface_incomps = map (expectJust "iface_incomps"
                         . (flip findIndex lhs_s
@@ -1537,63 +1554,91 @@ coAxBranchToIfaceBranch env0 lhs_s
                         . 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 })
+coAxBranchToIfaceBranch' :: TyCon -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch' tc (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs
+                                        , cab_roles = roles, cab_rhs = rhs })
   = IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tv_bndrs
-                  , ifaxbLHS    = map (tidyToIfaceType env1) lhs
+                  , ifaxbLHS    = tidyToIfaceTcArgs env1 tc lhs
                   , ifaxbRoles  = roles
                   , ifaxbRHS    = tidyToIfaceType env1 rhs
                   , ifaxbIncomps = [] }
   where
-    (env1, tv_bndrs) = tidyTyClTyVarBndrs env0 tvs
+    (env1, tv_bndrs) = tidyTyClTyVarBndrs emptyTidyEnv tvs
     -- Don't re-bind in-scope tyvars
     -- See Note [CoAxBranch type variables] in CoAxiom
 
 -----------------
-tyConToIfaceDecl :: TidyEnv -> TyCon -> IfaceDecl
+tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
 -- We *do* tidy TyCons, because they are not (and cannot
 -- conveniently be) built in tidy form
+-- The returned TidyEnv is the one after tidying the tyConTyVars
 tyConToIfaceDecl env tycon
   | Just clas <- tyConClass_maybe tycon
   = classToIfaceDecl env clas
 
   | 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) }
+  = ( tc_env1
+    , IfaceSyn {  ifName    = getOccName tycon,
+                  ifTyVars  = if_tc_tyvars,
+                  ifRoles   = tyConRoles tycon,
+                  ifSynRhs  = to_ifsyn_rhs syn_rhs,
+                  ifSynKind = tidyToIfaceType tc_env1 (synTyConResKind tycon) })
 
   | isAlgTyCon 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),
-                ifGadtSyntax = isGadtSyntaxTyCon tycon,
-                ifPromotable = isJust (promotableTyCon_maybe tycon),
-                ifAxiom   = fmap coAxiomName (tyConFamilyCoercion_maybe tycon) }
+  = ( tc_env1
+    , IfaceData { ifName    = getOccName tycon,
+                  ifCType   = tyConCType tycon,
+                  ifTyVars  = if_tc_tyvars,
+                  ifRoles   = tyConRoles tycon,
+                  ifCtxt    = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
+                  ifCons    = ifaceConDecls (algTyConRhs tycon),
+                  ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
+                  ifGadtSyntax = isGadtSyntaxTyCon tycon,
+                  ifPromotable = isJust (promotableTyCon_maybe tycon),
+                  ifParent  = parent })
 
   | isForeignTyCon tycon
-  = IfaceForeign { ifName    = getOccName tycon,
-                   ifExtName = tyConExtName tycon }
-
-  | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
+  = (env, IfaceForeign { ifName    = getOccName tycon,
+                         ifExtName = tyConExtName tycon })
+
+  | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
+  -- For pretty printing purposes only.
+  = ( env
+    , IfaceData { ifName       = getOccName tycon,
+                  ifCType      = Nothing,
+                  ifTyVars     = funAndPrimTyVars,
+                  ifRoles      = tyConRoles tycon,
+                  ifCtxt       = [],
+                  ifCons       = IfDataTyCon [],
+                  ifRec        = boolToRecFlag False,
+                  ifGadtSyntax = False,
+                  ifPromotable = False,
+                  ifParent     = IfNoParent })
   where
-    (env1, tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
+    (tc_env1, tc_tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
+    if_tc_tyvars = toIfaceTvBndrs tc_tyvars
+
+    funAndPrimTyVars = toIfaceTvBndrs $ take (tyConArity tycon) alphaTyVars
+
+    parent = case tyConFamInstSig_maybe tycon of
+               Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
+                                                   (toIfaceTyCon tc)
+                                                   (tidyToIfaceTcArgs tc_env1 tc ty)
+               Nothing           -> IfNoParent
+
+    to_ifsyn_rhs OpenSynFamilyTyCon        = IfaceOpenSynFamilyTyCon
+    to_ifsyn_rhs (ClosedSynFamilyTyCon ax) = IfaceClosedSynFamilyTyCon axn ibr
+      where defs = fromBranchList $ coAxiomBranches ax
+            ibr  = map (coAxBranchToIfaceBranch' tycon) defs
+            axn  = coAxiomName ax
+    to_ifsyn_rhs AbstractClosedSynFamilyTyCon
+      = IfaceAbstractClosedSynFamilyTyCon
 
-    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)
+      = IfaceSynonymTyCon (tidyToIfaceType tc_env1 ty)
 
-    to_ifsyn_rhs (BuiltInSynFamTyCon {}) = pprPanic "toIfaceDecl: BuiltInFamTyCon" (ppr tycon)
+    to_ifsyn_rhs (BuiltInSynFamTyCon {})
+      = IfaceBuiltInSynFamTyCon
 
 
     ifaceConDecls (NewTyCon { data_con = con })     = IfNewTyCon  (ifaceConDecl con)
@@ -1609,23 +1654,28 @@ tyConToIfaceDecl env tycon
         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
                     ifConInfix   = dataConIsInfix data_con,
                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
-                    ifConUnivTvs = toIfaceTvBndrs univ_tvs',
                     ifConExTvs   = toIfaceTvBndrs ex_tvs',
-                    ifConEqSpec  = to_eq_spec eq_spec,
-                    ifConCtxt    = tidyToIfaceContext env2 theta,
-                    ifConArgTys  = map (tidyToIfaceType env2) arg_tys,
+                    ifConEqSpec  = map to_eq_spec eq_spec,
+                    ifConCtxt    = tidyToIfaceContext con_env2 theta,
+                    ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,
                     ifConFields  = map getOccName
                                        (dataConFieldLabels data_con),
-                    ifConStricts = map (toIfaceBang env2) (dataConRepBangs data_con) }
+                    ifConStricts = map (toIfaceBang con_env2) (dataConRepBangs data_con) }
         where
           (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con
 
-          -- Start with 'emptyTidyEnv' not 'env1', because the type of the
-          -- data constructor is fully standalone
-          (env1, univ_tvs') = tidyTyVarBndrs emptyTidyEnv univ_tvs
-          (env2, ex_tvs')   = tidyTyVarBndrs env1 ex_tvs
-          to_eq_spec spec = [ (getOccName (tidyTyVar env2 tv), tidyToIfaceType env2 ty)
-                            | (tv,ty) <- spec]
+          -- Tidy the univ_tvs of the data constructor to be identical
+          -- to the tyConTyVars of the type constructor.  This means
+          -- (a) we don't need to redundantly put them into the interface file
+          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
+          --     we know that the type variables will line up
+          -- The latter (b) is important because we pretty-print type construtors
+          -- by converting to IfaceSyn and pretty-printing that
+          con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
+                     -- A bit grimy, perhaps, but it's simple!
+
+          (con_env2, ex_tvs') = tidyTyVarBndrs con_env1 ex_tvs
+          to_eq_spec (tv,ty)  = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
 
 toIfaceBang :: TidyEnv -> HsBang -> IfaceBang
 toIfaceBang _    HsNoBang            = IfNoBang
@@ -1634,17 +1684,18 @@ toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env c
 toIfaceBang _   HsStrict             = IfStrict
 toIfaceBang _   (HsUserBang {})      = panic "toIfaceBang"
 
-classToIfaceDecl :: TidyEnv -> Class -> IfaceDecl
+classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 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,
-                 ifMinDef = fmap getOccName (classMinimalDef clas),
-                 ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
+  = ( env1
+    , 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,
+                   ifMinDef = fmap getFS (classMinimalDef clas),
+                   ifRec    = boolToRecFlag (isRecursiveTyCon tycon) })
   where
     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
       = classExtraBigSig clas
@@ -1653,8 +1704,10 @@ classToIfaceDecl env clas
     (env1, clas_tyvars') = tidyTyVarBndrs env clas_tyvars
 
     toIfaceAT :: ClassATItem -> IfaceAT
-    toIfaceAT (tc, defs)
-      = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch' env1) defs)
+    toIfaceAT (ATI tc def)
+      = IfaceAT if_decl (fmap (tidyToIfaceType env2) def)
+      where
+        (env2, if_decl) = tyConToIfaceDecl env1 tc
 
     toIfaceClassOp (sel_id, def_meth)
         = ASSERT(sel_tyvars == clas_tyvars)
@@ -1680,6 +1733,9 @@ classToIfaceDecl env clas
 tidyToIfaceType :: TidyEnv -> Type -> IfaceType
 tidyToIfaceType env ty = toIfaceType (tidyType env ty)
 
+tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceTcArgs
+tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
+
 tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
 tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index cc45648ea2..68f9e8fd65 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -6,14 +6,15 @@
 Type checking of type signatures in interface files
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcIface (
         tcLookupImported_maybe,
         importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
         tcIfaceVectInfo, tcIfaceAnnotations,
         tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
-        tcIfaceGlobal,
-        tcExtCoreBindings
+        tcIfaceGlobal
  ) where
 
 #include "HsVersions.h"
@@ -343,26 +344,34 @@ tcHiBootIface hsc_src mod
           else do
 
         -- OK, so we're in one-shot mode.
-        -- In that case, we're read all the direct imports by now,
-        -- so eps_is_boot will record if any of our imports mention us by
-        -- way of hi-boot file
-        { eps <- getEps
-        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
-            Nothing -> return emptyModDetails ; -- The typical case
+        -- Re #9245, we always check if there is an hi-boot interface
+        -- to check consistency against, rather than just when we notice
+        -- that an hi-boot is necessary due to a circular import.
+        { read_result <- findAndReadIface
+                                need mod
+                                True    -- Hi-boot file
 
-            Just (_, False) -> failWithTc moduleLoop ;
+        ; case read_result of {
+                Succeeded (iface, _path) -> typecheckIface iface ;
+                Failed err               ->
+
+        -- There was no hi-boot file. But if there is circularity in
+        -- the module graph, there really should have been one.
+        -- Since we've read all the direct imports by now,
+        -- eps_is_boot will record if any of our imports mention the
+        -- current module, which either means a module loop (not
+        -- a SOURCE import) or that our hi-boot file has mysteriously
+        -- disappeared.
+    do  { eps <- getEps
+        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of
+            Nothing -> return emptyModDetails -- The typical case
+
+            Just (_, False) -> failWithTc moduleLoop
                 -- Someone below us imported us!
                 -- This is a loop with no hi-boot in the way
 
-            Just (_mod, True) ->        -- There's a hi-boot interface below us
-
-    do  { read_result <- findAndReadIface
-                                need mod
-                                True    -- Hi-boot file
-
-        ; case read_result of
-                Failed err               -> failWithTc (elaborate err)
-                Succeeded (iface, _path) -> typecheckIface iface
+            Just (_mod, True) -> failWithTc (elaborate err)
+                -- The hi-boot file has mysteriously disappeared.
     }}}}
   where
     need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
@@ -451,41 +460,26 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons,
                           ifRec = is_rec, ifPromotable = is_prom,
-                          ifAxiom = mb_axiom_name })
+                          ifParent = mb_parent })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name <- lookupIfaceTop occ_name
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
-            ; parent' <- tc_parent tyvars mb_axiom_name
+            ; parent' <- tc_parent mb_parent
             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
             ; 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) }
   where
-    tc_parent :: [TyVar] -> Maybe Name -> IfL TyConParent
-    tc_parent _ Nothing = return parent
-    tc_parent tyvars (Just ax_name)
+    tc_parent :: IfaceTyConParent -> IfL TyConParent
+    tc_parent IfNoParent = return parent
+    tc_parent (IfDataInstance ax_name _ arg_tys)
       = ASSERT( isNoParent parent )
         do { ax <- tcIfaceCoAxiom ax_name
-           ; let fam_tc = coAxiomTyCon ax
+           ; 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
-                 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
-                            -- 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
+           ; lhs_tys <- tcIfaceTcArgs arg_tys
            ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
 
 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
@@ -502,12 +496,14 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
    where
      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
      tc_syn_rhs IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
-     tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name)
+     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_syn_rhs IfaceBuiltInSynFamTyCon   = pprPanic "tc_iface_decl"
+                                               (ptext (sLit "IfaceBuiltInSynFamTyCon in interface file"))
 
 tc_iface_decl _parent ignore_prags
             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
@@ -524,11 +520,11 @@ tc_iface_decl _parent ignore_prags
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; traceIf (text "tc-iface-class3" <+> ppr tc_occ)
-    ; mindef <- traverse lookupIfaceTop mindef_occ
+    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
     ; 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 roles ctxt fds ats sigs mindef tc_isrec }
+              ; buildClass tc_name tyvars roles ctxt fds ats sigs mindef tc_isrec }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -548,13 +544,18 @@ tc_iface_decl _parent ignore_prags
                 -- it mentions unless it's necessary to do so
           ; return (op_name, dm, op_ty) }
 
-   tc_at cls (IfaceAT tc_decl defs_decls)
+   tc_at cls (IfaceAT tc_decl if_def)
      = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
-          defs <- forkM (mk_at_doc tc) (tc_ax_branches tc defs_decls)
+          mb_def <- case if_def of
+                      Nothing  -> return Nothing
+                      Just def -> forkM (mk_at_doc tc)                 $
+                                  extendIfaceTyVarEnv (tyConTyVars tc) $
+                                  do { tc_def <- tcIfaceType def
+                                     ; return (Just tc_def) }
                   -- 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)
+          return (ATI tc mb_def)
 
    mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
    mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
@@ -573,7 +574,7 @@ 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 <- tc_ax_branches tc_tycon branches
+       ; tc_branches <- tc_ax_branches branches
        ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
                              , co_ax_name     = tc_name
                              , co_ax_tc       = tc_tycon
@@ -583,7 +584,8 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
        ; return (ACoAxiom axiom) }
 
 tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
-                              , ifPatHasWrapper = has_wrapper
+                              , ifPatMatcher = matcher_name
+                              , ifPatWrapper = wrapper_name
                               , ifPatIsInfix = is_infix
                               , ifPatUnivTvs = univ_tvs
                               , ifPatExTvs = ex_tvs
@@ -593,31 +595,35 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
                               , ifPatTy = pat_ty })
   = do { name <- lookupIfaceTop occ_name
        ; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name)
+       ; matcher <- tcExt "Matcher" matcher_name
+       ; wrapper <- case wrapper_name of
+                        Nothing -> return Nothing
+                        Just wn -> do { wid <- tcExt "Wrapper" wn
+                                      ; return (Just wid) }
        ; bindIfaceTyVars univ_tvs $ \univ_tvs -> do
        { bindIfaceTyVars ex_tvs $ \ex_tvs -> do
-       { bindIfaceIdVars args $ \args -> do
-       { ~(prov_theta, req_theta, pat_ty) <- forkM (mk_doc name) $
+       { patsyn <- forkM (mk_doc name) $
              do { prov_theta <- tcIfaceCtxt prov_ctxt
                 ; req_theta  <- tcIfaceCtxt req_ctxt
                 ; pat_ty     <- tcIfaceType pat_ty
-                ; return (prov_theta, req_theta, pat_ty) }
-       ; bindIfaceTyVar (fsLit "r", toIfaceKind liftedTypeKind) $ \tv -> do
-       { patsyn <- buildPatSyn name is_infix has_wrapper args univ_tvs ex_tvs prov_theta req_theta pat_ty tv
-       ; return (AConLike (PatSynCon patsyn)) }}}}}
+                ; arg_tys    <- mapM tcIfaceType args
+                ; return $ buildPatSyn name is_infix matcher wrapper
+                                       arg_tys univ_tvs ex_tvs prov_theta req_theta pat_ty }
+       ; return $ AConLike . PatSynCon $ patsyn }}}
   where
      mk_doc n = ptext (sLit "Pattern synonym") <+> ppr n
+     tcExt s name = forkM (ptext (sLit s) <+> ppr name) $ tcIfaceExtId name
 
+tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
+tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
 
-tc_ax_branches :: TyCon -> [IfaceAxBranch] -> IfL [CoAxBranch]
-tc_ax_branches tc if_branches = foldlM (tc_ax_branch (tyConKind tc)) [] if_branches
-
-tc_ax_branch :: Kind -> [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
-tc_ax_branch tc_kind prev_branches
+tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
+tc_ax_branch prev_branches
              (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
                             , ifaxbRoles = roles, ifaxbIncomps = incomps })
   = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do
          -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
-    { tc_lhs <- tcIfaceTcArgs tc_kind lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
+    { tc_lhs <- tcIfaceTcArgs lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
     ; tc_rhs <- tcIfaceType rhs
     ; let br = CoAxBranch { cab_loc     = noSrcSpan
                           , cab_tvs     = tvs
@@ -628,7 +634,7 @@ tc_ax_branch tc_kind prev_branches
     ; return (prev_branches ++ [br]) }
 
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
-tcIfaceDataCons tycon_name tycon _ if_cons
+tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
   = case if_cons of
         IfAbstractTyCon dis -> return (AbstractTyCon dis)
         IfDataFamTyCon  -> return DataFamilyTyCon
@@ -638,11 +644,12 @@ tcIfaceDataCons tycon_name tycon _ if_cons
                                 ; mkNewTyConRhs tycon_name tycon data_con }
   where
     tc_con_decl (IfCon { ifConInfix = is_infix,
-                         ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
+                         ifConExTvs = ex_tvs,
                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
                          ifConArgTys = args, ifConFields = field_lbls,
                          ifConStricts = if_stricts})
-     = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
+     = -- Universally-quantified tyvars are shared with 
+       -- parent TyCon, and are alrady in scope
        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
         ; name  <- lookupIfaceTop occ
@@ -664,12 +671,12 @@ tcIfaceDataCons tycon_name tycon _ if_cons
 
         -- Remember, tycon is the representation tycon
         ; let orig_res_ty = mkFamilyTyConApp tycon
-                                (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
+                                (substTyVars (mkTopTvSubst eq_spec) tc_tyvars)
 
         ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
                        name is_infix
                        stricts lbl_names
-                       univ_tyvars ex_tyvars
+                       tc_tyvars ex_tyvars
                        eq_spec theta
                        arg_tys orig_res_ty tycon
         ; traceIf (text "Done interface-file tc_con_decl" <+> ppr name)
@@ -682,11 +689,11 @@ tcIfaceDataCons tycon_name tycon _ if_cons
     tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                       ; return (HsUnpack (Just co)) }
 
-tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
+tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)]
 tcIfaceEqSpec spec
   = mapM do_item spec
   where
-    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
+    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
                               ; ty <- tcIfaceType if_ty
                               ; return (tv,ty) }
 \end{code}
@@ -957,25 +964,38 @@ tcIfaceType :: IfaceType -> IfL Type
 tcIfaceType (IfaceTyVar n)         = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)     = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 tcIfaceType (IfaceLitTy l)         = do { l1 <- tcIfaceTyLit l; return (LitTy l1) }
-tcIfaceType (IfaceFunTy t1 t2)     = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
+tcIfaceType (IfaceFunTy t1 t2)     = tcIfaceTypeFun t1 t2
+tcIfaceType (IfaceDFunTy t1 t2)    = tcIfaceTypeFun t1 t2
 tcIfaceType (IfaceTyConApp tc tks) = do { tc' <- tcIfaceTyCon tc
-                                        ; tks' <- tcIfaceTcArgs (tyConKind tc') tks
+                                        ; tks' <- tcIfaceTcArgs tks
                                         ; return (mkTyConApp tc' tks') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 
-tcIfaceTypes :: [IfaceType] -> IfL [Type]
-tcIfaceTypes tys = mapM tcIfaceType tys
-
-tcIfaceTcArgs :: Kind -> [IfaceType] -> IfL [Type]
-tcIfaceTcArgs _ []
-  = return []
-tcIfaceTcArgs kind (tk:tks)
-  = case splitForAllTy_maybe kind of
-      Nothing         -> tcIfaceTypes (tk:tks)
-      Just (_, kind') -> do { k'   <- tcIfaceKind tk
-                            ; tks' <- tcIfaceTcArgs kind' tks
-                            ; return (k':tks') }
-
+tcIfaceTypeFun :: IfaceType -> IfaceType -> IfL Type
+tcIfaceTypeFun t1 t2 = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
+
+tcIfaceKind :: IfaceKind -> IfL Type
+tcIfaceKind (IfaceAppTy t1 t2)  = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (AppTy t1' t2') }
+tcIfaceKind (IfaceFunTy t1 t2)  = tcIfaceKindFun t1 t2
+tcIfaceKind (IfaceDFunTy t1 t2) = tcIfaceKindFun t1 t2
+tcIfaceKind (IfaceLitTy l)      = pprPanic "tcIfaceKind" (ppr l)
+tcIfaceKind k                   = tcIfaceType k
+
+tcIfaceKindFun :: IfaceKind -> IfaceKind -> IfL Type
+tcIfaceKindFun t1 t2 = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') }
+
+tcIfaceTcArgs :: IfaceTcArgs -> IfL [Type]
+tcIfaceTcArgs args
+  = case args of
+      ITC_Type t ts ->
+        do { t'  <- tcIfaceType t
+           ; ts' <- tcIfaceTcArgs ts
+           ; return (t':ts') }
+      ITC_Kind k ks ->
+        do { k'  <- tcIfaceKind k
+           ; ks' <- tcIfaceTcArgs ks
+           ; return (k':ks') }
+      ITC_Nil -> return []
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
 tcIfaceCtxt sts = mapM tcIfaceType sts
@@ -984,43 +1004,8 @@ tcIfaceCtxt sts = mapM tcIfaceType sts
 tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
 tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n)
 tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n)
-
------------------------------------------
-tcIfaceKind :: IfaceKind -> IfL Kind   -- See Note [Checking IfaceTypes vs IfaceKinds]
-tcIfaceKind (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
-tcIfaceKind (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (AppTy t1' t2') }
-tcIfaceKind (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') }
-tcIfaceKind (IfaceTyConApp tc ts) = do { tc' <- tcIfaceKindCon tc; ts' <- tcIfaceKinds ts; return (mkTyConApp tc' ts') }
-tcIfaceKind (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceKind t; return (ForAllTy tv' t') }
-tcIfaceKind t                     = pprPanic "tcIfaceKind" (ppr t)  -- IfaceCoApp, IfaceLitTy
-
-tcIfaceKinds :: [IfaceKind] -> IfL [Kind]
-tcIfaceKinds tys = mapM tcIfaceKind tys
 \end{code}
 
-Note [Checking IfaceTypes vs IfaceKinds]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We need to know whether we are checking a *type* or a *kind*.
-Consider   module M where
-             Proxy :: forall k. k -> *
-             data T = T
-and consider the two IfaceTypes
-      M.Proxy * M.T{tc}
-      M.Proxy 'M.T{tc} 'M.T(d}
-The first is conventional, but in the latter we use the promoted
-type constructor (as a kind) and data constructor (as a type).  However,
-the Name of the promoted type constructor is just M.T; it's the *same name*
-as the ordinary type constructor.
-
-We could add a "promoted" flag to an IfaceTyCon, but that's a bit heavy.
-Instead we use context to distinguish, as in the source language.
-  - When checking a kind, we look up M.T{tc} and promote it
-  - When checking a type, we look up M.T{tc} and don't promote it
-                                 and M.T{d}  and promote it
-    See tcIfaceKindCon and tcIfaceKTyCon respectively
-
-This context business is why we need tcIfaceTcArgs, and tcIfaceApps
-
 
 %************************************************************************
 %*                                                                      *
@@ -1186,7 +1171,7 @@ tcIfaceApps fun arg
     go_up fun _ [] = return fun
     go_up fun fun_ty (IfaceType t : args)
        | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty
-       = do { t' <- if isKindVar tv  -- See Note [Checking IfaceTypes vs IfaceKinds]
+       = do { t' <- if isKindVar tv
                     then tcIfaceKind t
                     else tcIfaceType t
             ; let fun_ty' = substTyWith [tv] [t'] body_ty
@@ -1251,30 +1236,6 @@ tcIfaceDataAlt con inst_tys arg_strs rhs
 \end{code}
 
 
-\begin{code}
-tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram  -- Used for external core
-tcExtCoreBindings []     = return []
-tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
-
-do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
-do_one (IfaceNonRec bndr rhs) thing_inside
-  = do  { rhs' <- tcIfaceExpr rhs
-        ; bndr' <- newExtCoreBndr bndr
-        ; extendIfaceIdEnv [bndr'] $ do
-        { core_binds <- thing_inside
-        ; return (NonRec bndr' rhs' : core_binds) }}
-
-do_one (IfaceRec pairs) thing_inside
-  = do  { bndrs' <- mapM newExtCoreBndr bndrs
-        ; extendIfaceIdEnv bndrs' $ do
-        { rhss' <- mapM tcIfaceExpr rhss
-        ; core_binds <- thing_inside
-        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
-  where
-    (bndrs,rhss) = unzip pairs
-\end{code}
-
-
 %************************************************************************
 %*                                                                      *
                 IdInfo
@@ -1457,26 +1418,19 @@ tcIfaceGlobal name
 -- emasculated form (e.g. lacking data constructors).
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon (IfaceTc name)
-  = do { thing <- tcIfaceGlobal name
-       ; case thing of    -- A "type constructor" can be a promoted data constructor
-                          --           c.f. Trac #5881
-           ATyCon   tc               -> return tc
-           AConLike (RealDataCon dc) -> return (promoteDataCon dc)
-           _ -> pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing) }
-
-tcIfaceKindCon :: IfaceTyCon -> IfL TyCon
-tcIfaceKindCon (IfaceTc name)
-  = do { thing <- tcIfaceGlobal name
-       ; case thing of    -- A "type constructor" here is a promoted type constructor
-                          --           c.f. Trac #5881
-           ATyCon tc
-             | isSuperKind (tyConKind tc)
-             -> return tc   -- Mainly just '*' or 'AnyK'
-             | Just prom_tc <- promotableTyCon_maybe tc
-             -> return prom_tc
-
-           _ -> pprPanic "tcIfaceKindCon" (ppr name $$ ppr thing) }
+tcIfaceTyCon itc
+  = do {
+    ; thing <- tcIfaceGlobal (ifaceTyConName itc)
+    ; case itc of
+        IfaceTc _ -> return $ tyThingTyCon thing
+        IfacePromotedDataCon _ -> return $ promoteDataCon $ tyThingDataCon thing
+        IfacePromotedTyCon name ->
+          let ktycon tc
+                | isSuperKind (tyConKind tc) = return tc
+                | Just prom_tc <- promotableTyCon_maybe tc = return prom_tc
+                | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing)
+          in ktycon (tyThingTyCon thing)
+    }
 
 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
@@ -1519,14 +1473,6 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
-newExtCoreBndr :: IfaceLetBndr -> IfL Id
-newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
-  = do  { mod <- getIfModule
-        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
-        ; ty' <- tcIfaceType ty
-        ; return (mkLocalId name ty') }
-
------------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
   = do  { name <- newIfaceName (mkTyVarOccFS occ)
@@ -1547,22 +1493,8 @@ bindIfaceTyVars bndrs thing_inside
   where
     (occs,kinds) = unzip bndrs
 
-bindIfaceIdVar :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
-bindIfaceIdVar (occ, ty) thing_inside
-  = do  { name <- newIfaceName (mkVarOccFS occ)
-        ; ty' <- tcIfaceType ty
-        ; let id = mkLocalId name ty'
-        ; extendIfaceIdEnv [id] (thing_inside id) }
-
-bindIfaceIdVars :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
-bindIfaceIdVars []     thing_inside = thing_inside []
-bindIfaceIdVars (v:vs) thing_inside
-  = bindIfaceIdVar v     $ \ v' ->
-    bindIfaceIdVars vs   $ \ vs' ->
-    thing_inside (v':vs')
-
 isSuperIfaceKind :: IfaceKind -> Bool
-isSuperIfaceKind (IfaceTyConApp (IfaceTc n) []) = n == superKindTyConName
+isSuperIfaceKind (IfaceTyConApp tc ITC_Nil) = ifaceTyConName tc == superKindTyConName
 isSuperIfaceKind _ = False
 
 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar