Merge remote-tracking branch 'origin/master' into type-nats

81 files changed, 2503 insertions, 2439 deletions

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index a40d46f8a9..60f4cf16ae 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -26,6 +26,7 @@ module MkId (
 
         mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         wrapFamInstBody, unwrapFamInstScrut,
+        wrapTypeFamInstBody, unwrapTypeFamInstScrut,
         mkUnpackCase, mkProductBox,
 
         -- And some particular Ids; see below for why they are wired in
@@ -227,7 +228,7 @@ mkDataConIds wrap_name wkr_name data_con
   = DCIds Nothing nt_work_id                 
 
   | any isBanged all_strict_marks      -- Algebraic, needs wrapper
-    || not (null eq_spec)              -- NB: LoadIface.ifaceDeclSubBndrs
+    || not (null eq_spec)              -- NB: LoadIface.ifaceDeclImplicitBndrs
     || isFamInstTyCon tycon            --     depends on this test
   = DCIds (Just alg_wrap_id) wrk_id
 
@@ -709,12 +710,22 @@ wrapFamInstBody tycon args body
   | otherwise
   = body
 
+-- Same as `wrapFamInstBody`, but for type family instances, which are
+-- represented by a `CoAxiom`, and not a `TyCon`
+wrapTypeFamInstBody :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
+wrapTypeFamInstBody axiom args body
+  = mkCast body (mkSymCo (mkAxInstCo axiom args))
+
 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 unwrapFamInstScrut tycon args scrut
   | Just co_con <- tyConFamilyCoercion_maybe tycon
   = mkCast scrut (mkAxInstCo co_con args)
   | otherwise
   = scrut
+
+unwrapTypeFamInstScrut :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
+unwrapTypeFamInstScrut axiom args scrut
+  = mkCast scrut (mkAxInstCo axiom args)
 \end{code}
 
 
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 9f8f32d1b3..ff1f71dc5c 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -209,7 +209,7 @@ pprNameSpaceBrief TcClsName = ptext (sLit "tc")
 
 -- demoteNameSpace lowers the NameSpace if possible.  We can not know
 -- in advance, since a TvName can appear in an HsTyVar.
--- see Note [Demotion]
+-- See Note [Demotion] in RnEnv
 demoteNameSpace :: NameSpace -> Maybe NameSpace
 demoteNameSpace VarName = Nothing
 demoteNameSpace DataName = Nothing
@@ -217,24 +217,6 @@ demoteNameSpace TvName = Nothing
 demoteNameSpace TcClsName = Just DataName
 \end{code}
 
-Note [Demotion]
-~~~~~~~~~~~~~~~
-
-When the user writes:
-  data Nat = Zero | Succ Nat
-  foo :: f Zero -> Int
-
-'Zero' in the type signature of 'foo' is parsed as:
-  HsTyVar ("Zero", TcClsName)
-
-When the renamer hits this occurence of 'Zero' it's going to realise
-that it's not in scope. But because it is renaming a type, it knows
-that 'Zero' might be a promoted data constructor, so it will demote
-its namespace to DataName and do a second lookup.
-
-The final result (after the renamer) will be:
-  HsTyVar ("Zero", DataName)
-
 
 %************************************************************************
 %*									*
@@ -371,7 +353,7 @@ sequentially starting at 0.
 
 So we can make a Unique using
 	mkUnique ns key  :: Unique
-where 'ns' is a Char reprsenting the name space.  This in turn makes it
+where 'ns' is a Char representing the name space.  This in turn makes it
 easy to build an OccEnv.
 
 \begin{code}
diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs
index d7caf2a521..ea8e9d2622 100644
--- a/compiler/basicTypes/Var.lhs
+++ b/compiler/basicTypes/Var.lhs
@@ -85,7 +85,7 @@ import FastTypes
 import FastString
 import Outputable
 
-import StaticFlags ( opt_SuppressVarKinds )
+-- import StaticFlags ( opt_SuppressVarKinds )
 
 import Data.Data
 \end{code}
@@ -211,9 +211,11 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds
 
 \begin{code}
 instance Outputable Var where
-  ppr var = ifPprDebug (text "(") <+> ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var))
-            <+> if (not opt_SuppressVarKinds) then ifPprDebug (text "::" <+> ppr (tyVarKind var) <+> text ")")
-                else empty
+  ppr var = ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var))
+-- Printing the type on every occurrence is too much!
+--            <+> if (not opt_SuppressVarKinds)
+--                then ifPprDebug (text "::" <+> ppr (tyVarKind var) <+> text ")")
+--                else empty
 
 ppr_debug :: Var -> SDoc
 ppr_debug (TyVar {})                           = ptext (sLit "tv")
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index c82f517849..42aaabc305 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -105,7 +105,7 @@ ofZgraph g = Old.ListGraph $ mapMaybe convert_block $ postorderDfs g
                               , Just expr' <- maybeInvertCmmExpr expr -> Old.CmmCondBranch expr' fid : tail_of tid
                               | otherwise -> [Old.CmmCondBranch expr tid, Old.CmmBranch fid]
                             CmmSwitch arg ids -> [Old.CmmSwitch arg ids]
-                            CmmCall e _ _ _ _ -> [Old.CmmJump e []]
+                            CmmCall e _ _ _ _ -> [Old.CmmJump e]
                             CmmForeignCall {} -> panic "ofZgraph: CmmForeignCall"
                           tail_of bid = case foldBlockNodesB3 (first, middle, last) block () of
                                           Old.BasicBlock _ stmts -> stmts
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index ee53c1b6c7..a99e5a50a8 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -143,9 +143,9 @@ lintCmmStmt platform labels = lint
               then return ()
               else cmmLintErr (text "switch scrutinee is not a word: " <> pprPlatform platform e <>
                                text " :: " <> ppr erep)
-          lint (CmmJump e args) = lintCmmExpr platform e >> mapM_ (lintCmmExpr platform . hintlessCmm) args
-          lint (CmmReturn ress) = mapM_ (lintCmmExpr platform . hintlessCmm) ress
-          lint (CmmBranch id)    = checkTarget id
+          lint (CmmJump e) = lintCmmExpr platform e >> return ()
+          lint (CmmReturn) = return ()
+          lint (CmmBranch id) = checkTarget id
           checkTarget id = if setMember id labels then return ()
                            else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
 
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 007b7a715e..84f106980e 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -65,8 +65,8 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
                 stmt m (CmmBranch b) = b:m
                 stmt m (CmmCondBranch e b) = b:(expr m e)
                 stmt m (CmmSwitch e bs) = catMaybes bs ++ expr m e
-                stmt m (CmmJump e as) = expr (actuals m as) e
-                stmt m (CmmReturn as) = actuals m as
+                stmt m (CmmJump e) = expr m e
+                stmt m (CmmReturn) = m
                 actuals m as = foldl' (\m h -> expr m (hintlessCmm h)) m as
                 -- We have to do a deep fold into CmmExpr because
                 -- there may be a BlockId in the CmmBlock literal.
@@ -273,7 +273,7 @@ inlineStmt u a (CmmCall target regs es ret)
          es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
-inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
+inlineStmt u a (CmmJump e) = CmmJump (inlineExpr u a e)
 inlineStmt _ _ other_stmt = other_stmt
 
 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
@@ -669,7 +669,7 @@ cmmLoopifyForC (CmmProc (Just info@(Statics info_lbl _)) entry_lbl
   where blocks' = [ BasicBlock id (map do_stmt stmts)
                   | BasicBlock id stmts <- blocks ]
 
-        do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
+        do_stmt (CmmJump (CmmLit (CmmLabel lbl))) | lbl == jump_lbl
                 = CmmBranch top_id
         do_stmt stmt = stmt
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index e0d3da8a62..f20a05f40f 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -411,10 +411,10 @@ stmt	:: { ExtCode }
 		{ do as <- sequence $5; doSwitch $2 $3 as $6 }
 	| 'goto' NAME ';'
 		{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
-	| 'jump' expr maybe_actuals ';'
-		{ do e1 <- $2; e2 <- sequence $3; stmtEC (CmmJump e1 e2) }
-        | 'return' maybe_actuals ';'
-		{ do e <- sequence $2; stmtEC (CmmReturn e) }
+	| 'jump' expr ';'
+		{ do e <- $2; stmtEC (CmmJump e) }
+        | 'return' ';'
+		{ stmtEC CmmReturn }
 	| 'if' bool_expr 'goto' NAME
 		{ do l <- lookupLabel $4; cmmRawIf $2 l }
 	| 'if' bool_expr '{' body '}' else 	
@@ -945,8 +945,7 @@ emitRetUT args = do
                            -- or regs that we assign to, so better use
                            -- simultaneous assignments here (#3546)
   when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
-  stmtC (CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) [])
-  -- TODO (when using CPS): emitStmt (CmmReturn (map snd args))
+  stmtC $ CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord))
 
 -- -----------------------------------------------------------------------------
 -- If-then-else and boolean expressions
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index a8a9d5dde0..98e6db627f 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -6,42 +6,41 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module OldCmm (
         CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl,
         ListGraph(..),
-        CmmInfo(..), UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..),
+
+        CmmInfo(..), CmmInfoTable(..), ClosureTypeInfo(..), UpdateFrame(..),
+
         CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual,
+
         cmmMapGraph, cmmTopMapGraph,
+
         GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
+
         CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
         HintedCmmFormal, HintedCmmActual,
+
         CmmSafety(..), CmmCallTarget(..),
-        New.GenCmmDecl(..),
-        New.ForeignHint(..),
+        New.GenCmmDecl(..), New.ForeignHint(..),
+
         module CmmExpr,
-        Section(..),
-        ProfilingInfo(..), C_SRT(..)
-  ) where
+
+        Section(..), ProfilingInfo(..), C_SRT(..)
+    ) where
 
 #include "HsVersions.h"
 
 import qualified Cmm as New
-import Cmm           ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..),
-                       CmmFormal, CmmActual, Section(..), CmmStatic(..),
-                       ProfilingInfo(..), ClosureTypeInfo(..) )
+import Cmm ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..),
+             CmmFormal, CmmActual, Section(..), CmmStatic(..),
+             ProfilingInfo(..), ClosureTypeInfo(..) )
 
 import BlockId
-import CmmExpr
-import ForeignCall
 import ClosureInfo
+import CmmExpr
 import FastString
+import ForeignCall
 
 
 -- A [[BlockId]] is a local label.
@@ -55,17 +54,17 @@ import FastString
 
 data CmmInfo
   = CmmInfo
-      (Maybe BlockId)     -- GC target. Nothing <=> CPS won't do stack check
-                          -- JD: NOT USED BY NEW CODE GEN
-      (Maybe UpdateFrame) -- Update frame
-      CmmInfoTable        -- Info table
+        (Maybe BlockId)     -- GC target. Nothing <=> CPS won't do stack check
+                            -- JD: NOT USED BY NEW CODE GEN
+        (Maybe UpdateFrame) -- Update frame
+        CmmInfoTable        -- Info table
 
 -- | A frame that is to be pushed before entry to the function.
 -- Used to handle 'update' frames.
-data UpdateFrame =
-    UpdateFrame
-      CmmExpr    -- Frame header.  Behaves like the target of a 'jump'.
-      [CmmExpr]  -- Frame remainder.  Behaves like the arguments of a 'jump'.
+data UpdateFrame
+  = UpdateFrame
+        CmmExpr    -- Frame header.  Behaves like the target of a 'jump'.
+        [CmmExpr]  -- Frame remainder.  Behaves like the arguments of a 'jump'.
 
 -----------------------------------------------------------------------------
 --  Cmm, CmmDecl, CmmBasicBlock
@@ -75,14 +74,15 @@ data UpdateFrame =
 -- re-orderd during code generation.
 
 -- | A control-flow graph represented as a list of extended basic blocks.
+--
+-- Code, may be empty.  The first block is the entry point.  The
+-- order is otherwise initially unimportant, but at some point the
+-- code gen will fix the order.
+--
+-- BlockIds must be unique across an entire compilation unit, since
+-- they are translated to assembly-language labels, which scope
+-- across a whole compilation unit.
 newtype ListGraph i = ListGraph [GenBasicBlock i]
-   -- ^ Code, may be empty.  The first block is the entry point.  The
-   -- order is otherwise initially unimportant, but at some point the
-   -- code gen will fix the order.
-
-   -- BlockIds must be unique across an entire compilation unit, since
-   -- they are translated to assembly-language labels, which scope
-   -- across a whole compilation unit.
 
 -- | Cmm with the info table as a data type
 type CmmGroup = GenCmmGroup CmmStatics CmmInfo (ListGraph CmmStmt)
@@ -108,84 +108,90 @@ type CmmBasicBlock   = GenBasicBlock CmmStmt
 instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
     foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l
 
-blockId :: GenBasicBlock i -> BlockId
--- The branch block id is that of the first block in 
+-- | The branch block id is that of the first block in
 -- the branch, which is that branch's entry point
+blockId :: GenBasicBlock i -> BlockId
 blockId (BasicBlock blk_id _ ) = blk_id
 
 blockStmts :: GenBasicBlock i -> [i]
 blockStmts (BasicBlock _ stmts) = stmts
 
-
 mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
 mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
+
 ----------------------------------------------------------------
 --   graph maps
 ----------------------------------------------------------------
 
 cmmMapGraph    :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g'
-cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
-
 cmmMapGraph f tops = map (cmmTopMapGraph f) tops
+
+cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
 cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
 cmmTopMapGraph _ (CmmData s ds)  = CmmData s ds
 
-data CmmReturnInfo = CmmMayReturn
-                   | CmmNeverReturns
-    deriving ( Eq )
+data CmmReturnInfo
+  = CmmMayReturn
+  | CmmNeverReturns
+  deriving ( Eq )
 
 -----------------------------------------------------------------------------
---		CmmStmt
+--              CmmStmt
 -- A "statement".  Note that all branches are explicit: there are no
 -- control transfers to computed addresses, except when transfering
 -- control to a new function.
 -----------------------------------------------------------------------------
 
-data CmmStmt	-- Old-style
+data CmmStmt
   = CmmNop
   | CmmComment FastString
 
-  | CmmAssign CmmReg CmmExpr	 -- Assign to register
+  | CmmAssign CmmReg CmmExpr     -- Assign to register
 
   | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
                                  -- given by cmmExprType of the rhs.
 
-  | CmmCall	 		 -- A call (foreign, native or primitive), with 
-     CmmCallTarget
-     [HintedCmmFormal]		 -- zero or more results
-     [HintedCmmActual]		 -- zero or more arguments
-     CmmReturnInfo
-  -- Some care is necessary when handling the arguments of these, see
-  -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
+  | CmmCall                      -- A call (foreign, native or primitive), with
+       CmmCallTarget
+       [HintedCmmFormal]           -- zero or more results
+       [HintedCmmActual]           -- zero or more arguments
+       CmmReturnInfo
+       -- Some care is necessary when handling the arguments of these, see
+       -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
 
   | CmmBranch BlockId             -- branch to another BB in this fn
 
   | CmmCondBranch CmmExpr BlockId -- conditional branch
 
   | CmmSwitch CmmExpr [Maybe BlockId]   -- Table branch
-	-- The scrutinee is zero-based; 
-	--	zero -> first block
-	--	one  -> second block etc
-	-- Undefined outside range, and when there's a Nothing
+        -- The scrutinee is zero-based;
+        --      zero -> first block
+        --      one  -> second block etc
+        -- Undefined outside range, and when there's a Nothing
 
-  | CmmJump CmmExpr      -- Jump to another C-- function,
-      [HintedCmmActual]        -- with these parameters.  (parameters never used)
+  | CmmJump CmmExpr  -- Jump to another C-- function,
 
-  | CmmReturn            -- Return from a native C-- function,
-      [HintedCmmActual]        -- with these return values. (parameters never used)
+  | CmmReturn        -- Return from a native C-- function,
 
-data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: New.ForeignHint }
-	   	 deriving( Eq )
+data CmmHinted a
+  = CmmHinted {
+        hintlessCmm :: a,
+        cmmHint :: New.ForeignHint
+    }
+  deriving( Eq )
 
-type HintedCmmFormal  = CmmHinted CmmFormal
-type HintedCmmActual  = CmmHinted CmmActual
+type HintedCmmFormal = CmmHinted CmmFormal
+type HintedCmmActual = CmmHinted CmmActual
 
-data CmmSafety      = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
+data CmmSafety
+  = CmmUnsafe
+  | CmmSafe C_SRT
+  | CmmInterruptible
 
 -- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
 instance UserOfLocalRegs CmmStmt where
   foldRegsUsed f (set::b) s = stmt s set
-    where 
+    where
       stmt :: CmmStmt -> b -> b
       stmt (CmmNop)                  = id
       stmt (CmmComment {})           = id
@@ -195,8 +201,8 @@ instance UserOfLocalRegs CmmStmt where
       stmt (CmmBranch _)             = id
       stmt (CmmCondBranch e _)       = gen e
       stmt (CmmSwitch e _)           = gen e
-      stmt (CmmJump e es)            = gen e . gen es
-      stmt (CmmReturn es)            = gen es
+      stmt (CmmJump e)               = gen e
+      stmt (CmmReturn)               = id
 
       gen :: UserOfLocalRegs a => a -> b -> b
       gen a set = foldRegsUsed f set a
@@ -210,13 +216,13 @@ instance UserOfSlots CmmCallTarget where
     foldSlotsUsed _ set (CmmPrim {})    = set
 
 instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
-  foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
+    foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
 
 instance UserOfSlots a => UserOfSlots (CmmHinted a) where
-  foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
+    foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
 
 instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
-  foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
+    foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
 
 {-
 Discussion
@@ -232,7 +238,7 @@ conditional jump are explicit. ---NR]
 
 One possible way to fix this would be:
 
-data CmmStat = 
+data CmmStat =
   ...
   | CmmJump CmmBranchDest
   | CmmCondJump CmmExpr CmmBranchDest
@@ -259,18 +265,19 @@ So we'll stick with the way it is, and add the optimisation to the NCG.
 -}
 
 -----------------------------------------------------------------------------
---		CmmCallTarget
+--              CmmCallTarget
 --
 -- The target of a CmmCall.
 -----------------------------------------------------------------------------
 
 data CmmCallTarget
-  = CmmCallee		-- Call a function (foreign or native)
-	CmmExpr 		-- literal label <=> static call
-				-- other expression <=> dynamic call
-	CCallConv		-- The calling convention
-
-  | CmmPrim		-- Call a "primitive" (eg. sin, cos)
-	CallishMachOp		-- These might be implemented as inline
-				-- code by the backend.
+  = CmmCallee           -- Call a function (foreign or native)
+        CmmExpr                 -- literal label <=> static call
+                                -- other expression <=> dynamic call
+        CCallConv               -- The calling convention
+
+  | CmmPrim             -- Call a "primitive" (eg. sin, cos)
+        CallishMachOp           -- These might be implemented as inline
+                                -- code by the backend.
   deriving Eq
+
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index 07dfbf63bf..44692d45ac 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -153,8 +153,8 @@ pprStmt platform stmt = case stmt of
 
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch platform expr ident
-    CmmJump expr params      -> genJump platform expr params
-    CmmReturn params         -> genReturn platform params
+    CmmJump expr             -> genJump platform expr
+    CmmReturn                -> genReturn platform
     CmmSwitch arg ids        -> genSwitch platform arg ids
 
 -- Just look like a tuple, since it was a tuple before
@@ -203,8 +203,8 @@ genCondBranch platform expr ident =
 --
 --     jump foo(a, b, c);
 --
-genJump :: Platform -> CmmExpr -> [CmmHinted CmmExpr] -> SDoc
-genJump platform expr args =
+genJump :: Platform -> CmmExpr -> SDoc
+genJump platform expr =
     hcat [ ptext (sLit "jump")
          , space
          , if isTrivialCmmExpr expr
@@ -212,8 +212,6 @@ genJump platform expr args =
                 else case expr of
                     CmmLoad (CmmReg _) _ -> pprExpr platform expr
                     _ -> parens (pprExpr platform expr)
-         , space
-         , parens  ( commafy $ map (pprPlatform platform) args )
          , semi ]
 
 
@@ -222,12 +220,9 @@ genJump platform expr args =
 --
 --     return (a, b, c);
 --
-genReturn :: Platform -> [CmmHinted CmmExpr] -> SDoc
-genReturn platform args =
-    hcat [ ptext (sLit "return")
-         , space
-         , parens  ( commafy $ map (pprPlatform platform) args )
-         , semi ]
+genReturn :: Platform -> SDoc
+genReturn _ =
+    hcat [ ptext (sLit "return") , semi ]
 
 -- --------------------------------------------------------------------------
 -- Tabled jump to local label
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index d2a95b6599..330d09082b 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -172,7 +172,7 @@ pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext (sLit "static ")
 pprStmt :: Platform -> CmmStmt -> SDoc
 
 pprStmt platform stmt = case stmt of
-    CmmReturn _  -> panic "pprStmt: return statement should have been cps'd away"
+    CmmReturn    -> panic "pprStmt: return statement should have been cps'd away"
     CmmNop       -> empty
     CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
                           -- XXX if the string contains "*/", we need to fix it
@@ -248,7 +248,7 @@ pprStmt platform stmt = case stmt of
 
     CmmBranch ident          -> pprBranch ident
     CmmCondBranch expr ident -> pprCondBranch platform expr ident
-    CmmJump lbl _params      -> mkJMP_(pprExpr platform lbl) <> semi
+    CmmJump lbl              -> mkJMP_(pprExpr platform lbl) <> semi
     CmmSwitch arg ids        -> pprSwitch platform arg ids
 
 pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc
@@ -757,12 +757,14 @@ isStrangeTypeReg (CmmLocal _)   = False
 isStrangeTypeReg (CmmGlobal g)  = isStrangeTypeGlobal g
 
 isStrangeTypeGlobal :: GlobalReg -> Bool
+isStrangeTypeGlobal CCCS                = True
 isStrangeTypeGlobal CurrentTSO          = True
 isStrangeTypeGlobal CurrentNursery      = True
 isStrangeTypeGlobal BaseReg             = True
 isStrangeTypeGlobal r                   = isFixedPtrGlobalReg r
 
 strangeRegType :: CmmReg -> Maybe SDoc
+strangeRegType (CmmGlobal CCCS) = Just (ptext (sLit "struct CostCentreStack_ *"))
 strangeRegType (CmmGlobal CurrentTSO) = Just (ptext (sLit "struct StgTSO_ *"))
 strangeRegType (CmmGlobal CurrentNursery) = Just (ptext (sLit "struct bdescr_ *"))
 strangeRegType (CmmGlobal BaseReg) = Just (ptext (sLit "struct StgRegTable_ *"))
@@ -793,6 +795,7 @@ pprGlobalReg gr = case gr of
     SpLim          -> ptext (sLit "SpLim")
     Hp             -> ptext (sLit "Hp")
     HpLim          -> ptext (sLit "HpLim")
+    CCCS           -> ptext (sLit "CCCS")
     CurrentTSO     -> ptext (sLit "CurrentTSO")
     CurrentNursery -> ptext (sLit "CurrentNursery")
     HpAlloc        -> ptext (sLit "HpAlloc")
@@ -927,7 +930,7 @@ te_Stmt (CmmCall _ rs es _)     = mapM_ (te_temp.hintlessCmm) rs >>
                                   mapM_ (te_Expr.hintlessCmm) es
 te_Stmt (CmmCondBranch e _)     = te_Expr e
 te_Stmt (CmmSwitch e _)         = te_Expr e
-te_Stmt (CmmJump e _)           = te_Expr e
+te_Stmt (CmmJump e)             = te_Expr e
 te_Stmt _                       = return ()
 
 te_Expr :: CmmExpr -> TE ()
diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 65f8a52981..198e192f5c 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -5,37 +5,31 @@
 \section[CgBindery]{Utility functions related to doing @CgBindings@}
 
 \begin{code}
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
 module CgBindery (
-	CgBindings, CgIdInfo,
-	StableLoc, VolatileLoc,
+        CgBindings, CgIdInfo,
+        StableLoc, VolatileLoc,
 
-	cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
+        cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
 
-	stableIdInfo, heapIdInfo,
+        stableIdInfo, heapIdInfo,
         taggedStableIdInfo, taggedHeapIdInfo,
-	letNoEscapeIdInfo, idInfoToAmode,
+        letNoEscapeIdInfo, idInfoToAmode,
 
-	addBindC, addBindsC,
+        addBindC, addBindsC,
 
-	nukeVolatileBinds,
-	nukeDeadBindings,
-	getLiveStackSlots,
+        nukeVolatileBinds,
+        nukeDeadBindings,
+        getLiveStackSlots,
         getLiveStackBindings,
 
-	bindArgsToStack,  rebindToStack,
-	bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
-	bindNewToTemp,
-	getArgAmode, getArgAmodes, 
-	getCgIdInfo, 
-	getCAddrModeIfVolatile, getVolatileRegs,
-	maybeLetNoEscape, 
+        bindArgsToStack,  rebindToStack,
+        bindNewToNode, bindNewToUntagNode, bindNewToReg, bindArgsToRegs,
+        bindNewToTemp,
+        getArgAmode, getArgAmodes, 
+        getCgIdInfo, 
+        getCAddrModeIfVolatile, getVolatileRegs,
+        maybeLetNoEscape, 
     ) where
 
 import CgMonad
@@ -47,7 +41,7 @@ import ClosureInfo
 import Constants
 
 import OldCmm
-import PprCmm		( {- instance Outputable -} )
+import PprCmm           ( {- instance Outputable -} )
 import SMRep
 import Id
 import DataCon
@@ -64,40 +58,39 @@ import FastString
 
 \end{code}
 
-
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-datatypes]{Data types}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @(CgBinding a b)@ is a type of finite maps from a to b.
 
 The assumption used to be that @lookupCgBind@ must get exactly one
-match.  This is {\em completely wrong} in the case of compiling
-letrecs (where knot-tying is used).  An initial binding is fed in (and
+match. This is {\em completely wrong} in the case of compiling
+letrecs (where knot-tying is used). An initial binding is fed in (and
 never evaluated); eventually, a correct binding is put into the
-environment.  So there can be two bindings for a given name.
+environment. So there can be two bindings for a given name.
 
 \begin{code}
 type CgBindings = IdEnv CgIdInfo
 
 data CgIdInfo
-  = CgIdInfo	
-	{ cg_id :: Id	-- Id that this is the info for
-			-- Can differ from the Id at occurrence sites by 
-			-- virtue of being externalised, for splittable C
-	, cg_rep :: CgRep
-	, cg_vol :: VolatileLoc
-	, cg_stb :: StableLoc
-	, cg_lf  :: LambdaFormInfo 
+  = CgIdInfo    
+        { cg_id :: Id   -- Id that this is the info for
+                        -- Can differ from the Id at occurrence sites by 
+                        -- virtue of being externalised, for splittable C
+        , cg_rep :: CgRep
+        , cg_vol :: VolatileLoc
+        , cg_stb :: StableLoc
+        , cg_lf  :: LambdaFormInfo 
         , cg_tag :: {-# UNPACK #-} !Int  -- tag to be added in idInfoToAmode
          }
 
 mkCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> CgIdInfo
 mkCgIdInfo id vol stb lf
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag }
   where
     tag
       | Just con <- isDataConWorkId_maybe id,
@@ -114,16 +107,16 @@ mkCgIdInfo id vol stb lf
 
 voidIdInfo :: Id -> CgIdInfo
 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
-			 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
-			 , cg_rep = VoidArg, cg_tag = 0 }
-	-- Used just for VoidRep things
+                         , cg_stb = VoidLoc, cg_lf = mkLFArgument id
+                         , cg_rep = VoidArg, cg_tag = 0 }
+        -- Used just for VoidRep things
 
-data VolatileLoc	-- These locations die across a call
+data VolatileLoc        -- These locations die across a call
   = NoVolatileLoc
-  | RegLoc	CmmReg		   -- In one of the registers (global or local)
-  | VirHpLoc	VirtualHpOffset  -- Hp+offset (address of closure)
-  | VirNodeLoc	ByteOff            -- Cts of offset indirect from Node
-				   -- ie *(Node+offset).
+  | RegLoc      CmmReg             -- In one of the registers (global or local)
+  | VirHpLoc    VirtualHpOffset  -- Hp+offset (address of closure)
+  | VirNodeLoc  ByteOff            -- Cts of offset indirect from Node
+                                   -- ie *(Node+offset).
                                    -- NB. Byte offset, because we subtract R1's
                                    -- tag from the offset.
 
@@ -131,7 +124,7 @@ mkTaggedCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> DataCon
                  -> CgIdInfo
 mkTaggedCgIdInfo id vol stb lf con
   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
+               cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con }
 \end{code}
 
 @StableLoc@ encodes where an Id can be found, used by
@@ -141,20 +134,18 @@ the @CgBindings@ environment in @CgBindery@.
 data StableLoc
   = NoStableLoc
 
-  | VirStkLoc	VirtualSpOffset		-- The thing is held in this
-					-- stack slot
+  | VirStkLoc   VirtualSpOffset         -- The thing is held in this
+                                        -- stack slot
 
-  | VirStkLNE	VirtualSpOffset		-- A let-no-escape thing; the
-					-- value is this stack pointer
-					-- (as opposed to the contents of the slot)
+  | VirStkLNE   VirtualSpOffset         -- A let-no-escape thing; the
+                                        -- value is this stack pointer
+                                        -- (as opposed to the contents of the slot)
 
-  | StableLoc	CmmExpr
-  | VoidLoc	-- Used only for VoidRep variables.  They never need to
-		-- be saved, so it makes sense to treat treat them as
-		-- having a stable location
-\end{code}
+  | StableLoc   CmmExpr
+  | VoidLoc     -- Used only for VoidRep variables.  They never need to
+                -- be saved, so it makes sense to treat treat them as
+                -- having a stable location
 
-\begin{code}
 instance PlatformOutputable CgIdInfo where
   pprPlatform platform (CgIdInfo id _ vol stb _ _)
     -- TODO, pretty pring the tag info
@@ -175,9 +166,9 @@ instance PlatformOutputable StableLoc where
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-idInfo]{Manipulating IdInfo}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -191,7 +182,7 @@ letNoEscapeIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
 
 stackIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
-stackIdInfo id sp	lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
+stackIdInfo id sp       lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
 
 nodeIdInfo :: Id -> Int -> LambdaFormInfo -> CgIdInfo
 nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset)) NoStableLoc lf_info
@@ -216,7 +207,7 @@ untagNodeIdInfo id offset    lf_info tag
 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
 idInfoToAmode info
   = case cg_vol info of {
-      RegLoc reg 	-> returnFC (CmmReg reg) ;
+      RegLoc reg        -> returnFC (CmmReg reg) ;
       VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetB (CmmReg nodeReg) nd_off)
                                              mach_rep) ;
       VirHpLoc hp_off   -> do { off <- getHpRelOffset hp_off
@@ -226,14 +217,14 @@ idInfoToAmode info
     case cg_stb info of
       StableLoc amode  -> returnFC $! maybeTag amode
       VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
-			     ; return (CmmLoad sp_rel mach_rep) }
+                             ; return (CmmLoad sp_rel mach_rep) }
 
       VirStkLNE sp_off -> getSpRelOffset sp_off
 
       VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
-		-- We return a 'bottom' amode, rather than panicing now
-		-- In this way getArgAmode returns a pair of (VoidArg, bottom)
-		-- and that's exactly what we want
+                -- We return a 'bottom' amode, rather than panicing now
+                -- In this way getArgAmode returns a pair of (VoidArg, bottom)
+                -- and that's exactly what we want
 
       NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
     }
@@ -256,16 +247,16 @@ cgIdInfoArgRep = cg_rep
 
 maybeLetNoEscape :: CgIdInfo -> Maybe VirtualSpOffset
 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
-maybeLetNoEscape _       				  = Nothing
+maybeLetNoEscape _                                        = Nothing
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-.There are three basic routines, for adding (@addBindC@), modifying
+There are three basic routines, for adding (@addBindC@), modifying
 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
 
 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
@@ -274,72 +265,72 @@ The name should not already be bound. (nice ASSERT, eh?)
 \begin{code}
 addBindC :: Id -> CgIdInfo -> Code
 addBindC name stuff_to_bind = do
-	binds <- getBinds
-	setBinds $ extendVarEnv binds name stuff_to_bind
+        binds <- getBinds
+        setBinds $ extendVarEnv binds name stuff_to_bind
 
 addBindsC :: [(Id, CgIdInfo)] -> Code
 addBindsC new_bindings = do
-	binds <- getBinds
-	let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
-			      binds
-			      new_bindings
-	setBinds new_binds
+        binds <- getBinds
+        let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
+                              binds
+                              new_bindings
+        setBinds new_binds
 
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 modifyBindC name mangle_fn = do
-	binds <- getBinds
-	setBinds $ modifyVarEnv mangle_fn binds name
+        binds <- getBinds
+        setBinds $ modifyVarEnv mangle_fn binds name
 
 getCgIdInfo :: Id -> FCode CgIdInfo
 getCgIdInfo id
-  = do	{ 	-- Try local bindings first
-	; local_binds  <- getBinds
-	; case lookupVarEnv local_binds id of {
-	    Just info -> return info ;
-	    Nothing   -> do
-
-	{ 	-- Try top-level bindings
-	  static_binds <- getStaticBinds
-	; case lookupVarEnv static_binds id of {
-	    Just info -> return info ;
-	    Nothing   ->
-
-		-- Should be imported; make up a CgIdInfo for it
-	let 
-	    name = idName id
-	in
-	if isExternalName name then do
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
-	    return (stableIdInfo id ext_lbl (mkLFImported id))
-	else
-	if isVoidArg (idCgRep id) then
-		-- Void things are never in the environment
-	    return (voidIdInfo id)
-	else
-	-- Bug	
-	cgLookupPanic id
-	}}}}
+  = do  {       -- Try local bindings first
+        ; local_binds  <- getBinds
+        ; case lookupVarEnv local_binds id of {
+            Just info -> return info ;
+            Nothing   -> do
+
+        {       -- Try top-level bindings
+          static_binds <- getStaticBinds
+        ; case lookupVarEnv static_binds id of {
+            Just info -> return info ;
+            Nothing   ->
+
+                -- Should be imported; make up a CgIdInfo for it
+        let 
+            name = idName id
+        in
+        if isExternalName name then do
+            let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id))
+            return (stableIdInfo id ext_lbl (mkLFImported id))
+        else
+        if isVoidArg (idCgRep id) then
+                -- Void things are never in the environment
+            return (voidIdInfo id)
+        else
+        -- Bug  
+        cgLookupPanic id
+        }}}}
     
-			
+                        
 cgLookupPanic :: Id -> FCode a
 cgLookupPanic id
-  = do	static_binds <- getStaticBinds
-	local_binds <- getBinds
+  = do  static_binds <- getStaticBinds
+        local_binds <- getBinds
 --      srt <- getSRTLabel
         pprPanic "cgLookupPanic (probably invalid Core; try -dcore-lint)"
-		(vcat [ppr id,
-		ptext (sLit "static binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
-		ptext (sLit "local binds for:"),
+                (vcat [ppr id,
+                ptext (sLit "static binds for:"),
+                vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
+                ptext (sLit "local binds for:"),
                 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
 --              ptext (sLit "SRT label") <+> pprCLabel srt
-	      ])
+              ])
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 We sometimes want to nuke all the volatile bindings; we must be sure
@@ -357,71 +348,68 @@ nukeVolatileBinds binds
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[lookup-interface]{Interface functions to looking up bindings}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
 getCAddrModeIfVolatile id
-  = do	{ info <- getCgIdInfo id
-	; case cg_stb info of
-		NoStableLoc -> do -- Aha!  So it is volatile!
-			amode <- idInfoToAmode info
-			return $ Just amode
-		_ -> return Nothing }
+  = do  { info <- getCgIdInfo id
+        ; case cg_stb info of
+                NoStableLoc -> do -- Aha!  So it is volatile!
+                        amode <- idInfoToAmode info
+                        return $ Just amode
+                _ -> return Nothing }
 \end{code}
 
 @getVolatileRegs@ gets a set of live variables, and returns a list of
-all registers on which these variables depend.  These are the regs
-which must be saved and restored across any C calls.  If a variable is
+all registers on which these variables depend. These are the regs
+which must be saved and restored across any C calls. If a variable is
 both in a volatile location (depending on a register) {\em and} a
 stable one (notably, on the stack), we modify the current bindings to
 forget the volatile one.
 
 \begin{code}
 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
-
 getVolatileRegs vars = do
-  do 	{ stuff <- mapFCs snaffle_it (varSetElems vars)
-	; returnFC $ catMaybes stuff }
+  do    { stuff <- mapFCs snaffle_it (varSetElems vars)
+        ; returnFC $ catMaybes stuff }
   where
     snaffle_it var = do
-	{ info <- getCgIdInfo var 
-	; let
-		-- commoned-up code...
-	     consider_reg reg
-		=	-- We assume that all regs can die across C calls
-			-- We leave it to the save-macros to decide which
-			-- regs *really* need to be saved.
-		  case cg_stb info of
-			NoStableLoc     -> returnFC (Just reg) -- got one!
-			_ -> do
-				{ -- has both volatile & stable locations;
-				  -- force it to rely on the stable location
-				  modifyBindC var nuke_vol_bind 
-				; return Nothing }
-
-	; case cg_vol info of
-	    RegLoc (CmmGlobal reg) -> consider_reg reg
-	    VirNodeLoc _ 	   -> consider_reg node
-	    _         	 	   -> returnFC Nothing	-- Local registers
-	}
+        { info <- getCgIdInfo var 
+        ; let
+                -- commoned-up code...
+             consider_reg reg
+                =       -- We assume that all regs can die across C calls
+                        -- We leave it to the save-macros to decide which
+                        -- regs *really* need to be saved.
+                  case cg_stb info of
+                        NoStableLoc     -> returnFC (Just reg) -- got one!
+                        _ -> do
+                                { -- has both volatile & stable locations;
+                                  -- force it to rely on the stable location
+                                  modifyBindC var nuke_vol_bind 
+                                ; return Nothing }
+
+        ; case cg_vol info of
+            RegLoc (CmmGlobal reg) -> consider_reg reg
+            VirNodeLoc _           -> consider_reg node
+            _                      -> returnFC Nothing  -- Local registers
+        }
 
     nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
-\end{code}
 
-\begin{code}
 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
 getArgAmode (StgVarArg var) 
-  = do	{ info <- getCgIdInfo var
-	; amode <- idInfoToAmode info
-	; return (cgIdInfoArgRep info, amode ) }
+  = do  { info <- getCgIdInfo var
+        ; amode <- idInfoToAmode info
+        ; return (cgIdInfoArgRep info, amode ) }
 
 getArgAmode (StgLitArg lit) 
-  = do	{ cmm_lit <- cgLit lit
-	; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
+  = do  { cmm_lit <- cgLit lit
+        ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 
 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
 
@@ -429,15 +417,15 @@ getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 getArgAmodes [] = returnFC []
 getArgAmodes (atom:atoms)
   | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise 	      = do { amode  <- getArgAmode  atom 
-	 		   ; amodes <- getArgAmodes atoms
-	 		   ; return ( amode : amodes ) }
+  | otherwise         = do { amode  <- getArgAmode  atom 
+                           ; amodes <- getArgAmodes atoms
+                           ; return ( amode : amodes ) }
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -466,22 +454,20 @@ bindNewToUntagNode id offset lf_info tag
 -- temporary.
 bindNewToTemp :: Id -> FCode LocalReg
 bindNewToTemp id
-  = do	addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
-	return temp_reg
+  = do  addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
+        return temp_reg
   where
     uniq     = getUnique id
     temp_reg = LocalReg uniq (argMachRep (idCgRep id))
-    lf_info  = mkLFArgument id	-- Always used of things we
-				-- know nothing about
+    lf_info  = mkLFArgument id  -- Always used of things we
+                                -- know nothing about
 
 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
 bindNewToReg name reg lf_info
   = addBindC name info
   where
     info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
-\end{code}
 
-\begin{code}
 rebindToStack :: Id -> VirtualSpOffset -> Code
 rebindToStack name offset
   = modifyBindC name replace_stable_fn
@@ -490,19 +476,19 @@ rebindToStack name offset
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgMonad-deadslots]{Finding dead stack slots}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 nukeDeadBindings does the following:
 
-      -	Removes all bindings from the environment other than those
-	for variables in the argument to nukeDeadBindings.
-      -	Collects any stack slots so freed, and returns them to the  stack free
-	list.
-      -	Moves the virtual stack pointer to point to the topmost used
-	stack locations.
+      - Removes all bindings from the environment other than those
+        for variables in the argument to nukeDeadBindings.
+      - Collects any stack slots so freed, and returns them to the  stack free
+        list.
+      - Moves the virtual stack pointer to point to the topmost used
+        stack locations.
 
 You can have multi-word slots on the stack (where a Double# used to
 be, for instance); if dead, such a slot will be reported as *several*
@@ -512,60 +498,56 @@ Probably *naughty* to look inside monad...
 
 \begin{code}
 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
-		 -> Code
+                 -> Code
 nukeDeadBindings live_vars = do
-	binds <- getBinds
-	let (dead_stk_slots, bs') =
-		dead_slots live_vars 
-			[] []
-			[ (cg_id b, b) | b <- varEnvElts binds ]
-	setBinds $ mkVarEnv bs'
-	freeStackSlots dead_stk_slots
+        binds <- getBinds
+        let (dead_stk_slots, bs') =
+                dead_slots live_vars 
+                        [] []
+                        [ (cg_id b, b) | b <- varEnvElts binds ]
+        setBinds $ mkVarEnv bs'
+        freeStackSlots dead_stk_slots
 \end{code}
 
 Several boring auxiliary functions to do the dirty work.
 
 \begin{code}
 dead_slots :: StgLiveVars
-	   -> [(Id,CgIdInfo)]
-	   -> [VirtualSpOffset]
-	   -> [(Id,CgIdInfo)]
-	   -> ([VirtualSpOffset], [(Id,CgIdInfo)])
+           -> [(Id,CgIdInfo)]
+           -> [VirtualSpOffset]
+           -> [(Id,CgIdInfo)]
+           -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 
 -- dead_slots carries accumulating parameters for
---	filtered bindings, dead slots
+--      filtered bindings, dead slots
 dead_slots _ fbs ds []
   = (ds, reverse fbs) -- Finished; rm the dups, if any
 
 dead_slots live_vars fbs ds ((v,i):bs)
   | v `elementOfUniqSet` live_vars
     = dead_slots live_vars ((v,i):fbs) ds bs
-	  -- Live, so don't record it in dead slots
-	  -- Instead keep it in the filtered bindings
+          -- Live, so don't record it in dead slots
+          -- Instead keep it in the filtered bindings
 
   | otherwise
     = case cg_stb i of
-	VirStkLoc offset
-	 | size > 0
-	 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
+        VirStkLoc offset
+         | size > 0
+         -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 
-	_ -> dead_slots live_vars fbs ds bs
+        _ -> dead_slots live_vars fbs ds bs
   where
     size :: WordOff
     size = cgRepSizeW (cg_rep i)
-\end{code}
 
-\begin{code}
 getLiveStackSlots :: FCode [VirtualSpOffset]
 -- Return the offsets of slots in stack containig live pointers
 getLiveStackSlots 
-  = do 	{ binds <- getBinds
-	; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
-				   cg_rep = rep } <- varEnvElts binds, 
-		        isFollowableArg rep] }
-\end{code}
+  = do  { binds <- getBinds
+        ; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
+                                   cg_rep = rep } <- varEnvElts binds, 
+                        isFollowableArg rep] }
 
-\begin{code}
 getLiveStackBindings :: FCode [(VirtualSpOffset, CgIdInfo)]
 getLiveStackBindings
   = do { binds <- getBinds
@@ -575,3 +557,4 @@ getLiveStackBindings
                             cg_rep = rep} <- [bind],
                  isFollowableArg rep] }
 \end{code}
+
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 0a3911ea82..c65194b62f 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -4,34 +4,27 @@
 --
 -- CgCallConv
 --
--- The datatypes and functions here encapsulate the 
+-- The datatypes and functions here encapsulate the
 -- calling and return conventions used by the code generator.
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CgCallConv (
-	-- Argument descriptors
-	mkArgDescr, 
+        -- Argument descriptors
+        mkArgDescr,
 
-	-- Liveness
-	mkRegLiveness, 
+        -- Liveness
+        mkRegLiveness,
 
-	-- Register assignment
-	assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
+        -- Register assignment
+        assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
 
-	-- Calls
-	constructSlowCall, slowArgs, slowCallPattern,
+        -- Calls
+        constructSlowCall, slowArgs, slowCallPattern,
 
-	-- Returns
-	dataReturnConvPrim,
-	getSequelAmode
+        -- Returns
+        dataReturnConvPrim,
+        getSequelAmode
     ) where
 
 import CgMonad
@@ -57,11 +50,11 @@ import Data.Bits
 
 -------------------------------------------------------------------------
 --
---	Making argument descriptors
+--      Making argument descriptors
 --
 --  An argument descriptor describes the layout of args on the stack,
---  both for 	* GC (stack-layout) purposes, and 
---		* saving/restoring registers when a heap-check fails
+--  both for    * GC (stack-layout) purposes, and
+--              * saving/restoring registers when a heap-check fails
 --
 -- Void arguments aren't important, therefore (contrast constructSlowCall)
 --
@@ -72,29 +65,29 @@ import Data.Bits
 
 -------------------------
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr _nm args 
+mkArgDescr _nm args
   = case stdPattern arg_reps of
-	Just spec_id -> return (ArgSpec spec_id)
-	Nothing      -> return (ArgGen arg_bits)
+        Just spec_id -> return (ArgSpec spec_id)
+        Nothing      -> return (ArgGen arg_bits)
   where
     arg_bits = argBits arg_reps
     arg_reps = filter nonVoidArg (map idCgRep args)
-	-- Getting rid of voids eases matching of standard patterns
+        -- Getting rid of voids eases matching of standard patterns
 
-argBits :: [CgRep] -> [Bool]	-- True for non-ptr, False for ptr
-argBits [] 		= []
+argBits :: [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
+argBits []              = []
 argBits (PtrArg : args) = False : argBits args
 argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
 
 stdPattern :: [CgRep] -> Maybe StgHalfWord
-stdPattern []          = Just ARG_NONE	-- just void args, probably
+stdPattern []          = Just ARG_NONE  -- just void args, probably
 
 stdPattern [PtrArg]    = Just ARG_P
 stdPattern [FloatArg]  = Just ARG_F
 stdPattern [DoubleArg] = Just ARG_D
 stdPattern [LongArg]   = Just ARG_L
 stdPattern [NonPtrArg] = Just ARG_N
-	 
+
 stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
 stdPattern [NonPtrArg,PtrArg]    = Just ARG_NP
 stdPattern [PtrArg,NonPtrArg]    = Just ARG_PN
@@ -103,13 +96,13 @@ stdPattern [PtrArg,PtrArg]       = Just ARG_PP
 stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
 stdPattern [NonPtrArg,NonPtrArg,PtrArg]    = Just ARG_NNP
 stdPattern [NonPtrArg,PtrArg,NonPtrArg]    = Just ARG_NPN
-stdPattern [NonPtrArg,PtrArg,PtrArg]	   = Just ARG_NPP
+stdPattern [NonPtrArg,PtrArg,PtrArg]       = Just ARG_NPP
 stdPattern [PtrArg,NonPtrArg,NonPtrArg]    = Just ARG_PNN
-stdPattern [PtrArg,NonPtrArg,PtrArg]	   = Just ARG_PNP
-stdPattern [PtrArg,PtrArg,NonPtrArg]	   = Just ARG_PPN
-stdPattern [PtrArg,PtrArg,PtrArg]	   = Just ARG_PPP
-	 
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]	       = Just ARG_PPPP
+stdPattern [PtrArg,NonPtrArg,PtrArg]       = Just ARG_PNP
+stdPattern [PtrArg,PtrArg,NonPtrArg]       = Just ARG_PPN
+stdPattern [PtrArg,PtrArg,PtrArg]          = Just ARG_PPP
+
+stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]               = Just ARG_PPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
 stdPattern _ = Nothing
@@ -117,17 +110,17 @@ stdPattern _ = Nothing
 
 -------------------------------------------------------------------------
 --
---		Bitmap describing register liveness
---		across GC when doing a "generic" heap check
---		(a RET_DYN stack frame).
+--              Bitmap describing register liveness
+--              across GC when doing a "generic" heap check
+--              (a RET_DYN stack frame).
 --
--- NB. Must agree with these macros (currently in StgMacros.h): 
+-- NB. Must agree with these macros (currently in StgMacros.h):
 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
 -------------------------------------------------------------------------
 
 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
 mkRegLiveness regs ptrs nptrs
-  = (fromIntegral nptrs `shiftL` 16) .|. 
+  = (fromIntegral nptrs `shiftL` 16) .|.
     (fromIntegral ptrs  `shiftL` 24) .|.
     all_non_ptrs `xor` reg_bits regs
   where
@@ -135,31 +128,31 @@ mkRegLiveness regs ptrs nptrs
 
     reg_bits [] = 0
     reg_bits ((id, VanillaReg i _) : regs) | isFollowableArg (idCgRep id)
-  	= (1 `shiftL` (i - 1)) .|. reg_bits regs
+        = (1 `shiftL` (i - 1)) .|. reg_bits regs
     reg_bits (_ : regs)
-	= reg_bits regs
-  
+        = reg_bits regs
+
 -------------------------------------------------------------------------
 --
---		Pushing the arguments for a slow call
+--              Pushing the arguments for a slow call
 --
 -------------------------------------------------------------------------
 
 -- For a slow call, we must take a bunch of arguments and intersperse
 -- some stg_ap_<pattern>_ret_info return addresses.
 constructSlowCall
-	:: [(CgRep,CmmExpr)]
-	-> (CLabel,		-- RTS entry point for call
-	   [(CgRep,CmmExpr)],	-- args to pass to the entry point
-	   [(CgRep,CmmExpr)])	-- stuff to save on the stack
+        :: [(CgRep,CmmExpr)]
+        -> (CLabel,             -- RTS entry point for call
+           [(CgRep,CmmExpr)],   -- args to pass to the entry point
+           [(CgRep,CmmExpr)])   -- stuff to save on the stack
 
    -- don't forget the zero case
-constructSlowCall [] 
+constructSlowCall []
   = (mkRtsApFastLabel (fsLit "stg_ap_0"), [], [])
 
 constructSlowCall amodes
   = (stg_ap_pat, these, rest)
-  where 
+  where
     stg_ap_pat = mkRtsApFastLabel arg_pat
     (arg_pat, these, rest) = matchSlowPattern amodes
 
@@ -178,33 +171,33 @@ slowArgs amodes
     save_cccs  = [(NonPtrArg, mkLblExpr save_cccs_lbl), (NonPtrArg, curCCS)]
     save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
 
-matchSlowPattern :: [(CgRep,CmmExpr)] 
-		 -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
+matchSlowPattern :: [(CgRep,CmmExpr)]
+                 -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
 matchSlowPattern amodes = (arg_pat, these, rest)
   where (arg_pat, n)  = slowCallPattern (map fst amodes)
-	(these, rest) = splitAt n amodes
+        (these, rest) = splitAt n amodes
 
 -- These cases were found to cover about 99% of all slow calls:
 slowCallPattern :: [CgRep] -> (FastString, Int)
 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) 	    = (fsLit "stg_ap_ppppp", 5)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) 	= (fsLit "stg_ap_pppp", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) 	= (fsLit "stg_ap_pppv", 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: _)       	= (fsLit "stg_ap_ppp", 3)
-slowCallPattern (PtrArg: PtrArg: VoidArg: _)       	= (fsLit "stg_ap_ppv", 3)
-slowCallPattern (PtrArg: PtrArg: _)			= (fsLit "stg_ap_pp", 2)
-slowCallPattern (PtrArg: VoidArg: _)			= (fsLit "stg_ap_pv", 2)
-slowCallPattern (PtrArg: _)				= (fsLit "stg_ap_p", 1)
-slowCallPattern (VoidArg: _)				= (fsLit "stg_ap_v", 1)
-slowCallPattern (NonPtrArg: _)				= (fsLit "stg_ap_n", 1)
-slowCallPattern (FloatArg: _)				= (fsLit "stg_ap_f", 1)
-slowCallPattern (DoubleArg: _)				= (fsLit "stg_ap_d", 1)
-slowCallPattern (LongArg: _)				= (fsLit "stg_ap_l", 1)
-slowCallPattern _ 					= panic "CgStackery.slowCallPattern"
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _)         = (fsLit "stg_ap_ppppp", 5)
+slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _)     = (fsLit "stg_ap_pppp", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _)    = (fsLit "stg_ap_pppv", 4)
+slowCallPattern (PtrArg: PtrArg: PtrArg: _)             = (fsLit "stg_ap_ppp", 3)
+slowCallPattern (PtrArg: PtrArg: VoidArg: _)            = (fsLit "stg_ap_ppv", 3)
+slowCallPattern (PtrArg: PtrArg: _)                     = (fsLit "stg_ap_pp", 2)
+slowCallPattern (PtrArg: VoidArg: _)                    = (fsLit "stg_ap_pv", 2)
+slowCallPattern (PtrArg: _)                             = (fsLit "stg_ap_p", 1)
+slowCallPattern (VoidArg: _)                            = (fsLit "stg_ap_v", 1)
+slowCallPattern (NonPtrArg: _)                          = (fsLit "stg_ap_n", 1)
+slowCallPattern (FloatArg: _)                           = (fsLit "stg_ap_f", 1)
+slowCallPattern (DoubleArg: _)                          = (fsLit "stg_ap_d", 1)
+slowCallPattern (LongArg: _)                            = (fsLit "stg_ap_l", 1)
+slowCallPattern _                                       = panic "CgStackery.slowCallPattern"
 
 -------------------------------------------------------------------------
 --
---		Return conventions
+--              Return conventions
 --
 -------------------------------------------------------------------------
 
@@ -219,7 +212,7 @@ dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
 
 -- getSequelAmode returns an amode which refers to an info table.  The info
 -- table will always be of the RET_(BIG|SMALL) kind.  We're careful
--- not to handle real code pointers, just in case we're compiling for 
+-- not to handle real code pointers, just in case we're compiling for
 -- an unregisterised/untailcallish architecture, where info pointers and
 -- code pointers aren't the same.
 -- DIRE WARNING.
@@ -230,60 +223,60 @@ dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
 
 getSequelAmode :: FCode CmmExpr
 getSequelAmode
-  = do	{ EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
-	; case sequel of
-	    OnStack -> do { sp_rel <- getSpRelOffset virt_sp
-			  ; returnFC (CmmLoad sp_rel bWord) }
+  = do  { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
+        ; case sequel of
+            OnStack -> do { sp_rel <- getSpRelOffset virt_sp
+                          ; returnFC (CmmLoad sp_rel bWord) }
 
-	    CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
-	}
+            CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
+        }
 
 -------------------------------------------------------------------------
 --
---		Register assignment
+--              Register assignment
 --
 -------------------------------------------------------------------------
 
---  How to assign registers for 
+--  How to assign registers for
 --
---	1) Calling a fast entry point.
---	2) Returning an unboxed tuple.
---	3) Invoking an out-of-line PrimOp.
+--      1) Calling a fast entry point.
+--      2) Returning an unboxed tuple.
+--      3) Invoking an out-of-line PrimOp.
 --
 -- Registers are assigned in order.
--- 
+--
 -- If we run out, we don't attempt to assign any further registers (even
 -- though we might have run out of only one kind of register); we just
 -- return immediately with the left-overs specified.
--- 
+--
 -- The alternative version @assignAllRegs@ uses the complete set of
 -- registers, including those that aren't mapped to real machine
 -- registers.  This is used for calling special RTS functions and PrimOps
 -- which expect their arguments to always be in the same registers.
 
 assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
-	:: [(CgRep,a)]		-- Arg or result values to assign
-	-> ([(a, GlobalReg)],	-- Register assignment in same order
-				-- for *initial segment of* input list
-				--   (but reversed; doesn't matter)
-				-- VoidRep args do not appear here
-	    [(CgRep,a)])	-- Leftover arg or result values
+        :: [(CgRep,a)]          -- Arg or result values to assign
+        -> ([(a, GlobalReg)],   -- Register assignment in same order
+                                -- for *initial segment of* input list
+                                --   (but reversed; doesn't matter)
+                                -- VoidRep args do not appear here
+            [(CgRep,a)])        -- Leftover arg or result values
 
 assignCallRegs args
   = assign_regs args (mkRegTbl [node])
-	-- The entry convention for a function closure
-	-- never uses Node for argument passing; instead
-	-- Node points to the function closure itself
+        -- The entry convention for a function closure
+        -- never uses Node for argument passing; instead
+        -- Node points to the function closure itself
 
 assignPrimOpCallRegs args
  = assign_regs args (mkRegTbl_allRegs [])
-	-- For primops, *all* arguments must be passed in registers
+        -- For primops, *all* arguments must be passed in registers
 
 assignReturnRegs args
  -- when we have a single non-void component to return, use the normal
  -- unpointed return convention.  This make various things simpler: it
  -- means we can assume a consistent convention for IO, which is useful
- -- when writing code that relies on knowing the IO return convention in 
+ -- when writing code that relies on knowing the IO return convention in
  -- the RTS (primops, especially exception-related primops).
  -- Also, the bytecode compiler assumes this when compiling
  -- case expressions and ccalls, so it only needs to know one set of
@@ -292,24 +285,24 @@ assignReturnRegs args
     = ([(arg, r)], [])
  | otherwise
     = assign_regs args (mkRegTbl [])
-	-- For returning unboxed tuples etc, 
-	-- we use all regs
- where 
+        -- For returning unboxed tuples etc,
+        -- we use all regs
+ where
        non_void_args = filter ((/= VoidArg).fst) args
 
-assign_regs :: [(CgRep,a)]     	-- Arg or result values to assign
-	    -> AvailRegs	-- Regs still avail: Vanilla, Float, Double, Longs
-	    -> ([(a, GlobalReg)], [(CgRep, a)])
+assign_regs :: [(CgRep,a)]      -- Arg or result values to assign
+            -> AvailRegs        -- Regs still avail: Vanilla, Float, Double, Longs
+            -> ([(a, GlobalReg)], [(CgRep, a)])
 assign_regs args supply
   = go args [] supply
   where
-    go [] acc _ = (acc, [])	-- Return the results reversed (doesn't matter)
-    go ((VoidArg,_) : args) acc supply 	-- Skip void arguments; they aren't passed, and
-	= go args acc supply		-- there's nothing to bind them to
-    go ((rep,arg) : args) acc supply 
-	= case assign_reg rep supply of
-		Just (reg, supply') -> go args ((arg,reg):acc) supply'
-		Nothing	   	    -> (acc, (rep,arg):args) 	-- No more regs
+    go [] acc _ = (acc, [])     -- Return the results reversed (doesn't matter)
+    go ((VoidArg,_) : args) acc supply  -- Skip void arguments; they aren't passed, and
+        = go args acc supply            -- there's nothing to bind them to
+    go ((rep,arg) : args) acc supply
+        = case assign_reg rep supply of
+                Just (reg, supply') -> go args ((arg,reg):acc) supply'
+                Nothing             -> (acc, (rep,arg):args)    -- No more regs
 
 assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
 assign_reg FloatArg  (vs, f:fs, ds, ls) = Just (FloatReg f,   (vs, fs, ds, ls))
@@ -323,7 +316,7 @@ assign_reg _         _                  = Nothing
 
 -------------------------------------------------------------------------
 --
---		Register supplies
+--              Register supplies
 --
 -------------------------------------------------------------------------
 
@@ -335,37 +328,37 @@ assign_reg _         _                  = Nothing
 
 useVanillaRegs :: Int
 useVanillaRegs | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Vanilla_REG
+               | otherwise          = mAX_Real_Vanilla_REG
 useFloatRegs :: Int
 useFloatRegs   | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Float_REG
+               | otherwise          = mAX_Real_Float_REG
 useDoubleRegs :: Int
 useDoubleRegs  | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Double_REG
+               | otherwise          = mAX_Real_Double_REG
 useLongRegs :: Int
 useLongRegs    | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Long_REG
+               | otherwise          = mAX_Real_Long_REG
 
 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos	 = regList useVanillaRegs
-floatRegNos	 = regList useFloatRegs
-doubleRegNos	 = regList useDoubleRegs
+vanillaRegNos    = regList useVanillaRegs
+floatRegNos      = regList useFloatRegs
+doubleRegNos     = regList useDoubleRegs
 longRegNos       = regList useLongRegs
 
 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 allVanillaRegNos = regList mAX_Vanilla_REG
-allFloatRegNos	 = regList mAX_Float_REG
-allDoubleRegNos	 = regList mAX_Double_REG
-allLongRegNos	 = regList mAX_Long_REG
+allFloatRegNos   = regList mAX_Float_REG
+allDoubleRegNos  = regList mAX_Double_REG
+allLongRegNos    = regList mAX_Long_REG
 
 regList :: Int -> [Int]
 regList n = [1 .. n]
 
 type AvailRegs = ( [Int]   -- available vanilla regs.
-		 , [Int]   -- floats
-		 , [Int]   -- doubles
-		 , [Int]   -- longs (int64 and word64)
-		 )
+                 , [Int]   -- floats
+                 , [Int]   -- doubles
+                 , [Int]   -- longs (int64 and word64)
+                 )
 
 mkRegTbl :: [GlobalReg] -> AvailRegs
 mkRegTbl regs_in_use
@@ -381,23 +374,23 @@ mkRegTbl' regs_in_use vanillas floats doubles longs
   = (ok_vanilla, ok_float, ok_double, ok_long)
   where
     ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr)) vanillas
-		    -- ptrhood isn't looked at, hence we can use any old rep.
-    ok_float   = mapCatMaybes (select FloatReg)	  floats
+                    -- ptrhood isn't looked at, hence we can use any old rep.
+    ok_float   = mapCatMaybes (select FloatReg)   floats
     ok_double  = mapCatMaybes (select DoubleReg)  doubles
-    ok_long    = mapCatMaybes (select LongReg)    longs   
+    ok_long    = mapCatMaybes (select LongReg)    longs
 
     select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
-	-- one we've unboxed the Int, we make a GlobalReg
-	-- and see if it is already in use; if not, return its number.
+        -- one we've unboxed the Int, we make a GlobalReg
+        -- and see if it is already in use; if not, return its number.
 
     select mk_reg_fun cand
       = let
-	    reg = mk_reg_fun cand
-	in
-	if reg `not_elem` regs_in_use
-	then Just cand
-	else Nothing
+            reg = mk_reg_fun cand
+        in
+        if reg `not_elem` regs_in_use
+        then Just cand
+        else Nothing
       where
-	not_elem = isn'tIn "mkRegTbl"
+        not_elem = isn'tIn "mkRegTbl"
 
 
diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index a36621bdaf..dd607de1fc 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -4,20 +4,16 @@
 %
 
 \begin{code}
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
-module CgCase (	cgCase, saveVolatileVarsAndRegs, 
-		restoreCurrentCostCentre
-	) where
+module CgCase (
+        cgCase,
+        saveVolatileVarsAndRegs,
+        restoreCurrentCostCentre
+    ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} CgExpr  ( cgExpr )
+import {-# SOURCE #-} CgExpr ( cgExpr )
 
 import CgMonad
 import CgBindery
@@ -54,12 +50,12 @@ import Control.Monad (when)
 
 \begin{code}
 data GCFlag
-  = GCMayHappen	-- The scrutinee may involve GC, so everything must be
-		-- tidy before the code for the scrutinee.
+  = GCMayHappen -- The scrutinee may involve GC, so everything must be
+                -- tidy before the code for the scrutinee.
 
-  | NoGC	-- The scrutinee is a primitive value, or a call to a
-		-- primitive op which does no GC.  Hence the case can
-		-- be done inline, without tidying up first.
+  | NoGC        -- The scrutinee is a primitive value, or a call to a
+                -- primitive op which does no GC.  Hence the case can
+                -- be done inline, without tidying up first.
 \end{code}
 
 It is quite interesting to decide whether to put a heap-check
@@ -70,11 +66,11 @@ op which can trigger GC.
 A more interesting situation is this:
 
  \begin{verbatim}
-	!A!;
-	...A...
-	case x# of
-	  0#      -> !B!; ...B...
-	  default -> !C!; ...C...
+        !A!;
+        ...A...
+        case x# of
+          0#      -> !B!; ...B...
+          default -> !C!; ...C...
  \end{verbatim}
 
 where \tr{!x!} indicates a possible heap-check point. The heap checks
@@ -84,29 +80,29 @@ heapcheck will take their worst case into account.
 In favour of omitting \tr{!B!}, \tr{!C!}:
 
  - {\em May} save a heap overflow test,
-	if ...A... allocates anything.  The other advantage
-	of this is that we can use relative addressing
-	from a single Hp to get at all the closures so allocated.
+        if ...A... allocates anything.  The other advantage
+        of this is that we can use relative addressing
+        from a single Hp to get at all the closures so allocated.
 
  - No need to save volatile vars etc across the case
 
 Against:
 
   - May do more allocation than reqd.  This sometimes bites us
-	badly.  For example, nfib (ha!)  allocates about 30\% more space if the
-	worst-casing is done, because many many calls to nfib are leaf calls
-	which don't need to allocate anything.
+        badly.  For example, nfib (ha!)  allocates about 30\% more space if the
+        worst-casing is done, because many many calls to nfib are leaf calls
+        which don't need to allocate anything.
 
-	This never hurts us if there is only one alternative.
+        This never hurts us if there is only one alternative.
 
 \begin{code}
-cgCase	:: StgExpr
-	-> StgLiveVars
-	-> StgLiveVars
-	-> Id
-	-> AltType
-	-> [StgAlt]
-	-> Code
+cgCase  :: StgExpr
+        -> StgLiveVars
+        -> StgLiveVars
+        -> Id
+        -> AltType
+        -> [StgAlt]
+        -> Code
 \end{code}
 
 Special case #1: case of literal.
@@ -114,15 +110,15 @@ Special case #1: case of literal.
 \begin{code}
 cgCase (StgLit lit) _live_in_whole_case _live_in_alts bndr
        alt_type@(PrimAlt _) alts
-  = do	{ tmp_reg <- bindNewToTemp bndr
-	; cm_lit <- cgLit lit
-	; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
-	; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
+  = do  { tmp_reg <- bindNewToTemp bndr
+        ; cm_lit <- cgLit lit
+        ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
+        ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
 \end{code}
 
-Special case #2: scrutinising a primitive-typed variable.	No
+Special case #2: scrutinising a primitive-typed variable.       No
 evaluation required.  We don't save volatile variables, nor do we do a
-heap-check in the alternatives.	 Instead, the heap usage of the
+heap-check in the alternatives.  Instead, the heap usage of the
 alternatives is worst-cased and passed upstream.  This can result in
 allocating more heap than strictly necessary, but it will sometimes
 eliminate a heap check altogether.
@@ -159,15 +155,15 @@ cgCase (StgApp v []) _live_in_whole_case _live_in_alts bndr
             panic "cgCase: reps do not match, perhaps a dodgy unsafeCoerce?"
 
           -- Careful! we can't just bind the default binder to the same thing
-	  -- as the scrutinee, since it might be a stack location, and having
-	  -- two bindings pointing at the same stack locn doesn't work (it
-	  -- confuses nukeDeadBindings).  Hence, use a new temp.
-	; v_info <- getCgIdInfo v
-	; amode <- idInfoToAmode v_info
-	; tmp_reg <- bindNewToTemp bndr
-	; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
-
-	; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
+          -- as the scrutinee, since it might be a stack location, and having
+          -- two bindings pointing at the same stack locn doesn't work (it
+          -- confuses nukeDeadBindings).  Hence, use a new temp.
+        ; v_info <- getCgIdInfo v
+        ; amode <- idInfoToAmode v_info
+        ; tmp_reg <- bindNewToTemp bndr
+        ; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
+
+        ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
   where
     reps_compatible = idCgRep v == idCgRep bndr
 \end{code}
@@ -194,7 +190,7 @@ cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _)
 Special case #3: inline PrimOps and foreign calls.
 
 \begin{code}
-cgCase (StgOpApp (StgPrimOp primop) args _) 
+cgCase (StgOpApp (StgPrimOp primop) args _)
        _live_in_whole_case live_in_alts bndr alt_type alts
   | not (primOpOutOfLine primop)
   = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
@@ -209,23 +205,23 @@ Special case #4: inline foreign calls: an unsafe foreign call can be done
 right here, just like an inline primop.
 
 \begin{code}
-cgCase (StgOpApp (StgFCallOp fcall _) args _) 
+cgCase (StgOpApp (StgFCallOp fcall _) args _)
        _live_in_whole_case live_in_alts _bndr _alt_type alts
   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
-    do	--  *must* be an unboxed tuple alt.
-	-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
-	{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; let res_hints = map (typeForeignHint.idType) non_void_res_ids
-	; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
-	; cgExpr rhs }
+    do  --  *must* be an unboxed tuple alt.
+        -- exactly like the cgInlinePrimOp case for unboxed tuple alts..
+        { res_tmps <- mapFCs bindNewToTemp non_void_res_ids
+        ; let res_hints = map (typeForeignHint.idType) non_void_res_ids
+        ; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
+        ; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
    non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
 
    unsafe_foreign_call
-	 = case fcall of
-	 	CCall (CCallSpec _ _ s) -> not (playSafe s)
+         = case fcall of
+                CCall (CCallSpec _ _ s) -> not (playSafe s)
 \end{code}
 
 Special case: scrutinising a non-primitive variable.
@@ -234,28 +230,28 @@ we can reuse/trim the stack slot holding the variable (if it is in one).
 
 \begin{code}
 cgCase (StgApp fun args)
-	_live_in_whole_case live_in_alts bndr alt_type alts
-  = do	{ fun_info <- getCgIdInfo fun
-	; arg_amodes <- getArgAmodes args
-
-	-- Nuking dead bindings *before* calculating the saves is the
-	-- value-add here.  We might end up freeing up some slots currently
-	-- occupied by variables only required for the call.
-	-- NOTE: we need to look up the variables used in the call before
-	-- doing this, because some of them may not be in the environment
-	-- afterward.
-	; nukeDeadBindings live_in_alts	
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	; scrut_eob_info
-	    <- forkEval alts_eob_info 
-			(allocStackTop retAddrSizeW >> nopC)
-			(do { deAllocStackTop retAddrSizeW
-			    ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
-
-	; setEndOfBlockInfo scrut_eob_info
-			    (performTailCall fun_info arg_amodes save_assts) }
+        _live_in_whole_case live_in_alts bndr alt_type alts
+  = do  { fun_info <- getCgIdInfo fun
+        ; arg_amodes <- getArgAmodes args
+
+        -- Nuking dead bindings *before* calculating the saves is the
+        -- value-add here.  We might end up freeing up some slots currently
+        -- occupied by variables only required for the call.
+        -- NOTE: we need to look up the variables used in the call before
+        -- doing this, because some of them may not be in the environment
+        -- afterward.
+        ; nukeDeadBindings live_in_alts
+        ; (save_assts, alts_eob_info, maybe_cc_slot)
+            <- saveVolatileVarsAndRegs live_in_alts
+
+        ; scrut_eob_info
+            <- forkEval alts_eob_info
+                        (allocStackTop retAddrSizeW >> nopC)
+                        (do { deAllocStackTop retAddrSizeW
+                            ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
+
+        ; setEndOfBlockInfo scrut_eob_info
+                            (performTailCall fun_info arg_amodes save_assts) }
 \end{code}
 
 Note about return addresses: we *always* push a return address, even
@@ -273,25 +269,25 @@ Finally, here is the general case.
 
 \begin{code}
 cgCase expr live_in_whole_case live_in_alts bndr alt_type alts
-  = do	{	-- Figure out what volatile variables to save
-	  nukeDeadBindings live_in_whole_case
-    
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	     -- Save those variables right now!
-	; emitStmts save_assts
-
-	    -- generate code for the alts
-	; scrut_eob_info
-	       <- forkEval alts_eob_info
-		      	   (do 	{ nukeDeadBindings live_in_alts
-				; allocStackTop retAddrSizeW   -- space for retn address 
-				; nopC })
-			   (do	{ deAllocStackTop retAddrSizeW
-				; cgEvalAlts maybe_cc_slot bndr alt_type alts })
-
-	; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
+  = do  {       -- Figure out what volatile variables to save
+          nukeDeadBindings live_in_whole_case
+
+        ; (save_assts, alts_eob_info, maybe_cc_slot)
+                <- saveVolatileVarsAndRegs live_in_alts
+
+             -- Save those variables right now!
+        ; emitStmts save_assts
+
+            -- generate code for the alts
+        ; scrut_eob_info
+               <- forkEval alts_eob_info
+                           (do  { nukeDeadBindings live_in_alts
+                                ; allocStackTop retAddrSizeW   -- space for retn address
+                                ; nopC })
+                           (do  { deAllocStackTop retAddrSizeW
+                                ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
+
+        ; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
     }
 \end{code}
 
@@ -300,15 +296,15 @@ stack pointer here.  forkEval takes the virtual Sp and free list from
 the first argument, and turns that into the *real* Sp for the second
 argument.  It also uses this virtual Sp as the args-Sp in the EOB info
 returned, so that the scrutinee will trim the real Sp back to the
-right place before doing whatever it does.  
-  --SDM (who just spent an hour figuring this out, and didn't want to 
-	 forget it).
+right place before doing whatever it does.
+  --SDM (who just spent an hour figuring this out, and didn't want to
+         forget it).
 
 Why don't we push the return address just before evaluating the
 scrutinee?  Because the slot reserved for the return address might
 contain something useful, so we wait until performing a tail call or
 return before pushing the return address (see
-CgTailCall.pushReturnAddress).  
+CgTailCall.pushReturnAddress).
 
 This also means that the environment doesn't need to know about the
 free stack slot for the return address (for generating bitmaps),
@@ -322,9 +318,9 @@ follow the layout of closures when we're profiling.  The CCS could be
 anywhere within the record).
 
 %************************************************************************
-%*									*
-		Inline primops
-%*									*
+%*                                                                      *
+                Inline primops
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -334,78 +330,78 @@ cgInlinePrimOp :: PrimOp -> [StgArg] -> Id -> AltType -> StgLiveVars
 cgInlinePrimOp primop args bndr (PrimAlt _) live_in_alts alts
   | isVoidArg (idCgRep bndr)
   = ASSERT( con == DEFAULT && isSingleton alts && null bs )
-    do	{ 	-- VOID RESULT; just sequencing, 
-		-- so get in there and do it
-		-- The bndr should not occur, so no need to bind it
-	  cgPrimOp [] primop args live_in_alts
-	; cgExpr rhs }
+    do  {       -- VOID RESULT; just sequencing,
+                -- so get in there and do it
+                -- The bndr should not occur, so no need to bind it
+          cgPrimOp [] primop args live_in_alts
+        ; cgExpr rhs }
   where
     (con,bs,_,rhs) = head alts
 
 cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
-  = do	{ 	-- PRIMITIVE ALTS, with non-void result
-	  tmp_reg <- bindNewToTemp bndr
-	; cgPrimOp [tmp_reg] primop args live_in_alts
-	; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
+  = do  {       -- PRIMITIVE ALTS, with non-void result
+          tmp_reg <- bindNewToTemp bndr
+        ; cgPrimOp [tmp_reg] primop args live_in_alts
+        ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
 
 cgInlinePrimOp primop args _ (UbxTupAlt _) live_in_alts alts
   = ASSERT( isSingleton alts )
-    do	{  	-- UNBOXED TUPLE ALTS
-	 	-- No heap check, no yield, just get in there and do it.
-		-- NB: the case binder isn't bound to anything; 
-		--     it has a unboxed tuple type
-	  
-	  res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; cgPrimOp res_tmps primop args live_in_alts
-	; cgExpr rhs }
+    do  {       -- UNBOXED TUPLE ALTS
+                -- No heap check, no yield, just get in there and do it.
+                -- NB: the case binder isn't bound to anything;
+                --     it has a unboxed tuple type
+
+          res_tmps <- mapFCs bindNewToTemp non_void_res_ids
+        ; cgPrimOp res_tmps primop args live_in_alts
+        ; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
    non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
 
 cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
-  = do 	{ 	-- ENUMERATION TYPE RETURN
-		-- Typical: case a ># b of { True -> ..; False -> .. }
-		-- The primop itself returns an index into the table of
-		-- closures for the enumeration type.
-	   tag_amode <- ASSERT( isEnumerationTyCon tycon )
-			do_enum_primop primop
-
-	 	-- Bind the default binder if necessary
-		-- (avoiding it avoids the assignment)
-		-- The deadness info is set by StgVarInfo
-	; whenC (not (isDeadBinder bndr))
-		(do { tmp_reg <- bindNewToTemp bndr
-		    ; stmtC (CmmAssign
+  = do  {       -- ENUMERATION TYPE RETURN
+                -- Typical: case a ># b of { True -> ..; False -> .. }
+                -- The primop itself returns an index into the table of
+                -- closures for the enumeration type.
+           tag_amode <- ASSERT( isEnumerationTyCon tycon )
+                        do_enum_primop primop
+
+                -- Bind the default binder if necessary
+                -- (avoiding it avoids the assignment)
+                -- The deadness info is set by StgVarInfo
+        ; whenC (not (isDeadBinder bndr))
+                (do { tmp_reg <- bindNewToTemp bndr
+                    ; stmtC (CmmAssign
                              (CmmLocal tmp_reg)
                              (tagToClosure tycon tag_amode)) })
 
-		-- Compile the alts
-	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
-				   	    (AlgAlt tycon) alts
+                -- Compile the alts
+        ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
+                                            (AlgAlt tycon) alts
 
-		-- Do the switch
-	; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
-	}
+                -- Do the switch
+        ; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
+        }
   where
 
-    do_enum_primop :: PrimOp -> FCode CmmExpr	-- Returns amode for result
-    do_enum_primop TagToEnumOp	-- No code!
+    do_enum_primop :: PrimOp -> FCode CmmExpr   -- Returns amode for result
+    do_enum_primop TagToEnumOp  -- No code!
        | [arg] <- args = do
          (_,e) <- getArgAmode arg
-	 return e
+         return e
     do_enum_primop primop
       = do tmp <- newTemp bWord
-	   cgPrimOp [tmp] primop args live_in_alts
-    	   returnFC (CmmReg (CmmLocal tmp))
+           cgPrimOp [tmp] primop args live_in_alts
+           returnFC (CmmReg (CmmLocal tmp))
 
 cgInlinePrimOp _ _ bndr _ _ _
   = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-alts]{Alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @cgEvalAlts@ returns an addressing mode for a continuation for the
@@ -413,77 +409,77 @@ alternatives of a @case@, used in a context when there
 is some evaluation to be done.
 
 \begin{code}
-cgEvalAlts :: Maybe VirtualSpOffset	-- Offset of cost-centre to be restored, if any
-	   -> Id
-	   -> AltType
-	   -> [StgAlt]
-	   -> FCode Sequel	-- Any addr modes inside are guaranteed
-				-- to be a label so that we can duplicate it 
-				-- without risk of duplicating code
+cgEvalAlts :: Maybe VirtualSpOffset     -- Offset of cost-centre to be restored, if any
+           -> Id
+           -> AltType
+           -> [StgAlt]
+           -> FCode Sequel      -- Any addr modes inside are guaranteed
+                                -- to be a label so that we can duplicate it
+                                -- without risk of duplicating code
 
 cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts
-  = do	{ let   rep = tyConCgRep tycon
-		reg = dataReturnConvPrim rep	-- Bottom for voidRep
+  = do  { let   rep = tyConCgRep tycon
+                reg = dataReturnConvPrim rep    -- Bottom for voidRep
 
-	; abs_c <- forkProc $ do
-		{ 	-- Bind the case binder, except if it's void
-			-- (reg is bottom in that case)
-		  whenC (nonVoidArg rep) $
-		  bindNewToReg bndr reg (mkLFArgument bndr)
-		; restoreCurrentCostCentre cc_slot True
-		; cgPrimAlts GCMayHappen alt_type reg alts }
+        ; abs_c <- forkProc $ do
+                {       -- Bind the case binder, except if it's void
+                        -- (reg is bottom in that case)
+                  whenC (nonVoidArg rep) $
+                  bindNewToReg bndr reg (mkLFArgument bndr)
+                ; restoreCurrentCostCentre cc_slot True
+                ; cgPrimAlts GCMayHappen alt_type reg alts }
 
-	; lbl <- emitReturnTarget (idName bndr) abs_c
-	; returnFC (CaseAlts lbl Nothing bndr) }
+        ; lbl <- emitReturnTarget (idName bndr) abs_c
+        ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
-  =	-- Unboxed tuple case
-	-- By now, the simplifier should have have turned it
-	-- into 	case e of (# a,b #) -> e
-	-- There shouldn't be a 
-	--		case e of DEFAULT -> e
+  =     -- Unboxed tuple case
+        -- By now, the simplifier should have have turned it
+        -- into         case e of (# a,b #) -> e
+        -- There shouldn't be a
+        --              case e of DEFAULT -> e
     ASSERT2( case con of { DataAlt _ -> True; _ -> False },
-	     text "cgEvalAlts: dodgy case of unboxed tuple type" )
-    do	{ 	-- forkAbsC for the RHS, so that the envt is
-		-- not changed for the emitReturn call
-	  abs_c <- forkProc $ do 
-		{ (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
-			-- Restore the CC *after* binding the tuple components, 
-			-- so that we get the stack offset of the saved CC right.
-		; restoreCurrentCostCentre cc_slot True
-			-- Generate a heap check if necessary
-			-- and finally the code for the alternative
-		; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
-				     (cgExpr rhs) }
-	; lbl <- emitReturnTarget (idName bndr) abs_c
-	; returnFC (CaseAlts lbl Nothing bndr) }
+             text "cgEvalAlts: dodgy case of unboxed tuple type" )
+    do  {       -- forkAbsC for the RHS, so that the envt is
+                -- not changed for the emitReturn call
+          abs_c <- forkProc $ do
+                { (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
+                        -- Restore the CC *after* binding the tuple components,
+                        -- so that we get the stack offset of the saved CC right.
+                ; restoreCurrentCostCentre cc_slot True
+                        -- Generate a heap check if necessary
+                        -- and finally the code for the alternative
+                ; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
+                                     (cgExpr rhs) }
+        ; lbl <- emitReturnTarget (idName bndr) abs_c
+        ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr alt_type alts
-  = 	-- Algebraic and polymorphic case
-    do	{	-- Bind the default binder
-	  bindNewToReg bndr nodeReg (mkLFArgument bndr)
+  =     -- Algebraic and polymorphic case
+    do  {       -- Bind the default binder
+          bindNewToReg bndr nodeReg (mkLFArgument bndr)
 
-	-- Generate sequel info for use downstream
-	-- At the moment, we only do it if the type is vector-returnable.
-	-- Reason: if not, then it costs extra to label the
-	-- alternatives, because we'd get return code like:
-	--
-	--	switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
-	--
-	-- which is worse than having the alt code in the switch statement
+        -- Generate sequel info for use downstream
+        -- At the moment, we only do it if the type is vector-returnable.
+        -- Reason: if not, then it costs extra to label the
+        -- alternatives, because we'd get return code like:
+        --
+        --      switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
+        --
+        -- which is worse than having the alt code in the switch statement
 
-	; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
+        ; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
 
-	; (lbl, branches) <- emitAlgReturnTarget (idName bndr) 
-				alts mb_deflt fam_sz
+        ; (lbl, branches) <- emitAlgReturnTarget (idName bndr)
+                                alts mb_deflt fam_sz
 
-	; returnFC (CaseAlts lbl branches bndr) }
+        ; returnFC (CaseAlts lbl branches bndr) }
   where
     fam_sz = case alt_type of
-    		AlgAlt tc -> tyConFamilySize tc
-    		PolyAlt   -> 0
-    		PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
-    		UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
+                AlgAlt tc -> tyConFamilySize tc
+                PolyAlt   -> 0
+                PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
+                UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
 \end{code}
 
 
@@ -494,9 +490,9 @@ must be  propagated  to cgAlgAltRhs (where the  GRAN_YIELD  macro might  be
 emitted). Hence, the new Bool arg to cgAlgAltRhs.
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-alg-alts]{Algebraic alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 In @cgAlgAlts@, none of the binders in the alternatives are
@@ -510,36 +506,36 @@ are inlined alternatives.
 \begin{code}
 cgAlgAlts :: GCFlag
        -> Maybe VirtualSpOffset
-       -> AltType				--  ** AlgAlt or PolyAlt only **
-       -> [StgAlt]				-- The alternatives
+       -> AltType                               --  ** AlgAlt or PolyAlt only **
+       -> [StgAlt]                              -- The alternatives
        -> FCode ( [(ConTagZ, CgStmts)], -- The branches
-		  Maybe CgStmts )	-- The default case
+                  Maybe CgStmts )       -- The default case
 
 cgAlgAlts gc_flag cc_slot alt_type alts
   = do alts <- forkAlts [ cgAlgAlt gc_flag cc_slot alt_type alt | alt <- alts]
        let
-	    mb_deflt = case alts of -- DEFAULT is always first, if present
-			 ((DEFAULT,blks) : _) -> Just blks
-			 _    		      -> Nothing
+            mb_deflt = case alts of -- DEFAULT is always first, if present
+                         ((DEFAULT,blks) : _) -> Just blks
+                         _                    -> Nothing
 
-	    branches = [(dataConTagZ con, blks) 
-	   	       | (DataAlt con, blks) <- alts]
+            branches = [(dataConTagZ con, blks)
+                       | (DataAlt con, blks) <- alts]
        -- in
        return (branches, mb_deflt)
 
 
 cgAlgAlt :: GCFlag
-      	 -> Maybe VirtualSpOffset	-- Turgid state
-      	 -> AltType			--  ** AlgAlt or PolyAlt only **
-      	 -> StgAlt
-      	 -> FCode (AltCon, CgStmts)
+         -> Maybe VirtualSpOffset       -- Turgid state
+         -> AltType                     --  ** AlgAlt or PolyAlt only **
+         -> StgAlt
+         -> FCode (AltCon, CgStmts)
 
 cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)
-  = do	{ abs_c <- getCgStmts $ do
-		{ bind_con_args con args
-		; restoreCurrentCostCentre cc_slot True
-		; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
-	; return (con, abs_c) }
+  = do  { abs_c <- getCgStmts $ do
+                { bind_con_args con args
+                ; restoreCurrentCostCentre cc_slot True
+                ; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
+        ; return (con, abs_c) }
   where
     bind_con_args DEFAULT      _    = nopC
     bind_con_args (DataAlt dc) args = bindConArgs dc args
@@ -548,9 +544,9 @@ cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-prim-alts]{Primitive alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 @cgPrimAlts@ generates suitable a @CSwitch@
@@ -562,10 +558,10 @@ As usual, no binders in the alternatives are yet bound.
 
 \begin{code}
 cgPrimAlts :: GCFlag
-	   -> AltType	-- Always PrimAlt, but passed to maybeAltHeapCheck
-	   -> CmmReg	-- Scrutinee
-	   -> [StgAlt]	-- Alternatives
-	   -> Code
+           -> AltType   -- Always PrimAlt, but passed to maybeAltHeapCheck
+           -> CmmReg    -- Scrutinee
+           -> [StgAlt]  -- Alternatives
+           -> Code
 -- NB: cgPrimAlts emits code that does the case analysis.
 -- It's often used in inline situations, rather than to genearte
 -- a labelled return point.  That's why its interface is a little
@@ -573,73 +569,73 @@ cgPrimAlts :: GCFlag
 --
 -- INVARIANT: the default binder is already bound
 cgPrimAlts gc_flag alt_type scrutinee alts
-  = do	{ tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
-	; let ((DEFAULT, deflt_absC) : others) = tagged_absCs	-- There is always a default
-	      alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
- 	; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
+  = do  { tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
+        ; let ((DEFAULT, deflt_absC) : others) = tagged_absCs   -- There is always a default
+              alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
+        ; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
 
 cgPrimAlt :: GCFlag
-	  -> AltType
-	  -> StgAlt				-- The alternative
-	  -> FCode (AltCon, CgStmts)	-- Its compiled form
+          -> AltType
+          -> StgAlt                             -- The alternative
+          -> FCode (AltCon, CgStmts)    -- Its compiled form
 
 cgPrimAlt gc_flag alt_type (con, [], [], rhs)
   = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; _ -> False } )
-    do	{ abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)) 
-	; returnFC (con, abs_c) }
+    do  { abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs))
+        ; returnFC (con, abs_c) }
 cgPrimAlt _ _ _ = panic "cgPrimAlt: non-empty lists"
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[CgCase-tidy]{Code for tidying up prior to an eval}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-maybeAltHeapCheck 
-	:: GCFlag 
-	-> AltType	-- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
-	-> Code		-- Continuation
-	-> Code
-maybeAltHeapCheck NoGC	      _        code = code
+maybeAltHeapCheck
+        :: GCFlag
+        -> AltType      -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
+        -> Code         -- Continuation
+        -> Code
+maybeAltHeapCheck NoGC        _        code = code
 maybeAltHeapCheck GCMayHappen alt_type code = altHeapCheck alt_type code
 
 saveVolatileVarsAndRegs
     :: StgLiveVars                    -- Vars which should be made safe
-    -> FCode (CmmStmts,  	      -- Assignments to do the saves
-	      EndOfBlockInfo,	      -- sequel for the alts
+    -> FCode (CmmStmts,               -- Assignments to do the saves
+              EndOfBlockInfo,         -- sequel for the alts
               Maybe VirtualSpOffset)  -- Slot for current cost centre
 
 saveVolatileVarsAndRegs vars
-  = do	{ var_saves <- saveVolatileVars vars
-	; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
-	; eob_info <- getEndOfBlockInfo
-	; returnFC (var_saves `plusStmts` cc_save,
-		    eob_info,
-		    maybe_cc_slot) }
+  = do  { var_saves <- saveVolatileVars vars
+        ; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
+        ; eob_info <- getEndOfBlockInfo
+        ; returnFC (var_saves `plusStmts` cc_save,
+                    eob_info,
+                    maybe_cc_slot) }
 
 
-saveVolatileVars :: StgLiveVars		-- Vars which should be made safe
-		 -> FCode CmmStmts	-- Assignments to to the saves
+saveVolatileVars :: StgLiveVars         -- Vars which should be made safe
+                 -> FCode CmmStmts      -- Assignments to to the saves
 
 saveVolatileVars vars
-  = do	{ stmts_s <- mapFCs save_it (varSetElems vars)
-	; return (foldr plusStmts noStmts stmts_s) }
+  = do  { stmts_s <- mapFCs save_it (varSetElems vars)
+        ; return (foldr plusStmts noStmts stmts_s) }
   where
     save_it var
       = do { v <- getCAddrModeIfVolatile var
-	   ; case v of
-		Nothing	        -> return noStmts 	   -- Non-volatile
-		Just vol_amode  -> save_var var vol_amode  -- Aha! It's volatile
-	}
+           ; case v of
+                Nothing         -> return noStmts          -- Non-volatile
+                Just vol_amode  -> save_var var vol_amode  -- Aha! It's volatile
+        }
 
     save_var var vol_amode
       = do { slot <- allocPrimStack (idCgRep var)
-	   ; rebindToStack var slot
-	   ; sp_rel <- getSpRelOffset slot
-	   ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
+           ; rebindToStack var slot
+           ; sp_rel <- getSpRelOffset slot
+           ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
 \end{code}
 
 ---------------------------------------------------------------------------
@@ -651,25 +647,25 @@ virtual offset of the location, to pass on to the alternatives, and
 
 \begin{code}
 saveCurrentCostCentre ::
-	FCode (Maybe VirtualSpOffset,	-- Where we decide to store it
-	       CmmStmts)		-- Assignment to save it
+        FCode (Maybe VirtualSpOffset,   -- Where we decide to store it
+               CmmStmts)                -- Assignment to save it
 
 saveCurrentCostCentre
-  | not opt_SccProfilingOn 
+  | not opt_SccProfilingOn
   = returnFC (Nothing, noStmts)
   | otherwise
-  = do	{ slot <- allocPrimStack PtrArg
-	; sp_rel <- getSpRelOffset slot
-	; returnFC (Just slot,
-		    oneStmt (CmmStore sp_rel curCCS)) }
+  = do  { slot <- allocPrimStack PtrArg
+        ; sp_rel <- getSpRelOffset slot
+        ; returnFC (Just slot,
+                    oneStmt (CmmStore sp_rel curCCS)) }
 
 -- Sometimes we don't free the slot containing the cost centre after restoring it
 -- (see CgLetNoEscape.cgLetNoEscapeBody).
 restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Bool -> Code
 restoreCurrentCostCentre Nothing     _freeit = nopC
 restoreCurrentCostCentre (Just slot) freeit
- = do 	{ sp_rel <- getSpRelOffset slot
-	; whenC freeit (freeStackSlots [slot])
+ = do   { sp_rel <- getSpRelOffset slot
+        ; whenC freeit (freeStackSlots [slot])
         ; stmtC (storeCurCCS (CmmLoad sp_rel bWord)) }
 \end{code}
 
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 7bad8516d9..8e599c3fb5 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -374,7 +374,7 @@ mkSlowEntryCode cl_info reg_args
 
      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
-     jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name has_caf_refs)) []
+     jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI cl_info))
 \end{code}
 
 
@@ -590,7 +590,7 @@ link_caf cl_info _is_upd = do
         -- assuming lots of things, like the stack pointer hasn't
         -- moved since we entered the CAF.
         let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
-        stmtC (CmmJump target [])
+        stmtC (CmmJump target)
 
   ; returnFC hp_rel }
   where
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 17bb9d0ad8..99690945cb 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -352,8 +352,8 @@ cgReturnDataCon con amodes
         }
   where
     enter_it    = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
-                           CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ]
-    jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
+                           CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg)))]
+    jump_to lbl = stmtC (CmmJump (CmmLit lbl))
     build_it_then return_code
       = do {    -- BUILD THE OBJECT IN THE HEAP
                 -- The first "con" says that the name bound to this
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 8d8b97d76a..09636bc6b2 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -7,15 +7,15 @@
 -----------------------------------------------------------------------------
 
 module CgForeignCall (
-  cgForeignCall,
-  emitForeignCall,
-  emitForeignCall',
-  shimForeignCallArg,
-  emitSaveThreadState, -- will be needed by the Cmm parser
-  emitLoadThreadState, -- ditto
-  emitCloseNursery,
-  emitOpenNursery,
- ) where
+        cgForeignCall,
+        emitForeignCall,
+        emitForeignCall',
+        shimForeignCallArg,
+        emitSaveThreadState, -- will be needed by the Cmm parser
+        emitLoadThreadState, -- ditto
+        emitCloseNursery,
+        emitOpenNursery,
+    ) where
 
 import StgSyn
 import CgProf
@@ -271,7 +271,7 @@ nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
 
 tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: ByteOff
 tso_stackobj = closureField oFFSET_StgTSO_stackobj
-tso_CCCS     = closureField oFFSET_StgTSO_CCCS
+tso_CCCS     = closureField oFFSET_StgTSO_cccs
 stack_STACK  = closureField oFFSET_StgStack_stack
 stack_SP     = closureField oFFSET_StgStack_sp
 
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 03b5deb058..d8ac298b58 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -464,7 +464,7 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
         -- the appropriate RTS stub.
         ; exit_blk_id <- forkLabelledCode $ do {
 			; emitStmts reg_save_code
-			; stmtC (CmmJump rts_lbl []) }
+			; stmtC (CmmJump rts_lbl) }
 
 	-- In the case of a heap-check failure, we must also set
 	-- HpAlloc.  NB. HpAlloc is *only* set if Hp has been
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 25ba154d12..9f003a2302 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -253,7 +253,7 @@ emitAlgReturnTarget name branches mb_deflt fam_sz
 emitReturnInstr :: Code
 emitReturnInstr 
   = do 	{ info_amode <- getSequelAmode
-	; stmtC (CmmJump (entryCode info_amode) []) }
+	; stmtC (CmmJump (entryCode info_amode)) }
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 6636e24ec1..c05019e3ac 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -4,20 +4,19 @@
 %
 \section[CgMonad]{The code generation monad}
 
-See the beginning of the top-level @CodeGen@ module, to see how this
-monadic stuff fits into the Big Picture.
+See the beginning of the top-level @CodeGen@ module, to see how this monadic
+stuff fits into the Big Picture.
 
 \begin{code}
 
 {-# LANGUAGE BangPatterns #-}
 module CgMonad (
-        Code,
-        FCode,
+        Code, FCode,
 
         initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
-        returnFC, fixC, fixC_, checkedAbsC, 
+        returnFC, fixC, fixC_, checkedAbsC,
         stmtC, stmtsC, labelC, emitStmts, nopC, whenC, newLabelC,
-        newUnique, newUniqSupply, 
+        newUnique, newUniqSupply,
 
         CgStmts, emitCgStmts, forkCgStmts, cgStmtsToBlocks,
         getCgStmts', getCgStmts,
@@ -35,7 +34,7 @@ module CgMonad (
         setEndOfBlockInfo, getEndOfBlockInfo,
 
         setSRT, getSRT,
-        setSRTLabel, getSRTLabel, 
+        setSRTLabel, getSRTLabel,
         setTickyCtrLabel, getTickyCtrLabel,
 
         StackUsage(..), HeapUsage(..),
@@ -48,10 +47,11 @@ module CgMonad (
 
         Sequel(..),
 
-        -- ideally we wouldn't export these, but some other modules access internal state
-        getState, setState, getInfoDown, getDynFlags, getThisPackage, 
+        -- ideally we wouldn't export these, but some other modules access
+        -- internal state
+        getState, setState, getInfoDown, getDynFlags, getThisPackage,
 
-        -- more localised access to monad state 
+        -- more localised access to monad state
         getStkUsage, setStkUsage,
         getBinds, setBinds, getStaticBinds,
 
@@ -92,82 +92,86 @@ infixr 9 `thenFC`
 %*                                                                      *
 %************************************************************************
 
-This monadery has some information that it only passes {\em
-downwards}, as well as some ``state'' which is modified as we go
-along.
+This monadery has some information that it only passes {\em downwards}, as well
+as some ``state'' which is modified as we go along.
 
 \begin{code}
-data CgInfoDownwards    -- information only passed *downwards* by the monad
+
+-- | State only passed *downwards* by the monad
+data CgInfoDownwards
   = MkCgInfoDown {
-        cgd_dflags  :: DynFlags,
-        cgd_mod     :: Module,          -- Module being compiled
-        cgd_statics :: CgBindings,      -- [Id -> info] : static environment
-        cgd_srt_lbl :: CLabel,          -- label of the current SRT
-        cgd_srt     :: SRT,             -- the current SRT
-        cgd_ticky   :: CLabel,          -- current destination for ticky counts
-        cgd_eob     :: EndOfBlockInfo   -- Info for stuff to do at end of basic block:
+        cgd_dflags  :: DynFlags,      -- current flag settings
+        cgd_mod     :: Module,        -- Module being compiled
+        cgd_statics :: CgBindings,    -- [Id -> info] : static environment
+        cgd_srt_lbl :: CLabel,        -- label of the current SRT
+        cgd_srt     :: SRT,           -- the current SRT
+        cgd_ticky   :: CLabel,        -- current destination for ticky counts
+        cgd_eob     :: EndOfBlockInfo -- Info for stuff to do at end of basic block:
   }
 
+-- | Setup initial @CgInfoDownwards@ for the code gen
 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
 initCgInfoDown dflags mod
-  = MkCgInfoDown {      cgd_dflags  = dflags,
-                        cgd_mod     = mod,
-                        cgd_statics = emptyVarEnv,
-                        cgd_srt_lbl = error "initC: srt_lbl",
-                        cgd_srt     = error "initC: srt",
-                        cgd_ticky   = mkTopTickyCtrLabel,
-                        cgd_eob     = initEobInfo }
+  = MkCgInfoDown { cgd_dflags  = dflags,
+                   cgd_mod     = mod,
+                   cgd_statics = emptyVarEnv,
+                   cgd_srt_lbl = error "initC: srt_lbl",
+                   cgd_srt     = error "initC: srt",
+                   cgd_ticky   = mkTopTickyCtrLabel,
+                   cgd_eob     = initEobInfo
+  }
 
+-- | State passed around and modified during code generation
 data CgState
   = MkCgState {
-     cgs_stmts :: OrdList CgStmt, -- Current proc
-     cgs_tops  :: OrdList CmmDecl,
-        -- Other procedures and data blocks in this compilation unit
-        -- Both the latter two are ordered only so that we can 
-        -- reduce forward references, when it's easy to do so
-     
-     cgs_binds :: CgBindings,     -- [Id -> info] : *local* bindings environment
-                                  -- Bindings for top-level things are given in
-                                  -- the info-down part
-     
+     cgs_stmts   :: OrdList CgStmt,
+         -- Current proc
+     cgs_tops    :: OrdList CmmDecl,
+         -- Other procedures and data blocks in this compilation unit
+         -- Both the latter two are ordered only so that we can
+         -- reduce forward references, when it's easy to do so
+
+     cgs_binds   :: CgBindings,
+         -- [Id -> info] : *local* bindings environment Bindings for
+         -- top-level things are given in the info-down part
+
      cgs_stk_usg :: StackUsage,
      cgs_hp_usg  :: HeapUsage,
-     
-     cgs_uniqs :: UniqSupply }
+     cgs_uniqs   :: UniqSupply
+  }
 
+-- | Setup initial @CgState@ for the code gen
 initCgState :: UniqSupply -> CgState
 initCgState uniqs
-  = MkCgState { cgs_stmts = nilOL, cgs_tops = nilOL,
-                cgs_binds = emptyVarEnv, 
-                cgs_stk_usg = initStkUsage, 
-                cgs_hp_usg = initHpUsage,
-                cgs_uniqs = uniqs }
-\end{code}
-
-@EndOfBlockInfo@ tells what to do at the end of this block of code or,
-if the expression is a @case@, what to do at the end of each
-alternative.
+  = MkCgState { cgs_stmts   = nilOL,
+                cgs_tops    = nilOL,
+                cgs_binds   = emptyVarEnv,
+                cgs_stk_usg = initStkUsage,
+                cgs_hp_usg  = initHpUsage,
+                cgs_uniqs   = uniqs
+  }
 
-\begin{code}
+-- | @EndOfBlockInfo@ tells what to do at the end of this block of code or, if
+-- the expression is a @case@, what to do at the end of each alternative.
 data EndOfBlockInfo
   = EndOfBlockInfo
-        VirtualSpOffset   -- Args Sp: trim the stack to this point at a
-                          -- return; push arguments starting just
-                          -- above this point on a tail call.
-                          
-                          -- This is therefore the stk ptr as seen
-                          -- by a case alternative.
+        VirtualSpOffset -- Args Sp: trim the stack to this point at a
+                        -- return; push arguments starting just
+                        -- above this point on a tail call.
+                        --
+                        -- This is therefore the stk ptr as seen
+                        -- by a case alternative.
         Sequel
 
+-- | Standard @EndOfBlockInfo@ where the continuation is on the stack
 initEobInfo :: EndOfBlockInfo
 initEobInfo = EndOfBlockInfo 0 OnStack
-\end{code}
 
-Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
-that it must survive stack pointer adjustments at the end of the
-block.
-
-\begin{code}
+-- | @Sequel@ is a representation of the next continuation to jump to
+-- after the current function.
+--
+-- Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
+-- that it must survive stack pointer adjustments at the end of the block.
 data Sequel
   = OnStack          -- Continuation is on the stack
 
@@ -178,9 +182,9 @@ data Sequel
           Id          -- The case binder, only used to see if it's dead
 
 type SemiTaggingStuff
-  = Maybe                   -- Maybe we don't have any semi-tagging stuff...
-     ([(ConTagZ, CmmLit)],  -- Alternatives
-      CmmLit)               -- Default (will be a can't happen RTS label if can't happen)
+  = Maybe                  -- Maybe we don't have any semi-tagging stuff...
+     ([(ConTagZ, CmmLit)], -- Alternatives
+      CmmLit)              -- Default (will be a can't happen RTS label if can't happen)
 
 -- The case branch is executed only from a successful semitagging
 -- venture, when a case has looked at a variable, found that it's
@@ -195,9 +199,9 @@ type SemiTaggingStuff
 %************************************************************************
 
 The CgStmts type is what the code generator outputs: it is a tree of
-statements, including in-line labels.  The job of flattenCgStmts is to
-turn this into a list of basic blocks, each of which ends in a jump
-statement (either a local branch or a non-local jump).
+statements, including in-line labels. The job of flattenCgStmts is to turn
+this into a list of basic blocks, each of which ends in a jump statement
+(either a local branch or a non-local jump).
 
 \begin{code}
 type CgStmts = OrdList CgStmt
@@ -208,7 +212,7 @@ data CgStmt
   | CgFork  BlockId CgStmts
 
 flattenCgStmts :: BlockId -> CgStmts -> [CmmBasicBlock]
-flattenCgStmts id stmts = 
+flattenCgStmts id stmts =
         case flatten (fromOL stmts) of
           ([],blocks)    -> blocks
           (block,blocks) -> BasicBlock id block : blocks
@@ -231,24 +235,24 @@ flattenCgStmts id stmts =
         [CgLabel id]           -> ( [stmt], [BasicBlock id [CmmBranch id]])
         (CgLabel id : stmts)   -> ( [stmt], BasicBlock id block : blocks )
             where (block,blocks) = flatten stmts
-        (CgFork fork_id stmts : ss) -> 
+        (CgFork fork_id stmts : ss) ->
            flatten (CgFork fork_id stmts : CgStmt stmt : ss)
         (CgStmt {} : _) -> panic "CgStmt not seen as ordinary"
 
-  flatten (s:ss) = 
+  flatten (s:ss) =
         case s of
           CgStmt stmt -> (stmt:block,blocks)
           CgLabel id  -> ([CmmBranch id],BasicBlock id block:blocks)
-          CgFork fork_id stmts -> 
+          CgFork fork_id stmts ->
                 (block, BasicBlock fork_id fork_block : fork_blocks ++ blocks)
                 where (fork_block, fork_blocks) = flatten (fromOL stmts)
     where (block,blocks) = flatten ss
 
 isJump :: CmmStmt -> Bool
-isJump (CmmJump   _ _) = True
+isJump (CmmJump   _  ) = True
 isJump (CmmBranch _  ) = True
 isJump (CmmSwitch _ _) = True
-isJump (CmmReturn _  ) = True
+isJump (CmmReturn    ) = True
 isJump _               = False
 
 isOrdinaryStmt :: CgStmt -> Bool
@@ -263,10 +267,15 @@ isOrdinaryStmt _          = False
 %************************************************************************
 
 \begin{code}
-type VirtualHpOffset = WordOff  -- Both are in
-type VirtualSpOffset = WordOff  -- units of words
+type VirtualHpOffset = WordOff -- Both are in
+type VirtualSpOffset = WordOff -- units of words
 
-data StackUsage 
+-- | Stack usage information during code generation.
+--
+-- INVARIANT: The environment contains no Stable references to
+--            stack slots below (lower offset) frameSp
+--            It can contain volatile references to this area though.
+data StackUsage
   = StackUsage {
         virtSp :: VirtualSpOffset,
                 -- Virtual offset of topmost allocated slot
@@ -277,83 +286,83 @@ data StackUsage
                 -- all the stack from frameSp downwards
                 -- INVARIANT: less than or equal to virtSp
 
-         freeStk :: [VirtualSpOffset], 
+         freeStk :: [VirtualSpOffset],
                 -- List of free slots, in *increasing* order
                 -- INVARIANT: all <= virtSp
-                -- All slots <= virtSp are taken except these ones
+                --            All slots <= virtSp are taken except these ones
 
-         realSp :: VirtualSpOffset,     
+         realSp :: VirtualSpOffset,
                 -- Virtual offset of real stack pointer register
 
          hwSp :: VirtualSpOffset
-  }                -- Highest value ever taken by virtSp
-
--- INVARIANT: The environment contains no Stable references to
---            stack slots below (lower offset) frameSp
---            It can contain volatile references to this area though.
-
-data HeapUsage =
-  HeapUsage {
-        virtHp :: VirtualHpOffset,      -- Virtual offset of highest-allocated word
-        realHp :: VirtualHpOffset       -- realHp: Virtual offset of real heap ptr
+  }             -- Highest value ever taken by virtSp
+
+-- | Heap usage information during code generation.
+--
+-- virtHp keeps track of the next location to allocate an object at. realHp
+-- keeps track of what the Hp STG register actually points to. The reason these
+-- aren't always the same is that we want to be able to move the realHp in one
+-- go when allocating numerous objects to save having to bump it each time.
+-- virtHp we do bump each time but it doesn't create corresponding inefficient
+-- machine code.
+data HeapUsage
+  = HeapUsage {
+        virtHp :: VirtualHpOffset, -- Virtual offset of highest allocated word
+        realHp :: VirtualHpOffset  -- Virtual offset of real heap ptr
   }
-\end{code}
 
-virtHp keeps track of the next location to allocate an object at. realHp keeps
-track of what the Hp STG register actually points to. The reason these aren't
-always the same is that we want to be able to move the realHp in one go when
-allocating numerous objects to save having to bump it each time. virtHp we do
-bump each time but it doesn't create corresponding inefficient machine code.
-
-\begin{code}
+-- | Return the heap usage high water mark
 heapHWM :: HeapUsage -> VirtualHpOffset
 heapHWM = virtHp
-\end{code}
 
-Initialisation.
 
-\begin{code}
+-- | Initial stack usage
 initStkUsage :: StackUsage
-initStkUsage = StackUsage {
-                        virtSp = 0,
-                        frameSp = 0,
-                        freeStk = [],
-                        realSp = 0,
-                        hwSp = 0
-               }
-                
-initHpUsage :: HeapUsage 
-initHpUsage = HeapUsage {
-                virtHp = 0,
-                realHp = 0
-              }
+initStkUsage
+  = StackUsage {
+        virtSp  = 0,
+        frameSp = 0,
+        freeStk = [],
+        realSp  = 0,
+        hwSp    = 0
+  }
+
+-- | Initial heap usage
+initHpUsage :: HeapUsage
+initHpUsage
+  = HeapUsage {
+        virtHp = 0,
+        realHp = 0
+  }
 
 -- | @stateIncUsafe@ sets the stack and heap high water marks of $arg1$ to
 -- be the max of the high water marks of $arg1$ and $arg2$.
 stateIncUsage :: CgState -> CgState -> CgState
 stateIncUsage s1 s2@(MkCgState { cgs_stk_usg = stk_usg, cgs_hp_usg = hp_usg })
-     = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
-            cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
-       `addCodeBlocksFrom` s2
-                
+  = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
+         cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
+    `addCodeBlocksFrom` s2
+
+-- | Similar to @stateIncUsafe@ but we don't max the heap high-watermark
+-- because @stateIncUsageEval@ is used only in forkEval, which in turn is only
+-- used for blocks of code which do their own heap-check.
 stateIncUsageEval :: CgState -> CgState -> CgState
 stateIncUsageEval s1 s2
-     = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
-       `addCodeBlocksFrom` s2
-        -- We don't max the heap high-watermark because stateIncUsageEval is
-        -- used only in forkEval, which in turn is only used for blocks of code
-        -- which do their own heap-check.
+  = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
+    `addCodeBlocksFrom` s2
 
+-- | Add code blocks from the latter to the former
+-- (The cgs_stmts will often be empty, but not always; see @codeOnly@)
 addCodeBlocksFrom :: CgState -> CgState -> CgState
--- Add code blocks from the latter to the former
--- (The cgs_stmts will often be empty, but not always; see codeOnly)
 s1 `addCodeBlocksFrom` s2
   = s1 { cgs_stmts = cgs_stmts s1 `appOL` cgs_stmts s2,
          cgs_tops  = cgs_tops  s1 `appOL` cgs_tops  s2 }
 
+-- | Set @HeapUsage@ virtHp to max of current or $arg2$.
 maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
 hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
 
+-- | Set @StackUsage@ hwSp to max of current or $arg2$.
 maxStkHw :: StackUsage -> VirtualSpOffset -> StackUsage
 stk_usg `maxStkHw` hw = stk_usg { hwSp = hwSp stk_usg `max` hw }
 \end{code}
@@ -369,52 +378,39 @@ newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 type Code       = FCode ()
 
 instance Monad FCode where
-        (>>=) = thenFC
+        (>>=)  = thenFC
         return = returnFC
 
 {-# INLINE thenC #-}
 {-# INLINE thenFC #-}
 {-# INLINE returnFC #-}
-\end{code}
-The Abstract~C is not in the environment so as to improve strictness.
 
-\begin{code}
 initC :: DynFlags -> Module -> FCode a -> IO a
-
-initC dflags mod (FCode code)
-  = do  { uniqs <- mkSplitUniqSupply 'c'
-        ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
-              (res, _) -> return res
-        }
+initC dflags mod (FCode code) = do
+    uniqs <- mkSplitUniqSupply 'c'
+    case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+        (res, _) -> return res
 
 returnFC :: a -> FCode a
-returnFC val = FCode (\_ state -> (val, state))
-\end{code}
+returnFC val = FCode $ \_ state -> (val, state)
 
-\begin{code}
 thenC :: Code -> FCode a -> FCode a
-thenC (FCode m) (FCode k) = 
-        FCode (\info_down state -> let (_,new_state) = m info_down state in 
-                k info_down new_state)
+thenC (FCode m) (FCode k) = FCode $ \info_down state ->
+    let (_,new_state) = m info_down state
+    in k info_down new_state
 
 listCs :: [Code] -> Code
-listCs [] = return ()
-listCs (fc:fcs) = do
-        fc
-        listCs fcs
-        
+listCs []       = return ()
+listCs (fc:fcs) = fc >> listCs fcs
+
 mapCs :: (a -> Code) -> [a] -> Code
 mapCs = mapM_
 
 thenFC  :: FCode a -> (a -> FCode c) -> FCode c
-thenFC (FCode m) k = FCode (
-        \info_down state ->
-                let 
-                        (m_result, new_state) = m info_down state
-                        (FCode kcode) = k m_result
-                in 
-                        kcode info_down new_state
-        )
+thenFC (FCode m) k = FCode $ \info_down state ->
+    let (m_result, new_state) = m info_down state
+        (FCode kcode)         = k m_result
+    in kcode info_down new_state
 
 listFCs :: [FCode a] -> FCode [a]
 listFCs = sequence
@@ -424,11 +420,10 @@ mapFCs = mapM
 
 -- | Knot-tying combinator for @FCode@
 fixC :: (a -> FCode a) -> FCode a
-fixC fcode = FCode $
-        \info_down state -> 
-                let FCode fc     = fcode v
-                    result@(v,_) = fc info_down state
-                in result
+fixC fcode = FCode $ \info_down state ->
+    let FCode fc     = fcode v
+        result@(v,_) = fc info_down state
+    in result
 
 -- | Knot-tying combinator that throws result away
 fixC_ :: (a -> FCode a) -> FCode ()
@@ -443,64 +438,65 @@ fixC_ fcode = fixC fcode >> return ()
 
 \begin{code}
 getState :: FCode CgState
-getState = FCode $ \_ state -> (state,state)
+getState = FCode $ \_ state -> (state, state)
 
 setState :: CgState -> FCode ()
-setState state = FCode $ \_ _ -> ((),state)
+setState state = FCode $ \_ _ -> ((), state)
 
 getStkUsage :: FCode StackUsage
 getStkUsage = do
-        state <- getState
-        return $ cgs_stk_usg state
+    state <- getState
+    return $ cgs_stk_usg state
 
 setStkUsage :: StackUsage -> Code
 setStkUsage new_stk_usg = do
-        state <- getState
-        setState $ state {cgs_stk_usg = new_stk_usg}
+    state <- getState
+    setState $ state {cgs_stk_usg = new_stk_usg}
 
 getHpUsage :: FCode HeapUsage
 getHpUsage = do
-        state <- getState
-        return $ cgs_hp_usg state
-        
+    state <- getState
+    return $ cgs_hp_usg state
+
 setHpUsage :: HeapUsage -> Code
 setHpUsage new_hp_usg = do
-        state <- getState
-        setState $ state {cgs_hp_usg = new_hp_usg}
+    state <- getState
+    setState $ state {cgs_hp_usg = new_hp_usg}
 
 getBinds :: FCode CgBindings
 getBinds = do
-        state <- getState
-        return $ cgs_binds state
-        
+    state <- getState
+    return $ cgs_binds state
+
 setBinds :: CgBindings -> FCode ()
 setBinds new_binds = do
-        state <- getState
-        setState $ state {cgs_binds = new_binds}
+    state <- getState
+    setState $ state {cgs_binds = new_binds}
 
 getStaticBinds :: FCode CgBindings
 getStaticBinds = do
-        info  <- getInfoDown
-        return (cgd_statics info)
+    info  <- getInfoDown
+    return (cgd_statics info)
 
 withState :: FCode a -> CgState -> FCode (a,CgState)
-withState (FCode fcode) newstate = FCode $ \info_down state -> 
-        let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
+withState (FCode fcode) newstate = FCode $ \info_down state ->
+    let (retval, state2) = fcode info_down newstate
+    in ((retval, state2), state)
 
 newUniqSupply :: FCode UniqSupply
 newUniqSupply = do
-        state <- getState
-        let (us1, us2) = splitUniqSupply (cgs_uniqs state)
-        setState $ state { cgs_uniqs = us1 }
-        return us2
+    state <- getState
+    let (us1, us2) = splitUniqSupply (cgs_uniqs state)
+    setState $ state { cgs_uniqs = us1 }
+    return us2
 
 newUnique :: FCode Unique
 newUnique = do
-        us <- newUniqSupply
-        return (uniqFromSupply us)
+    us <- newUniqSupply
+    return (uniqFromSupply us)
 
 getInfoDown :: FCode CgInfoDownwards
-getInfoDown = FCode $ \info_down state -> (info_down,state)
+getInfoDown = FCode $ \info_down state -> (info_down, state)
 
 instance HasDynFlags FCode where
     getDynFlags = liftM cgd_dflags getInfoDown
@@ -509,175 +505,158 @@ getThisPackage :: FCode PackageId
 getThisPackage = liftM thisPackage getDynFlags
 
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
-withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
+withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
 
 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
 doFCode (FCode fcode) info_down state = fcode info_down state
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                 Forking
 %*                                                                      *
 %************************************************************************
 
-@forkClosureBody@ takes a code, $c$, and compiles it in a completely
-fresh environment, except that:
-        - compilation info and statics are passed in unchanged.
-The current environment is passed on completely unaltered, except that
-abstract C from the fork is incorporated.
-
-@forkProc@ takes a code and compiles it in the current environment,
-returning the basic blocks thus constructed.  The current environment
-is passed on completely unchanged.  It is pretty similar to
-@getBlocks@, except that the latter does affect the environment.
-
-@forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
-from the current bindings, but which is otherwise freshly initialised.
-The Abstract~C returned is attached to the current state, but the
-bindings and usage information is otherwise unchanged.
-
 \begin{code}
+
+-- | Takes code and compiles it in a completely fresh environment, except that
+-- compilation info and statics are passed in unchanged. The current
+-- environment is passed on completely unaltered, except that the Cmm code
+-- from the fork is incorporated.
 forkClosureBody :: Code -> Code
-forkClosureBody body_code
-  = do  { info <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   body_info_down = info { cgd_eob = initEobInfo }
-                ((),fork_state) = doFCode body_code body_info_down 
-                                          (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state) )
-          setState $ state `addCodeBlocksFrom` fork_state }
-        
+forkClosureBody body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let body_info_down   = info { cgd_eob = initEobInfo }
+        ((), fork_state) = doFCode body_code body_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state) )
+      setState $ state `addCodeBlocksFrom` fork_state
+
+-- | @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
+-- from the current bindings, but which is otherwise freshly initialised.
+-- The Cmm returned is attached to the current state, but the bindings and
+-- usage information is otherwise unchanged.
 forkStatics :: FCode a -> FCode a
-forkStatics body_code
-  = do  { info  <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   rhs_info_down = info { cgd_statics = cgs_binds state,
-                                       cgd_eob     = initEobInfo }
-                (result, fork_state_out) = doFCode body_code rhs_info_down 
-                                                   (initCgState us)
-        ; ASSERT( isNilOL (cgs_stmts fork_state_out) )
-          setState (state `addCodeBlocksFrom` fork_state_out)
-        ; return result }
-
+forkStatics body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let rhs_info_down = info { cgd_statics = cgs_binds state,
+                               cgd_eob     = initEobInfo }
+        (result, fork_state_out) = doFCode body_code rhs_info_down (initCgState us)
+
+    ASSERT( isNilOL (cgs_stmts fork_state_out) )
+      setState (state `addCodeBlocksFrom` fork_state_out)
+    return result
+
+-- | @forkProc@ takes a code and compiles it in the current environment,
+-- returning the basic blocks thus constructed. The current environment is
+-- passed on completely unchanged. It is pretty similar to @getBlocks@, except
+-- that the latter does affect the environment.
 forkProc :: Code -> FCode CgStmts
-forkProc body_code
-  = do  { info_down <- getInfoDown
-        ; us    <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) 
-                                        { cgs_binds   = cgs_binds state,
-                                          cgs_stk_usg = cgs_stk_usg state,
-                                          cgs_hp_usg  = cgs_hp_usg state }
-                        -- ToDo: is the hp usage necesary?
-                (code_blks, fork_state_out) = doFCode (getCgStmts body_code) 
-                                                      info_down fork_state_in
-        ; setState $ state `stateIncUsageEval` fork_state_out
-        ; return code_blks }
+forkProc body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us)
+                            { cgs_binds   = cgs_binds state,
+                              cgs_stk_usg = cgs_stk_usg state,
+                              cgs_hp_usg  = cgs_hp_usg state }
+        (code_blks, fork_state_out) = doFCode (getCgStmts body_code)
+                                              info fork_state_in
+    setState $ state `stateIncUsageEval` fork_state_out
+    return code_blks
 
 -- Emit any code from the inner thing into the outer thing
 -- Do not affect anything else in the outer state
 -- Used in almost-circular code to prevent false loop dependencies
 codeOnly :: Code -> Code
-codeOnly body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let   fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
-                                                   cgs_stk_usg = cgs_stk_usg state,
-                                                   cgs_hp_usg  = cgs_hp_usg state }
-                ((), fork_state_out) = doFCode body_code info_down fork_state_in
-        ; setState $ state `addCodeBlocksFrom` fork_state_out }
-\end{code}
-
-@forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
-an fcode for the default case $d$, and compiles each in the current
-environment.  The current environment is passed on unmodified, except
-that
-        - the worst stack high-water mark is incorporated
-        - the virtual Hp is moved on to the worst virtual Hp for the branches
-
-\begin{code}
+codeOnly body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
+                                           cgs_stk_usg = cgs_stk_usg state,
+                                           cgs_hp_usg  = cgs_hp_usg state }
+        ((), fork_state_out) = doFCode body_code info fork_state_in
+    setState $ state `addCodeBlocksFrom` fork_state_out
+
+-- | @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and an
+-- an fcode for the default case $d$, and compiles each in the current
+-- environment. The current environment is passed on unmodified, except that:
+--     * the worst stack high-water mark is incorporated
+--     * the virtual Hp is moved on to the worst virtual Hp for the branches
 forkAlts :: [FCode a] -> FCode [a]
-
-forkAlts branch_fcodes
-  = do  { info_down <- getInfoDown
-        ; us <- newUniqSupply
-        ; state <- getState
-        ; let compile us branch 
-                = (us2, doFCode branch info_down branch_state)
-                where
-                  (us1,us2) = splitUniqSupply us
-                  branch_state = (initCgState us1) {
-                                        cgs_binds   = cgs_binds state,
-                                        cgs_stk_usg = cgs_stk_usg state,
-                                        cgs_hp_usg  = cgs_hp_usg state }
-
-              (_us, results) = mapAccumL compile us branch_fcodes
-              (branch_results, branch_out_states) = unzip results
-        ; setState $ foldl stateIncUsage state branch_out_states
-                -- NB foldl.  state is the *left* argument to stateIncUsage
-        ; return branch_results }
-\end{code}
-
-@forkEval@ takes two blocks of code.
-
-   -  The first meddles with the environment to set it up as expected by
-      the alternatives of a @case@ which does an eval (or gc-possible primop).
-   -  The second block is the code for the alternatives.
-      (plus info for semi-tagging purposes)
-
-@forkEval@ picks up the virtual stack pointer and returns a suitable
-@EndOfBlockInfo@ for the caller to use, together with whatever value
-is returned by the second block.
-
-It uses @initEnvForAlternatives@ to initialise the environment, and
-@stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
-usage.
-
-\begin{code}
-forkEval :: EndOfBlockInfo              -- For the body
-         -> Code                        -- Code to set environment
-         -> FCode Sequel                -- Semi-tagging info to store
-         -> FCode EndOfBlockInfo        -- The new end of block info
-
-forkEval body_eob_info env_code body_code
-  = do  { (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
-        ; returnFC (EndOfBlockInfo v sequel) }
-
+forkAlts branch_fcodes = do 
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+    let compile us branch = (us2, doFCode branch info branch_state)
+            where
+                (us1,us2)    = splitUniqSupply us
+                branch_state = (initCgState us1) {
+                                   cgs_binds   = cgs_binds state,
+                                   cgs_stk_usg = cgs_stk_usg state,
+                                   cgs_hp_usg  = cgs_hp_usg state }
+        (_us, results) = mapAccumL compile us branch_fcodes
+        (branch_results, branch_out_states) = unzip results
+    -- NB foldl. state is the *left* argument to stateIncUsage
+    setState $ foldl stateIncUsage state branch_out_states
+    return branch_results
+
+-- | @forkEval@ takes two blocks of code.
+-- 
+--   *  The first meddles with the environment to set it up as expected by
+--      the alternatives of a @case@ which does an eval (or gc-possible primop).
+--   *  The second block is the code for the alternatives.
+--      (plus info for semi-tagging purposes)
+--
+-- @forkEval@ picks up the virtual stack pointer and returns a suitable
+-- @EndOfBlockInfo@ for the caller to use, together with whatever value
+-- is returned by the second block.
+-- 
+-- It uses @initEnvForAlternatives@ to initialise the environment, and
+-- @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap usage.
+forkEval :: EndOfBlockInfo       -- For the body
+         -> Code                 -- Code to set environment
+         -> FCode Sequel         -- Semi-tagging info to store
+         -> FCode EndOfBlockInfo -- The new end of block info
+forkEval body_eob_info env_code body_code = do
+    (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
+    returnFC (EndOfBlockInfo v sequel)
+
+-- A disturbingly complicated function
 forkEvalHelp :: EndOfBlockInfo  -- For the body
              -> Code            -- Code to set environment
              -> FCode a         -- The code to do after the eval
              -> FCode (VirtualSpOffset, -- Sp
                        a)               -- Result of the FCode
-        -- A disturbingly complicated function
-forkEvalHelp body_eob_info env_code body_code
-  = do  { info_down <- getInfoDown
-        ; us   <- newUniqSupply
-        ; state <- getState
-        ; let { info_down_for_body = info_down {cgd_eob = body_eob_info}
-              ; (_, env_state) = doFCode env_code info_down_for_body 
-                                         (state {cgs_uniqs = us})
-              ; state_for_body = (initCgState (cgs_uniqs env_state)) 
-                                        { cgs_binds   = binds_for_body,
-                                          cgs_stk_usg = stk_usg_for_body }
-              ; binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
-              ; stk_usg_from_env = cgs_stk_usg env_state
-              ; virtSp_from_env  = virtSp stk_usg_from_env
-              ; stk_usg_for_body = stk_usg_from_env {realSp = virtSp_from_env,
-                                                     hwSp   = virtSp_from_env}
-              ; (value_returned, state_at_end_return)
-                        = doFCode body_code info_down_for_body state_for_body           
-          } 
-        ; ASSERT( isNilOL (cgs_stmts state_at_end_return) )
-                 -- The code coming back should consist only of nested declarations,
-                 -- notably of the return vector!
-          setState $ state `stateIncUsageEval` state_at_end_return
-        ; return (virtSp_from_env, value_returned) }
-
+forkEvalHelp body_eob_info env_code body_code = do
+    info  <- getInfoDown
+    us    <- newUniqSupply
+    state <- getState
+
+    let info_body      = info { cgd_eob = body_eob_info }
+        (_, env_state) = doFCode env_code info_body
+                                 (state {cgs_uniqs = us})
+        state_for_body = (initCgState (cgs_uniqs env_state))
+                            { cgs_binds   = binds_for_body,
+                              cgs_stk_usg = stk_usg_for_body }
+        binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
+        stk_usg_from_env = cgs_stk_usg env_state
+        virtSp_from_env  = virtSp stk_usg_from_env
+        stk_usg_for_body = stk_usg_from_env { realSp = virtSp_from_env,
+                                              hwSp   = virtSp_from_env }
+        (value_returned, state_at_end_return)
+            = doFCode body_code info_body state_for_body
+
+    -- The code coming back should consist only of nested declarations,
+    -- notably of the return vector!
+    ASSERT( isNilOL (cgs_stmts state_at_end_return) )
+      setState $ state `stateIncUsageEval` state_at_end_return
+    return (virtSp_from_env, value_returned)
 
 -- ----------------------------------------------------------------------------
 -- Combinators for emitting code
@@ -698,20 +677,20 @@ labelC :: BlockId -> Code
 labelC id = emitCgStmt (CgLabel id)
 
 newLabelC :: FCode BlockId
-newLabelC = do { u <- newUnique
-               ; return $ mkBlockId u }
+newLabelC = do
+    u <- newUnique
+    return $ mkBlockId u
 
 -- Emit code, eliminating no-ops
 checkedAbsC :: CmmStmt -> Code
-checkedAbsC stmt = emitStmts (if isNopStmt stmt then nilOL
-                              else unitOL stmt)
+checkedAbsC stmt = emitStmts $ if isNopStmt stmt then nilOL else unitOL stmt
 
 stmtsC :: [CmmStmt] -> Code
-stmtsC stmts = emitStmts (toOL stmts)
+stmtsC stmts = emitStmts $ toOL stmts
 
 -- Emit code; no no-op checking
 emitStmts :: CmmStmts -> Code
-emitStmts stmts = emitCgStmts (fmap CgStmt stmts)
+emitStmts stmts = emitCgStmts $ fmap CgStmt stmts
 
 -- forkLabelledCode is for emitting a chunk of code with a label, outside
 -- of the current instruction stream.
@@ -719,40 +698,38 @@ forkLabelledCode :: Code -> FCode BlockId
 forkLabelledCode code = getCgStmts code >>= forkCgStmts
 
 emitCgStmt :: CgStmt -> Code
-emitCgStmt stmt
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
-        }
+emitCgStmt stmt = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
 
 emitDecl :: CmmDecl -> Code
-emitDecl decl
-  = do  { state <- getState
-        ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
+emitDecl decl = do
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` decl }
 
 emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
-emitProc info lbl [] blocks
-  = do  { let proc_block = CmmProc info lbl (ListGraph blocks)
-        ; state <- getState
-        ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
+emitProc info lbl [] blocks = do
+    let proc_block = CmmProc info lbl (ListGraph blocks)
+    state <- getState
+    setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block }
 emitProc _ _ (_:_) _ = panic "emitProc called with nonempty args"
 
 -- Emit a procedure whose body is the specified code; no info table
 emitSimpleProc :: CLabel -> Code -> Code
-emitSimpleProc lbl code
-  = do  { stmts <- getCgStmts code
-        ; blks <- cgStmtsToBlocks stmts
-        ; emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks }
+emitSimpleProc lbl code = do
+    stmts <- getCgStmts code
+    blks <- cgStmtsToBlocks stmts
+    emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks
 
 -- Get all the CmmTops (there should be no stmts)
 -- Return a single Cmm which may be split from other Cmms by
 -- object splitting (at a later stage)
 getCmm :: Code -> FCode CmmGroup
-getCmm code 
-  = do  { state1 <- getState
-        ; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
-        ; setState $ state2 { cgs_tops = cgs_tops state1 } 
-        ; return (fromOL (cgs_tops state2))
-        }
+getCmm code = do
+    state1 <- getState
+    ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
+    setState $ state2 { cgs_tops = cgs_tops state1 }
+    return (fromOL (cgs_tops state2))
 
 -- ----------------------------------------------------------------------------
 -- CgStmts
@@ -760,38 +737,37 @@ getCmm code
 -- These functions deal in terms of CgStmts, which is an abstract type
 -- representing the code in the current proc.
 
-
 -- emit CgStmts into the current instruction stream
 emitCgStmts :: CgStmts -> Code
-emitCgStmts stmts
-  = do  { state <- getState
-        ; setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts } }
+emitCgStmts stmts = do
+    state <- getState
+    setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts }
 
 -- emit CgStmts outside the current instruction stream, and return a label
 forkCgStmts :: CgStmts -> FCode BlockId
-forkCgStmts stmts
-  = do  { id <- newLabelC
-        ; emitCgStmt (CgFork id stmts)
-        ; return id
-        }
+forkCgStmts stmts = do
+    id <- newLabelC
+    emitCgStmt (CgFork id stmts)
+    return id
 
 -- turn CgStmts into [CmmBasicBlock], for making a new proc.
 cgStmtsToBlocks :: CgStmts -> FCode [CmmBasicBlock]
-cgStmtsToBlocks stmts
-  = do  { id <- newLabelC
-        ; return (flattenCgStmts id stmts)
-        }       
+cgStmtsToBlocks stmts = do
+    id <- newLabelC
+    return (flattenCgStmts id stmts)
 
 -- collect the code emitted by an FCode computation
 getCgStmts' :: FCode a -> FCode (a, CgStmts)
-getCgStmts' fcode
-  = do  { state1 <- getState
-        ; (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
-        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }
-        ; return (a, cgs_stmts state2) }
+getCgStmts' fcode = do
+    state1 <- getState
+    (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
+    setState $ state2 { cgs_stmts = cgs_stmts state1  }
+    return (a, cgs_stmts state2)
 
 getCgStmts :: FCode a -> FCode CgStmts
-getCgStmts fcode = do { (_,stmts) <- getCgStmts' fcode; return stmts }
+getCgStmts fcode = do
+    (_,stmts) <- getCgStmts' fcode
+    return stmts
 
 -- Simple ways to construct CgStmts:
 noCgStmts :: CgStmts
@@ -807,56 +783,60 @@ consCgStmt stmt stmts = CgStmt stmt `consOL` stmts
 -- Get the current module name
 
 getModuleName :: FCode Module
-getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
+getModuleName = do
+    info <- getInfoDown
+    return (cgd_mod info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the end-of-block info
 
 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
 setEndOfBlockInfo eob_info code = do
-        info  <- getInfoDown
-        withInfoDown code (info {cgd_eob = eob_info})
+    info  <- getInfoDown
+    withInfoDown code (info {cgd_eob = eob_info})
 
 getEndOfBlockInfo :: FCode EndOfBlockInfo
 getEndOfBlockInfo = do
-        info <- getInfoDown
-        return (cgd_eob info)
+    info <- getInfoDown
+    return (cgd_eob info)
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current SRT label
 
 -- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
+-- bindings use sub-sections of this SRT. The label is passed down to
 -- the nested bindings via the monad.
 
 getSRTLabel :: FCode CLabel     -- Used only by cgPanic
-getSRTLabel = do info  <- getInfoDown
-                 return (cgd_srt_lbl info)
+getSRTLabel = do
+    info  <- getInfoDown
+    return (cgd_srt_lbl info)
 
 setSRTLabel :: CLabel -> FCode a -> FCode a
-setSRTLabel srt_lbl code
-  = do  info <- getInfoDown
-        withInfoDown code (info { cgd_srt_lbl = srt_lbl})
+setSRTLabel srt_lbl code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt_lbl = srt_lbl})
 
 getSRT :: FCode SRT
-getSRT = do info <- getInfoDown
-            return (cgd_srt info)
+getSRT = do
+    info <- getInfoDown
+    return (cgd_srt info)
 
 setSRT :: SRT -> FCode a -> FCode a
-setSRT srt code
-  = do info <- getInfoDown
-       withInfoDown code (info { cgd_srt = srt})
+setSRT srt code = do
+    info <- getInfoDown
+    withInfoDown code (info { cgd_srt = srt})
 
 -- ----------------------------------------------------------------------------
 -- Get/set the current ticky counter label
 
 getTickyCtrLabel :: FCode CLabel
 getTickyCtrLabel = do
-        info <- getInfoDown
-        return (cgd_ticky info)
+    info <- getInfoDown
+    return (cgd_ticky info)
 
 setTickyCtrLabel :: CLabel -> Code -> Code
 setTickyCtrLabel ticky code = do
-        info <- getInfoDown
-        withInfoDown code (info {cgd_ticky = ticky})
+    info <- getInfoDown
+    withInfoDown code (info {cgd_ticky = ticky})
 \end{code}
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 3b11054efe..b0865d69d9 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -6,16 +6,9 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CgPrimOp (
-   cgPrimOp
- ) where
+        cgPrimOp
+    ) where
 
 import BasicTypes
 import ForeignCall
@@ -43,44 +36,44 @@ import StaticFlags
 -- ---------------------------------------------------------------------------
 -- Code generation for PrimOps
 
-cgPrimOp   :: [CmmFormal]	-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [StgArg]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
+cgPrimOp :: [CmmFormal]       -- where to put the results
+         -> PrimOp            -- the op
+         -> [StgArg]          -- arguments
+         -> StgLiveVars       -- live vars, in case we need to save them
+         -> Code
 
 cgPrimOp results op args live
   = do arg_exprs <- getArgAmodes args
-       let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ] 
+       let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
        emitPrimOp results op non_void_args live
 
 
-emitPrimOp :: [CmmFormal]	-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [CmmExpr]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
+emitPrimOp :: [CmmFormal]       -- where to put the results
+           -> PrimOp            -- the op
+           -> [CmmExpr]         -- arguments
+           -> StgLiveVars       -- live vars, in case we need to save them
+           -> Code
 
 --  First we handle various awkward cases specially.  The remaining
 -- easy cases are then handled by translateOp, defined below.
 
 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
-{- 
+{-
    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
    C, and without needing any comparisons.  This may not be the
    fastest way to do it - if you have better code, please send it! --SDM
-  
+
    Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
-  
-   We currently don't make use of the r value if c is != 0 (i.e. 
+
+   We currently don't make use of the r value if c is != 0 (i.e.
    overflow), we just convert to big integers and try again.  This
    could be improved by making r and c the correct values for
-   plugging into a new J#.  
-   
-   { r = ((I_)(a)) + ((I_)(b));					\
-     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
-   } 
+   plugging into a new J#.
+
+   { r = ((I_)(a)) + ((I_)(b));                                 \
+     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
+         >> (BITS_IN (I_) - 1);                                 \
+   }
    Wading through the mass of bracketry, it seems to reduce to:
    c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
 
@@ -88,22 +81,22 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
    = stmtsC [
         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
+          CmmMachOp mo_wordUShr [
+                CmmMachOp mo_wordAnd [
+                    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
+                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+                ],
+                CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
+          ]
      ]
 
 
 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
 {- Similarly:
-   #define subIntCzh(r,c,a,b)					\
-   { r = ((I_)(a)) - ((I_)(b));					\
-     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
+   #define subIntCzh(r,c,a,b)                                   \
+   { r = ((I_)(a)) - ((I_)(b));                                 \
+     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
+         >> (BITS_IN (I_) - 1);                                 \
    }
 
    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
@@ -111,27 +104,27 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
    = stmtsC [
         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordXor [aa,bb],
-		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
+          CmmMachOp mo_wordUShr [
+                CmmMachOp mo_wordAnd [
+                    CmmMachOp mo_wordXor [aa,bb],
+                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+                ],
+                CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
+          ]
      ]
 
 
 emitPrimOp [res] ParOp [arg] live
   = do
-	-- for now, just implement this in a C function
-	-- later, we might want to inline it.
+        -- for now, just implement this in a C function
+        -- later, we might want to inline it.
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
-	[CmmHinted res NoHint]
-    	(CmmCallee newspark CCallConv) 
-	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
-          , (CmmHinted arg AddrHint)  ] 
-	(Just vols)
+        [CmmHinted res NoHint]
+        (CmmCallee newspark CCallConv)
+        [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+          , (CmmHinted arg AddrHint)  ]
+        (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
   where
@@ -148,15 +141,15 @@ emitPrimOp [res] SparkOp [arg] live = do
     res' <- newTemp bWord
     emitForeignCall' PlayRisky
         [CmmHinted res' NoHint]
-    	(CmmCallee newspark CCallConv) 
-	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
-          , (CmmHinted arg AddrHint)  ] 
-	(Just vols)
+        (CmmCallee newspark CCallConv)
+        [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+          , (CmmHinted arg AddrHint)  ]
+        (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
     stmtC (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
   where
-	newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
+        newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
 
 emitPrimOp [res] GetCCSOfOp [arg] _live
   = stmtC (CmmAssign (CmmLocal res) val)
@@ -172,15 +165,15 @@ emitPrimOp [res] ReadMutVarOp [mutv] _
 
 emitPrimOp [] WriteMutVarOp [mutv,var] live
    = do
-	stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
-	vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-		[{-no results-}]
-		(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
-			 CCallConv)
-		[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
+        stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
+        vols <- getVolatileRegs live
+        emitForeignCall' PlayRisky
+                [{-no results-}]
+                (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+                         CCallConv)
+                [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
                   , (CmmHinted mutv AddrHint)  ]
-		(Just vols)
+                (Just vols)
                 NoC_SRT -- No SRT b/c we do PlayRisky
                 CmmMayReturn
 
@@ -188,7 +181,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
 --     r = ((StgArrWords *)(a))->bytes
 emitPrimOp [res] SizeofByteArrayOp [arg] _
    = stmtC $
-	CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
+        CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
 
 --  #define sizzeofMutableByteArrayzh(r,a) \
 --      r = ((StgArrWords *)(a))->bytes
@@ -208,13 +201,13 @@ emitPrimOp [res] ByteArrayContents_Char [arg] _
 emitPrimOp [res] StableNameToIntOp [arg] _
    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
 
---  #define eqStableNamezh(r,sn1,sn2)					\
+--  #define eqStableNamezh(r,sn1,sn2)                                   \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp [res] EqStableNameOp [arg1,arg2] _
    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
-				cmmLoadIndexW arg1 fixedHdrSize bWord,
-				cmmLoadIndexW arg2 fixedHdrSize bWord
-			 ]))
+                                cmmLoadIndexW arg1 fixedHdrSize bWord,
+                                cmmLoadIndexW arg2 fixedHdrSize bWord
+                         ]))
 
 
 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
@@ -232,13 +225,13 @@ emitPrimOp [res] DataToTagOp [arg] _
 {- Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
    objects, even if they are in old space.  When they become immutable,
-   they can be removed from this scavenge list.	 -}
+   they can be removed from this scavenge list.  -}
 
 --  #define unsafeFreezzeArrayzh(r,a)
---	{
+--      {
 --        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
---	  r = a;
---	}
+--        r = a;
+--      }
 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
        CmmAssign (CmmLocal res) arg ]
@@ -246,7 +239,7 @@ emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg] _
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
        CmmAssign (CmmLocal res) arg ]
 
---  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
+--  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
    = stmtC (CmmAssign (CmmLocal res) arg)
 
@@ -286,7 +279,7 @@ emitPrimOp []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] _  = doWritePtrArr
 emitPrimOp []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] _  = doWritePtrArrayOp obj ix v
 
 emitPrimOp [res] SizeofArrayOp [arg] _
-   = stmtC $ 
+   = stmtC $
        CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
 emitPrimOp [res] SizeofMutableArrayOp [arg] live
    = emitPrimOp [res] SizeofArrayOp [arg] live
@@ -430,16 +423,16 @@ emitPrimOp [res] op [arg] _
 
    | Just (mop,rep) <- narrowOp op
    = stmtC (CmmAssign (CmmLocal res) $
-	    CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
+            CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
 
 emitPrimOp [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-	   [CmmHinted res NoHint] 
-	   (CmmPrim prim) 
-	   [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
-	   (Just vols)
+        emitForeignCall' PlayRisky
+           [CmmHinted res NoHint]
+           (CmmPrim prim)
+           [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
+           (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
            CmmMayReturn
 
@@ -458,9 +451,9 @@ nopOp Int2WordOp     = True
 nopOp Word2IntOp     = True
 nopOp Int2AddrOp     = True
 nopOp Addr2IntOp     = True
-nopOp ChrOp	     = True  -- Int# and Char# are rep'd the same
-nopOp OrdOp	     = True
-nopOp _		     = False
+nopOp ChrOp          = True  -- Int# and Char# are rep'd the same
+nopOp OrdOp          = True
+nopOp _              = False
 
 -- These PrimOps turn into double casts
 
@@ -471,7 +464,7 @@ narrowOp Narrow32IntOp  = Just (MO_SS_Conv, W32)
 narrowOp Narrow8WordOp  = Just (MO_UU_Conv, W8)
 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
-narrowOp _ 		= Nothing
+narrowOp _              = Nothing
 
 -- Native word signless ops
 
@@ -494,10 +487,10 @@ translateOp AndOp          = Just mo_wordAnd
 translateOp OrOp           = Just mo_wordOr
 translateOp XorOp          = Just mo_wordXor
 translateOp NotOp          = Just mo_wordNot
-translateOp SllOp	   = Just mo_wordShl
-translateOp SrlOp	   = Just mo_wordUShr
+translateOp SllOp          = Just mo_wordShl
+translateOp SrlOp          = Just mo_wordUShr
 
-translateOp AddrRemOp	   = Just mo_wordURem
+translateOp AddrRemOp      = Just mo_wordURem
 
 -- Native word signed ops
 
@@ -513,9 +506,9 @@ translateOp IntLeOp        = Just mo_wordSLe
 translateOp IntGtOp        = Just mo_wordSGt
 translateOp IntLtOp        = Just mo_wordSLt
 
-translateOp ISllOp	   = Just mo_wordShl
-translateOp ISraOp	   = Just mo_wordSShr
-translateOp ISrlOp	   = Just mo_wordUShr
+translateOp ISllOp         = Just mo_wordShl
+translateOp ISraOp         = Just mo_wordSShr
+translateOp ISrlOp         = Just mo_wordUShr
 
 -- Native word unsigned ops
 
@@ -633,9 +626,9 @@ callishOp _ = Nothing
 -- Helpers for translating various minor variants of array indexing.
 
 -- Bytearrays outside the heap; hence non-pointers
-doIndexOffAddrOp, doIndexByteArrayOp 
-	:: Maybe MachOp -> CmmType 
-	-> [LocalReg] -> [CmmExpr] -> Code
+doIndexOffAddrOp, doIndexByteArrayOp
+        :: Maybe MachOp -> CmmType
+        -> [LocalReg] -> [CmmExpr] -> Code
 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
    = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
 doIndexOffAddrOp _ _ _ _
@@ -643,7 +636,7 @@ doIndexOffAddrOp _ _ _ _
 
 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
    = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
-doIndexByteArrayOp _ _ _ _ 
+doIndexByteArrayOp _ _ _ _
    = panic "CgPrimOp: doIndexByteArrayOp"
 
 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
@@ -651,9 +644,9 @@ doReadPtrArrayOp res addr idx
    = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
 
 
-doWriteOffAddrOp, doWriteByteArrayOp 
-	:: Maybe MachOp -> CmmType 
-	-> [LocalReg] -> [CmmExpr] -> Code
+doWriteOffAddrOp, doWriteByteArrayOp
+        :: Maybe MachOp -> CmmType
+        -> [LocalReg] -> [CmmExpr] -> Code
 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
    = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
 doWriteOffAddrOp _ _ _ _
@@ -661,7 +654,7 @@ doWriteOffAddrOp _ _ _ _
 
 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
    = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
-doWriteByteArrayOp _ _ _ _ 
+doWriteByteArrayOp _ _ _ _
    = panic "CgPrimOp: doWriteByteArrayOp"
 
 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
@@ -682,16 +675,16 @@ loadArrPtrsSize :: CmmExpr -> CmmExpr
 loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
  where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
 
-mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType 
-		   -> LocalReg -> CmmExpr -> CmmExpr -> Code
+mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
+                   -> LocalReg -> CmmExpr -> CmmExpr -> Code
 mkBasicIndexedRead off Nothing read_rep res base idx
    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
 mkBasicIndexedRead off (Just cast) read_rep res base idx
    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
-				cmmLoadIndexOffExpr off read_rep base idx]))
+                                cmmLoadIndexOffExpr off read_rep base idx]))
 
-mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType 
-		    -> CmmExpr -> CmmExpr -> CmmExpr -> Code
+mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
+                    -> CmmExpr -> CmmExpr -> CmmExpr -> Code
 mkBasicIndexedWrite off Nothing write_rep base idx val
    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
 mkBasicIndexedWrite off (Just cast) write_rep base idx val
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index fb8f854c0b..07be7f23fa 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -123,7 +123,7 @@ performTailCall fun_info arg_amodes pending_assts
 	    EnterIt -> do
 		{ emitSimultaneously (node_asst `plusStmts` pending_assts) 
 		; let target     = entryCode (closureInfoPtr (CmmReg nodeReg))
-                      enterClosure = stmtC (CmmJump target [])
+                      enterClosure = stmtC (CmmJump target)
                       -- If this is a scrutinee
                       -- let's check if the closure is a constructor
                       -- so we can directly jump to the alternatives switch
@@ -203,7 +203,7 @@ performTailCall fun_info arg_amodes pending_assts
                    -- No, enter the closure.
                    ; enterClosure
                    ; labelC is_constr
-                   ; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl)) [])
+                   ; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl)))
                    }
 {-
               -- This is a scrutinee for a case expression
@@ -218,7 +218,7 @@ performTailCall fun_info arg_amodes pending_assts
                    ; stmtC (CmmCondBranch (cond1 tag) no_cons)
                    ; stmtC (CmmCondBranch (cond2 tag) no_cons)
                    -- Yes, jump to switch statement
-                   ; stmtC (CmmJump (CmmLit (CmmLabel lbl)) [])
+                   ; stmtC (CmmJump (CmmLit (CmmLabel lbl)))
                    ; labelC no_cons
                    -- No, enter the closure.
                    ; enterClosure
@@ -438,9 +438,9 @@ pushReturnAddress _ = nopC
 -- -----------------------------------------------------------------------------
 -- Misc.
 
-jumpToLbl :: CLabel -> Code
 -- Passes no argument to the destination procedure
-jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [{- No args -}])
+jumpToLbl :: CLabel -> Code
+jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)))
 
 assignToRegs :: [(CmmExpr, GlobalReg)] -> CmmStmts
 assignToRegs reg_args 
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 5274a176a0..2a524a182c 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -1020,7 +1020,7 @@ fixStgRegStmt stmt
 
         CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr expr) ids
 
-        CmmJump addr regs -> CmmJump (fixStgRegExpr addr) regs
+        CmmJump addr -> CmmJump (fixStgRegExpr addr)
 
         -- CmmNop, CmmComment, CmmBranch, CmmReturn
         _other -> stmt
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 682d76096b..2cd0cf6434 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -43,7 +43,7 @@ module ClosureInfo (
         closureFunInfo, isKnownFun,
         funTag, funTagLFInfo, tagForArity, clHasCafRefs,
 
-	enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
+        enterIdLabel, enterReturnPtLabel,
 
 	nodeMustPointToIt, 
 	CallMethod(..), getCallMethod,
@@ -963,7 +963,10 @@ infoTableLabelFromCI :: ClosureInfo -> CLabel
 infoTableLabelFromCI = fst . labelsFromCI
 
 entryLabelFromCI :: ClosureInfo -> CLabel
-entryLabelFromCI = snd . labelsFromCI
+entryLabelFromCI ci
+  | tablesNextToCode = info_lbl
+  | otherwise        = entry_lbl
+  where (info_lbl, entry_lbl) = labelsFromCI ci
 
 labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
 labelsFromCI cl@(ClosureInfo { closureName = name,
@@ -1032,11 +1035,6 @@ enterIdLabel id
   | tablesNextToCode = mkInfoTableLabel id
   | otherwise        = mkEntryLabel id
 
-enterLocalIdLabel :: Name -> CafInfo -> CLabel
-enterLocalIdLabel id
-  | tablesNextToCode = mkLocalInfoTableLabel id
-  | otherwise        = mkLocalEntryLabel id
-
 enterReturnPtLabel :: Unique -> CLabel
 enterReturnPtLabel name
   | tablesNextToCode = mkReturnInfoLabel name
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 7c739c61b6..af88ba848a 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -246,7 +246,7 @@ nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
 
 tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: ByteOff
 tso_stackobj = closureField oFFSET_StgTSO_stackobj
-tso_CCCS     = closureField oFFSET_StgTSO_CCCS
+tso_CCCS     = closureField oFFSET_StgTSO_cccs
 stack_STACK  = closureField oFFSET_StgStack_stack
 stack_SP     = closureField oFFSET_StgStack_sp
 
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 310a05e1a9..a41302d5d3 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -447,12 +447,12 @@ data CoreRule
 	ru_act  :: Activation,          -- ^ When the rule is active
 
 	-- Rough-matching stuff
-	-- see comments with InstEnv.Instance( is_cls, is_rough )
+	-- see comments with InstEnv.ClsInst( is_cls, is_rough )
 	ru_fn    :: Name,	        -- ^ Name of the 'Id.Id' at the head of this rule
 	ru_rough :: [Maybe Name],	-- ^ Name at the head of each argument to the left hand side
 	
 	-- Proper-matching stuff
-	-- see comments with InstEnv.Instance( is_tvs, is_tys )
+	-- see comments with InstEnv.ClsInst( is_tvs, is_tys )
 	ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
 	ru_args  :: [CoreExpr],         -- ^ Left hand side arguments
 	
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 30d4af9804..cce8ba78c7 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -138,7 +138,7 @@ dsCImport :: Id
           -> DsM ([Binding], SDoc, SDoc)
 dsCImport id co (CLabel cid) cconv _ _ = do
    let ty = pFst $ coercionKind co
-       fod = case tyConAppTyCon_maybe ty of
+       fod = case tyConAppTyCon_maybe (dropForAlls ty) of
              Just tycon
               | tyConUnique tycon == funPtrTyConKey ->
                  IsFunction
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index f521ee6b06..f140c8fb09 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -72,7 +72,7 @@ import Data.Array.Base
 import Data.Ix
 import Data.List
 import qualified Data.Sequence as Seq
-import Data.Monoid
+import Data.Monoid (mappend)
 import Data.Sequence (viewl, ViewL(..))
 import Foreign.Safe
 import System.IO.Unsafe
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 772a3ebee7..f8e6bc0e9d 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -1096,7 +1096,7 @@ data VectDecl name
   | HsVectInstIn                -- pre type-checking (always SCALAR)
       (LHsType name)
   | HsVectInstOut               -- post type-checking (always SCALAR)
-      Instance
+      ClsInst
   deriving (Data, Typeable)
 
 lvectDeclName :: NamedThing name => LVectDecl name -> Name
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 15434f0473..5cb7cd1e4d 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1408,13 +1408,12 @@ instance Binary IfaceDecl where
         put_ bh a6
         put_ bh a7
 
-    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
+    put_ bh (IfaceSyn a1 a2 a3 a4) = do
         putByte bh 3
         put_ bh (occNameFS a1)
         put_ bh a2
         put_ bh a3
         put_ bh a4
-        put_ bh a5
 
     put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
         putByte bh 4
@@ -1425,6 +1424,13 @@ instance Binary IfaceDecl where
         put_ bh a5
         put_ bh a6
         put_ bh a7
+        
+    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
+        putByte bh 5
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
 
     get bh = do
         h <- getByte bh
@@ -1449,10 +1455,9 @@ instance Binary IfaceDecl where
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
-                    a5 <- get bh
                     occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceSyn occ a2 a3 a4 a5)
-            _ -> do a1 <- get bh
+                    return (IfaceSyn occ a2 a3 a4)
+            4 -> do a1 <- get bh
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
@@ -1461,9 +1466,15 @@ instance Binary IfaceDecl where
                     a7 <- get bh
                     occ <- return $! mkOccNameFS clsName a2
                     return (IfaceClass a1 occ a3 a4 a5 a6 a7)
+            _ -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    occ <- return $! mkOccNameFS tcName a1
+                    return (IfaceAxiom occ a2 a3 a4)
 
-instance Binary IfaceInst where
-    put_ bh (IfaceInst cls tys dfun flag orph) = do
+instance Binary IfaceClsInst where
+    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
         put_ bh cls
         put_ bh tys
         put_ bh dfun
@@ -1475,18 +1486,20 @@ instance Binary IfaceInst where
         dfun <- get bh
         flag <- get bh
         orph <- get bh
-        return (IfaceInst cls tys dfun flag orph)
+        return (IfaceClsInst cls tys dfun flag orph)
 
 instance Binary IfaceFamInst where
-    put_ bh (IfaceFamInst fam tys tycon) = do
+    put_ bh (IfaceFamInst fam tys name orph) = do
         put_ bh fam
         put_ bh tys
-        put_ bh tycon
+        put_ bh name
+        put_ bh orph
     get bh = do
-        fam   <- get bh
-        tys   <- get bh
-        tycon <- get bh
-        return (IfaceFamInst fam tys tycon)
+        fam      <- get bh
+        tys      <- get bh
+        name     <- get bh
+        orph     <- get bh
+        return (IfaceFamInst fam tys name orph)
 
 instance Binary OverlapFlag where
     put_ bh (NoOverlap  b) = putByte bh 0 >> put_ bh b
@@ -1503,14 +1516,14 @@ instance Binary OverlapFlag where
 
 instance Binary IfaceConDecls where
     put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
-    put_ bh IfOpenDataTyCon     = putByte bh 1
+    put_ bh IfDataFamTyCon     = putByte bh 1
     put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
     put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
     get bh = do
         h <- getByte bh
         case h of
             0 -> get bh >>= (return . IfAbstractTyCon)
-            1 -> return IfOpenDataTyCon
+            1 -> return IfDataFamTyCon
             2 -> get bh >>= (return . IfDataTyCon)
             _ -> get bh >>= (return . IfNewTyCon)
 
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 612b098c2f..1ffabb4f73 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -12,13 +12,13 @@
 -- for details
 
 module BuildTyCl (
-	buildSynTyCon, 
+        buildSynTyCon,
         buildAlgTyCon, 
         buildDataCon,
         buildPromotedDataTyCon,
         TcMethInfo, buildClass,
-	distinctAbstractTyConRhs, totallyAbstractTyConRhs,
-	mkNewTyConRhs, mkDataTyConRhs, 
+        distinctAbstractTyConRhs, totallyAbstractTyConRhs,
+        mkNewTyConRhs, mkDataTyConRhs, 
         newImplicitBinder
     ) where
 
@@ -49,69 +49,28 @@ import Unique           ( getUnique )
 ------------------------------------------------------
 buildSynTyCon :: Name -> [TyVar] 
               -> SynTyConRhs
-	      -> Kind			-- ^ Kind of the RHS
-	      -> TyConParent
-	      -> Maybe (TyCon, [Type])    -- ^ family instance if applicable
+              -> Kind                   -- ^ Kind of the RHS
+              -> TyConParent
               -> TcRnIf m n TyCon
-buildSynTyCon tc_name tvs rhs rhs_kind parent mb_family 
-  | Just fam_inst_info <- mb_family
-  = ASSERT( isNoParent parent )
-    fixM $ \ tycon_rec -> do 
-    { fam_parent <- mkFamInstParentInfo tc_name tvs fam_inst_info tycon_rec 
-    ; return (mkSynTyCon tc_name kind tvs rhs fam_parent) }
-
-  | otherwise
+buildSynTyCon tc_name tvs rhs rhs_kind parent 
   = return (mkSynTyCon tc_name kind tvs rhs parent)
   where kind = mkPiKinds tvs rhs_kind
 
 ------------------------------------------------------
-buildAlgTyCon :: Name -> [TyVar]        -- ^ Kind variables adn type variables
-	      -> ThetaType		-- ^ Stupid theta
+buildAlgTyCon :: Name 
+              -> [TyVar]               -- ^ Kind variables and type variables
+	      -> ThetaType	       -- ^ Stupid theta
 	      -> AlgTyConRhs
 	      -> RecFlag
-	      -> Bool			-- ^ True <=> was declared in GADT syntax
+	      -> Bool		       -- ^ True <=> was declared in GADT syntax
               -> TyConParent
-	      -> Maybe (TyCon, [Type])  -- ^ family instance if applicable
-	      -> TcRnIf m n TyCon
-
-buildAlgTyCon tc_name ktvs stupid_theta rhs is_rec gadt_syn
-	      parent mb_family
-  | Just fam_inst_info <- mb_family
-  = -- We need to tie a knot as the coercion of a data instance depends
-     -- on the instance representation tycon and vice versa.
-    ASSERT( isNoParent parent )
-    fixM $ \ tycon_rec -> do 
-    { fam_parent <- mkFamInstParentInfo tc_name ktvs fam_inst_info tycon_rec
-    ; return (mkAlgTyCon tc_name kind ktvs stupid_theta rhs
-		         fam_parent is_rec gadt_syn) }
-
-  | otherwise
-  = return (mkAlgTyCon tc_name kind ktvs stupid_theta rhs
-	               parent is_rec gadt_syn)
-  where kind = mkPiKinds ktvs liftedTypeKind
-
--- | If a family tycon with instance types is given, the current tycon is an
--- instance of that family and we need to
---
--- (1) create a coercion that identifies the family instance type and the
---     representation type from Step (1); ie, it is of the form 
---	   `Co tvs :: F ts ~ R tvs', where `Co' is the name of the coercion,
---	   `F' the family tycon and `R' the (derived) representation tycon,
---	   and
--- (2) produce a `TyConParent' value containing the parent and coercion
---     information.
---
-mkFamInstParentInfo :: Name -> [TyVar] 
-             	    -> (TyCon, [Type]) 
-             	    -> TyCon 
-             	    -> TcRnIf m n TyConParent
-mkFamInstParentInfo tc_name tvs (family, instTys) rep_tycon
-  = do { -- Create the coercion
-       ; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
-       ; let co_tycon = mkFamInstCo co_tycon_name tvs
-                                    family instTys rep_tycon
-       ; return $ FamInstTyCon family instTys co_tycon }
-    
+	      -> TyCon
+
+buildAlgTyCon tc_name ktvs stupid_theta rhs is_rec gadt_syn parent
+  = mkAlgTyCon tc_name kind ktvs stupid_theta rhs parent is_rec gadt_syn
+  where 
+    kind = mkPiKinds ktvs liftedTypeKind
+
 ------------------------------------------------------
 distinctAbstractTyConRhs, totallyAbstractTyConRhs :: AlgTyConRhs
 distinctAbstractTyConRhs = AbstractTyCon True
diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index 611228e567..5e4a7092bf 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -41,7 +41,9 @@ fingerprintDynFlags DynFlags{..} nameio =
         -- -i, -osuf, -hcsuf, -hisuf, -odir, -hidir, -stubdir, -o, -ohi
         paths = (map normalise importPaths,
                    [ objectSuf, hcSuf, hiSuf ],
-                   [ objectDir, hiDir, stubDir, outputFile, outputHi ])
+                   [ objectDir, hiDir, stubDir, outputHi ])
+                   -- NB. not outputFile, we don't want "ghc --make M -o <file>"
+                   -- to force recompilation when <file> changes.
 
         -- -fprof-auto etc.
         prof = if opt_SccProfilingOn then fromEnum profAuto else 0
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 541f041589..f01c3b63b3 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -20,13 +20,13 @@ module IfaceSyn (
         IfaceBinding(..), IfaceConAlt(..),
         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
-        IfaceInst(..), IfaceFamInst(..), IfaceTickish(..),
+        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
 
         -- Misc
-        ifaceDeclSubBndrs, visibleIfConDecls,
+        ifaceDeclImplicitBndrs, visibleIfConDecls,
 
         -- Free Names
-        freeNamesIfDecl, freeNamesIfRule,
+        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
 
         -- Pretty printing
         pprIfaceExpr, pprIfaceDeclHead
@@ -70,26 +70,19 @@ data IfaceDecl
   | IfaceData { ifName       :: OccName,        -- Type constructor
                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
-                ifCons       :: IfaceConDecls,  -- Includes new/data info
+                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
                 ifRec        :: RecFlag,        -- Recursive or not?
                 ifGadtSyntax :: Bool,           -- True <=> declared using
                                                 -- GADT syntax
-                ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
-                                                -- Just <=> instance of family
-                                                -- Invariant:
-                                                --   ifCons /= IfOpenDataTyCon
-                                                --   for family instances
+                ifAxiom      :: Maybe IfExtName -- The axiom, for a newtype, 
+                                                -- or data/newtype family instance
     }
 
   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
-                ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
-                                                -- Nothing for an open family
-                ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-                                                -- Just <=> instance of family
-                                                -- Invariant: ifOpenSyn == False
-                                                --   for family instances
+                ifSynRhs  :: Maybe IfaceType    -- Just rhs for an ordinary synonyn
+                                                -- Nothing for an type family declaration
     }
 
   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
@@ -102,6 +95,11 @@ data IfaceDecl
                                                 --   with the class recursive?
     }
 
+  | IfaceAxiom { ifName   :: OccName       -- Axiom name
+               , ifTyVars :: [IfaceTvBndr] -- Axiom tyvars
+               , ifLHS    :: IfaceType     -- Axiom LHS
+               , ifRHS    :: IfaceType }   -- and RHS
+
   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
                                                 -- beyond .NET
                    ifExtName :: Maybe FastString }
@@ -123,13 +121,13 @@ data IfaceATDefault = IfaceATD [IfaceTvBndr] [IfaceType] IfaceType
 
 data IfaceConDecls
   = IfAbstractTyCon Bool        -- c.f TyCon.AbstractTyCon
-  | IfOpenDataTyCon             -- Open data family
-  | IfDataTyCon [IfaceConDecl]  -- data type decls
-  | IfNewTyCon  IfaceConDecl    -- newtype decls
+  | IfDataFamTyCon              -- Data family
+  | IfDataTyCon [IfaceConDecl]  -- Data type decls
+  | IfNewTyCon  IfaceConDecl    -- Newtype decls
 
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls (IfAbstractTyCon {}) = []
-visibleIfConDecls IfOpenDataTyCon      = []
+visibleIfConDecls IfDataFamTyCon      = []
 visibleIfConDecls (IfDataTyCon cs)     = cs
 visibleIfConDecls (IfNewTyCon c)       = [c]
 
@@ -147,12 +145,12 @@ data IfaceConDecl
         ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
                                                 -- or 1-1 corresp with arg tys
 
-data IfaceInst
-  = IfaceInst { ifInstCls  :: IfExtName,                -- See comments with
-                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
-                ifDFun     :: IfExtName,                -- The dfun
-                ifOFlag    :: OverlapFlag,              -- Overlap flag
-                ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
+data IfaceClsInst
+  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
+                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
+                   ifDFun     :: IfExtName,                -- The dfun
+                   ifOFlag    :: OverlapFlag,              -- Overlap flag
+                   ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
         -- There's always a separate IfaceDecl for the DFun, which gives
         -- its IdInfo with its full type and version number.
         -- The instance declarations taken together have a version number,
@@ -161,9 +159,10 @@ data IfaceInst
         -- and if the head does not change it won't be used if it wasn't before
 
 data IfaceFamInst
-  = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
+  = IfaceFamInst { ifFamInstFam   :: IfExtName           -- Family name
                  , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
-                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
+                 , ifFamInstAxiom :: IfExtName           -- The axiom
+                 , ifFamInstOrph  :: Maybe OccName       -- Just like IfaceClsInst
                  }
 
 data IfaceRule
@@ -175,7 +174,7 @@ data IfaceRule
         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
         ifRuleRhs    :: IfaceExpr,
         ifRuleAuto   :: Bool,
-        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
+        ifRuleOrph   :: Maybe OccName   -- Just like IfaceClsInst
     }
 
 data IfaceAnnotation
@@ -375,38 +374,34 @@ See [http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationA
 -- -----------------------------------------------------------------------------
 -- Utils on IfaceSyn
 
-ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
+ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 -- Deeply revolting, because it has to predict what gets bound,
 -- especially the question of whether there's a wrapper for a datacon
+-- See Note [Implicit TyThings] in HscTypes
 
 -- N.B. the set of names returned here *must* match the set of
 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
 -- TyThing.getOccName should define a bijection between the two lists.
 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 -- The order of the list does not matter.
-ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon {}}  = []
+ifaceDeclImplicitBndrs IfaceData {ifCons = IfAbstractTyCon {}}  = []
 
 -- Newtype
-ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
+ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ,
                               ifCons = IfNewTyCon (
-                                        IfCon { ifConOcc = con_occ }),
-                              ifFamInst = famInst})
-  =   -- implicit coerion and (possibly) family instance coercion
-    (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
+                                        IfCon { ifConOcc = con_occ })})
+  =   -- implicit newtype coercion
+    (mkNewTyCoOcc tc_occ) : -- JPM: newtype coercions shouldn't be implicit
       -- data constructor and worker (newtypes don't have a wrapper)
     [con_occ, mkDataConWorkerOcc con_occ]
 
 
-ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
-                              ifCons = IfDataTyCon cons,
-                              ifFamInst = famInst})
-  =   -- (possibly) family instance coercion;
-      -- there is no implicit coercion for non-newtypes
-    famInstCo famInst tc_occ
-      -- for each data constructor in order,
-      --    data constructor, worker, and (possibly) wrapper
-    ++ concatMap dc_occs cons
+ifaceDeclImplicitBndrs (IfaceData {ifName = _tc_occ,
+                              ifCons = IfDataTyCon cons })
+  = -- for each data constructor in order,
+    --    data constructor, worker, and (possibly) wrapper
+    concatMap dc_occs cons
   where
     dc_occs con_decl
         | has_wrapper = [con_occ, work_occ, wrap_occ]
@@ -418,7 +413,7 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
           has_wrapper = ifConWrapper con_decl     -- This is the reason for
                                                   -- having the ifConWrapper field!
 
-ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
+ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
                                ifSigs = sigs, ifATs = ats })
   = --   (possibly) newtype coercion
     co_occs ++
@@ -441,16 +436,7 @@ ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
     dc_occ = mkClassDataConOcc cls_tc_occ
     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 
-ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
-                             ifFamInst = famInst})
-  = famInstCo famInst tc_occ
-
-ifaceDeclSubBndrs _ = []
-
--- coercion for data/newtype family instances
-famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
-famInstCo Nothing  _       = []
-famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
+ifaceDeclImplicitBndrs _ = []
 
 ----------------------------- Printing IfaceDecl ------------------------------
 
@@ -468,10 +454,9 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
-                        ifSynRhs = Just mono_ty,
-                        ifFamInst = mbFamInst})
+                        ifSynRhs = Just mono_ty})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
+       4 (vcat [equals <+> ppr mono_ty])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
                         ifSynRhs = Nothing, ifSynKind = kind })
@@ -480,14 +465,14 @@ pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 
 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
                          ifTyVars = tyvars, ifCons = condecls,
-                         ifRec = isrec, ifFamInst = mbFamInst})
+                         ifRec = isrec, ifAxiom = mbAxiom})
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
        4 (vcat [pprRec isrec, pp_condecls tycon condecls,
-                pprFamily mbFamInst])
+                pprAxiom mbAxiom])
   where
     pp_nd = case condecls of
                 IfAbstractTyCon dis -> ptext (sLit "abstract") <> parens (ppr dis)
-                IfOpenDataTyCon     -> ptext (sLit "data family")
+                IfDataFamTyCon     -> ptext (sLit "data family")
                 IfDataTyCon _       -> ptext (sLit "data")
                 IfNewTyCon _        -> ptext (sLit "newtype")
 
@@ -499,12 +484,17 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
                 sep (map ppr ats),
                 sep (map ppr sigs)])
 
+pprIfaceDecl (IfaceAxiom {ifName = name, ifTyVars = tyvars,
+                          ifLHS = lhs, ifRHS = rhs})
+  = hang (ptext (sLit "axiom") <+> ppr name <+> ppr tyvars)
+       2 (dcolon <+> ppr lhs <+> text "~#" <+> ppr rhs)
+
 pprRec :: RecFlag -> SDoc
 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 
-pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
-pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
-pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
+pprAxiom :: Maybe Name -> SDoc
+pprAxiom Nothing   = ptext (sLit "FamilyInstance: none")
+pprAxiom (Just ax) = ptext (sLit "FamilyInstance:") <+> ppr ax
 
 instance Outputable IfaceClassOp where
    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
@@ -522,7 +512,7 @@ pprIfaceDeclHead context thing tyvars
 
 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 pp_condecls _  (IfAbstractTyCon {}) = empty
-pp_condecls _  IfOpenDataTyCon      = 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))
@@ -571,8 +561,8 @@ instance Outputable IfaceRule where
                         ptext (sLit "=") <+> ppr rhs])
       ]
 
-instance Outputable IfaceInst where
-  ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
+instance Outputable IfaceClsInst where
+  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))
@@ -580,10 +570,10 @@ instance Outputable IfaceInst where
 
 instance Outputable IfaceFamInst where
   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
-                     ifFamInstTyCon = tycon_id})
+                     ifFamInstAxiom = tycon_ax})
     = hang (ptext (sLit "family instance") <+>
             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
-         2 (equals <+> ppr tycon_id)
+         2 (equals <+> ppr tycon_ax)
 
 ppr_rough :: Maybe IfaceTyCon -> SDoc
 ppr_rough Nothing   = dot
@@ -741,13 +731,12 @@ freeNamesIfDecl IfaceForeign{} =
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
-  freeNamesIfTcFam (ifFamInst d) &&&
+  maybe emptyNameSet unitNameSet (ifAxiom d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfSynRhs (ifSynRhs d) &&&
-  freeNamesIfTcFam (ifFamInst d) &&&
   freeNamesIfKind (ifSynKind d) -- IA0_NOTE: because of promotion, we
                                 -- return names in the kind signature
 freeNamesIfDecl d@IfaceClass{} =
@@ -755,6 +744,10 @@ freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfContext (ifCtxt d) &&&
   fnList freeNamesIfAT     (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
+freeNamesIfDecl d@IfaceAxiom{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfType (ifLHS d) &&&
+  freeNamesIfType (ifRHS d)
 
 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
@@ -765,12 +758,6 @@ freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 freeNamesIfSynRhs Nothing   = emptyNameSet
 
-freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
-freeNamesIfTcFam (Just (tc,tys)) =
-  freeNamesIfTc tc &&& fnList freeNamesIfType tys
-freeNamesIfTcFam Nothing =
-  emptyNameSet
-
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
 
@@ -903,6 +890,12 @@ 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
 
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 7df2f49778..ec1205f83d 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -236,7 +236,7 @@ loadInterface doc_str mod from
         --
         -- The main thing is to add the ModIface to the PIT, but
         -- we also take the
-        --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
+        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo
         -- out of the ModIface and put them into the big EPS pools
 
         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
@@ -372,7 +372,7 @@ loadDecl ignore_prags mod (_version, decl)
                 -- the names associated with the decl
           main_name      <- lookupOrig mod (ifName decl)
 --        ; traceIf (text "Loading decl for " <> ppr main_name)
-        ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl)
+        ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
 
         -- Typecheck the thing, lazily
         -- NB. Firstly, the laziness is there in case we never need the
@@ -402,7 +402,7 @@ loadDecl ignore_prags mod (_version, decl)
         -- (where the "MkT" is the *Name* associated with MkT, etc.)
         --
         -- We do this by mapping the implict_names to the associated
-        -- TyThings.  By the invariant on ifaceDeclSubBndrs and
+        -- 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
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 2125181e6d..4e8c96b962 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -68,6 +68,7 @@ import CoreFVs
 import Class
 import Kind
 import TyCon
+import Coercion         ( coAxiomSplitLHS )
 import DataCon
 import Type
 import TcType
@@ -261,8 +262,9 @@ mkIface_ hsc_env maybe_old_fingerprint
                 ; iface_insts = map instanceToIfaceInst insts
                 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
                 ; iface_vect_info = flattenVectInfo vect_info
-                -- Check if we are in Safe Inference mode but we failed to pass
-                -- the muster
+
+                -- Check if we are in Safe Inference mode 
+                -- but we failed to pass the muster
                 ; safeMode    = if safeInferOn dflags && not safeInf
                                     then Sf_None
                                     else safeHaskell dflags
@@ -361,7 +363,7 @@ mkIface_ hsc_env maybe_old_fingerprint
      deliberatelyOmitted :: String -> a
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 
-     ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
+     ifFamInstTcName = ifFamInstFam
 
      flattenVectInfo (VectInfo { vectInfoVar          = vVar
                                , vectInfoTyCon        = vTyCon
@@ -430,7 +432,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
         -- see IfaceDeclABI below.
        declABI :: IfaceDecl -> IfaceDeclABI 
        declABI decl = (this_mod, decl, extras)
-        where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
+        where extras = declExtras fix_fn non_orph_rules non_orph_insts
+                                  non_orph_fis decl
 
        edges :: [(IfaceDeclABI, Unique, [Unique])]
        edges = [ (abi, getUnique (ifName decl), out)
@@ -451,7 +454,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
        parent_map :: OccEnv OccName
        parent_map = foldr extend emptyOccEnv new_decls
           where extend d env = 
-                  extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
+                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
                   where n = ifName d
 
         -- strongly-connected groups of declarations, in dependency order
@@ -473,8 +476,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
           | otherwise
           = ASSERT2( isExternalName name, ppr name )
             let hash | nameModule name /= this_mod =  global_hash_fn name
-                     | otherwise = 
-                        snd (lookupOccEnv local_env (getOccName name)
+                     | otherwise = snd (lookupOccEnv local_env (getOccName name)
                            `orElse` pprPanic "urk! lookup local fingerprint" 
                                        (ppr name)) -- (undefined,fingerprint0))
                 -- This panic indicates that we got the dependency
@@ -484,8 +486,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                 -- pprTraces below, run the compile again, and inspect
                 -- the output and the generated .hi file with
                 -- --show-iface.
-            in 
-            put_ bh hash
+            in put_ bh hash
 
         -- take a strongly-connected group of declarations and compute
         -- its fingerprint.
@@ -530,7 +531,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                        -> IO (OccEnv (OccName,Fingerprint))
        extend_hash_env env0 (hash,d) = do
           let
-            sub_bndrs = ifaceDeclSubBndrs d
+            sub_bndrs = ifaceDeclImplicitBndrs d
             fp_sub_bndr occ = computeFingerprint putNameLiterally (hash,occ)
           --
           sub_fps <- mapM fp_sub_bndr sub_bndrs
@@ -561,7 +562,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 
    orphan_hash <- computeFingerprint (mk_put_name local_env)
-                      (map ifDFun orph_insts, orph_rules, fam_insts)
+                      (map ifDFun orph_insts, orph_rules, orph_fis)
 
    -- the export list hash doesn't depend on the fingerprints of
    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
@@ -619,7 +620,9 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                 mi_exp_hash    = export_hash,
                 mi_orphan_hash = orphan_hash,
                 mi_flag_hash   = flag_hash,
-                mi_orphan      = not (null orph_rules && null orph_insts
+                mi_orphan      = not (   null orph_rules
+                                      && null orph_insts
+                                      && null orph_fis
                                       && null (ifaceVectInfoVar (mi_vect_info iface0))),
                 mi_finsts      = not . null $ mi_fam_insts iface0,
                 mi_decls       = sorted_decls,
@@ -631,12 +634,9 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
     this_mod = mi_module iface0
     dflags = hsc_dflags hsc_env
     this_pkg = thisPackage dflags
-    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
-    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
-        -- See Note [Orphans] in IfaceSyn
-        -- ToDo: shouldn't we be splitting fam_insts into orphans and
-        -- non-orphans?
-    fam_insts = mi_fam_insts iface0
+    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph    (mi_insts iface0)
+    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)
+    (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
     fix_fn = mi_fix_fn iface0
 
 
@@ -700,7 +700,7 @@ data IfaceDeclExtras
 
   | IfaceDataExtras  
        Fixity                   -- Fixity of the tycon itself
-       [IfaceInstABI]           -- Local instances of this tycon
+       [IfaceInstABI]           -- Local class and family instances of this tycon
                                 -- See Note [Orphans] in IfaceSyn
        [(Fixity,[IfaceRule])]   -- For each construcotr, fixity and RULES
 
@@ -711,10 +711,16 @@ data IfaceDeclExtras
                                 -- See Note [Orphans] in IfaceSyn
        [(Fixity,[IfaceRule])]   -- For each class method, fixity and RULES
 
-  | IfaceSynExtras   Fixity
+  | IfaceSynExtras   Fixity [IfaceInstABI]
 
   | IfaceOtherDeclExtras
 
+-- When hashing a class or family instance, we hash only the 
+-- DFunId or CoAxiom, because that depends on all the 
+-- information about the instance.
+--
+type IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance
+
 abiDecl :: IfaceDeclABI -> IfaceDecl
 abiDecl (_, decl, _) = decl
 
@@ -733,8 +739,8 @@ freeNamesDeclExtras (IfaceDataExtras  _ insts subs)
   = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
 freeNamesDeclExtras (IfaceClassExtras _ insts subs)
   = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
-freeNamesDeclExtras (IfaceSynExtras _)
-  = emptyNameSet
+freeNamesDeclExtras (IfaceSynExtras _ insts)
+  = mkNameSet insts
 freeNamesDeclExtras IfaceOtherDeclExtras
   = emptyNameSet
 
@@ -744,9 +750,9 @@ freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
 instance Outputable IfaceDeclExtras where
   ppr IfaceOtherDeclExtras       = empty
   ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
-  ppr (IfaceSynExtras fix)       = ppr fix
-  ppr (IfaceDataExtras fix insts stuff)  = vcat [ppr fix, ppr_insts insts,
-                                                 ppr_id_extras_s stuff]
+  ppr (IfaceSynExtras fix finsts) = vcat [ppr fix, ppr finsts]
+  ppr (IfaceDataExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
+                                                ppr_id_extras_s stuff]
   ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
                                                  ppr_id_extras_s stuff]
 
@@ -768,24 +774,26 @@ instance Binary IfaceDeclExtras where
    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
   put_ bh (IfaceClassExtras fix insts methods) = do
    putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
-  put_ bh (IfaceSynExtras fix) = do
-   putByte bh 4; put_ bh fix
+  put_ bh (IfaceSynExtras fix finsts) = do
+   putByte bh 4; put_ bh fix; put_ bh finsts
   put_ bh IfaceOtherDeclExtras = do
    putByte bh 5
 
 declExtras :: (OccName -> Fixity)
            -> OccEnv [IfaceRule]
-           -> OccEnv [IfaceInst]
+           -> OccEnv [IfaceClsInst]
+           -> OccEnv [IfaceFamInst]
            -> IfaceDecl
            -> IfaceDeclExtras
 
-declExtras fix_fn rule_env inst_env decl
+declExtras fix_fn rule_env inst_env fi_env decl
   = case decl of
       IfaceId{} -> IfaceIdExtras (fix_fn n) 
                         (lookupOccEnvL rule_env n)
       IfaceData{ifCons=cons} -> 
                      IfaceDataExtras (fix_fn n)
-                        (map ifDFun $ lookupOccEnvL inst_env n)
+                        (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
+                         map ifDFun         (lookupOccEnvL inst_env n))
                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
       IfaceClass{ifSigs=sigs, ifATs=ats} -> 
                      IfaceClassExtras (fix_fn n)
@@ -794,18 +802,14 @@ declExtras fix_fn rule_env inst_env decl
                            -- Include instances of the associated types
                            -- as well as instances of the class (Trac #5147)
                         [id_extras op | IfaceClassOp op _ _ <- sigs]
-      IfaceSyn{} -> IfaceSynExtras (fix_fn n)
+      IfaceSyn{} -> IfaceSynExtras (fix_fn n) 
+                        (map ifFamInstAxiom (lookupOccEnvL fi_env n))
       _other -> IfaceOtherDeclExtras
   where
         n = ifName decl
         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
         at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (ifName decl)
 
---
--- When hashing an instance, we hash only the DFunId, because that
--- depends on all the information about the instance.
---
-type IfaceInstABI = IfExtName
 
 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
@@ -837,7 +841,7 @@ oldMD5 dflags bh = do
         return $! readHexFingerprint hash_str
 -}
 
-instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
+instOrphWarn :: PrintUnqualified -> ClsInst -> WarnMsg
 instOrphWarn unqual inst
   = mkWarnMsg (getSrcSpan inst) unqual $
     hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
@@ -1419,9 +1423,7 @@ tyThingToIfaceDecl (ATyCon tycon)
   = IfaceSyn {  ifName    = getOccName tycon,
                 ifTyVars  = toIfaceTvBndrs tyvars,
                 ifSynRhs  = syn_rhs,
-                ifSynKind = syn_ki,
-                ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
-             }
+                ifSynKind = syn_ki }
 
   | isAlgTyCon tycon
   = IfaceData { ifName    = getOccName tycon,
@@ -1430,7 +1432,7 @@ tyThingToIfaceDecl (ATyCon tycon)
                 ifCons    = ifaceConDecls (algTyConRhs tycon),
                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
-                ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
+                ifAxiom   = fmap coAxiomName (tyConFamilyCoercion_maybe tycon) }
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1448,7 +1450,7 @@ tyThingToIfaceDecl (ATyCon tycon)
       IfNewTyCon  (ifaceConDecl con)
     ifaceConDecls (DataTyCon { data_cons = cons })  = 
       IfDataTyCon (map ifaceConDecl cons)
-    ifaceConDecls DataFamilyTyCon {}                = IfOpenDataTyCon
+    ifaceConDecls DataFamilyTyCon {}                = IfDataFamTyCon
     ifaceConDecls (AbstractTyCon distinct)          = IfAbstractTyCon distinct
         -- The last case happens when a TyCon has been trimmed during tidying
         -- Furthermore, tyThingToIfaceDecl is also used
@@ -1472,11 +1474,16 @@ tyThingToIfaceDecl (ATyCon tycon)
 
     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
 
-    famInstToIface Nothing                    = Nothing
-    famInstToIface (Just (famTyCon, instTys)) = 
-      Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
-
-tyThingToIfaceDecl c@(ACoAxiom _) = pprPanic "tyThingToIfaceDecl (ACoCon _)" (ppr c)
+tyThingToIfaceDecl (ACoAxiom ax)
+ = IfaceAxiom { ifName = name
+              , ifTyVars = tv_bndrs
+              , ifLHS = lhs
+              , ifRHS = rhs }
+ where
+   name = getOccName ax
+   tv_bndrs = toIfaceTvBndrs (coAxiomTyVars ax)
+   lhs = toIfaceType (coAxiomLHS ax)
+   rhs = toIfaceType (coAxiomRHS ax)
 
 tyThingToIfaceDecl (ADataCon dc)
  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
@@ -1527,11 +1534,11 @@ getFS :: NamedThing a => a -> FastString
 getFS x = occNameFS (getOccName x)
 
 --------------------------
-instanceToIfaceInst :: Instance -> IfaceInst
-instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
+instanceToIfaceInst :: ClsInst -> IfaceClsInst
+instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag,
                                 is_cls = cls_name, is_tcs = mb_tcs })
   = ASSERT( cls_name == className cls )
-    IfaceInst { ifDFun    = dfun_name,
+    IfaceClsInst { ifDFun    = dfun_name,
                 ifOFlag   = oflag,
                 ifInstCls = cls_name,
                 ifInstTys = map do_rough mb_tcs,
@@ -1569,16 +1576,34 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
 
 --------------------------
 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
-famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
-                                 fi_fam = fam,
-                                 fi_tcs = mb_tcs })
-  = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
-                 , ifFamInstFam    = fam
-                 , ifFamInstTys    = map do_rough mb_tcs }
+famInstToIfaceFamInst (FamInst { fi_axiom  = axiom,
+                                 fi_fam    = fam,
+                                 fi_tcs    = mb_tcs })
+  = IfaceFamInst { ifFamInstAxiom = coAxiomName axiom
+                 , ifFamInstFam   = fam
+                 , ifFamInstTys   = map do_rough mb_tcs
+                 , ifFamInstOrph  = orph }
   where
     do_rough Nothing  = Nothing
     do_rough (Just n) = Just (toIfaceTyCon_name n)
 
+    fam_decl = tyConName . fst $ coAxiomSplitLHS axiom
+    mod = ASSERT( isExternalName (coAxiomName axiom) )
+          nameModule (coAxiomName axiom)
+    is_local name = nameIsLocalOrFrom mod name
+
+    lhs_names = filterNameSet is_local (orphNamesOfType (coAxiomLHS axiom))
+
+    orph | is_local fam_decl
+         = Just (nameOccName fam_decl)
+
+         | not (isEmptyNameSet lhs_names)
+         = Just (nameOccName (head (nameSetToList lhs_names)))
+
+
+         | otherwise
+         = Nothing
+
 --------------------------
 toIfaceLetBndr :: Id -> IfaceLetBndr
 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e981995bd4..c04d7284c5 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -436,31 +436,41 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons, 
                           ifRec = is_rec, 
-                          ifFamInst = mb_family })
+                          ifAxiom = mb_axiom_name })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name <- lookupIfaceTop occ_name
-    ; tycon <- fixM ( \ tycon -> do
+    ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
+            ; parent' <- tc_parent tyvars mb_axiom_name
             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
-            ; mb_fam_inst  <- tcFamInst mb_family
-            ; buildAlgTyCon tc_name tyvars stupid_theta cons is_rec
-                            gadt_syn parent mb_fam_inst
-            })
+            ; return (buildAlgTyCon tc_name tyvars stupid_theta 
+                                    cons is_rec 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)
+      = ASSERT( isNoParent parent )
+        do { ax <- tcIfaceCoAxiom ax_name
+           ; let (fam_tc, fam_tys) = coAxiomSplitLHS ax
+                 subst = zipTopTvSubst (coAxiomTyVars ax) (mkTyVarTys tyvars)
+                            -- The subst matches the tyvar of the TyCon
+                            -- with those from the CoAxiom.  They aren't
+                            -- necessarily the same, since the two may be
+                            -- gotten from separate interface-file declarations
+           ; return (FamInstTyCon ax fam_tc (substTys subst fam_tys)) }
 
 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
                                   ifSynRhs = mb_rhs_ty,
-                                  ifSynKind = kind, ifFamInst = mb_family})
+                                  ifSynKind = kind })
    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
      { tc_name  <- lookupIfaceTop occ_name
      ; rhs_kind <- tcIfaceType kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $ 
                    tc_syn_rhs mb_rhs_ty
-     ; fam_info <- tcFamInst mb_family
-     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind parent fam_info
-     ; return (ATyCon tycon)
-     }
+     ; tycon    <- buildSynTyCon tc_name tyvars rhs rhs_kind parent
+     ; return (ATyCon tycon) }
    where
      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
      tc_syn_rhs Nothing   = return SynFamilyTyCon
@@ -493,14 +503,10 @@ tc_iface_decl _parent ignore_prags
           ; return (op_name, dm, op_ty) }
 
    tc_at cls (IfaceAT tc_decl defs_decls)
-     = do tc <- tc_iface_tc_decl (AssocFamilyTyCon cls) tc_decl
+     = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
           defs <- mapM tc_iface_at_def defs_decls
           return (tc, defs)
 
-   tc_iface_tc_decl parent decl = do
-       ATyCon tc <- tc_iface_decl parent ignore_prags decl
-       return tc
-
    tc_iface_at_def (IfaceATD tvs pat_tys ty) =
        bindIfaceTyVars_AT tvs $
          \tvs' -> liftM2 (\pats tys -> ATD tvs' pats tys noSrcSpan)
@@ -517,17 +523,25 @@ tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
         ; return (ATyCon (mkForeignTyCon name ext_name 
                                          liftedTypeKind 0)) }
 
-tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
-tcFamInst Nothing           = return Nothing
-tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
-                                 ; insttys <- mapM tcIfaceType tys
-                                 ; return $ Just (famTyCon, insttys) }
+tc_iface_decl _ _ (IfaceAxiom {ifName = tc_occ, ifTyVars = tv_bndrs,
+                               ifLHS = lhs, ifRHS = rhs })
+  = bindIfaceTyVars tv_bndrs $ \ tvs -> do
+    { tc_name <- lookupIfaceTop tc_occ
+    ; tc_lhs  <- tcIfaceType lhs
+    ; tc_rhs  <- tcIfaceType rhs
+    ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
+                          , co_ax_name     = tc_name
+                          , co_ax_implicit = False
+                          , co_ax_tvs      = tvs
+                          , co_ax_lhs      = tc_lhs
+                          , co_ax_rhs      = tc_rhs }
+    ; return (ACoAxiom axiom) }
 
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
 tcIfaceDataCons tycon_name tycon _ if_cons
   = case if_cons of
         IfAbstractTyCon dis -> return (AbstractTyCon dis)
-        IfOpenDataTyCon  -> return DataFamilyTyCon
+        IfDataFamTyCon  -> return DataFamilyTyCon
         IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
                                 ; return (mkDataTyConRhs data_cons) }
         IfNewTyCon con   -> do  { data_con <- tc_con_decl con
@@ -603,8 +617,8 @@ look at it.
 %************************************************************************
 
 \begin{code}
-tcIfaceInst :: IfaceInst -> IfL Instance
-tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
+tcIfaceInst :: IfaceClsInst -> IfL ClsInst
+tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag,
                               ifInstCls = cls, ifInstTys = mb_tcs })
   = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                      tcIfaceExtId dfun_occ
@@ -612,14 +626,12 @@ tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
 
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
-tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
-                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
---      { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
--- the above line doesn't work, but this below does => CPP in Haskell = evil!
-    = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
-                    tcIfaceTyCon tycon
+tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
+                             , ifFamInstAxiom = axiom_name } )
+    = do axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
+                   tcIfaceCoAxiom axiom_name
          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
-         return (mkImportedFamInst fam mb_tcs' tycon')
+         return (mkImportedFamInst fam mb_tcs' axiom')
 \end{code}
 
 
diff --git a/compiler/iface/TcIface.lhs-boot b/compiler/iface/TcIface.lhs-boot
index a9684a6a91..591419a251 100644
--- a/compiler/iface/TcIface.lhs-boot
+++ b/compiler/iface/TcIface.lhs-boot
@@ -1,10 +1,10 @@
 \begin{code}
 module TcIface where
 
-import IfaceSyn    ( IfaceDecl, IfaceInst, IfaceFamInst, IfaceRule, IfaceAnnotation )
+import IfaceSyn    ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule, IfaceAnnotation )
 import TypeRep     ( TyThing )
 import TcRnTypes   ( IfL )
-import InstEnv     ( Instance )
+import InstEnv     ( ClsInst )
 import FamInstEnv  ( FamInst )
 import CoreSyn     ( CoreRule )
 import HscTypes    ( TypeEnv, VectInfo, IfaceVectInfo )
@@ -14,7 +14,7 @@ import Annotations ( Annotation )
 tcIfaceDecl        :: Bool -> IfaceDecl -> IfL TyThing
 tcIfaceRules       :: Bool -> [IfaceRule] -> IfL [CoreRule]
 tcIfaceVectInfo    :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
-tcIfaceInst        :: IfaceInst -> IfL Instance
+tcIfaceInst        :: IfaceClsInst -> IfL ClsInst
 tcIfaceFamInst     :: IfaceFamInst -> IfL FamInst
 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
 \end{code}
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index d8507ab810..b8a44447fa 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -127,12 +127,12 @@ stmtToInstrs env stmt = case stmt of
         -> genCall env target res args ret
 
     -- Tail call
-    CmmJump arg _ -> genJump env arg
+    CmmJump arg -> genJump env arg
 
     -- CPS, only tail calls, no return's
     -- Actually, there are a few return statements that occur because of hand
     -- written Cmm code.
-    CmmReturn _
+    CmmReturn
         -> return (env, unitOL $ Return Nothing, [])
 
 
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index df670f1d63..6c31e2e1bf 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -168,7 +168,7 @@ module GHC (
         pprFundeps,
 
         -- ** Instances
-        Instance, 
+        ClsInst, 
         instanceDFunId, 
         pprInstance, pprInstanceHdr,
         pprFamInst, pprFamInstHdr,
@@ -915,7 +915,7 @@ getBindings = withSession $ \hsc_env ->
     return $ icInScopeTTs $ hsc_IC hsc_env
 
 -- | Return the instances for the current interactive session.
-getInsts :: GhcMonad m => m ([Instance], [FamInst])
+getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
 getInsts = withSession $ \hsc_env ->
     return $ ic_instances (hsc_IC hsc_env)
 
@@ -928,7 +928,7 @@ data ModuleInfo = ModuleInfo {
         minf_type_env  :: TypeEnv,
         minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
         minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
-        minf_instances :: [Instance],
+        minf_instances :: [ClsInst],
         minf_iface     :: Maybe ModIface
 #ifdef GHCI
        ,minf_modBreaks :: ModBreaks 
@@ -1011,7 +1011,7 @@ modInfoExports minf = nameSetToList $! minf_exports minf
 
 -- | Returns the instances defined by the specified module.
 -- Warning: currently unimplemented for package modules.
-modInfoInstances :: ModuleInfo -> [Instance]
+modInfoInstances :: ModuleInfo -> [ClsInst]
 modInfoInstances = minf_instances
 
 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 2882816c0b..8c9e9a8f00 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -296,7 +296,7 @@ hscTcRcLookupName hsc_env name =
       -- "name not found", and the Maybe in the return type
       -- is used to indicate that.
 
-hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [Instance]))
+hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst]))
 hscTcRnGetInfo hsc_env name =
     runHsc hsc_env $ ioMsgMaybe' $ tcRnGetInfo hsc_env name
 
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 6b389fd1b2..3eda19fba1 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -119,7 +119,7 @@ import HsSyn
 import RdrName
 import Avail
 import Module
-import InstEnv          ( InstEnv, Instance )
+import InstEnv          ( InstEnv, ClsInst )
 import FamInstEnv
 import Rules            ( RuleBase )
 import CoreSyn          ( CoreProgram )
@@ -467,7 +467,7 @@ lookupIfaceByModule dflags hpt pit mod
 -- modules imported by this one, directly or indirectly, and are in the Home
 -- Package Table.  This ensures that we don't see instances from modules @--make@
 -- compiled before this one, but which are not below this one.
-hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
+hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
 hptInstances hsc_env want_this_module
   = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
                 guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
@@ -693,7 +693,7 @@ data ModIface
                 -- 'HomeModInfo', but that leads to more plumbing.
 
                 -- Instance declarations and rules
-        mi_insts       :: [IfaceInst],     -- ^ Sorted class instance
+        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance
         mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances
         mi_rules       :: [IfaceRule],     -- ^ Sorted rules
         mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules and class
@@ -771,7 +771,7 @@ data ModDetails
         -- The next two fields are created by the typechecker
         md_exports   :: [AvailInfo],
         md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module
-        md_insts     :: ![Instance],    -- ^ 'DFunId's for the instances in this module
+        md_insts     :: ![ClsInst],    -- ^ 'DFunId's for the instances in this module
         md_fam_insts :: ![FamInst],
         md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules
         md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently
@@ -817,7 +817,7 @@ data ModGuts
                                          -- ToDo: I'm unconvinced this is actually used anywhere
         mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module
                                          -- (includes TyCons for classes)
-        mg_insts     :: ![Instance],     -- ^ Class instances declared in this module
+        mg_insts     :: ![ClsInst],     -- ^ Class instances declared in this module
         mg_fam_insts :: ![FamInst],      -- ^ Family instances declared in this module
         mg_rules     :: ![CoreRule],     -- ^ Before the core pipeline starts, contains
                                          -- See Note [Overall plumbing for rules] in Rules.lhs
@@ -937,7 +937,7 @@ data InteractiveContext
              -- ^ Variables defined automatically by the system (e.g.
              -- record field selectors).  See Notes [ic_sys_vars]
 
-         ic_instances  :: ([Instance], [FamInst]),
+         ic_instances  :: ([ClsInst], [FamInst]),
              -- ^ All instances and family instances created during
              -- this session.  These are grabbed en masse after each
              -- update to be sure that proper overlapping is retained.
@@ -1163,10 +1163,34 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
 %************************************************************************
 %*                                                                      *
-                TyThing
+                Implicit TyThings
 %*                                                                      *
 %************************************************************************
 
+Note [Implicit TyThings]
+~~~~~~~~~~~~~~~~~~~~~~~~
+  DEFINITION: An "implicit" TyThing is one that does not have its own
+  IfaceDecl in an interface file.  Instead, its binding in the type
+  environment is created as part of typechecking the IfaceDecl for
+  some other thing.
+
+Examples:
+  * All DataCons are implicit, because they are generated from the
+    IfaceDecl for the data/newtype.  Ditto class methods.
+
+  * Record selectors are *not* implicit, because they get their own
+    free-standing IfaceDecl.
+
+  * Associated data/type families are implicit because they are
+    included in the IfaceDecl of the parent class.  (NB: the
+    IfaceClass decl happens to use IfaceDecl recursively for the
+    associated types, but that's irrelevant here.)
+
+  * Dictionary function Ids are not implict.
+
+  * Axioms for newtypes are implicit (same as above), but axioms
+    for data/type family instances are *not* implicit (like DFunIds).
+
 \begin{code}
 -- | Determine the 'TyThing's brought into scope by another 'TyThing'
 -- /other/ than itself. For example, Id's don't have any implicit TyThings
@@ -1175,7 +1199,7 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 -- scope, just for a start!
 
 -- N.B. the set of TyThings returned here *must* match the set of
--- names returned by LoadIface.ifaceDeclSubBndrs, in the sense that
+-- names returned by LoadIface.ifaceDeclImplicitBndrs, in the sense that
 -- TyThing.getOccName should define a bijection between the two lists.
 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 -- The order of the list does not matter.
@@ -1201,9 +1225,10 @@ implicitTyConThings :: TyCon -> [TyThing]
 implicitTyConThings tc
   = class_stuff ++
       -- fields (names of selectors)
-      -- (possibly) implicit coercion and family coercion
-      --   depending on whether it's a newtype or a family instance or both
+
+      -- (possibly) implicit newtype coercion
     implicitCoTyCon tc ++
+
       -- for each data constructor in order,
       --   the contructor, worker, and (possibly) wrapper
     concatMap (extras_plus . ADataCon) (tyConDataCons tc)
@@ -1218,14 +1243,11 @@ implicitTyConThings tc
 extras_plus :: TyThing -> [TyThing]
 extras_plus thing = thing : implicitTyThings thing
 
--- For newtypes and indexed data types (and both),
--- add the implicit coercion tycon
+-- For newtypes (only) add the implicit coercion tycon
 implicitCoTyCon :: TyCon -> [TyThing]
 implicitCoTyCon tc
-  = map ACoAxiom . catMaybes $ [-- Just if newtype, Nothing if not
-                              newTyConCo_maybe tc,
-                              -- Just if family instance, Nothing if not
-                              tyConFamilyCoercion_maybe tc]
+  | Just co <- newTyConCo_maybe tc = [ACoAxiom co]
+  | otherwise                      = []
 
 -- | Returns @True@ if there should be no interface-file declaration
 -- for this thing on its own: either it is built-in, or it is part
@@ -1235,7 +1257,7 @@ isImplicitTyThing :: TyThing -> Bool
 isImplicitTyThing (ADataCon {}) = True
 isImplicitTyThing (AnId id)     = isImplicitId id
 isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
-isImplicitTyThing (ACoAxiom {}) = True
+isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
 
 -- | tyThingParent_maybe x returns (Just p)
 -- when pprTyThingInContext sould print a declaration for p
@@ -1321,13 +1343,14 @@ mkTypeEnvWithImplicits things =
   mkTypeEnv (concatMap implicitTyThings things)
 
 typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv
-typeEnvFromEntities ids tcs faminsts =
+typeEnvFromEntities ids tcs famInsts =
   mkTypeEnv (   map AnId ids
              ++ map ATyCon all_tcs
              ++ concatMap implicitTyConThings all_tcs
+             ++ map (ACoAxiom . famInstAxiom) famInsts
             )
  where
-  all_tcs = tcs ++ map famInstTyCon faminsts
+  all_tcs = tcs ++ famInstsRepTyCons famInsts
 
 lookupTypeEnv = lookupNameEnv
 
@@ -1432,7 +1455,7 @@ mkIfaceHashCache pairs
   = \occ -> lookupOccEnv env occ
   where
     env = foldr add_decl emptyOccEnv pairs
-    add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
+    add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclImplicitBndrs d)
       where
           decl_name = ifName d
           env1 = extendOccEnv env0 decl_name (decl_name, v)
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 3439231aa6..eee5c00255 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -869,7 +869,7 @@ moduleIsInterpreted modl = withSession $ \h ->
 -- are in scope (qualified or otherwise).  Otherwise we list a whole lot too many!
 -- The exact choice of which ones to show, and which to hide, is a judgement call.
 --      (see Trac #1581)
-getInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[Instance]))
+getInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst]))
 getInfo name
   = withSession $ \hsc_env ->
     do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 23906c69bc..75b4d542a5 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -192,6 +192,7 @@ initSysTools mbMinusB
                                 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
         ; targetArch <- readSetting "target arch"
         ; targetOS <- readSetting "target os"
+        ; targetWordSize <- readSetting "target word size"
         ; targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack"
         ; targetHasIdentDirective <- readSetting "target has .ident directive"
         ; targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
@@ -257,6 +258,7 @@ initSysTools mbMinusB
                         sTargetPlatform = Platform {
                                               platformArch = targetArch,
                                               platformOS   = targetOS,
+                                              platformWordSize = targetWordSize,
                                               platformHasGnuNonexecStack = targetHasGnuNonexecStack,
                                               platformHasIdentDirective = targetHasIdentDirective,
                                               platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 830a352be2..5e2a9375a0 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -488,7 +488,7 @@ mustExposeTyCon exports tc
     exported_con con = any (`elemNameSet` exports) 
 			   (dataConName con : dataConFieldLabels con)
 
-tidyInstances :: (DFunId -> DFunId) -> [Instance] -> [Instance]
+tidyInstances :: (DFunId -> DFunId) -> [ClsInst] -> [ClsInst]
 tidyInstances tidy_dfun ispecs
   = map tidy ispecs
   where
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index f56238fd12..b404e87f31 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -878,9 +878,9 @@ cmmStmtConFold stmt
                  src'  <- cmmExprConFold DataReference src
                  return $ CmmStore addr' src'
 
-        CmmJump addr regs
+        CmmJump addr
            -> do addr' <- cmmExprConFold JumpReference addr
-                 return $ CmmJump addr' regs
+                 return $ CmmJump addr'
 
         CmmCall target regs args returns
 	   -> do target' <- case target of
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 2fd11bc35a..8b96f7140a 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -141,8 +141,8 @@ stmtToInstrs stmt = do
     CmmBranch id          -> genBranch id
     CmmCondBranch arg id  -> genCondJump id arg
     CmmSwitch arg ids     -> genSwitch arg ids
-    CmmJump arg _         -> genJump arg
-    CmmReturn _           ->
+    CmmJump arg           -> genJump arg
+    CmmReturn             ->
       panic "stmtToInstrs: return statement should have been cps'd away"
 
 
@@ -849,12 +849,7 @@ genCCall target dest_regs argsAndHints
       case platformOS (targetPlatform dflags) of
           OSLinux    -> genCCall' GCPLinux  target dest_regs argsAndHints
           OSDarwin   -> genCCall' GCPDarwin target dest_regs argsAndHints
-          OSSolaris2 -> panic "PPC.CodeGen.genCCall: not defined for this os"
-          OSMinGW32  -> panic "PPC.CodeGen.genCCall: not defined for this os"
-          OSFreeBSD  -> panic "PPC.CodeGen.genCCall: not defined for this os"
-          OSOpenBSD  -> panic "PPC.CodeGen.genCCall: not defined for this os"
-          OSNetBSD   -> panic "PPC.CodeGen.genCCall: not defined for this os"
-          OSUnknown  -> panic "PPC.CodeGen.genCCall: not defined for this os"
+          _ -> panic "PPC.CodeGen.genCCall: not defined for this os"
 
 data GenCCallPlatform = GCPLinux | GCPDarwin
 
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index ff1e9f2eb2..0022e043ee 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -141,9 +141,9 @@ stmtToInstrs stmt = case stmt of
     CmmBranch	id		-> genBranch id
     CmmCondBranch arg id	-> genCondJump id arg
     CmmSwitch	arg ids		-> genSwitch arg ids
-    CmmJump	arg _		-> genJump arg
+    CmmJump	arg  		-> genJump arg
 
-    CmmReturn	_		
+    CmmReturn	 		
      -> panic "stmtToInstrs: return statement should have been cps'd away"
 
 
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 2ade04d36f..b7356ea3fd 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -166,8 +166,8 @@ stmtToInstrs stmt = do
     CmmBranch id          -> genBranch id
     CmmCondBranch arg id  -> genCondJump id arg
     CmmSwitch arg ids     -> genSwitch arg ids
-    CmmJump arg _         -> genJump arg
-    CmmReturn _           ->
+    CmmJump arg           -> genJump arg
+    CmmReturn             ->
       panic "stmtToInstrs: return statement should have been cps'd away"
 
 
@@ -1690,6 +1690,7 @@ genCCall32 target dest_regs args =
         use_sse2 <- sse2Enabled
         push_codes <- mapM (push_arg use_sse2) (reverse args)
         delta <- getDeltaNat
+        MASSERT (delta == delta0 - tot_arg_size)
 
         -- in
         -- deal with static vs dynamic call targets
@@ -1728,10 +1729,10 @@ genCCall32 target dest_regs args =
                       (if pop_size==0 then [] else
                        [ADD II32 (OpImm (ImmInt pop_size)) (OpReg esp)])
                       ++
-                      [DELTA (delta + tot_arg_size)]
+                      [DELTA delta0]
                    )
         -- in
-        setDeltaNat (delta + tot_arg_size)
+        setDeltaNat delta0
 
         let
             -- assign the results, if necessary
@@ -1744,9 +1745,11 @@ genCCall32 target dest_regs args =
                                                        (ImmInt 0)
                              sz = floatSize w
                          in toOL [ SUB II32 (OpImm (ImmInt b)) (OpReg esp),
+                                   DELTA (delta0 - b),
                                    GST sz fake0 tmp_amode,
                                    MOV sz (OpAddr tmp_amode) (OpReg r_dest),
-                                   ADD II32 (OpImm (ImmInt b)) (OpReg esp)]
+                                   ADD II32 (OpImm (ImmInt b)) (OpReg esp),
+                                   DELTA delta0]
                     else unitOL (GMOV fake0 r_dest)
               | isWord64 ty    = toOL [MOV II32 (OpReg eax) (OpReg r_dest),
                                         MOV II32 (OpReg edx) (OpReg r_dest_hi)]
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 4f36d03254..ccce0c9caf 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -454,32 +454,45 @@ lookupOccRn rdr_name = do
 
 -- lookupPromotedOccRn looks up an optionally promoted RdrName.
 lookupPromotedOccRn :: RdrName -> RnM Name
--- see Note [Demotion] in OccName
-lookupPromotedOccRn rdr_name = do {
-    -- 1. lookup the name
-    opt_name <- lookupOccRn_maybe rdr_name 
-  ; case opt_name of
-      -- 1.a. we found it!
-      Just name -> return name
-      -- 1.b. we did not find it -> 2
-      Nothing -> do {
-  ; -- 2. maybe it was implicitly promoted
-    case demoteRdrName rdr_name of
-      -- 2.a it was not in a promoted namespace
-      Nothing -> err
-      -- 2.b let's try every thing again -> 3
-      Just demoted_rdr_name -> do {
-  ; poly_kinds <- xoptM Opt_PolyKinds
-    -- 3. lookup again
-  ; opt_demoted_name <- lookupOccRn_maybe demoted_rdr_name ;
-  ; case opt_demoted_name of
-      -- 3.a. it was implicitly promoted, but confirm that we can promote
-      -- JPM: We could try to suggest turning on PolyKinds here
-      Just demoted_name -> if poly_kinds then return demoted_name else err
-      -- 3.b. use rdr_name to have a correct error message
-      Nothing -> err } } }
-  where err = unboundName WL_Any rdr_name
+-- see Note [Demotion] 
+lookupPromotedOccRn rdr_name 
+  = do { mb_name <- lookupOccRn_maybe rdr_name 
+       ; case mb_name of {
+             Just name -> return name ;
+             Nothing   -> 
+
+    do { -- Maybe it's the name of a *data* constructor
+         poly_kinds <- xoptM Opt_PolyKinds
+       ; mb_demoted_name <- case demoteRdrName rdr_name of
+                              Just demoted_rdr -> lookupOccRn_maybe demoted_rdr
+                              Nothing          -> return Nothing
+       ; case mb_demoted_name of
+           Nothing -> unboundName WL_Any rdr_name
+           Just demoted_name 
+             | poly_kinds -> return demoted_name
+             | otherwise  -> unboundNameX WL_Any rdr_name suggest_pk }}}
+  where 
+    suggest_pk = ptext (sLit "A data constructor of that name is in scope; did you mean -XPolyKinds?")
+\end{code}
+
+Note [Demotion]
+~~~~~~~~~~~~~~~
+When the user writes:
+  data Nat = Zero | Succ Nat
+  foo :: f Zero -> Int
+
+'Zero' in the type signature of 'foo' is parsed as:
+  HsTyVar ("Zero", TcClsName)
 
+When the renamer hits this occurence of 'Zero' it's going to realise
+that it's not in scope. But because it is renaming a type, it knows
+that 'Zero' might be a promoted data constructor, so it will demote
+its namespace to DataName and do a second lookup.
+
+The final result (after the renamer) will be:
+  HsTyVar ("Zero", DataName)
+
+\begin{code}
 -- lookupOccRn looks up an occurrence of a RdrName
 lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
 lookupOccRn_maybe rdr_name
@@ -1125,13 +1138,16 @@ data WhereLooking = WL_Any        -- Any binding
                   | WL_LocalTop   -- Any top-level binding in this module
 
 unboundName :: WhereLooking -> RdrName -> RnM Name
-unboundName where_look rdr_name
+unboundName wl rdr = unboundNameX wl rdr empty
+
+unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name
+unboundNameX where_look rdr_name extra
   = do  { show_helpful_errors <- doptM Opt_HelpfulErrors
-        ; let err = unknownNameErr rdr_name
+        ; let err = unknownNameErr rdr_name $$ extra
         ; if not show_helpful_errors
           then addErr err
-          else do { extra_err <- unknownNameSuggestErr where_look rdr_name
-                  ; addErr (err $$ extra_err) }
+          else do { suggestions <- unknownNameSuggestErr where_look rdr_name
+                  ; addErr (err $$ suggestions) }
 
         ; env <- getGlobalRdrEnv;
 	; traceRn (vcat [unknownNameErr rdr_name, 
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index e2fb0c8540..defec7516b 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -3,88 +3,80 @@
 %
 \section[StgSyn]{Shared term graph (STG) syntax for spineless-tagless code generation}
 
-This data type represents programs just before code generation
-(conversion to @AbstractC@): basically, what we have is a stylised
-form of @CoreSyntax@, the style being one that happens to be ideally
-suited to spineless tagless code generation.
+This data type represents programs just before code generation (conversion to
+@Cmm@): basically, what we have is a stylised form of @CoreSyntax@, the style
+being one that happens to be ideally suited to spineless tagless code
+generation.
 
 \begin{code}
-{-# OPTIONS -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
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
 module StgSyn (
-	GenStgArg(..), 
-	GenStgLiveVars,
+        GenStgArg(..),
+        GenStgLiveVars,
 
-	GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
-	GenStgAlt, AltType(..),
+        GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
+        GenStgAlt, AltType(..),
 
-	UpdateFlag(..), isUpdatable,
+        UpdateFlag(..), isUpdatable,
 
-	StgBinderInfo,
-	noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
-	combineStgBinderInfo,
+        StgBinderInfo,
+        noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
+        combineStgBinderInfo,
 
-	-- a set of synonyms for the most common (only :-) parameterisation
-	StgArg, StgLiveVars,
-	StgBinding, StgExpr, StgRhs, StgAlt, 
+        -- a set of synonyms for the most common (only :-) parameterisation
+        StgArg, StgLiveVars,
+        StgBinding, StgExpr, StgRhs, StgAlt,
 
-	-- StgOp
-	StgOp(..),
+        -- StgOp
+        StgOp(..),
 
-	-- SRTs
-	SRT(..),
+        -- SRTs
+        SRT(..),
 
-	-- utils
-	stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
-	isDllConApp, isStgTypeArg,
-	stgArgType,
+        -- utils
+        stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
+        isDllConApp, isStgTypeArg,
+        stgArgType,
 
-	pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs
-
-	, pprStgLVs
+        pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs,
+        pprStgLVs
     ) where
 
 #include "HsVersions.h"
 
-import CostCentre	( CostCentreStack, CostCentre )
-import VarSet		( IdSet, isEmptyVarSet )
-import Id		
-import DataCon
-import IdInfo		( mayHaveCafRefs )
-import Literal		( Literal, literalType )
-import ForeignCall	( ForeignCall )
-import CoreSyn		( AltCon )
-import PprCore		( {- instances -} )
-import PrimOp		( PrimOp, PrimCall )
-import Outputable
-import Type             ( Type )
-import TyCon            ( TyCon )
-import UniqSet
-import Unique		( Unique )
 import Bitmap
+import CoreSyn     ( AltCon )
+import CostCentre  ( CostCentreStack, CostCentre )
+import DataCon
 import DynFlags
-import Platform
-import StaticFlags	( opt_SccProfilingOn )
-import Module
 import FastString
-
-import Packages		( isDllName )
-import Type		( typePrimRep )
-import TyCon		( PrimRep(..) )
+import ForeignCall ( ForeignCall )
+import Id
+import IdInfo      ( mayHaveCafRefs )
+import Literal     ( Literal, literalType )
+import Module
+import Outputable
+import Packages    ( isDllName )
+import Platform
+import PprCore     ( {- instances -} )
+import PrimOp      ( PrimOp, PrimCall )
+import StaticFlags ( opt_SccProfilingOn )
+import TyCon       ( PrimRep(..) )
+import TyCon       ( TyCon )
+import Type        ( Type )
+import Type        ( typePrimRep )
+import UniqSet
+import Unique      ( Unique )
+import VarSet      ( IdSet, isEmptyVarSet )
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{@GenStgBinding@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-As usual, expressions are interesting; other things are boring.  Here
+As usual, expressions are interesting; other things are boring. Here
 are the boring things [except note the @GenStgRhs@], parameterised
 with respect to binder and occurrence information (just as in
 @CoreSyn@):
@@ -93,32 +85,30 @@ There is one SRT for each group of bindings.
 
 \begin{code}
 data GenStgBinding bndr occ
-  = StgNonRec	bndr (GenStgRhs bndr occ)
-  | StgRec	[(bndr, GenStgRhs bndr occ)]
+  = StgNonRec bndr (GenStgRhs bndr occ)
+  | StgRec    [(bndr, GenStgRhs bndr occ)]
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{@GenStgArg@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 data GenStgArg occ
-  = StgVarArg	occ
-  | StgLitArg   Literal
-  | StgTypeArg  Type		-- For when we want to preserve all type info
-\end{code}
+  = StgVarArg  occ
+  | StgLitArg  Literal
+  | StgTypeArg Type     -- For when we want to preserve all type info
 
-\begin{code}
 isStgTypeArg :: StgArg -> Bool
 isStgTypeArg (StgTypeArg _) = True
 isStgTypeArg _              = False
 
-isDllConApp :: DynFlags -> DataCon -> [StgArg] -> Bool
--- Does this constructor application refer to 
+-- | Does this constructor application refer to
 -- anything in a different *Windows* DLL?
 -- If so, we can't allocate it statically
+isDllConApp :: DynFlags -> DataCon -> [StgArg] -> Bool
 isDllConApp dflags con args
  | platformOS (targetPlatform dflags) == OSMinGW32
     = isDllName this_pkg (dataConName con) || any is_dll_arg args
@@ -131,11 +121,10 @@ isDllConApp dflags con args
 
     this_pkg = thisPackage dflags
 
-isAddrRep :: PrimRep -> Bool
 -- True of machine adddresses; these are the things that don't
--- work across DLLs.
--- The key point here is that VoidRep comes out False, so that
--- a top level nullary GADT construtor is False for isDllConApp
+-- work across DLLs. The key point here is that VoidRep comes
+-- out False, so that a top level nullary GADT construtor is
+-- False for isDllConApp
 --    data T a where
 --      T1 :: T Int
 -- gives
@@ -144,35 +133,38 @@ isAddrRep :: PrimRep -> Bool
 --    $WT1 :: T Int
 --    $WT1 = T1 Int (Coercion (Refl Int))
 -- The coercion argument here gets VoidRep
+isAddrRep :: PrimRep -> Bool
 isAddrRep AddrRep = True
 isAddrRep PtrRep  = True
 isAddrRep _       = False
 
+-- | Type of an @StgArg@
+--
+-- Very half baked becase we have lost the type arguments.
 stgArgType :: StgArg -> Type
-	-- Very half baked becase we have lost the type arguments
 stgArgType (StgVarArg v)   = idType v
 stgArgType (StgLitArg lit) = literalType lit
 stgArgType (StgTypeArg _)  = panic "stgArgType called on stgTypeArg"
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{STG expressions}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 The @GenStgExpr@ data type is parameterised on binder and occurrence
 info, as before.
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@GenStgExpr@ application}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 An application is of a function to a list of atoms [not expressions].
 Operationally, we want to push the arguments on the stack and call the
-function.  (If the arguments were expressions, we would have to build
+function. (If the arguments were expressions, we would have to build
 their closures first.)
 
 There is no constructor for a lone variable; it would appear as
@@ -182,87 +174,91 @@ type GenStgLiveVars occ = UniqSet occ
 
 data GenStgExpr bndr occ
   = StgApp
-	occ		-- function
-	[GenStgArg occ]	-- arguments; may be empty
+        occ             -- function
+        [GenStgArg occ] -- arguments; may be empty
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-There are a specialised forms of application, for
-constructors, primitives, and literals.
+There are a specialised forms of application, for constructors,
+primitives, and literals.
 \begin{code}
-  | StgLit	Literal
-  
-	-- StgConApp is vital for returning unboxed tuples
-	-- which can't be let-bound first
-  | StgConApp	DataCon
-		[GenStgArg occ]	-- Saturated
-
-  | StgOpApp	StgOp		-- Primitive op or foreign call
-		[GenStgArg occ]	-- Saturated
-		Type		-- Result type
-				-- We need to know this so that we can 
-				-- assign result registers
+  | StgLit      Literal
+
+        -- StgConApp is vital for returning unboxed tuples
+        -- which can't be let-bound first
+  | StgConApp   DataCon
+                [GenStgArg occ] -- Saturated
+
+  | StgOpApp    StgOp           -- Primitive op or foreign call
+                [GenStgArg occ] -- Saturated
+                Type            -- Result type
+                                -- We need to know this so that we can
+                                -- assign result registers
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@StgLam@}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-StgLam is used *only* during CoreToStg's work.  Before CoreToStg has finished
-it encodes (\x -> e) as (let f = \x -> e in f)
+StgLam is used *only* during CoreToStg's work. Before CoreToStg has
+finished it encodes (\x -> e) as (let f = \x -> e in f)
 
 \begin{code}
   | StgLam
-	Type		-- Type of whole lambda (useful when making a binder for it)
-	[bndr]
-	StgExpr		-- Body of lambda
+        Type       -- Type of whole lambda (useful when
+                   -- making a binder for it)
+        [bndr]
+        StgExpr    -- Body of lambda
 \end{code}
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@GenStgExpr@: case-expressions}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 This has the same boxed/unboxed business as Core case expressions.
 \begin{code}
   | StgCase
-	(GenStgExpr bndr occ)
-			-- the thing to examine
+        (GenStgExpr bndr occ)
+                    -- the thing to examine
 
-	(GenStgLiveVars occ) -- Live vars of whole case expression, 
-			-- plus everything that happens after the case
-			-- i.e., those which mustn't be overwritten
+        (GenStgLiveVars occ)
+                    -- Live vars of whole case expression,
+                    -- plus everything that happens after the case
+                    -- i.e., those which mustn't be overwritten
 
-	(GenStgLiveVars occ) -- Live vars of RHSs (plus what happens afterwards)
-			-- i.e., those which must be saved before eval.
-			--
-			-- note that an alt's constructor's
-			-- binder-variables are NOT counted in the
-			-- free vars for the alt's RHS
+        (GenStgLiveVars occ)
+                    -- Live vars of RHSs (plus what happens afterwards)
+                    -- i.e., those which must be saved before eval.
+                    --
+                    -- note that an alt's constructor's
+                    -- binder-variables are NOT counted in the
+                    -- free vars for the alt's RHS
 
-	bndr		-- binds the result of evaluating the scrutinee
+        bndr        -- binds the result of evaluating the scrutinee
 
-	SRT		-- The SRT for the continuation
+        SRT         -- The SRT for the continuation
 
-	AltType 
+        AltType
 
-	[GenStgAlt bndr occ]	-- The DEFAULT case is always *first* 
-				-- if it is there at all
+        [GenStgAlt bndr occ]
+                    -- The DEFAULT case is always *first*
+                    -- if it is there at all
 \end{code}
 
 %************************************************************************
-%*									*
-\subsubsection{@GenStgExpr@:  @let(rec)@-expressions}
-%*									*
+%*                                                                      *
+\subsubsection{@GenStgExpr@: @let(rec)@-expressions}
+%*                                                                      *
 %************************************************************************
 
 The various forms of let(rec)-expression encode most of the
@@ -270,7 +266,7 @@ interesting things we want to do.
 \begin{enumerate}
 \item
 \begin{verbatim}
-let-closure x = [free-vars] expr [args]
+let-closure x = [free-vars] [args] expr
 in e
 \end{verbatim}
 is equivalent to
@@ -310,13 +306,14 @@ distinguish between them with an @is_recursive@ boolean flag.
 let-unboxed u = an arbitrary arithmetic expression in unboxed values
 in e
 \end{verbatim}
-All the stuff on the RHS must be fully evaluated.  No function calls either!
+All the stuff on the RHS must be fully evaluated.
+No function calls either!
 
 (We've backed away from this toward case-expressions with
 suitably-magical alts ...)
 
 \item
-~[Advanced stuff here!  Not to start with, but makes pattern matching
+~[Advanced stuff here! Not to start with, but makes pattern matching
 generate more efficient code.]
 
 \begin{verbatim}
@@ -324,7 +321,7 @@ let-escapes-not fail = expr
 in e'
 \end{verbatim}
 Here the idea is that @e'@ guarantees not to put @fail@ in a data structure,
-or pass it to another function.  All @e'@ will ever do is tail-call @fail@.
+or pass it to another function. All @e'@ will ever do is tail-call @fail@.
 Rather than build a closure for @fail@, all we need do is to record the stack
 level at the moment of the @let-escapes-not@; then entering @fail@ is just
 a matter of adjusting the stack pointer back down to that point and entering
@@ -333,9 +330,9 @@ the code for it.
 Another example:
 \begin{verbatim}
 f x y = let z = huge-expression in
-	if y==1 then z else
-	if y==2 then z else
-	1
+        if y==1 then z else
+        if y==2 then z else
+        1
 \end{verbatim}
 
 (A let-escapes-not is an @StgLetNoEscape@.)
@@ -346,66 +343,65 @@ We may eventually want:
 let-literal x = Literal
 in e
 \end{verbatim}
-
-(ToDo: is this obsolete?)
 \end{enumerate}
 
 And so the code for let(rec)-things:
 \begin{code}
   | StgLet
-	(GenStgBinding bndr occ)	-- right hand sides (see below)
-	(GenStgExpr bndr occ)		-- body
+        (GenStgBinding bndr occ)    -- right hand sides (see below)
+        (GenStgExpr bndr occ)       -- body
 
-  | StgLetNoEscape			-- remember: ``advanced stuff''
-	(GenStgLiveVars occ)		-- Live in the whole let-expression
-					-- Mustn't overwrite these stack slots
-    	    	    	    	    	--  *Doesn't* include binders of the let(rec).
+  | StgLetNoEscape                  -- remember: ``advanced stuff''
+        (GenStgLiveVars occ)        -- Live in the whole let-expression
+                                    -- Mustn't overwrite these stack slots
+                                    -- _Doesn't_ include binders of the let(rec).
 
-	(GenStgLiveVars occ)		-- Live in the right hand sides (only)
-					-- These are the ones which must be saved on
-					-- the stack if they aren't there already
-    	    	    	    	    	--  *Does* include binders of the let(rec) if recursive.
+        (GenStgLiveVars occ)        -- Live in the right hand sides (only)
+                                    -- These are the ones which must be saved on
+                                    -- the stack if they aren't there already
+                                    -- _Does_ include binders of the let(rec) if recursive.
 
-	(GenStgBinding bndr occ)	-- right hand sides (see below)
-	(GenStgExpr bndr occ)		-- body
+        (GenStgBinding bndr occ)    -- right hand sides (see below)
+        (GenStgExpr bndr occ)       -- body
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@GenStgExpr@: @scc@ expressions}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-Finally for @scc@ expressions we introduce a new STG construct.
+For @scc@ expressions we introduce a new STG construct.
 
 \begin{code}
   | StgSCC
-	CostCentre		-- label of SCC expression
-        !Bool                   -- bump the entry count?
-        !Bool                   -- push the cost centre?
-        (GenStgExpr bndr occ)   -- scc expression
+        CostCentre             -- label of SCC expression
+        !Bool                  -- bump the entry count?
+        !Bool                  -- push the cost centre?
+        (GenStgExpr bndr occ)  -- scc expression
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsubsection{@GenStgExpr@: @hpc@ expressions}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Finally for @scc@ expressions we introduce a new STG construct.
 
 \begin{code}
   | StgTick
-    Module			-- the module of the source of this tick
-    Int				-- tick number
-    (GenStgExpr bndr occ)	-- sub expression
-  -- end of GenStgExpr
+        Module                 -- the module of the source of this tick
+        Int                    -- tick number
+        (GenStgExpr bndr occ)  -- sub expression
+
+-- END of GenStgExpr
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{STG right-hand sides}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Here's the rest of the interesting stuff for @StgLet@s; the first
@@ -413,15 +409,15 @@ flavour is for closures:
 \begin{code}
 data GenStgRhs bndr occ
   = StgRhsClosure
-	CostCentreStack		-- CCS to be attached (default is CurrentCCS)
-	StgBinderInfo		-- Info about how this binder is used (see below)
-	[occ]			-- non-global free vars; a list, rather than
-				-- a set, because order is important
-	!UpdateFlag		-- ReEntrant | Updatable | SingleEntry
-	SRT 			-- The SRT reference
-	[bndr]			-- arguments; if empty, then not a function;
-				-- as above, order is important.
-	(GenStgExpr bndr occ)	-- body
+        CostCentreStack         -- CCS to be attached (default is CurrentCCS)
+        StgBinderInfo           -- Info about how this binder is used (see below)
+        [occ]                   -- non-global free vars; a list, rather than
+                                -- a set, because order is important
+        !UpdateFlag             -- ReEntrant | Updatable | SingleEntry
+        SRT                     -- The SRT reference
+        [bndr]                  -- arguments; if empty, then not a function;
+                                -- as above, order is important.
+        (GenStgExpr bndr occ)   -- body
 \end{code}
 An example may be in order.  Consider:
 \begin{verbatim}
@@ -438,30 +434,26 @@ will be exactly that in parentheses above.
 The second flavour of right-hand-side is for constructors (simple but important):
 \begin{code}
   | StgRhsCon
-	CostCentreStack		-- CCS to be attached (default is CurrentCCS).
-				-- Top-level (static) ones will end up with
-				-- DontCareCCS, because we don't count static
-				-- data in heap profiles, and we don't set CCCS
-				-- from static closure.
-	DataCon			-- constructor
-	[GenStgArg occ]	-- args
-\end{code}
+        CostCentreStack  -- CCS to be attached (default is CurrentCCS).
+                         -- Top-level (static) ones will end up with
+                         -- DontCareCCS, because we don't count static
+                         -- data in heap profiles, and we don't set CCCS
+                         -- from static closure.
+        DataCon          -- constructor
+        [GenStgArg occ]  -- args
 
-\begin{code}
 stgRhsArity :: StgRhs -> Int
-stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _) 
+stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _)
   = ASSERT( all isId bndrs ) length bndrs
   -- The arity never includes type parameters, but they should have gone by now
 stgRhsArity (StgRhsCon _ _ _) = 0
-\end{code}
 
-\begin{code}
 stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
 stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
 stgBindHasCafRefs (StgRec binds)    = any rhsHasCafRefs (map snd binds)
 
 rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
-rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _) 
+rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _)
   = isUpdatable upd || nonEmptySRT srt
 rhsHasCafRefs (StgRhsCon _ _ args)
   = any stgArgHasCafRefs args
@@ -475,10 +467,10 @@ Here's the @StgBinderInfo@ type, and its combining op:
 \begin{code}
 data StgBinderInfo
   = NoStgBinderInfo
-  | SatCallsOnly	-- All occurrences are *saturated* *function* calls
-			-- This means we don't need to build an info table and 
-			-- slow entry code for the thing
-			-- Thunks never get this value
+  | SatCallsOnly        -- All occurrences are *saturated* *function* calls
+                        -- This means we don't need to build an info table and
+                        -- slow entry code for the thing
+                        -- Thunks never get this value
 
 noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
 noBinderInfo = NoStgBinderInfo
@@ -500,54 +492,54 @@ pp_binder_info SatCallsOnly    = ptext (sLit "sat-only")
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Stg-case-alternatives]{STG case alternatives}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Very like in @CoreSyntax@ (except no type-world stuff).
 
 The type constructor is guaranteed not to be abstract; that is, we can
-see its representation.  This is important because the code generator
-uses it to determine return conventions etc.  But it's not trivial
+see its representation. This is important because the code generator
+uses it to determine return conventions etc. But it's not trivial
 where there's a moduule loop involved, because some versions of a type
-constructor might not have all the constructors visible.  So
+constructor might not have all the constructors visible. So
 mkStgAlgAlts (in CoreToStg) ensures that it gets the TyCon from the
 constructors or literals (which are guaranteed to have the Real McCoy)
 rather than from the scrutinee type.
 
 \begin{code}
 type GenStgAlt bndr occ
-  = (AltCon,		-- alts: data constructor,
-     [bndr],		-- constructor's parameters,
-     [Bool],		-- "use mask", same length as
-			-- parameters; a True in a
-			-- param's position if it is
-			-- used in the ...
-     GenStgExpr bndr occ)	-- ...right-hand side.
+  = (AltCon,            -- alts: data constructor,
+     [bndr],            -- constructor's parameters,
+     [Bool],            -- "use mask", same length as
+                        -- parameters; a True in a
+                        -- param's position if it is
+                        -- used in the ...
+     GenStgExpr bndr occ)       -- ...right-hand side.
 
 data AltType
-  = PolyAlt		-- Polymorphic (a type variable)
-  | UbxTupAlt TyCon	-- Unboxed tuple
-  | AlgAlt    TyCon	-- Algebraic data type; the AltCons will be DataAlts
-  | PrimAlt   TyCon	-- Primitive data type; the AltCons will be LitAlts
+  = PolyAlt             -- Polymorphic (a type variable)
+  | UbxTupAlt TyCon     -- Unboxed tuple
+  | AlgAlt    TyCon     -- Algebraic data type; the AltCons will be DataAlts
+  | PrimAlt   TyCon     -- Primitive data type; the AltCons will be LitAlts
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Stg]{The Plain STG parameterisation}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 This happens to be the only one we use at the moment.
 
 \begin{code}
-type StgBinding     = GenStgBinding	Id Id
-type StgArg         = GenStgArg		Id
-type StgLiveVars    = GenStgLiveVars	Id
-type StgExpr        = GenStgExpr	Id Id
-type StgRhs         = GenStgRhs		Id Id
-type StgAlt	    = GenStgAlt		Id Id
+type StgBinding  = GenStgBinding  Id Id
+type StgArg      = GenStgArg      Id
+type StgLiveVars = GenStgLiveVars Id
+type StgExpr     = GenStgExpr     Id Id
+type StgRhs      = GenStgRhs      Id Id
+type StgAlt      = GenStgAlt      Id Id
 \end{code}
 
 %************************************************************************
@@ -559,8 +551,8 @@ type StgAlt	    = GenStgAlt		Id Id
 This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
 
 A @ReEntrant@ closure may be entered multiple times, but should not be
-updated or blackholed.  An @Updatable@ closure should be updated after
-evaluation (and may be blackholed during evaluation).  A @SingleEntry@
+updated or blackholed. An @Updatable@ closure should be updated after
+evaluation (and may be blackholed during evaluation). A @SingleEntry@
 closure will only be entered once, and so need not be updated but may
 safely be blackholed.
 
@@ -568,8 +560,10 @@ safely be blackholed.
 data UpdateFlag = ReEntrant | Updatable | SingleEntry
 
 instance Outputable UpdateFlag where
-    ppr u
-      = char (case u of { ReEntrant -> 'r';  Updatable -> 'u';  SingleEntry -> 's' })
+    ppr u = char $ case u of
+                       ReEntrant   -> 'r'
+                       Updatable   -> 'u'
+                       SingleEntry -> 's'
 
 isUpdatable :: UpdateFlag -> Bool
 isUpdatable ReEntrant   = False
@@ -588,14 +582,15 @@ It's quite useful to move these around together, notably
 in StgOpApp and COpStmt.
 
 \begin{code}
-data StgOp = StgPrimOp  PrimOp
+data StgOp
+  = StgPrimOp  PrimOp
 
-           | StgPrimCallOp PrimCall
+  | StgPrimCallOp PrimCall
 
-	   | StgFCallOp ForeignCall Unique
-		-- The Unique is occasionally needed by the C pretty-printer
-		-- (which lacks a unique supply), notably when generating a
-		-- typedef for foreign-export-dynamic
+  | StgFCallOp ForeignCall Unique
+        -- The Unique is occasionally needed by the C pretty-printer
+        -- (which lacks a unique supply), notably when generating a
+        -- typedef for foreign-export-dynamic
 \end{code}
 
 
@@ -605,19 +600,20 @@ data StgOp = StgPrimOp  PrimOp
 %*                                                                      *
 %************************************************************************
 
-There is one SRT per top-level function group.  Each local binding and
+There is one SRT per top-level function group. Each local binding and
 case expression within this binding group has a subrange of the whole
 SRT, expressed as an offset and length.
 
-In CoreToStg we collect the list of CafRefs at each SRT site, which is later 
+In CoreToStg we collect the list of CafRefs at each SRT site, which is later
 converted into the length and offset form by the SRT pass.
 
 \begin{code}
-data SRT = NoSRT
-	 | SRTEntries IdSet
-		-- generated by CoreToStg
-         | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
-		-- generated by computeSRTs
+data SRT
+  = NoSRT
+  | SRTEntries IdSet
+        -- generated by CoreToStg
+  | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
+        -- generated by computeSRTs
 
 nonEmptySRT :: SRT -> Bool
 nonEmptySRT NoSRT           = False
@@ -631,9 +627,9 @@ pprSRT (SRT off _ _)    = parens (ppr off <> comma <> text "*bitmap*")
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[Stg-pretty-printing]{Pretty-printing}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Robin Popplestone asked for semi-colon separators on STG binds; here's
@@ -641,77 +637,65 @@ hoping he likes terminators instead...  Ditto for case alternatives.
 
 \begin{code}
 pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
-		 => GenStgBinding bndr bdee -> SDoc
+                 => GenStgBinding bndr bdee -> SDoc
 
 pprGenStgBinding (StgNonRec bndr rhs)
   = hang (hsep [ppr bndr, equals])
-    	4 ((<>) (ppr rhs) semi)
+        4 ((<>) (ppr rhs) semi)
 
 pprGenStgBinding (StgRec pairs)
-  = vcat ((ifPprDebug (ptext (sLit "{- StgRec (begin) -}"))) :
-	   (map (ppr_bind) pairs) ++ [(ifPprDebug (ptext (sLit "{- StgRec (end) -}")))])
+  = vcat $ ifPprDebug (ptext $ sLit "{- StgRec (begin) -}") :
+           map (ppr_bind) pairs ++ [ifPprDebug $ ptext $ sLit "{- StgRec (end) -}"]
   where
     ppr_bind (bndr, expr)
       = hang (hsep [ppr bndr, equals])
-	     4 ((<>) (ppr expr) semi)
+             4 ((<>) (ppr expr) semi)
 
-pprStgBinding  :: StgBinding -> SDoc
+pprStgBinding :: StgBinding -> SDoc
 pprStgBinding  bind  = pprGenStgBinding bind
 
 pprStgBindings :: [StgBinding] -> SDoc
 pprStgBindings binds = vcat (map pprGenStgBinding binds)
 
-pprGenStgBindingWithSRT	 
-	:: (Outputable bndr, Outputable bdee, Ord bdee) 
-	=> (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
-
+pprGenStgBindingWithSRT :: (Outputable bndr, Outputable bdee, Ord bdee)
+                        => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
 pprGenStgBindingWithSRT (bind,srts)
-  = vcat (pprGenStgBinding bind : map pprSRT srts)
-  where pprSRT (id,srt) = 
-	   ptext (sLit "SRT") <> parens (ppr id) <> ptext (sLit ": ") <> ppr srt
+  = vcat $ pprGenStgBinding bind : map pprSRT srts
+  where pprSRT (id,srt) =
+           ptext (sLit "SRT") <> parens (ppr id) <> ptext (sLit ": ") <> ppr srt
 
 pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
 pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
-\end{code}
 
-\begin{code}
 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
     ppr = pprStgArg
 
 instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgBinding bndr bdee) where
+                => Outputable (GenStgBinding bndr bdee) where
     ppr = pprGenStgBinding
 
 instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgExpr bndr bdee) where
+                => Outputable (GenStgExpr bndr bdee) where
     ppr = pprStgExpr
 
 instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgRhs bndr bdee) where
+                => Outputable (GenStgRhs bndr bdee) where
     ppr rhs = pprStgRhs rhs
-\end{code}
 
-\begin{code}
 pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
-
 pprStgArg (StgVarArg var) = ppr var
 pprStgArg (StgLitArg con) = ppr con
 pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
-\end{code}
 
-\begin{code}
 pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
-	   => GenStgExpr bndr bdee -> SDoc
+           => GenStgExpr bndr bdee -> SDoc
 -- special case
 pprStgExpr (StgLit lit)     = ppr lit
 
 -- general case
 pprStgExpr (StgApp func args)
-  = hang (ppr func)
-	 4 (sep (map (ppr) args))
-\end{code}
+  = hang (ppr func) 4 (sep (map (ppr) args))
 
-\begin{code}
 pprStgExpr (StgConApp con args)
   = hsep [ ppr con, brackets (interppSP args)]
 
@@ -720,29 +704,27 @@ pprStgExpr (StgOpApp op args _)
 
 pprStgExpr (StgLam _ bndrs body)
   =sep [ char '\\' <+> ppr bndrs <+> ptext (sLit "->"),
-	 pprStgExpr body ]
-\end{code}
+         pprStgExpr body ]
 
-\begin{code}
 -- special case: let v = <very specific thing>
---		 in
---		 let ...
---		 in
---		 ...
+--               in
+--               let ...
+--               in
+--               ...
 --
 -- Very special!  Suspicious! (SLPJ)
 
 {-
 pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
-		    	expr@(StgLet _ _))
+                        expr@(StgLet _ _))
   = ($$)
       (hang (hcat [ptext (sLit "let { "), ppr bndr, ptext (sLit " = "),
-			  ppr cc,
-			  pp_binder_info bi,
-			  ptext (sLit " ["), ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
-			  ppr upd_flag, ptext (sLit " ["),
-			  interppSP args, char ']'])
-	    8 (sep [hsep [ppr rhs, ptext (sLit "} in")]]))
+                          ppr cc,
+                          pp_binder_info bi,
+                          ptext (sLit " ["), ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
+                          ppr upd_flag, ptext (sLit " ["),
+                          interppSP args, char ']'])
+            8 (sep [hsep [ppr rhs, ptext (sLit "} in")]]))
       (ppr expr)
 -}
 
@@ -751,24 +733,24 @@ pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag a
 pprStgExpr (StgLet bind expr@(StgLet _ _))
   = ($$)
       (sep [hang (ptext (sLit "let {"))
-	 	2 (hsep [pprGenStgBinding bind, ptext (sLit "} in")])])
+                2 (hsep [pprGenStgBinding bind, ptext (sLit "} in")])])
       (ppr expr)
 
 -- general case
 pprStgExpr (StgLet bind expr)
   = sep [hang (ptext (sLit "let {")) 2 (pprGenStgBinding bind),
-	   hang (ptext (sLit "} in ")) 2 (ppr expr)]
+           hang (ptext (sLit "} in ")) 2 (ppr expr)]
 
 pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
   = sep [hang (ptext (sLit "let-no-escape {"))
-	    	2 (pprGenStgBinding bind),
-	   hang ((<>) (ptext (sLit "} in "))
-		   (ifPprDebug (
-		    nest 4 (
-		      hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-			     ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
-			     char ']']))))
-		2 (ppr expr)]
+                2 (pprGenStgBinding bind),
+           hang ((<>) (ptext (sLit "} in "))
+                   (ifPprDebug (
+                    nest 4 (
+                      hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
+                             ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
+                             char ']']))))
+                2 (ppr expr)]
 
 pprStgExpr (StgSCC cc tick push expr)
   = sep [ hsep [scc, ppr cc], pprStgExpr expr ]
@@ -779,27 +761,27 @@ pprStgExpr (StgSCC cc tick push expr)
 
 pprStgExpr (StgTick m n expr)
   = sep [ hsep [ptext (sLit "_tick_"),  pprModule m,text (show n)],
-	  pprStgExpr expr ]
+          pprStgExpr expr ]
 
 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
   = sep [sep [ptext (sLit "case"),
-	   nest 4 (hsep [pprStgExpr expr,
-	     ifPprDebug (dcolon <+> ppr alt_type)]),
-	   ptext (sLit "of"), ppr bndr, char '{'],
-	   ifPprDebug (
-	   nest 4 (
-	     hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-		    ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
-		    ptext (sLit "]; "),
-		    pprMaybeSRT srt])),
-	   nest 2 (vcat (map pprStgAlt alts)),
-	   char '}']
+           nest 4 (hsep [pprStgExpr expr,
+             ifPprDebug (dcolon <+> ppr alt_type)]),
+           ptext (sLit "of"), ppr bndr, char '{'],
+           ifPprDebug (
+           nest 4 (
+             hcat [ptext  (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
+                    ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
+                    ptext (sLit "]; "),
+                    pprMaybeSRT srt])),
+           nest 2 (vcat (map pprStgAlt alts)),
+           char '}']
 
 pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
           => GenStgAlt bndr occ -> SDoc
 pprStgAlt (con, params, _use_mask, expr)
   = hang (hsep [ppr con, interppSP params, ptext (sLit "->")])
-	 4 (ppr expr <> semi)
+         4 (ppr expr <> semi)
 
 pprStgOp :: StgOp -> SDoc
 pprStgOp (StgPrimOp  op)   = ppr op
@@ -807,46 +789,43 @@ pprStgOp (StgPrimCallOp op)= ppr op
 pprStgOp (StgFCallOp op _) = ppr op
 
 instance Outputable AltType where
-  ppr PolyAlt 	     = ptext (sLit "Polymorphic")
+  ppr PolyAlt        = ptext (sLit "Polymorphic")
   ppr (UbxTupAlt tc) = ptext (sLit "UbxTup") <+> ppr tc
   ppr (AlgAlt tc)    = ptext (sLit "Alg")    <+> ppr tc
   ppr (PrimAlt tc)   = ptext (sLit "Prim")   <+> ppr tc
-\end{code}
 
-\begin{code}
 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
 pprStgLVs lvs
   = getPprStyle $ \ sty ->
     if userStyle sty || isEmptyUniqSet lvs then
-	empty
+        empty
     else
-	hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
-\end{code}
+        hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
 
-\begin{code}
 pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
-	  => GenStgRhs bndr bdee -> SDoc
+          => GenStgRhs bndr bdee -> SDoc
 
 -- special case
 pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp func []))
   = hcat [ ppr cc,
-	   pp_binder_info bi,
-	   brackets (ifPprDebug (ppr free_var)),
-	   ptext (sLit " \\"), ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
+           pp_binder_info bi,
+           brackets (ifPprDebug (ppr free_var)),
+           ptext (sLit " \\"), ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
 
 -- general case
 pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
   = hang (hsep [if opt_SccProfilingOn then ppr cc else empty,
-		pp_binder_info bi,
-		ifPprDebug (brackets (interppSP free_vars)),
-		char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
-	 4 (ppr body)
+                pp_binder_info bi,
+                ifPprDebug (brackets (interppSP free_vars)),
+                char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
+         4 (ppr body)
 
 pprStgRhs (StgRhsCon cc con args)
   = hcat [ ppr cc,
-	   space, ppr con, ptext (sLit "! "), brackets (interppSP args)]
+           space, ppr con, ptext (sLit "! "), brackets (interppSP args)]
 
 pprMaybeSRT :: SRT -> SDoc
 pprMaybeSRT (NoSRT) = empty
 pprMaybeSRT srt     = ptext (sLit "srt:") <> pprSRT srt
 \end{code}
+
diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index 0a94b2b5a7..6269051e5f 100644
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -27,6 +27,7 @@ import SrcLoc
 import Outputable
 import UniqFM
 import FastString
+import VarSet   ( varSetElems )
 
 import Maybes
 import Control.Monad
@@ -166,7 +167,7 @@ then we have a coercion (ie, type instance of family instance coercion)
 which implies that :R42T was declared as 'data instance T [a]'.
 
 \begin{code}
-tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
+tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (FamInst, [Type]))
 tcLookupFamInst tycon tys
   | not (isFamilyTyCon tycon)
   = return Nothing
@@ -176,7 +177,7 @@ tcLookupFamInst tycon tys
        ; case lookupFamInstEnv instEnv tycon tys of
 	   []                      -> return Nothing
 	   ((fam_inst, rep_tys):_) 
-             -> return $ Just (famInstTyCon fam_inst, rep_tys)
+             -> return $ Just (fam_inst, rep_tys)
        }
 
 tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type])
@@ -189,8 +190,9 @@ tcLookupDataFamInst tycon tys
   = ASSERT( isAlgTyCon tycon )
     do { maybeFamInst <- tcLookupFamInst tycon tys
        ; case maybeFamInst of
-           Nothing      -> famInstNotFound tycon tys
-           Just famInst -> return famInst }
+           Nothing             -> famInstNotFound tycon tys
+           Just (famInst, tys) -> let tycon' = dataFamInstRepTyCon famInst
+                                  in return (tycon', tys) }
 
 famInstNotFound :: TyCon -> [Type] -> TcM a
 famInstNotFound tycon tys 
@@ -250,7 +252,7 @@ addLocalFamInst home_fie famInst = do
     let inst_envs = (eps_fam_inst_env eps, home_fie)
 
         -- Check for conflicting instance decls
-    skol_tvs <- tcInstSkolTyVars (tyConTyVars (famInstTyCon famInst))
+    skol_tvs <- tcInstSkolTyVars (varSetElems (famInstTyVars famInst))
     let conflicts = lookupFamInstEnvConflicts inst_envs famInst skol_tvs
     -- If there are any conflicts, we should probably error
     -- But, if we're allowed to overwrite and the conflict is in the home FIE,
@@ -285,7 +287,7 @@ checkForConflicts inst_envs famInst
 		-- We use tcInstSkolType because we don't want to allocate
 		-- fresh *meta* type variables.  
 
-       ; skol_tvs <- tcInstSkolTyVars (tyConTyVars (famInstTyCon famInst))
+       ; skol_tvs <- tcInstSkolTyVars (varSetElems (famInstTyVars famInst))
        ; let conflicts = lookupFamInstEnvConflicts inst_envs famInst skol_tvs
        ; unless (null conflicts) $
 	   conflictInstErr famInst (fst (head conflicts))
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 34f68182ec..09ea2dfab4 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -395,7 +395,7 @@ tcGetInstEnvs :: TcM (InstEnv, InstEnv)
 tcGetInstEnvs = do { eps <- getEps; env <- getGblEnv;
 		     return (eps_inst_env eps, tcg_inst_env env) }
 
-tcExtendLocalInstEnv :: [Instance] -> TcM a -> TcM a
+tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
   -- Add new locally-defined instances
 tcExtendLocalInstEnv dfuns thing_inside
  = do { traceDFuns dfuns
@@ -405,7 +405,7 @@ tcExtendLocalInstEnv dfuns thing_inside
 			 tcg_inst_env = inst_env' }
       ; setGblEnv env' thing_inside }
 
-addLocalInst :: InstEnv -> Instance -> TcM InstEnv
+addLocalInst :: InstEnv -> ClsInst -> TcM InstEnv
 -- Check that the proposed new instance is OK, 
 -- and then add it to the home inst env
 -- If overwrite_inst, then we can overwrite a direct match
@@ -468,30 +468,30 @@ addLocalInst home_ie ispec = do
                     , let (_,_,_,dup_tys) = instanceHead dup_ispec
                     , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)]
 
-traceDFuns :: [Instance] -> TcRn ()
+traceDFuns :: [ClsInst] -> TcRn ()
 traceDFuns ispecs
   = traceTc "Adding instances:" (vcat (map pp ispecs))
   where
     pp ispec = ppr (instanceDFunId ispec) <+> colon <+> ppr ispec
 	-- Print the dfun name itself too
 
-funDepErr :: Instance -> [Instance] -> TcRn ()
+funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
 funDepErr ispec ispecs
   = addDictLoc ispec $
     addErr (hang (ptext (sLit "Functional dependencies conflict between instance declarations:"))
 	       2 (pprInstances (ispec:ispecs)))
-dupInstErr :: Instance -> Instance -> TcRn ()
+dupInstErr :: ClsInst -> ClsInst -> TcRn ()
 dupInstErr ispec dup_ispec
   = addDictLoc ispec $
     addErr (hang (ptext (sLit "Duplicate instance declarations:"))
 	       2 (pprInstances [ispec, dup_ispec]))
-overlappingInstErr :: Instance -> Instance -> TcRn ()
+overlappingInstErr :: ClsInst -> ClsInst -> TcRn ()
 overlappingInstErr ispec dup_ispec
   = addDictLoc ispec $
     addErr (hang (ptext (sLit "Overlapping instance declarations:"))
 	       2 (pprInstances [ispec, dup_ispec]))
 
-addDictLoc :: Instance -> TcRn a -> TcRn a
+addDictLoc :: ClsInst -> TcRn a -> TcRn a
 addDictLoc ispec thing_inside
   = setSrcSpan (mkSrcSpan loc loc) thing_inside
   where
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 67b36bf733..ba77be5f4d 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -338,16 +338,16 @@ tcDeriving tycl_decls inst_decls deriv_decls
   ; let all_tycons = map ATyCon (bagToList newTyCons)
   ; gbl_env <- tcExtendGlobalEnv all_tycons $
                tcExtendGlobalEnvImplicit (concatMap implicitTyThings all_tycons) $
-               tcExtendLocalFamInstEnv (map mkLocalFamInst (bagToList famInsts)) $
+               tcExtendLocalFamInstEnv (bagToList famInsts) $
                tcExtendLocalInstEnv (map iSpec (bagToList inst_info)) getGblEnv
 
   ; return (addTcgDUs gbl_env rn_dus, inst_info, rn_binds) }
   where
     ddump_deriving :: Bag (InstInfo Name) -> HsValBinds Name 
-                   -> Bag TyCon  -- ^ Empty data constructors
-                   -> Bag TyCon  -- ^ Rep type family instances
+                   -> Bag TyCon    -- ^ Empty data constructors
+                   -> Bag FamInst  -- ^ Rep type family instances
                    -> SDoc
-    ddump_deriving inst_infos extra_binds repMetaTys repTyCons
+    ddump_deriving inst_infos extra_binds repMetaTys repFamInsts
       =    hang (ptext (sLit "Derived instances:"))
               2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
                  $$ ppr extra_binds)
@@ -355,11 +355,14 @@ tcDeriving tycl_decls inst_decls deriv_decls
               hangP "Generated datatypes for meta-information:"
                (vcat (map ppr (bagToList repMetaTys)))
            $$ hangP "Representation types:"
-                (vcat (map pprTyFamInst (bagToList repTyCons))))
-    
-    pprTyFamInst t = ppr t <+> text "=" <+> ppr (synTyConType t)
+                (vcat (map pprRepTy (bagToList repFamInsts))))
+
     hangP s x = text "" $$ hang (ptext (sLit s)) 2 x
 
+-- Prints the representable type family instance
+pprRepTy :: FamInst -> SDoc
+pprRepTy fi
+  = pprFamInstHdr fi <+> ptext (sLit "=") <+> ppr (coAxiomRHS (famInstAxiom fi))
 
 renameDeriv :: Bool
 	    -> [InstInfo RdrName]
@@ -1349,7 +1352,7 @@ inferInstanceContexts oflag infer_specs
         the_pred = mkClassPred clas inst_tys
 
 ------------------------------------------------------------------
-mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> Instance
+mkInstance :: OverlapFlag -> ThetaType -> DerivSpec -> ClsInst
 mkInstance overlap_flag theta
 	    (DS { ds_name = dfun_name
 		, ds_tvs = tyvars, ds_cls = clas, ds_tys = tys })
@@ -1358,7 +1361,7 @@ mkInstance overlap_flag theta
     dfun = mkDictFunId dfun_name tyvars theta clas tys
 
 
-extendLocalInstEnv :: [Instance] -> TcM a -> TcM a
+extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
 -- Add new locally-defined instances; don't bother to check
 -- for functional dependency errors -- that'll happen in TcInstDcls
 extendLocalInstEnv dfuns thing_inside
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 5c2c895866..915978ba3a 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -17,7 +17,7 @@ module TcEnv(
         tcLookupLocatedGlobal, tcLookupGlobal, 
         tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
-        tcLookupLocatedClass, tcLookupInstance,
+        tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
         
         -- Local environment
         tcExtendKindEnv, tcExtendKindEnvTvs, tcExtendTcTyThingEnv,
@@ -45,7 +45,7 @@ module TcEnv(
         topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
 
         -- New Ids
-        newLocalName, newDFunName, newFamInstTyConName, 
+        newLocalName, newDFunName, newFamInstTyConName, newFamInstAxiomName,
         mkStableIdFromString, mkStableIdFromName
   ) where
 
@@ -164,6 +164,13 @@ tcLookupTyCon name = do
         ATyCon tc -> return tc
         _         -> wrongThingErr "type constructor" (AGlobal thing) name
 
+tcLookupAxiom :: Name -> TcM CoAxiom
+tcLookupAxiom name = do
+    thing <- tcLookupGlobal name
+    case thing of
+        ACoAxiom ax -> return ax
+        _           -> wrongThingErr "axiom" (AGlobal thing) name
+
 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 tcLookupLocatedGlobalId = addLocM tcLookupId
 
@@ -176,7 +183,7 @@ tcLookupLocatedTyCon = addLocM tcLookupTyCon
 -- Find the instance that exactly matches a type class application.  The class arguments must be precisely
 -- the same as in the instance declaration (modulo renaming).
 --
-tcLookupInstance :: Class -> [Type] -> TcM Instance
+tcLookupInstance :: Class -> [Type] -> TcM ClsInst
 tcLookupInstance cls tys
   = do { instEnv <- tcGetInstEnvs
        ; case lookupUniqueInstEnv instEnv cls tys of
@@ -610,7 +617,7 @@ as well as explicit user written ones.
 \begin{code}
 data InstInfo a
   = InstInfo {
-      iSpec   :: Instance,        -- Includes the dfun id.  Its forall'd type
+      iSpec   :: ClsInst,        -- Includes the dfun id.  Its forall'd type
       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
     }
 
@@ -688,13 +695,17 @@ Make a name for the representation tycon of a family instance.  It's an
 newGlobalBinder.
 
 \begin{code}
-newFamInstTyConName :: Located Name -> [Type] -> TcM Name
-newFamInstTyConName (L loc tc_name) tys
+newFamInstTyConName, newFamInstAxiomName :: Located Name -> [Type] -> TcM Name
+newFamInstTyConName = mk_fam_inst_name id
+newFamInstAxiomName = mk_fam_inst_name mkInstTyCoOcc
+
+mk_fam_inst_name :: (OccName -> OccName) -> Located Name -> [Type] -> TcM Name
+mk_fam_inst_name adaptOcc (L loc tc_name) tys
   = do  { mod   <- getModule
         ; let info_string = occNameString (getOccName tc_name) ++ 
                             concatMap (occNameString.getDFunTyKey) tys
         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
-        ; newGlobalBinder mod occ loc }
+        ; newGlobalBinder mod (adaptOcc occ) loc }
 \end{code}
 
 Stable names used for foreign exports and annotations.
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 340b33c749..67f212fd98 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -31,7 +31,8 @@ import TcUnify
 import BasicTypes
 import Inst
 import TcBinds
-import FamInst( tcLookupFamInst )
+import FamInst          ( tcLookupFamInst )
+import FamInstEnv       ( famInstAxiom, dataFamInstRepTyCon )
 import TcEnv
 import TcArrows
 import TcMatches
@@ -1159,12 +1160,12 @@ tcTagToEnum loc fun_name arg res_ty
       = do { mb_fam <- tcLookupFamInst tc tc_args
            ; case mb_fam of 
 	       Nothing -> failWithTc (tagToEnumError ty doc3)
-               Just (rep_tc, rep_args) 
+               Just (rep_fam, rep_args) 
                    -> return ( mkTcSymCo (mkTcAxInstCo co_tc rep_args)
                              , rep_tc, rep_args )
                  where
-                   co_tc = expectJust "tcTagToEnum" $
-                           tyConFamilyCoercion_maybe rep_tc }
+                   co_tc  = famInstAxiom rep_fam
+                   rep_tc = dataFamInstRepTyCon rep_fam }
 
 tagToEnumError :: TcType -> SDoc -> SDoc
 tagToEnumError ty what
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 0839e183be..70d841e5ed 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -49,6 +49,7 @@ import Name
 
 import HscTypes
 import PrelInfo
+import FamInstEnv( FamInst )
 import MkCore	( eRROR_ID )
 import PrelNames hiding (error_RDR)
 import PrimOp
@@ -90,7 +91,7 @@ data DerivStuff     -- Please add this auxiliary stuff
 
   -- Generics
   | DerivTyCon TyCon      -- New data types
-  | DerivFamInst TyCon    -- New type family instances
+  | DerivFamInst FamInst  -- New type family instances
 
   -- New top-level auxiliary bindings 
   | DerivHsBind (LHsBind RdrName, LSig RdrName) -- Also used for SYB
@@ -1800,8 +1801,8 @@ genAuxBindSpec loc (DerivMaxTag tycon)
 type SeparateBagsDerivStuff = -- AuxBinds and SYB bindings
                               ( Bag (LHsBind RdrName, LSig RdrName)
                                 -- Extra bindings (used by Generic only)
-                              , Bag TyCon -- Extra top-level datatypes
-                              , Bag TyCon -- Extra family instances
+                              , Bag TyCon   -- Extra top-level datatypes
+                              , Bag FamInst -- Extra family instances
                               , Bag (InstInfo RdrName)) -- Extra instances
 
 genAuxBinds :: SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index 126575d45e..8bef05968f 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -24,9 +24,10 @@ import TcType
 import TcGenDeriv
 import DataCon
 import TyCon
-import Name hiding (varName)
-import Module (Module, moduleName, moduleNameString)
-import IfaceEnv (newGlobalBinder)
+import FamInstEnv       ( FamInst, mkSynFamInst )
+import Module           ( Module, moduleName, moduleNameString )
+import IfaceEnv         ( newGlobalBinder )
+import Name      hiding ( varName )
 import RdrName
 import BasicTypes
 import TysWiredIn
@@ -70,7 +71,7 @@ gen_Generic_binds tc mod = do
                    `consBag` ((mapBag DerivTyCon (metaTyCons2TyCons metaTyCons))
                    `unionBags` metaInsts)) }
 
-genGenericRepExtras :: TyCon -> Module -> TcM (MetaTyCons, TyCon)
+genGenericRepExtras :: TyCon -> Module -> TcM (MetaTyCons, FamInst)
 genGenericRepExtras tc mod =
   do  uniqS <- newUniqueSupply
       let
@@ -99,15 +100,14 @@ genGenericRepExtras tc mod =
         
         mkTyCon name = ASSERT( isExternalName name )
                        buildAlgTyCon name [] [] distinctAbstractTyConRhs
-                           NonRecursive False NoParentTyCon Nothing
+                                          NonRecursive False NoParentTyCon
 
-      metaDTyCon  <- mkTyCon d_name
-      metaCTyCons <- sequence [ mkTyCon c_name | c_name <- c_names ]
-      metaSTyCons <- mapM sequence 
-                       [ [ mkTyCon s_name 
-                         | s_name <- s_namesC ] | s_namesC <- s_names ]
+      let metaDTyCon  = mkTyCon d_name
+          metaCTyCons = map mkTyCon c_names
+          metaSTyCons =  [ [ mkTyCon s_name | s_name <- s_namesC ] 
+                         | s_namesC <- s_names ]
 
-      let metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons
+          metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons
   
       rep0_tycon <- tc_mkRepTyCon tc metaDts mod
       
@@ -257,7 +257,7 @@ mkBindsRep tycon =
 tc_mkRepTyCon :: TyCon            -- The type to generate representation for
                -> MetaTyCons      -- Metadata datatypes to refer to
                -> Module          -- Used as the location of the new RepTy
-               -> TcM TyCon       -- Generated representation0 type
+               -> TcM FamInst     -- Generated representation0 coercion
 tc_mkRepTyCon tycon metaDts mod = 
 -- Consider the example input tycon `D`, where data D a b = D_ a
   do { -- `rep0` = GHC.Generics.Rep (type family)
@@ -269,17 +269,14 @@ tc_mkRepTyCon tycon metaDts mod =
        -- `rep_name` is a name we generate for the synonym
      ; rep_name <- newGlobalBinder mod (mkGenR (nameOccName (tyConName tycon)))
                      (nameSrcSpan (tyConName tycon))
+
      ; let -- `tyvars` = [a,b]
            tyvars  = tyConTyVars tycon
 
-           -- rep0Ty has kind * -> *
-           rep_kind = liftedTypeKind `mkArrowKind` liftedTypeKind
-
            -- `appT` = D a b
            appT = [mkTyConApp tycon (mkTyVarTys tyvars)]
-
-     ; buildSynTyCon rep_name tyvars (SynonymTyCon rep0Ty) rep_kind
-                     NoParentTyCon (Just (rep0, appT)) }
+     ; return $ mkSynFamInst rep_name tyvars rep0 appT rep0Ty
+     }
 
 
 
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 11ec17546b..ac9769ca25 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -366,40 +366,30 @@ tcInstDecls1    -- Deal with both source-code and imported instance decls
 
 tcInstDecls1 tycl_decls inst_decls deriv_decls 
   = checkNoErrs $
-    do {        -- Stop if addInstInfos etc discovers any errors
-                -- (they recover, so that we get more than one error each
-                -- round)
-
-                -- (1) Do class and family instance declarations
-       ; idx_tycons        <- mapAndRecoverM tcTopFamInstDecl $
-                              filter (isFamInstDecl . unLoc) tycl_decls
-       ; local_info_tycons <- mapAndRecoverM tcLocalInstDecl1  inst_decls
-
-       ; let { (local_info,
-                at_tycons_s)   = unzip local_info_tycons
-             ; at_idx_tycons   = concat at_tycons_s ++ idx_tycons
-             ; at_things       = map ATyCon at_idx_tycons }
-
-                -- (2) Add the tycons of indexed types and their implicit
-                --     tythings to the global environment
-       ; tcExtendGlobalEnvImplicit at_things $ do
-       { tcg_env <- tcAddImplicits at_things
-       ; setGblEnv tcg_env $
-
-
-                -- Next, construct the instance environment so far, consisting
-                -- of
-                --   (a) local instance decls
-                --   (b) local family instance decls
-         addInsts local_info         $
-         addFamInsts at_idx_tycons   $ do {
-
-                -- (3) Compute instances from "deriving" clauses;
-                -- This stuff computes a context for the derived instance
-                -- decl, so it needs to know about all the instances possible
-                -- NB: class instance declarations can contain derivings as
-                --     part of associated data type declarations
-         failIfErrsM    -- If the addInsts stuff gave any errors, don't
+    do {    -- Stop if addInstInfos etc discovers any errors
+            -- (they recover, so that we get more than one error each
+            -- round)
+
+            -- (1) Do class and family instance declarations
+       ; fam_insts       <- mapAndRecoverM tcTopFamInstDecl $
+                            filter (isFamInstDecl . unLoc) tycl_decls
+       ; inst_decl_stuff <- mapAndRecoverM tcLocalInstDecl1  inst_decls
+
+       ; let { (local_info, at_fam_insts_s) = unzip inst_decl_stuff
+             ; all_fam_insts = concat at_fam_insts_s ++ fam_insts }
+
+            -- (2) Next, construct the instance environment so far, consisting of
+            --   (a) local instance decls
+            --   (b) local family instance decls
+       ; addClsInsts local_info      $
+         addFamInsts all_fam_insts   $ do
+
+            -- (3) Compute instances from "deriving" clauses;
+            -- This stuff computes a context for the derived instance
+            -- decl, so it needs to know about all the instances possible
+            -- NB: class instance declarations can contain derivings as
+            --     part of associated data type declarations
+       { failIfErrsM    -- If the addInsts stuff gave any errors, don't
                         -- try the deriving stuff, because that may give
                         -- more errors still
 
@@ -421,24 +411,33 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
        ; return ( gbl_env
                 , (bagToList deriv_inst_info) ++ local_info
                 , deriv_binds)
-    }}}
+    }}
   where
     typInstCheck ty = is_cls (iSpec ty) `elem` typeableClassNames
     typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe"
                               ++ " Haskell! Can only derive them"
 
-addInsts :: [InstInfo Name] -> TcM a -> TcM a
-addInsts infos thing_inside
+addClsInsts :: [InstInfo Name] -> TcM a -> TcM a
+addClsInsts infos thing_inside
   = tcExtendLocalInstEnv (map iSpec infos) thing_inside
 
-addFamInsts :: [TyCon] -> TcM a -> TcM a
-addFamInsts tycons thing_inside
-  = tcExtendLocalFamInstEnv (map mkLocalFamInst tycons) thing_inside
+addFamInsts :: [FamInst] -> TcM a -> TcM a
+-- Extend (a) the family instance envt
+--        (b) the type envt with stuff from data type decls
+addFamInsts fam_insts thing_inside
+  = tcExtendLocalFamInstEnv fam_insts $ 
+    tcExtendGlobalEnvImplicit things  $ 
+    do { tcg_env <- tcAddImplicits things
+       ; setGblEnv tcg_env thing_inside }
+  where
+    axioms = map famInstAxiom fam_insts
+    tycons = famInstsRepTyCons fam_insts
+    things = map ATyCon tycons ++ map ACoAxiom axioms 
 \end{code}
 
 \begin{code}
 tcLocalInstDecl1 :: LInstDecl Name
-                 -> TcM (InstInfo Name, [TyCon])
+                 -> TcM (InstInfo Name, [FamInst])
         -- A source-file instance declaration
         -- Type-check all the stuff before the "where"
         --
@@ -457,14 +456,14 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats))
                            
         -- Next, process any associated types.
         ; traceTc "tcLocalInstDecl" (ppr poly_ty)
-        ; idx_tycons0 <- tcExtendTyVarEnv tyvars $
-                         mapAndRecoverM (tcAssocDecl clas mini_env) ats
+        ; fam_insts0 <- tcExtendTyVarEnv tyvars $
+                        mapAndRecoverM (tcAssocDecl clas mini_env) ats
 
         -- Check for missing associated types and build them
         -- from their defaults (if available)
         ; let defined_ats = mkNameSet $ map (tcdName . unLoc) ats
 
-              mk_deflt_at_instances :: ClassATItem -> TcM [TyCon]
+              mk_deflt_at_instances :: ClassATItem -> TcM [FamInst]
               mk_deflt_at_instances (fam_tc, defs)
                  -- User supplied instances ==> everything is OK
                 | tyConName fam_tc `elemNameSet` defined_ats 
@@ -487,12 +486,9 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats))
                            tvs'     = varSetElems tv_set'
                      ; rep_tc_name <- newFamInstTyConName (noLoc (tyConName fam_tc)) pat_tys'
                      ; ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' ) 
-                       buildSynTyCon rep_tc_name tvs'
-                                     (SynonymTyCon rhs')
-                                     (typeKind rhs')
-                                     NoParentTyCon (Just (fam_tc, pat_tys')) }
+                       return (mkSynFamInst rep_tc_name tvs' fam_tc pat_tys' rhs') }
 
-        ; idx_tycons1 <- mapM mk_deflt_at_instances (classATItems clas)
+        ; fam_insts1 <- mapM mk_deflt_at_instances (classATItems clas)
         
         -- Finally, construct the Core representation of the instance.
         -- (This no longer includes the associated types.)
@@ -504,10 +500,9 @@ tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats))
               ispec 	= mkLocalInstance dfun overlap_flag
               inst_info = InstInfo { iSpec  = ispec, iBinds = VanillaInst binds uprags False }
 
-        ; return (inst_info, idx_tycons0 ++ concat idx_tycons1) }
+        ; return ( inst_info, fam_insts0 ++ concat fam_insts1) }
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                Type checking family instances
@@ -520,15 +515,15 @@ lot of kinding and type checking code with ordinary algebraic data types (and
 GADTs).
 
 \begin{code}
-tcTopFamInstDecl :: LTyClDecl Name -> TcM TyCon
+tcTopFamInstDecl :: LTyClDecl Name -> TcM FamInst
 tcTopFamInstDecl (L loc decl)
   = setSrcSpan loc      $
     tcAddDeclCtxt decl  $
     tcFamInstDecl TopLevel decl
 
-tcFamInstDecl :: TopLevelFlag -> TyClDecl Name -> TcM TyCon
+tcFamInstDecl :: TopLevelFlag -> TyClDecl Name -> TcM FamInst
 tcFamInstDecl top_lvl decl
-  = do { -- type family instances require -XTypeFamilies
+  = do { -- Type family instances require -XTypeFamilies
          -- and can't (currently) be in an hs-boot file
        ; traceTc "tcFamInstDecl" (ppr decl)
        ; let fam_tc_lname = tcdLName decl
@@ -546,13 +541,9 @@ tcFamInstDecl top_lvl decl
 
          -- Now check the type/data instance itself
          -- This is where type and data decls are treated separately
-       ; tc <- tcFamInstDecl1 fam_tc decl
-       ; checkValidTyCon tc     -- Remember to check validity;
-                                -- no recursion to worry about here
+       ; tcFamInstDecl1 fam_tc decl }
 
-       ; return tc }
-
-tcFamInstDecl1 :: TyCon -> TyClDecl Name -> TcM TyCon
+tcFamInstDecl1 :: TyCon -> TyClDecl Name -> TcM FamInst
 
   -- "type instance"
 tcFamInstDecl1 fam_tc (decl@TySynonym {})
@@ -563,17 +554,14 @@ tcFamInstDecl1 fam_tc (decl@TySynonym {})
        ; checkValidFamInst t_typats t_rhs
 
          -- (3) construct representation tycon
-       ; rep_tc_name <- newFamInstTyConName (tcdLName decl) t_typats
-       ; buildSynTyCon rep_tc_name t_tvs
-                       (SynonymTyCon t_rhs)
-                       (typeKind t_rhs)
-                       NoParentTyCon (Just (fam_tc, t_typats))
-       }
+       ; rep_tc_name <- newFamInstAxiomName (tcdLName decl) t_typats
+
+       ; return (mkSynFamInst rep_tc_name t_tvs fam_tc t_typats t_rhs) }
 
   -- "newtype instance" and "data instance"
 tcFamInstDecl1 fam_tc (decl@TyData { tcdND = new_or_data, tcdCtxt = ctxt
                                    , tcdTyVars = tvs, tcdTyPats = Just pats
-                                  , tcdCons = cons})
+                                   , tcdCons = cons})
   = do { -- Check that the family declaration is for the right kind
          checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
        ; checkTc (isAlgTyCon fam_tc) (wrongKindOfFamily fam_tc)
@@ -595,27 +583,33 @@ tcFamInstDecl1 fam_tc (decl@TyData { tcdND = new_or_data, tcdCtxt = ctxt
 
          -- Construct representation tycon
        ; rep_tc_name <- newFamInstTyConName (tcdLName decl) pats'
+       ; axiom_name  <- newImplicitBinder rep_tc_name mkInstTyCoOcc
        ; let ex_ok = True       -- Existentials ok for type families!
-       ; fixM (\ rep_tycon -> do
-             { let orig_res_ty = mkTyConApp fam_tc pats'
-             ; data_cons <- tcConDecls new_or_data ex_ok rep_tycon
+             orig_res_ty = mkTyConApp fam_tc pats'
+
+       ; (rep_tc, fam_inst) <- fixM $ \ ~(rec_rep_tc, _) ->
+           do { data_cons <- tcConDecls new_or_data ex_ok rec_rep_tc
                                        (tvs', orig_res_ty) cons
-             ; tc_rhs <-
-                 case new_or_data of
-                   DataType -> return (mkDataTyConRhs data_cons)
-                   NewType  -> ASSERT( not (null data_cons) )
-                               mkNewTyConRhs rep_tc_name rep_tycon (head data_cons)
-             ; buildAlgTyCon rep_tc_name tvs' stupid_theta tc_rhs Recursive
-                             h98_syntax NoParentTyCon (Just (fam_tc, pats'))
+              ; tc_rhs <- case new_or_data of
+                     DataType -> return (mkDataTyConRhs data_cons)
+                     NewType  -> ASSERT( not (null data_cons) )
+                                 mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons)
+              ; let fam_inst = mkDataFamInst axiom_name tvs' fam_tc pats' rep_tc
+                    parent   = FamInstTyCon (famInstAxiom fam_inst) fam_tc pats'
+                    rep_tc   = buildAlgTyCon rep_tc_name tvs' stupid_theta tc_rhs 
+                                             Recursive h98_syntax parent
                  -- We always assume that indexed types are recursive.  Why?
                  -- (1) Due to their open nature, we can never be sure that a
                  -- further instance might not introduce a new recursive
                  -- dependency.  (2) They are always valid loop breakers as
                  -- they involve a coercion.
-             })
-       } }
+              ; return (rep_tc, fam_inst) }
+
+         -- Remember to check validity; no recursion to worry about here
+       ; checkValidTyCon rep_tc
+       ; return fam_inst } }
     where
-         h98_syntax = case cons of      -- All constructors have same shape
+       h98_syntax = case cons of      -- All constructors have same shape
                         L _ (ConDecl { con_res = ResTyGADT _ }) : _ -> False
                         _ -> True
 
@@ -626,26 +620,28 @@ tcFamInstDecl1 _ d = pprPanic "tcFamInstDecl1" (ppr d)
 tcAssocDecl :: Class           -- ^ Class of associated type
             -> VarEnv Type     -- ^ Instantiation of class TyVars
             -> LTyClDecl Name  -- ^ RHS
-            -> TcM TyCon
+            -> TcM FamInst
 tcAssocDecl clas mini_env (L loc decl)
   = setSrcSpan loc      $
     tcAddDeclCtxt decl  $
-    do { at_tc <- tcFamInstDecl NotTopLevel decl
-       ; let Just (fam_tc, at_tys) = tyConFamInst_maybe at_tc
-  
+    do { fam_inst <- tcFamInstDecl NotTopLevel decl
+       ; let (fam_tc, at_tys) = famInstLHS fam_inst
+
        -- Check that the associated type comes from this class
        ; checkTc (Just clas == tyConAssoc_maybe fam_tc)
-                 (badATErr (className clas) (tyConName at_tc))
+                 (badATErr (className clas) (tyConName fam_tc))
 
        -- See Note [Checking consistent instantiation] in TcTyClsDecls
        ; zipWithM_ check_arg (tyConTyVars fam_tc) at_tys
 
-       ; return at_tc }
+       ; return fam_inst }
   where
     check_arg fam_tc_tv at_ty
       | Just inst_ty <- lookupVarEnv mini_env fam_tc_tv
       = checkTc (inst_ty `eqType` at_ty) 
                 (wrongATArgErr at_ty inst_ty)
+                -- No need to instantiate here, becuase the axiom
+                -- uses the same type variables as the assocated class
       | otherwise
       = return ()   -- Allow non-type-variable instantiation
                     -- See Note [Associated type instances]
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index e55816e056..b491e7d755 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -20,10 +20,11 @@ import TcCanonical
 import VarSet
 import Type
 import Unify
+import FamInstEnv
+import Coercion( mkAxInstRHS )
 
 import Id 
 import Var
-import VarEnv ( ) -- unitVarEnv, mkInScopeSet
 
 import TcType
 import PrelNames (typeNatClassName)
@@ -1508,16 +1509,12 @@ doTopReact _inerts workItem@(CFunEqCan { cc_id = eqv, cc_flavor = fl
                                        , cc_fun = tc, cc_tyargs = args, cc_rhs = xi })
   = ASSERT (isSynFamilyTyCon tc)   -- No associated data families have reached that far 
     do { match_res <- matchFam tc args   -- See Note [MATCHING-SYNONYMS]
-       ; case match_res of 
+       ; case match_res of
            Nothing -> return NoTopInt 
-           Just (rep_tc, rep_tys)
-             -> do { let Just coe_tc = tyConFamilyCoercion_maybe rep_tc
-                         Just rhs_ty = tcView (mkTyConApp rep_tc rep_tys)
-			    -- Eagerly expand away the type synonym on the
-			    -- RHS of a type function, so that it never
-			    -- appears in an error message
-                            -- See Note [Type synonym families] in TyCon
-                         coe = mkTcAxInstCo coe_tc rep_tys 
+           Just (famInst, rep_tys)
+             -> do { let coe_ax = famInstAxiom famInst
+                         rhs_ty = mkAxInstRHS coe_ax rep_tys
+                         coe    = mkTcAxInstCo coe_ax rep_tys 
                    ; case fl of
                        Wanted {} -> do { evc <- newEqVar fl rhs_ty xi -- Wanted version
                                        ; let eqv' = evc_the_evvar evc
@@ -1546,7 +1543,6 @@ doTopReact _inerts workItem@(CFunEqCan { cc_id = eqv, cc_flavor = fl
                                                                , cc_flavor = fl'
                                                                , cc_depth = cc_depth workItem + 1}  
                                       ; updWorkListTcS (extendWorkListEq ct) 
-
                                       ; return $ 
                                         SomeTopInt { tir_rule = "Fun/Top (given)"
                                                    , tir_new_item = ContinueWith workItem } }
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 852537223f..67f79c435a 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -549,7 +549,8 @@ zonkTcTypeAndSubst subst ty = zonkType zonk_tv ty
   where
     zonk_tv tv
       = do { z_tv <- updateTyVarKindM zonkTcKind tv
-           ; case tcTyVarDetails tv of
+           ; ASSERT ( isTcTyVar tv )
+             case tcTyVarDetails tv of
                 SkolemTv {}   -> return (TyVarTy z_tv)
                 RuntimeUnk {} -> return (TyVarTy z_tv)
                 FlatSkol ty   -> zonkType zonk_tv ty
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 137df8af7c..f1f502d967 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -761,6 +761,9 @@ matchExpectedConTy data_tc pat_ty
   = do { (_, tys, subst) <- tcInstTyVars (tyConTyVars data_tc)
        	     -- tys = [ty1,ty2]
 
+       ; traceTc "matchExpectedConTy" (vcat [ppr data_tc, 
+                                             ppr (tyConTyVars data_tc),
+                                             ppr fam_tc, ppr fam_args])
        ; co1 <- unifyType (mkTyConApp fam_tc (substTys subst fam_args)) pat_ty
        	     -- co1 : T (ty1,ty2) ~ pat_ty
 
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 4879974387..bb1013b33d 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -689,7 +689,7 @@ checkHiBootIface
     local_export_env :: NameEnv AvailInfo
     local_export_env = availsToNameEnv local_exports
 
-    check_inst :: Instance -> TcM (Maybe (Id, Id))
+    check_inst :: ClsInst -> TcM (Maybe (Id, Id))
 	-- Returns a pair of the boot dfun in terms of the equivalent real dfun
     check_inst boot_inst
 	= case [dfun | inst <- local_insts, 
@@ -838,7 +838,7 @@ bootMisMatch thing boot_decl real_decl
 	  ptext (sLit "Main module:") <+> ppr real_decl,
 	  ptext (sLit "Boot file:  ") <+> ppr boot_decl]
 
-instMisMatch :: Instance -> SDoc
+instMisMatch :: ClsInst -> SDoc
 instMisMatch inst
   = hang (ppr inst)
        2 (ptext (sLit "is defined in the hs-boot file, but not in the module itself"))
@@ -1592,7 +1592,7 @@ tcRnLookupName' name = do
 
 tcRnGetInfo :: HscEnv
             -> Name
-            -> IO (Messages, Maybe (TyThing, Fixity, [Instance]))
+            -> IO (Messages, Maybe (TyThing, Fixity, [ClsInst]))
 
 -- Used to implement :info in GHCi
 --
@@ -1607,7 +1607,7 @@ tcRnGetInfo hsc_env name
 
 tcRnGetInfo' :: HscEnv
              -> Name
-             -> TcRn (TyThing, Fixity, [Instance])
+             -> TcRn (TyThing, Fixity, [ClsInst])
 tcRnGetInfo' hsc_env name
   = let ictxt = hsc_IC hsc_env in
     setInteractiveContext hsc_env ictxt $ do
@@ -1623,7 +1623,7 @@ tcRnGetInfo' hsc_env name
     ispecs <- lookupInsts thing
     return (thing, fixity, ispecs)
 
-lookupInsts :: TyThing -> TcM [Instance]
+lookupInsts :: TyThing -> TcM [ClsInst]
 lookupInsts (ATyCon tc)
   | Just cls <- tyConClass_maybe tc
   = do  { inst_envs <- tcGetInstEnvs
@@ -1734,7 +1734,7 @@ pprModGuts (ModGuts { mg_tcs = tcs
   = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs)),
 	   ppr_rules rules ]
 
-ppr_types :: [Instance] -> TypeEnv -> SDoc
+ppr_types :: [ClsInst] -> TypeEnv -> SDoc
 ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
   where
@@ -1756,14 +1756,14 @@ ppr_tycons fam_insts type_env
          , text "COERCION AXIOMS" 
          ,   nest 2 (vcat (map pprCoAxiom (typeEnvCoAxioms type_env))) ]
   where
-    fi_tycons = map famInstTyCon fam_insts
+    fi_tycons = famInstsRepTyCons fam_insts
     tycons = [tycon | tycon <- typeEnvTyCons type_env, want_tycon tycon]
     want_tycon tycon | opt_PprStyle_Debug = True
 	             | otherwise	  = not (isImplicitTyCon tycon) &&
 					    isExternalName (tyConName tycon) &&
 				            not (tycon `elem` fi_tycons)
 
-ppr_insts :: [Instance] -> SDoc
+ppr_insts :: [ClsInst] -> SDoc
 ppr_insts []     = empty
 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index b85a892651..8b59a1224f 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -305,7 +305,7 @@ data TcGblEnv
 	tcg_warns     :: Warnings,	    -- ...Warnings and deprecations
 	tcg_anns      :: [Annotation],      -- ...Annotations
         tcg_tcs       :: [TyCon],           -- ...TyCons and Classes
-	tcg_insts     :: [Instance],	    -- ...Instances
+	tcg_insts     :: [ClsInst],	    -- ...Instances
         tcg_fam_insts :: [FamInst],         -- ...Family instances
         tcg_rules     :: [LRuleDecl Id],    -- ...Rules
         tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index aabc7372e1..1106c92dba 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -1197,7 +1197,8 @@ isTouchableMetaTyVar tv
 
 isTouchableMetaTyVar_InRange :: TcsUntouchables -> TcTyVar -> Bool 
 isTouchableMetaTyVar_InRange (untch,untch_tcs) tv 
-  = case tcTyVarDetails tv of 
+  = ASSERT2 ( isTcTyVar tv, ppr tv )
+    case tcTyVarDetails tv of 
       MetaTv TcsTv _ -> not (tv `elemVarSet` untch_tcs)
                         -- See Note [Touchable meta type variables] 
       MetaTv {}      -> inTouchableRange untch tv 
@@ -1469,7 +1470,7 @@ matchClass clas tys
 	}
         }
 
-matchFam :: TyCon -> [Type] -> TcS (Maybe (TyCon, [Type]))
+matchFam :: TyCon -> [Type] -> TcS (Maybe (FamInst, [Type]))
 matchFam tycon args = wrapTcS $ tcLookupFamInst tycon args
 \end{code}
 
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 5653a153ce..6efbdf9ee9 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1268,7 +1268,7 @@ reifyClass cls
                           ; return (TH.SigD (reifyName op) ty) }
 
 ------------------------------
-reifyClassInstance :: Instance -> TcM TH.Dec
+reifyClassInstance :: ClsInst -> TcM TH.Dec
 reifyClassInstance i
   = do { cxt <- reifyCxt theta
        ; thtypes <- reifyTypes types
@@ -1280,21 +1280,22 @@ reifyClassInstance i
 ------------------------------
 reifyFamilyInstance :: FamInst -> TcM TH.Dec
 reifyFamilyInstance fi
-  | isSynTyCon rep_tc
-  = do { th_tys <- reifyTypes (fi_tys fi)
-       ; rhs_ty <- reifyType (synTyConType rep_tc)
-       ; return (TH.TySynInstD fam th_tys rhs_ty) }
-
-  | otherwise
-  = do { let tvs = tyConTyVars rep_tc
-             fam = reifyName (fi_fam fi)
-       ; cons <- mapM (reifyDataCon (mkTyVarTys tvs)) (tyConDataCons rep_tc)
-       ; th_tys <- reifyTypes (fi_tys fi)
-       ; return (if isNewTyCon rep_tc
-                 then TH.NewtypeInstD [] fam th_tys (head cons) []
-                 else TH.DataInstD    [] fam th_tys cons        []) }
+  = case fi_flavor fi of
+      SynFamilyInst ->
+        do { th_tys <- reifyTypes (fi_tys fi)
+           ; rhs_ty <- reifyType (coAxiomRHS rep_ax)
+           ; return (TH.TySynInstD fam th_tys rhs_ty) }
+
+      DataFamilyInst rep_tc ->
+        do { let tvs = tyConTyVars rep_tc
+                 fam = reifyName (fi_fam fi)
+           ; cons <- mapM (reifyDataCon (mkTyVarTys tvs)) (tyConDataCons rep_tc)
+           ; th_tys <- reifyTypes (fi_tys fi)
+           ; return (if isNewTyCon rep_tc
+                     then TH.NewtypeInstD [] fam th_tys (head cons) []
+                     else TH.DataInstD    [] fam th_tys cons        []) }
   where
-    rep_tc = fi_tycon fi
+    rep_ax = fi_axiom fi
     fam = reifyName (fi_fam fi)
 
 ------------------------------
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index f91ccdf43d..2e0e45bdc9 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -558,7 +558,7 @@ tcTyClDecl1 parent _calc_isrec
   = tcTyClTyVars tc_name tvs $ \ tvs' kind -> do
   { traceTc "type family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; tycon <- buildSynTyCon tc_name tvs' SynFamilyTyCon kind parent Nothing
+  ; tycon <- buildSynTyCon tc_name tvs' SynFamilyTyCon kind parent
   ; return [ATyCon tycon] }
 
   -- "data family" declaration
@@ -569,8 +569,8 @@ tcTyClDecl1 parent _calc_isrec
   ; checkFamFlag tc_name
   ; extra_tvs <- tcDataKindSig kind
   ; let final_tvs = tvs' ++ extra_tvs    -- we may not need these
-  ; tycon <- buildAlgTyCon tc_name final_tvs []
-               DataFamilyTyCon Recursive True parent Nothing
+        tycon = buildAlgTyCon tc_name final_tvs []
+                              DataFamilyTyCon Recursive True parent
   ; return [ATyCon tycon] }
 
   -- "type" synonym declaration
@@ -580,7 +580,7 @@ tcTyClDecl1 _parent _calc_isrec
     tcTyClTyVars tc_name tvs $ \ tvs' kind -> do
     { rhs_ty' <- tcCheckHsType rhs_ty kind
     ; tycon <- buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty')
-      	       		     kind NoParentTyCon Nothing
+                 kind NoParentTyCon
     ; return [ATyCon tycon] }
 
   -- "newtype" and "data"
@@ -606,7 +606,7 @@ tcTyClDecl1 _parent calc_isrec
 
   ; dataDeclChecks tc_name new_or_data stupid_theta cons
 
-  ; tycon <- fixM (\ tycon -> do
+  ; tycon <- fixM $ \ tycon -> do
 	{ let res_ty = mkTyConApp tycon (mkTyVarTys final_tvs)
 	; data_cons <- tcConDecls new_or_data ex_ok tycon (final_tvs, res_ty) cons
 	; tc_rhs <-
@@ -616,9 +616,8 @@ tcTyClDecl1 _parent calc_isrec
 		   DataType -> return (mkDataTyConRhs data_cons)
 		   NewType  -> ASSERT( not (null data_cons) )
                                mkNewTyConRhs tc_name tycon (head data_cons)
-	; buildAlgTyCon tc_name final_tvs stupid_theta tc_rhs is_rec
-	    (not h98_syntax) NoParentTyCon Nothing
-	})
+	; return (buildAlgTyCon tc_name final_tvs stupid_theta tc_rhs
+	                        is_rec (not h98_syntax) NoParentTyCon) }
   ; return [ATyCon tycon] }
 
 tcTyClDecl1 _parent calc_isrec
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index 6789bab913..6ea45ffd37 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -24,13 +24,17 @@ module Coercion (
         isReflCo_maybe,
         mkCoercionType,
 
+        -- ** Functions over coercion axioms
+        coAxiomSplitLHS,
+
 	-- ** Constructing coercions
         mkReflCo, mkCoVarCo, 
-        mkAxInstCo, mkPiCo, mkPiCos,
+        mkAxInstCo, mkAxInstRHS,
+        mkPiCo, mkPiCos,
         mkSymCo, mkTransCo, mkNthCo,
 	mkInstCo, mkAppCo, mkTyConAppCo, mkFunCo,
         mkForAllCo, mkUnsafeCo,
-        mkNewTypeCo, mkFamInstCo,
+        mkNewTypeCo, 
 
         -- ** Decomposition
         splitNewTypeRepCo_maybe, instNewTyCon_maybe, decomposeCo,
@@ -82,7 +86,7 @@ import TyCon
 import Var
 import VarEnv
 import VarSet
-import Maybes	( orElse )
+import Maybes   ( orElse )
 import Name	( Name, NamedThing(..), nameUnique )
 import OccName 	( parenSymOcc )
 import Util
@@ -277,6 +281,23 @@ Now (Nth 0 g) will optimise to Refl, but perhaps not instantly.
 
 
 %************************************************************************
+%*                                                                      *
+\subsection{Coercion axioms}
+%*                                                                      *
+%************************************************************************
+These functions are not in TyCon because they need knowledge about
+the type representation (from TypeRep)
+
+\begin{code}
+-- If `ax :: F a ~ b`, and `F` is a family instance, returns (F, [a])
+coAxiomSplitLHS :: CoAxiom -> (TyCon, [Type])
+coAxiomSplitLHS ax
+  = case splitTyConApp_maybe (coAxiomLHS ax) of
+      Just (tc,tys) -> (tc,tys)
+      Nothing       -> pprPanic "coAxiomSplitLHS" (ppr ax)
+\end{code}
+
+%************************************************************************
 %*									*
 \subsection{Coercion variables}
 %*									*
@@ -511,6 +532,8 @@ mkReflCo :: Type -> Coercion
 mkReflCo = Refl
 
 mkAxInstCo :: CoAxiom -> [Type] -> Coercion
+-- mkAxInstCo can legitimately be called over-staturated; 
+-- i.e. with more type arguments than the coercion requires
 mkAxInstCo ax tys
   | arity == n_tys = AxiomInstCo ax rtys
   | otherwise      = ASSERT( arity < n_tys )
@@ -521,6 +544,19 @@ mkAxInstCo ax tys
     arity = coAxiomArity ax
     rtys  = map Refl tys
 
+mkAxInstRHS :: CoAxiom -> [Type] -> Type
+-- Instantiate the axiom with specified types,
+-- returning the instantiated RHS
+-- A companion to mkAxInstCo: 
+--    mkAxInstRhs ax tys = snd (coercionKind (mkAxInstCo ax tys))
+mkAxInstRHS ax tys
+  = ASSERT( tvs `equalLength` tys1 ) 
+    mkAppTys rhs' tys2
+  where
+    tvs          = coAxiomTyVars ax
+    (tys1, tys2) = splitAtList tvs tys
+    rhs'         = substTyWith tvs tys1 (coAxiomRHS ax)
+
 -- | Apply a 'Coercion' to another 'Coercion'.
 mkAppCo :: Coercion -> Coercion -> Coercion
 mkAppCo (Refl ty1) (Refl ty2)       = Refl (mkAppTy ty1 ty2)
@@ -611,28 +647,12 @@ mkUnsafeCo ty1 ty2 = UnsafeCo ty1 ty2
 --   the free variables a subset of those 'TyVar's.
 mkNewTypeCo :: Name -> TyCon -> [TyVar] -> Type -> CoAxiom
 mkNewTypeCo name tycon tvs rhs_ty
-  = CoAxiom { co_ax_unique = nameUnique name
-            , co_ax_name   = name
-            , co_ax_tvs    = tvs
-            , co_ax_lhs    = mkTyConApp tycon (mkTyVarTys tvs)
-            , co_ax_rhs    = rhs_ty }
-
--- | Create a coercion identifying a @data@, @newtype@ or @type@ representation type
--- and its family instance.  It has the form @Co tvs :: F ts ~ R tvs@, where @Co@ is 
--- the coercion constructor built here, @F@ the family tycon and @R@ the (derived)
--- representation tycon.
-mkFamInstCo :: Name	-- ^ Unique name for the coercion tycon
-		  -> [TyVar]	-- ^ Type parameters of the coercion (@tvs@)
-		  -> TyCon	-- ^ Family tycon (@F@)
-		  -> [Type]	-- ^ Type instance (@ts@)
-		  -> TyCon	-- ^ Representation tycon (@R@)
-		  -> CoAxiom	-- ^ Coercion constructor (@Co@)
-mkFamInstCo name tvs family inst_tys rep_tycon
-  = CoAxiom { co_ax_unique = nameUnique name
-            , co_ax_name   = name
-            , co_ax_tvs    = tvs
-            , co_ax_lhs    = mkTyConApp family inst_tys 
-            , co_ax_rhs    = mkTyConApp rep_tycon (mkTyVarTys tvs) }
+  = CoAxiom { co_ax_unique   = nameUnique name
+            , co_ax_name     = name
+            , co_ax_implicit = True  -- See Note [Implicit axioms] in TyCon
+            , co_ax_tvs      = tvs
+            , co_ax_lhs      = mkTyConApp tycon (mkTyVarTys tvs)
+            , co_ax_rhs      = rhs_ty }
 
 mkPiCos :: [Var] -> Coercion -> Coercion
 mkPiCos vs co = foldr mkPiCo co vs
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 1f49842fab..891af71bc7 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -13,9 +13,11 @@ FamInstEnv: Type checked family instance declarations
 -- for details
 
 module FamInstEnv (
-	FamInst(..), famInstTyCon, famInstTyVars, 
+	FamInst(..), FamFlavor(..), famInstAxiom, famInstTyVars,
+        famInstsRepTyCons, famInstRepTyCon_maybe, dataFamInstRepTyCon, 
+        famInstLHS,
 	pprFamInst, pprFamInstHdr, pprFamInsts, 
-	famInstHead, mkLocalFamInst, mkImportedFamInst,
+	mkSynFamInst, mkDataFamInst, mkImportedFamInst,
 
 	FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs, 
 	extendFamInstEnv, overwriteFamInstEnv, extendFamInstEnvList, 
@@ -51,30 +53,76 @@ import FastString
 %*									*
 %************************************************************************
 
+Note [FamInsts and CoAxioms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* CoAxioms and FamInsts are just like
+  DFunIds  and ClsInsts
+
+* A CoAxiom is a System-FC thing: it can relate any two types
+
+* A FamInst is a Haskell source-language thing, corresponding
+  to a type/data family instance declaration.  
+    - The FamInst contains a CoAxiom, which is the evidence
+      for the instance
+
+    - The LHS of the CoAxiom is always of form F ty1 .. tyn
+      where F is a type family
+
+
 \begin{code}
-data FamInst 
-  = FamInst { fi_fam   :: Name		-- Family name
-		-- INVARIANT: fi_fam = case tyConFamInst_maybe fi_tycon of
-		--			   Just (tc, tys) -> tc
+data FamInst  -- See Note [FamInsts and CoAxioms]
+  = FamInst { fi_axiom  :: CoAxiom      -- The new coercion axiom introduced
+                                        -- by this family instance
+            , fi_flavor :: FamFlavor
+
+            -- Everything below here is a redundant, 
+            -- cached version of the two things above
+            , fi_fam   :: Name		-- Family name
+		-- INVARIANT: fi_fam = name of fi_fam_tc
 
 		-- Used for "rough matching"; same idea as for class instances
+                -- See Note [Rough-match field] in InstEnv
 	    , fi_tcs   :: [Maybe Name]	-- Top of type args
 		-- INVARIANT: fi_tcs = roughMatchTcs fi_tys
 
 		-- Used for "proper matching"; ditto
-	    , fi_tvs   :: TyVarSet	-- Template tyvars for full match
-	    , fi_tys   :: [Type]	-- Full arg types
-		-- INVARIANT: fi_tvs = tyConTyVars fi_tycon
-		--	      fi_tys = case tyConFamInst_maybe fi_tycon of
-		--			   Just (_, tys) -> tys
+	    , fi_tvs    :: TyVarSet	-- Template tyvars for full match
+            , fi_fam_tc :: TyCon        -- Family tycon
+	    , fi_tys    :: [Type]	--   and its arg types
+		-- INVARIANT: fi_tvs = coAxiomTyVars fi_axiom
+		--	      (fi_fam_tc, fi_tys) = coAxiomSplitLHS fi_axiom
+            }
+
+data FamFlavor 
+  = SynFamilyInst         -- A synonym family
+  | DataFamilyInst TyCon  -- A data family, with its representation TyCon
+\end{code}
 
-	    , fi_tycon :: TyCon		-- Representation tycon
-	    }
 
--- Obtain the representation tycon of a family instance.
---
-famInstTyCon :: FamInst -> TyCon
-famInstTyCon = fi_tycon
+\begin{code}
+-- Obtain the axiom of a family instance
+famInstAxiom :: FamInst -> CoAxiom
+famInstAxiom = fi_axiom
+
+famInstLHS :: FamInst -> (TyCon, [Type])
+famInstLHS (FamInst { fi_fam_tc = tc, fi_tys = tys }) = (tc, tys)
+
+-- Return the representation TyCons introduced by data family instances, if any
+famInstsRepTyCons :: [FamInst] -> [TyCon]
+famInstsRepTyCons fis = [tc | FamInst { fi_flavor = DataFamilyInst tc } <- fis]
+
+-- Extracts the TyCon for this *data* (or newtype) instance
+famInstRepTyCon_maybe :: FamInst -> Maybe TyCon
+famInstRepTyCon_maybe fi 
+  = case fi_flavor fi of
+       DataFamilyInst tycon -> Just tycon
+       SynFamilyInst        -> Nothing
+
+dataFamInstRepTyCon :: FamInst -> TyCon
+dataFamInstRepTyCon fi 
+  = case fi_flavor fi of
+       DataFamilyInst tycon -> tycon
+       SynFamilyInst        -> pprPanic "dataFamInstRepTyCon" (ppr fi)
 
 famInstTyVars :: FamInst -> TyVarSet
 famInstTyVars = fi_tvs
@@ -82,7 +130,7 @@ famInstTyVars = fi_tvs
 
 \begin{code}
 instance NamedThing FamInst where
-   getName = getName . fi_tycon
+   getName = coAxiomName . fi_axiom
 
 instance Outputable FamInst where
    ppr = pprFamInst
@@ -91,18 +139,17 @@ instance Outputable FamInst where
 pprFamInst :: FamInst -> SDoc
 pprFamInst famInst
   = hang (pprFamInstHdr famInst)
-       2 (vcat [ ifPprDebug (ptext (sLit "Coercion axiom:") <+> pp_ax)
+       2 (vcat [ ifPprDebug (ptext (sLit "Coercion axiom:") <+> ppr ax)
+               , ifPprDebug (ptext (sLit "RHS:") <+> ppr (coAxiomRHS ax))
                , ptext (sLit "--") <+> pprDefinedAt (getName famInst)])
   where
-    pp_ax = case tyConFamilyCoercion_maybe (fi_tycon famInst) of
-              Just ax -> ppr ax
-              Nothing -> ptext (sLit "<not there!>")
+    ax = fi_axiom famInst
 
 pprFamInstHdr :: FamInst -> SDoc
-pprFamInstHdr (FamInst {fi_tycon = rep_tc})
+pprFamInstHdr (FamInst {fi_axiom = axiom, fi_flavor = flavor})
   = pprTyConSort <+> pp_instance <+> pprHead
   where
-    Just (fam_tc, tys) = tyConFamInst_maybe rep_tc 
+    (fam_tc, tys) = coAxiomSplitLHS axiom 
     
     -- For *associated* types, say "type T Int = blah" 
     -- For *top level* type instances, say "type instance T Int = blah"
@@ -111,55 +158,100 @@ pprFamInstHdr (FamInst {fi_tycon = rep_tc})
       | otherwise           = ptext (sLit "instance")
 
     pprHead = pprTypeApp fam_tc tys
-    pprTyConSort | isDataTyCon     rep_tc = ptext (sLit "data")
-		 | isNewTyCon      rep_tc = ptext (sLit "newtype")
-		 | isSynTyCon      rep_tc = ptext (sLit "type")
-		 | isAbstractTyCon rep_tc = ptext (sLit "data")
-		 | otherwise	          = panic "FamInstEnv.pprFamInstHdr"
+    pprTyConSort = case flavor of
+                     SynFamilyInst        -> ptext (sLit "type")
+                     DataFamilyInst tycon
+                       | isDataTyCon     tycon -> ptext (sLit "data")
+                       | isNewTyCon      tycon -> ptext (sLit "newtype")
+                       | isAbstractTyCon tycon -> ptext (sLit "data")
+                       | otherwise             -> ptext (sLit "WEIRD") <+> ppr tycon
 
 pprFamInsts :: [FamInst] -> SDoc
 pprFamInsts finsts = vcat (map pprFamInst finsts)
 
-famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
-famInstHead (FamInst {fi_tycon = tycon})
-  = case tyConFamInst_maybe tycon of
-      Nothing         -> panic "FamInstEnv.famInstHead"
-      Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
-
--- Make a family instance representation from a tycon.  This is used for local
--- instances, where we can safely pull on the tycon.
---
-mkLocalFamInst :: TyCon -> FamInst
-mkLocalFamInst tycon
-  = case tyConFamInst_maybe tycon of
-           Nothing         -> panic "FamInstEnv.mkLocalFamInst"
-	   Just (fam, tys) -> 
-	     FamInst {
-	       fi_fam   = tyConName fam,
-	       fi_tcs   = roughMatchTcs tys,
-	       fi_tvs   = mkVarSet . tyConTyVars $ tycon,
-	       fi_tys   = tys,
-	       fi_tycon = tycon
-	     }
+-- | Create a coercion identifying a @type@ family instance.
+-- It has the form @Co tvs :: F ts ~ R@, where @Co@ is 
+-- the coercion constructor built here, @F@ the family tycon and @R@ the
+-- right-hand side of the type family instance.
+mkSynFamInst :: Name       -- ^ Unique name for the coercion tycon
+             -> [TyVar]    -- ^ Type parameters of the coercion (@tvs@)
+             -> TyCon      -- ^ Family tycon (@F@)
+             -> [Type]     -- ^ Type instance (@ts@)
+             -> Type       -- ^ Representation tycon (@R@)
+             -> FamInst
+mkSynFamInst name tvs fam_tc inst_tys rep_ty
+  = FamInst { fi_fam    = tyConName fam_tc,
+              fi_fam_tc = fam_tc,
+              fi_tcs    = roughMatchTcs inst_tys,
+              fi_tvs    = mkVarSet tvs,
+              fi_tys    = inst_tys,
+              fi_flavor = SynFamilyInst,
+              fi_axiom  = axiom }
+  where
+    axiom = CoAxiom { co_ax_unique   = nameUnique name
+                    , co_ax_name     = name
+                    , co_ax_implicit = False
+                    , co_ax_tvs      = tvs
+                    , co_ax_lhs      = mkTyConApp fam_tc inst_tys 
+                    , co_ax_rhs      = rep_ty }
+
+-- | Create a coercion identifying a @data@ or @newtype@ representation type
+-- and its family instance.  It has the form @Co tvs :: F ts ~ R tvs@,
+-- where @Co@ is the coercion constructor built here, @F@ the family tycon
+-- and @R@ the (derived) representation tycon.
+mkDataFamInst :: Name         -- ^ Unique name for the coercion tycon
+              -> [TyVar]      -- ^ Type parameters of the coercion (@tvs@)
+              -> TyCon        -- ^ Family tycon (@F@)
+              -> [Type]       -- ^ Type instance (@ts@)
+              -> TyCon        -- ^ Representation tycon (@R@)
+              -> FamInst
+mkDataFamInst name tvs fam_tc inst_tys rep_tc
+  = FamInst { fi_fam    = tyConName fam_tc,
+              fi_fam_tc = fam_tc,
+              fi_tcs    = roughMatchTcs inst_tys,
+              fi_tvs    = mkVarSet tvs,
+              fi_tys    = inst_tys,
+              fi_flavor = DataFamilyInst rep_tc,
+              fi_axiom  = axiom }
+  where
+    axiom = CoAxiom { co_ax_unique   = nameUnique name
+                    , co_ax_name     = name
+                    , co_ax_implicit = False
+                    , co_ax_tvs      = tvs
+                    , co_ax_lhs      = mkTyConApp fam_tc inst_tys 
+                    , co_ax_rhs      = mkTyConApp rep_tc (mkTyVarTys tvs) }
 
 -- Make a family instance representation from the information found in an
--- unterface file.  In particular, we get the rough match info from the iface
+-- interface file.  In particular, we get the rough match info from the iface
 -- (instead of computing it here).
---
-mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
-mkImportedFamInst fam mb_tcs tycon
+mkImportedFamInst :: Name               -- Name of the family
+                  -> [Maybe Name]       -- Rough match info
+                  -> CoAxiom            -- Axiom introduced
+                  -> FamInst            -- Resulting family instance
+mkImportedFamInst fam mb_tcs axiom
   = FamInst {
-      fi_fam   = fam,
-      fi_tcs   = mb_tcs,
-      fi_tvs   = mkVarSet . tyConTyVars $ tycon,
-      fi_tys   = case tyConFamInst_maybe tycon of
-		   Nothing       -> panic "FamInstEnv.mkImportedFamInst"
-		   Just (_, tys) -> tys,
-      fi_tycon = tycon
-    }
+      fi_fam    = fam,
+      fi_fam_tc = fam_tc,
+      fi_tcs    = mb_tcs,
+      fi_tvs    = mkVarSet . coAxiomTyVars $ axiom,
+      fi_tys    = tys,
+      fi_axiom  = axiom,
+      fi_flavor = flavor }
+  where 
+     (fam_tc, tys) = coAxiomSplitLHS axiom
+
+         -- Derive the flavor for an imported FamInst rather disgustingly
+         -- Maybe we should store it in the IfaceFamInst?
+     flavor = case splitTyConApp_maybe (coAxiomRHS axiom) of
+                Just (tc, _)
+                  | Just ax' <- tyConFamilyCoercion_maybe tc
+                  , ax' == axiom
+                  -> DataFamilyInst tc
+                _ -> SynFamilyInst
 \end{code}
 
 
+
 %************************************************************************
 %*									*
 		FamInstEnv
@@ -242,9 +334,8 @@ overwriteFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs
     ins_tyvar = not (any isJust mb_tcs)
     match _ tpl_tvs tpl_tys tys = tcMatchTys tpl_tvs tpl_tys tys
     
-    inst_tycon = famInstTyCon ins_item
-    (fam, tys) = expectJust "FamInstEnv.lookuFamInstEnvConflicts"
-    	       	            (tyConFamInst_maybe inst_tycon)
+    inst_axiom = famInstAxiom ins_item
+    (fam, tys) = coAxiomSplitLHS inst_axiom
     arity = tyConArity fam
     n_tys = length tys
     match_tys 
@@ -326,11 +417,10 @@ lookupFamInstEnvConflicts
 lookupFamInstEnvConflicts envs fam_inst skol_tvs
   = lookup_fam_inst_env my_unify False envs fam tys1
   where
-    inst_tycon = famInstTyCon fam_inst
-    (fam, tys) = expectJust "FamInstEnv.lookuFamInstEnvConflicts"
-    	       	            (tyConFamInst_maybe inst_tycon)
-    skol_tys = mkTyVarTys skol_tvs
-    tys1     = substTys (zipTopTvSubst (tyConTyVars inst_tycon) skol_tys) tys
+    inst_axiom = famInstAxiom fam_inst
+    (fam, tys) = famInstLHS fam_inst
+    skol_tys   = mkTyVarTys skol_tvs
+    tys1       = substTys (zipTopTvSubst (coAxiomTyVars inst_axiom) skol_tys) tys
         -- In example above,   fam tys' = F [b]   
 
     my_unify old_fam_inst tpl_tvs tpl_tys match_tys
@@ -348,10 +438,10 @@ lookupFamInstEnvConflicts envs fam_inst skol_tvs
       | isAlgTyCon fam = True
       | otherwise      = not (old_rhs `eqType` new_rhs)
       where
-        old_tycon = famInstTyCon old_fam_inst
-        old_tvs   = tyConTyVars old_tycon
-        old_rhs   = mkTyConApp old_tycon  (substTyVars subst old_tvs)
-        new_rhs   = mkTyConApp inst_tycon (substTyVars subst skol_tvs)
+        old_axiom = famInstAxiom old_fam_inst
+        old_tvs   = coAxiomTyVars old_axiom
+        old_rhs   = mkAxInstRHS old_axiom  (substTyVars subst old_tvs)
+        new_rhs   = mkAxInstRHS inst_axiom (substTyVars subst skol_tvs)
 
 -- This variant is called when we want to check if the conflict is only in the
 -- home environment (see FamInst.addLocalFamInst)
@@ -436,14 +526,14 @@ lookup_fam_inst_env' match_fun one_sided ie fam tys
     --------------
     find [] = []
     find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs, 
-			  fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
+			  fi_tys = tpl_tys, fi_axiom = axiom }) : rest)
 	-- Fast check for no match, uses the "rough match" fields
       | instanceCantMatch rough_tcs mb_tcs
       = find rest
 
         -- Proper check
       | Just subst <- match_fun item tpl_tvs tpl_tys match_tys
-      = (item, add_extra_tys $ substTyVars subst (tyConTyVars tycon)) : find rest
+      = (item, add_extra_tys $ substTyVars subst (coAxiomTyVars axiom)) : find rest
 
         -- No match => try next
       | otherwise
@@ -547,11 +637,11 @@ normaliseTcApp env tc tys
   , tyConArity tc <= length tys	   -- Unsaturated data families are possible
   , [(fam_inst, inst_tys)] <- lookupFamInstEnv env tc ntys 
   = let    -- A matching family instance exists
-	rep_tc         	= famInstTyCon fam_inst
-	co_tycon       	= expectJust "lookupFamInst" (tyConFamilyCoercion_maybe rep_tc)
-	co              = mkAxInstCo co_tycon inst_tys
+        ax              = famInstAxiom fam_inst
+        co              = mkAxInstCo  ax inst_tys
+        rhs             = mkAxInstRHS ax inst_tys
 	first_coi       = mkTransCo tycon_coi co
-	(rest_coi,nty)  = normaliseType env (mkTyConApp rep_tc inst_tys)
+	(rest_coi,nty)  = normaliseType env rhs
 	fix_coi         = mkTransCo first_coi rest_coi
     in 
     (fix_coi, nty)
diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs
index 70eabb441a..8a158139cc 100644
--- a/compiler/types/FunDeps.lhs
+++ b/compiler/types/FunDeps.lhs
@@ -324,7 +324,7 @@ improveFromInstEnv inst_env pred@(ty, _)
 		-- Remember that instanceCantMatch treats both argumnents
 		-- symmetrically, so it's ok to trim the rough_tcs,
 		-- rather than trimming each inst_tcs in turn
-    , ispec@(Instance { is_tvs = qtvs, is_tys = tys_inst,
+    , ispec@(ClsInst { is_tvs = qtvs, is_tys = tys_inst,
 		 	is_tcs = inst_tcs }) <- instances
     , not (instanceCantMatch inst_tcs trimmed_tcs)
     , let p_inst = (mkClassPred cls tys_inst,
@@ -504,8 +504,8 @@ if s1 matches
 
 
 \begin{code}
-checkFunDeps :: (InstEnv, InstEnv) -> Instance
-	     -> Maybe [Instance]	-- Nothing  <=> ok
+checkFunDeps :: (InstEnv, InstEnv) -> ClsInst
+	     -> Maybe [ClsInst]	-- Nothing  <=> ok
 					-- Just dfs <=> conflict with dfs
 -- Check wheher adding DFunId would break functional-dependency constraints
 -- Used only for instance decls defined in the module being compiled
@@ -518,14 +518,14 @@ checkFunDeps inst_envs ispec
     cls_inst_env = classInstances inst_envs clas
     bad_fundeps  = badFunDeps cls_inst_env clas ins_tv_set ins_tys
 
-badFunDeps :: [Instance] -> Class
+badFunDeps :: [ClsInst] -> Class
 	   -> TyVarSet -> [Type]	-- Proposed new instance type
-	   -> [Instance]
+	   -> [ClsInst]
 badFunDeps cls_insts clas ins_tv_set ins_tys 
   = nubBy eq_inst $
     [ ispec | fd <- fds,	-- fds is often empty, so do this first!
 	      let trimmed_tcs = trimRoughMatchTcs clas_tvs fd rough_tcs,
-	      ispec@(Instance { is_tcs = inst_tcs, is_tvs = tvs, 
+	      ispec@(ClsInst { is_tcs = inst_tcs, is_tvs = tvs, 
 				is_tys = tys }) <- cls_insts,
 		-- Filter out ones that can't possibly match, 
 		-- based on the head of the fundep
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index d05495f7ac..ee0749a78a 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -9,7 +9,7 @@ The bits common to TcInstDcls and TcDeriv.
 \begin{code}
 module InstEnv (
         DFunId, OverlapFlag(..),
-        Instance(..), pprInstance, pprInstanceHdr, pprInstances, 
+        ClsInst(..), pprInstance, pprInstanceHdr, pprInstances, 
         instanceHead, mkLocalInstance, mkImportedInstance,
         instanceDFunId, setInstanceDFunId, instanceRoughTcs,
 
@@ -47,8 +47,8 @@ import Data.Maybe       ( isJust, isNothing )
 %************************************************************************
 
 \begin{code}
-data Instance 
-  = Instance { is_cls  :: Name  -- Class name
+data ClsInst 
+  = ClsInst { is_cls  :: Name  -- Class name
 
                 -- Used for "rough matching"; see Note [Rough-match field]
                 -- INVARIANT: is_tcs = roughMatchTcs is_tys
@@ -117,15 +117,15 @@ being equal to
   * the InstDecl used to construct the Instance.
 
 \begin{code}
-instanceDFunId :: Instance -> DFunId
+instanceDFunId :: ClsInst -> DFunId
 instanceDFunId = is_dfun
 
-setInstanceDFunId :: Instance -> DFunId -> Instance
+setInstanceDFunId :: ClsInst -> DFunId -> ClsInst
 setInstanceDFunId ispec dfun
    = ASSERT( idType dfun `eqType` idType (is_dfun ispec) )
         -- We need to create the cached fields afresh from
         -- the new dfun id.  In particular, the is_tvs in
-        -- the Instance must match those in the dfun!
+        -- the ClsInst must match those in the dfun!
         -- We assume that the only thing that changes is
         -- the quantified type variables, so the other fields
         -- are ok; hence the assert
@@ -133,27 +133,27 @@ setInstanceDFunId ispec dfun
    where 
      (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
 
-instanceRoughTcs :: Instance -> [Maybe Name]
+instanceRoughTcs :: ClsInst -> [Maybe Name]
 instanceRoughTcs = is_tcs
 \end{code}
 
 \begin{code}
-instance NamedThing Instance where
+instance NamedThing ClsInst where
    getName ispec = getName (is_dfun ispec)
 
-instance Outputable Instance where
+instance Outputable ClsInst where
    ppr = pprInstance
 
-pprInstance :: Instance -> SDoc
--- Prints the Instance as an instance declaration
+pprInstance :: ClsInst -> SDoc
+-- Prints the ClsInst as an instance declaration
 pprInstance ispec
   = hang (pprInstanceHdr ispec)
         2 (ptext (sLit "--") <+> pprDefinedAt (getName ispec))
 
 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
-pprInstanceHdr :: Instance -> SDoc
--- Prints the Instance as an instance declaration
-pprInstanceHdr ispec@(Instance { is_flag = flag })
+pprInstanceHdr :: ClsInst -> SDoc
+-- Prints the ClsInst as an instance declaration
+pprInstanceHdr ispec@(ClsInst { is_flag = flag })
   = ptext (sLit "instance") <+> ppr flag
        <+> sep [pprThetaArrowTy theta, ppr res_ty]
   where
@@ -161,10 +161,10 @@ pprInstanceHdr ispec@(Instance { is_flag = flag })
     (_, theta, res_ty) = tcSplitSigmaTy (idType dfun)
         -- Print without the for-all, which the programmer doesn't write
 
-pprInstances :: [Instance] -> SDoc
+pprInstances :: [ClsInst] -> SDoc
 pprInstances ispecs = vcat (map pprInstance ispecs)
 
-instanceHead :: Instance -> ([TyVar], ThetaType, Class, [Type])
+instanceHead :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
 instanceHead ispec = (tvs, theta, cls, tys)
    where
      (tvs, theta, tau) = tcSplitSigmaTy (idType dfun)
@@ -173,21 +173,21 @@ instanceHead ispec = (tvs, theta, cls, tys)
 
 mkLocalInstance :: DFunId
                 -> OverlapFlag
-                -> Instance
+                -> ClsInst
 -- Used for local instances, where we can safely pull on the DFunId
 mkLocalInstance dfun oflag
-  = Instance {  is_flag = oflag, is_dfun = dfun,
+  = ClsInst {  is_flag = oflag, is_dfun = dfun,
                 is_tvs = mkVarSet tvs, is_tys = tys,
                 is_cls = className cls, is_tcs = roughMatchTcs tys }
   where
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
 
 mkImportedInstance :: Name -> [Maybe Name]
-                   -> DFunId -> OverlapFlag -> Instance
+                   -> DFunId -> OverlapFlag -> ClsInst
 -- Used for imported instances, where we get the rough-match stuff
 -- from the interface file
 mkImportedInstance cls mb_tcs dfun oflag
-  = Instance {  is_flag = oflag, is_dfun = dfun,
+  = ClsInst {  is_flag = oflag, is_dfun = dfun,
                 is_tvs = mkVarSet tvs, is_tys = tys,
                 is_cls = cls, is_tcs = mb_tcs }
   where
@@ -354,13 +354,13 @@ or, to put it another way, we have
 type InstEnv = UniqFM ClsInstEnv        -- Maps Class to instances for that class
 
 newtype ClsInstEnv 
-  = ClsIE [Instance]    -- The instances for a particular class, in any order
+  = ClsIE [ClsInst]    -- The instances for a particular class, in any order
 
 instance Outputable ClsInstEnv where
   ppr (ClsIE is) = pprInstances is
 
 -- INVARIANTS:
---  * The is_tvs are distinct in each Instance
+--  * The is_tvs are distinct in each ClsInst
 --      of a ClsInstEnv (so we can safely unify them)
 
 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
@@ -371,10 +371,10 @@ instance Outputable ClsInstEnv where
 emptyInstEnv :: InstEnv
 emptyInstEnv = emptyUFM
 
-instEnvElts :: InstEnv -> [Instance]
+instEnvElts :: InstEnv -> [ClsInst]
 instEnvElts ie = [elt | ClsIE elts <- eltsUFM ie, elt <- elts]
 
-classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
+classInstances :: (InstEnv,InstEnv) -> Class -> [ClsInst]
 classInstances (pkg_ie, home_ie) cls 
   = get home_ie ++ get pkg_ie
   where
@@ -382,24 +382,24 @@ classInstances (pkg_ie, home_ie) cls
                 Just (ClsIE insts) -> insts
                 Nothing            -> []
 
-extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
+extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv
 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
 
-extendInstEnv :: InstEnv -> Instance -> InstEnv
-extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm })
+extendInstEnv :: InstEnv -> ClsInst -> InstEnv
+extendInstEnv inst_env ins_item@(ClsInst { is_cls = cls_nm })
   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
   where
     add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)
 
-overwriteInstEnv :: InstEnv -> Instance -> InstEnv
-overwriteInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tys = tys })
+overwriteInstEnv :: InstEnv -> ClsInst -> InstEnv
+overwriteInstEnv inst_env ins_item@(ClsInst { is_cls = cls_nm, is_tys = tys })
   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
   where
     add (ClsIE cur_insts) _ = ClsIE (replaceInst cur_insts)
     
     rough_tcs  = roughMatchTcs tys
     replaceInst [] = [ins_item]
-    replaceInst (item@(Instance { is_tcs = mb_tcs,  is_tvs = tpl_tvs, 
+    replaceInst (item@(ClsInst { is_tcs = mb_tcs,  is_tvs = tpl_tvs, 
                                   is_tys = tpl_tys,
                                   is_dfun = dfun }) : rest)
     -- Fast check for no match, uses the "rough match" fields
@@ -431,13 +431,13 @@ type InstTypes = [Either TyVar Type]
         -- Right ty     => Instantiate with this type
         -- Left tv      => Instantiate with any type of this tyvar's kind
 
-type InstMatch = (Instance, InstTypes)
+type InstMatch = (ClsInst, InstTypes)
 \end{code}
 
 Note [InstTypes: instantiating types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A successful match is an Instance, together with the types at which
-        the dfun_id in the Instance should be instantiated
+A successful match is an ClsInst, together with the types at which
+        the dfun_id in the ClsInst should be instantiated
 The instantiating types are (Either TyVar Type)s because the dfun
 might have some tyvars that *only* appear in arguments
         dfun :: forall a b. C a b, Ord b => D [a]
@@ -454,7 +454,7 @@ where the 'Left b' indicates that 'b' can be freely instantiated.
 --
 lookupUniqueInstEnv :: (InstEnv, InstEnv) 
                     -> Class -> [Type]
-                    -> Either Message (Instance, [Type])
+                    -> Either Message (ClsInst, [Type])
 lookupUniqueInstEnv instEnv cls tys
   = case lookupInstEnv instEnv cls tys of
       ([(inst, inst_tys)], _, _) 
@@ -472,7 +472,7 @@ lookupUniqueInstEnv instEnv cls tys
 lookupInstEnv' :: InstEnv          -- InstEnv to look in
                -> Class -> [Type]  -- What we are looking for
                -> ([InstMatch],    -- Successful matches
-                   [Instance])     -- These don't match but do unify
+                   [ClsInst])     -- These don't match but do unify
 -- The second component of the result pair happens when we look up
 --      Foo [a]
 -- in an InstEnv that has entries for
@@ -495,7 +495,7 @@ lookupInstEnv' ie cls tys
 
     --------------
     find ms us [] = (ms, us)
-    find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs, 
+    find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs, 
                                  is_tys = tpl_tys, is_flag = oflag,
                                  is_dfun = dfun }) : rest)
         -- Fast check for no match, uses the "rough match" fields
@@ -537,7 +537,7 @@ lookupInstEnv' ie cls tys
 lookupInstEnv :: (InstEnv, InstEnv)     -- External and home package inst-env
                    -> Class -> [Type]   -- What we are looking for
                    -> ([InstMatch],     -- Successful matches
-                       [Instance],      -- These don't match but do unify
+                       [ClsInst],      -- These don't match but do unify
                        Bool)            -- True if error condition caused by
                                         -- SafeHaskell condition.
 
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index f2155803f4..755bf57942 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -31,7 +31,7 @@ module Kind (
 	pprKind, pprParendKind,
 
         -- ** Deconstructing Kinds
-        kindFunResult, kindAppResult, synTyConResKind,
+        kindAppResult, synTyConResKind,
         splitKindFunTys, splitKindFunTysN, splitKindFunTy_maybe,
 
         -- ** Predicates on Kinds
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index f8745e62fb..f5c05677e1 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -22,7 +22,9 @@ module TyCon(
 	SynTyConRhs(..),
 
 	-- ** Coercion axiom constructors
-        CoAxiom(..), coAxiomName, coAxiomArity,
+        CoAxiom(..), 
+        coAxiomName, coAxiomArity, coAxiomTyVars,
+        coAxiomLHS, coAxiomRHS, isImplicitCoAxiom,
 
         -- ** Constructing TyCons
 	mkAlgTyCon,
@@ -71,7 +73,7 @@ module TyCon(
 	tyConArity,
         tyConParent,
 	tyConTuple_maybe, tyConClass_maybe, tyConIP_maybe,
-	tyConFamInst_maybe, tyConFamilyCoercion_maybe,tyConFamInstSig_maybe,
+	tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
         synTyConDefn, synTyConRhs, synTyConType,
         tyConExtName,           -- External name for foreign types
 	algTyConRhs,
@@ -138,48 +140,11 @@ Note [Type synonym families]
   translates to
     a SynTyCon 'F', whose SynTyConRhs is SynFamilyTyCon
 
-* Translation of type instance decl:
-	type instance F [a] = Maybe a
-  translates to a "representation TyCon", 'R:FList', where
-     R:FList is a SynTyCon, whose 
-       SynTyConRhs is (SynonymTyCon (Maybe a))
-       TyConParent is (FamInstTyCon F [a] co)
-         where co :: F [a] ~ R:FList a
-
-  It's very much as if the user had written
-       type instance F [a] = R:FList a
-       type R:FList a = Maybe a
-  Indeed, in GHC's internal representation, the RHS of every
-  'type instance' is simply an application of the representation
-  TyCon to the quantified varaibles.
-
-  The intermediate representation TyCon is a bit gratuitous, but 
-  it means that:
-
-        each 'type instance' decls is in 1-1 correspondance 
-	with its representation TyCon
-
-  So the result of typechecking a 'type instance' decl is just a
-  TyCon.  In turn this means that type and data families can be
-  treated uniformly.
-
 * Translation of type family decl:
 	type family F a :: *
   translates to
     a SynTyCon 'F', whose SynTyConRhs is SynFamilyTyCon
 
-* Translation of type instance decl:
-	type instance F [a] = Maybe a
-  translates to
-    A SynTyCon 'R:FList a', whose 
-       SynTyConRhs is (SynonymTyCon (Maybe a))
-       TyConParent is (FamInstTyCon F [a] co)
-         where co :: F [a] ~ R:FList a
-    Notice that we introduce a gratuitous vanilla type synonym
-       type R:FList a = Maybe a
-    solely so that type and data families can be treated more
-    uniformly, via a single FamInstTyCon descriptor        
-
 * In the future we might want to support
     * closed type families (esp when we have proper kinds)
     * injective type families (allow decomposition)
@@ -570,7 +535,7 @@ data TyConParent
         Class		-- The class in whose declaration the family is declared
 			-- See Note [Associated families and their parent class]
 
-  -- | Type constructors representing an instance of a type family. Parameters:
+  -- | Type constructors representing an instance of a *data* family. Parameters:
   --
   --  1) The type family in question
   --
@@ -581,11 +546,17 @@ data TyConParent
   --  3) A 'CoTyCon' identifying the representation
   --  type with the type instance family
   | FamInstTyCon	  -- See Note [Data type families]
-    			  -- and Note [Type synonym families]
+        CoAxiom   -- The coercion constructor,
+                  -- always of kind   T ty1 ty2 ~ R:T a b c
+                  -- where T is the family TyCon, 
+                  -- and R:T is the representation TyCon (ie this one)
+                  -- and a,b,c are the tyConTyVars of this TyCon
+
+          -- Cached fields of the CoAxiom, but adjusted to
+          -- use the tyConTyVars of this TyCon
 	TyCon   -- The family TyCon
 	[Type]	-- Argument types (mentions the tyConTyVars of this TyCon)
 		-- Match in length the tyConTyVars of the family TyCon
-        CoAxiom   -- The coercion constructor
 
 	-- E.g.  data intance T [a] = ...
 	-- gives a representation tycon:
@@ -598,15 +569,15 @@ instance Outputable TyConParent where
     ppr (ClassTyCon cls)        = text "Class parent" <+> ppr cls
     ppr (IPTyCon n)             = text "IP parent" <+> ppr n
     ppr (AssocFamilyTyCon cls)  = text "Class parent (assoc. family)" <+> ppr cls
-    ppr (FamInstTyCon tc tys _) = text "Family parent (family instance)" <+> ppr tc <+> sep (map ppr tys)
+    ppr (FamInstTyCon _ tc tys) = text "Family parent (family instance)" <+> ppr tc <+> sep (map ppr tys)
 
 -- | Checks the invariants of a 'TyConParent' given the appropriate type class name, if any
 okParent :: Name -> TyConParent -> Bool
-okParent _       NoParentTyCon                    = True
-okParent tc_name (AssocFamilyTyCon cls)           = tc_name `elem` map tyConName (classATs cls)
-okParent tc_name (ClassTyCon cls)                 = tc_name == tyConName (classTyCon cls)
-okParent tc_name (IPTyCon ip)                     = tc_name == ipTyConName ip
-okParent _       (FamInstTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length tys
+okParent _       NoParentTyCon               = True
+okParent tc_name (AssocFamilyTyCon cls)      = tc_name `elem` map tyConName (classATs cls)
+okParent tc_name (ClassTyCon cls)            = tc_name == tyConName (classTyCon cls)
+okParent tc_name (IPTyCon ip)                = tc_name == ipTyConName ip
+okParent _       (FamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys
 
 isNoParent :: TyConParent -> Bool
 isNoParent NoParentTyCon = True
@@ -676,23 +647,21 @@ See Trac #4528.
 
 Note [Newtype coercions]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
-which is used for coercing from the representation type of the
-newtype, to the newtype itself. For example,
+The NewTyCon field nt_co is a CoAxiom which is used for coercing from
+the representation type of the newtype, to the newtype itself. For
+example,
 
    newtype T a = MkT (a -> a)
 
-the NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t ->
-t.  This TyCon is a CoTyCon, so it does not have a kind on its
-own; it basically has its own typing rule for the fully-applied
-version.  If the newtype T has k type variables then CoT has arity at
-most k.  In the case that the right hand side is a type application
+the NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t -> t.  
+
+In the case that the right hand side is a type application
 ending with the same type variables as the left hand side, we
 "eta-contract" the coercion.  So if we had
 
    newtype S a = MkT [a]
 
-then we would generate the arity 0 coercion CoS : S ~ [].  The
+then we would generate the arity 0 axiom CoS : S ~ [].  The
 primary reason we do this is to make newtype deriving cleaner.
 
 In the paper we'd write
@@ -701,14 +670,6 @@ and then when we used CoT at a particular type, s, we'd say
 	CoT @ s
 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 
-But in GHC we instead make CoT into a new piece of type syntax, CoTyCon,
-(like instCoercionTyCon, symCoercionTyCon etc), which must always
-be saturated, but which encodes as
-	TyConApp CoT [s]
-In the vocabulary of the paper it's as if we had axiom declarations
-like
-	axiom CoT t :  T t ~ [t]
-
 Note [Newtype eta]
 ~~~~~~~~~~~~~~~~~~
 Consider
@@ -757,12 +718,14 @@ so the coercion tycon CoT must have
 \begin{code}
 -- | A 'CoAxiom' is a \"coercion constructor\", i.e. a named equality axiom.
 data CoAxiom
-  = CoAxiom                   -- type equality axiom.
-    { co_ax_unique :: Unique   -- unique identifier
-    , co_ax_name   :: Name     -- name for pretty-printing
-    , co_ax_tvs    :: [TyVar]  -- bound type variables 
-    , co_ax_lhs    :: Type     -- left-hand side of the equality
-    , co_ax_rhs    :: Type     -- right-hand side of the equality
+  = CoAxiom                   -- Type equality axiom.
+    { co_ax_unique   :: Unique      -- unique identifier
+    , co_ax_name     :: Name        -- name for pretty-printing
+    , co_ax_tvs      :: [TyVar]     -- bound type variables 
+    , co_ax_lhs      :: Type        -- left-hand side of the equality
+    , co_ax_rhs      :: Type        -- right-hand side of the equality
+    , co_ax_implicit :: Bool        -- True <=> the axiom is "implicit"
+                                    -- See Note [Implicit axioms]
     }
   deriving Typeable
 
@@ -771,8 +734,29 @@ coAxiomArity ax = length (co_ax_tvs ax)
 
 coAxiomName :: CoAxiom -> Name
 coAxiomName = co_ax_name
+
+coAxiomTyVars :: CoAxiom -> [TyVar]
+coAxiomTyVars = co_ax_tvs
+
+coAxiomLHS, coAxiomRHS :: CoAxiom -> Type
+coAxiomLHS = co_ax_lhs
+coAxiomRHS = co_ax_rhs
+
+isImplicitCoAxiom :: CoAxiom -> Bool
+isImplicitCoAxiom = co_ax_implicit
 \end{code}
 
+Note [Implicit axioms]
+~~~~~~~~~~~~~~~~~~~~~~
+See also Note [Implicit TyThings] in HscTypes
+* A CoAxiom arising from data/type family instances is not "implicit".
+  That is, it has its own IfaceAxiom declaration in an interface file
+
+* The CoAxiom arising from a newtype declaration *is* "implicit".
+  That is, it does not have its own IfaceAxiom declaration in an
+  interface file; instead the CoAxiom is generated by type-checking
+  the newtype declaration
+
 
 %************************************************************************
 %*									*
@@ -1251,12 +1235,13 @@ isPromotedTypeTyCon _                      = False
 -- * Family instances are /not/ implicit as they represent the instance body
 --   (similar to a @dfun@ does that for a class instance).
 isImplicitTyCon :: TyCon -> Bool
-isImplicitTyCon tycon | isTyConAssoc tycon           = True
-		      | isSynTyCon tycon	     = False
-		      | isAlgTyCon tycon	     = isTupleTyCon tycon
-isImplicitTyCon _other                               = True
-        -- catches: FunTyCon, PrimTyCon, 
-        -- CoTyCon, SuperKindTyCon
+isImplicitTyCon tycon 
+  | isTyConAssoc tycon = True
+  | isSynTyCon tycon   = False
+  | isAlgTyCon tycon   = isTupleTyCon tycon
+  | otherwise          = True
+        -- 'otherwise' catches: FunTyCon, PrimTyCon, 
+        -- PromotedDataCon, PomotedTypeTyCon, SuperKindTyCon
 \end{code}
 
 
@@ -1465,15 +1450,15 @@ isFamInstTyCon tc = case tyConParent tc of
 tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom)
 tyConFamInstSig_maybe tc
   = case tyConParent tc of
-      FamInstTyCon f ts co_tc -> Just (f, ts, co_tc)
-      _                       -> Nothing
+      FamInstTyCon ax f ts -> Just (f, ts, ax)
+      _                    -> Nothing
 
 -- | If this 'TyCon' is that of a family instance, return the family in question
 -- and the instance types. Otherwise, return @Nothing@
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 tyConFamInst_maybe tc
   = case tyConParent tc of
-      FamInstTyCon f ts _ -> Just (f, ts)
+      FamInstTyCon _ f ts -> Just (f, ts)
       _                   -> Nothing
 
 -- | If this 'TyCon' is that of a family instance, return a 'TyCon' which represents 
@@ -1482,7 +1467,7 @@ tyConFamInst_maybe tc
 tyConFamilyCoercion_maybe :: TyCon -> Maybe CoAxiom
 tyConFamilyCoercion_maybe tc
   = case tyConParent tc of
-      FamInstTyCon _ _ co -> Just co
+      FamInstTyCon co _ _ -> Just co
       _                   -> Nothing
 \end{code}
 
diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs
index 7253af1274..7045f4b521 100644
--- a/compiler/utils/Platform.hs
+++ b/compiler/utils/Platform.hs
@@ -14,14 +14,13 @@ module Platform (
 
 where
 
-import Panic
-
 -- | Contains enough information for the native code generator to emit
 --      code for this platform.
 data Platform
         = Platform {
               platformArch                     :: Arch,
               platformOS                       :: OS,
+              platformWordSize                 :: {-# UNPACK #-} !Int,
               platformHasGnuNonexecStack       :: Bool,
               platformHasIdentDirective        :: Bool,
               platformHasSubsectionsViaSymbols :: Bool
@@ -57,6 +56,7 @@ data OS
         | OSFreeBSD
         | OSOpenBSD
         | OSNetBSD
+        | OSKFreeBSD
         deriving (Read, Show, Eq)
 
 -- | ARM Instruction Set Architecture and Extensions
@@ -77,15 +77,7 @@ data ArmISAExt
 
 
 target32Bit :: Platform -> Bool
-target32Bit p = case platformArch p of
-                ArchUnknown -> panic "Don't know if ArchUnknown is 32bit"
-                ArchX86     -> True
-                ArchX86_64  -> False
-                ArchPPC     -> True
-                ArchPPC_64  -> False
-                ArchSPARC   -> True
-                ArchARM _ _ -> True
-
+target32Bit p = platformWordSize p == 4
 
 -- | This predicates tells us whether the OS supports ELF-like shared libraries.
 osElfTarget :: OS -> Bool
@@ -96,5 +88,9 @@ osElfTarget OSNetBSD   = True
 osElfTarget OSSolaris2 = True
 osElfTarget OSDarwin   = False
 osElfTarget OSMinGW32  = False
-osElfTarget OSUnknown  = panic "Don't know if OSUnknown is elf"
-
+osElfTarget OSKFreeBSD = True
+osElfTarget OSUnknown  = False
+ -- Defaulting to False is safe; it means don't rely on any
+ -- ELF-specific functionality.  It is important to have a default for
+ -- portability, otherwise we have to answer this question for every
+ -- new platform we compile on (even unreg).
diff --git a/compiler/vectorise/Vectorise/Generic/PADict.hs b/compiler/vectorise/Vectorise/Generic/PADict.hs
index 0af5fe0776..d73bea17ee 100644
--- a/compiler/vectorise/Vectorise/Generic/PADict.hs
+++ b/compiler/vectorise/Vectorise/Generic/PADict.hs
@@ -44,13 +44,14 @@ import Name
 --
 buildPADict
         :: TyCon        -- ^ tycon of the type being vectorised.
-        -> TyCon        -- ^ tycon of the type used for the vectorised representation.
+        -> CoAxiom      -- ^ Coercion between the type and 
+                        --     its vectorised representation.
         -> TyCon        -- ^ PData  instance tycon
         -> TyCon        -- ^ PDatas instance tycon
         -> SumRepr      -- ^ representation used for the type being vectorised.
         -> VM Var       -- ^ name of the top-level dictionary function.
 
-buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
+buildPADict vect_tc prepr_ax pdata_tc pdatas_tc repr
  = polyAbstract tvs $ \args ->    -- The args are the dictionaries we lambda
                                   -- abstract over; and they are put in the
                                   -- envt, so when we need a (PA a) we can 
@@ -94,7 +95,7 @@ buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
 
     method args dfun_name (name, build)
      = localV
-     $ do  expr     <- build vect_tc prepr_tc pdata_tc pdatas_tc repr
+     $ do  expr     <- build vect_tc prepr_ax pdata_tc pdatas_tc repr
            let body = mkLams (tvs ++ args) expr
            raw_var  <- newExportedVar (method_name dfun_name name) (exprType body)
            let var  = raw_var
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index 85e33367d7..ce2d947519 100644
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -15,10 +15,10 @@ import Vectorise.Builtins
 import Vectorise.Generic.Description
 import CoreSyn
 import CoreUtils
+import FamInstEnv
 import MkCore            ( mkWildCase )
 import TyCon
 import Type
-import BuildTyCl
 import OccName
 import Coercion
 import MkId
@@ -29,26 +29,15 @@ import Control.Monad
 import Outputable
 
 
-buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPReprTyCon orig_tc vect_tc repr
  = do name      <- mkLocalisedName mkPReprTyConOcc (tyConName orig_tc)
       rhs_ty    <- sumReprType repr
       prepr_tc  <- builtin preprTyCon
-      liftDs    $  buildSynTyCon name
-                             tyvars
-                             (SynonymTyCon rhs_ty)
-                             (typeKind rhs_ty)
-                             NoParentTyCon
-                             (Just $ mk_fam_inst prepr_tc vect_tc)
+      return $ mkSynFamInst name tyvars prepr_tc instTys rhs_ty
   where
     tyvars = tyConTyVars vect_tc
-
-
-mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
-mk_fam_inst fam_tc arg_tc
-  = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
-
-
+    instTys = [mkTyConApp vect_tc . mkTyVarTys $ tyConTyVars vect_tc]
 
 -- buildPAScAndMethods --------------------------------------------------------
 
@@ -69,7 +58,7 @@ mk_fam_inst fam_tc arg_tc
 --
 type PAInstanceBuilder
         =  TyCon        -- ^ Vectorised TyCon 
-        -> TyCon        -- ^ Representation TyCon
+        -> CoAxiom      -- ^ Coercion to the representation TyCon
         -> TyCon        -- ^ 'PData'  TyCon
         -> TyCon        -- ^ 'PDatas' TyCon
         -> SumRepr      -- ^ Description of generic representation.
@@ -88,8 +77,8 @@ buildPAScAndMethods
 
 
 buildPRDict :: PAInstanceBuilder
-buildPRDict vect_tc prepr_tc _ _ _
-  = prDictOfPReprInstTyCon inst_ty prepr_tc arg_tys
+buildPRDict vect_tc prepr_ax _ _ _
+  = prDictOfPReprInstTyCon inst_ty prepr_ax arg_tys
   where
     arg_tys = mkTyVarTys (tyConTyVars vect_tc)
     inst_ty = mkTyConApp vect_tc arg_tys
@@ -98,7 +87,7 @@ buildPRDict vect_tc prepr_tc _ _ _
 -- buildToPRepr ---------------------------------------------------------------
 -- | Build the 'toRepr' method of the PA class.
 buildToPRepr :: PAInstanceBuilder
-buildToPRepr vect_tc repr_tc _ _ repr
+buildToPRepr vect_tc repr_ax _ _ repr
  = do let arg_ty = mkTyConApp vect_tc ty_args
 
       -- Get the representation type of the argument.
@@ -114,7 +103,7 @@ buildToPRepr vect_tc repr_tc _ _ repr
   where
     ty_args        = mkTyVarTys (tyConTyVars vect_tc)
 
-    wrap_repr_inst = wrapFamInstBody repr_tc ty_args
+    wrap_repr_inst = wrapTypeFamInstBody repr_ax ty_args
 
     -- CoreExp to convert the given argument to the generic representation.
     -- We start by doing a case branch on the possible data constructors.
@@ -172,12 +161,12 @@ buildToPRepr vect_tc repr_tc _ _ repr
 -- |Build the 'fromPRepr' method of the PA class.
 --
 buildFromPRepr :: PAInstanceBuilder
-buildFromPRepr vect_tc repr_tc _ _ repr
+buildFromPRepr vect_tc repr_ax _ _ repr
   = do
       arg_ty <- mkPReprType res_ty
       arg <- newLocalVar (fsLit "x") arg_ty
 
-      result <- from_sum (unwrapFamInstScrut repr_tc ty_args (Var arg))
+      result <- from_sum (unwrapTypeFamInstScrut repr_ax ty_args (Var arg))
                          repr
       return $ Lam arg result
   where
@@ -225,14 +214,13 @@ buildFromPRepr vect_tc repr_tc _ _ repr
 -- |Build the 'toArrRepr' method of the PA class.
 --
 buildToArrPRepr :: PAInstanceBuilder
-buildToArrPRepr vect_tc prepr_tc pdata_tc _ r
+buildToArrPRepr vect_tc repr_co pdata_tc _ r
  = do arg_ty <- mkPDataType el_ty
       res_ty <- mkPDataType =<< mkPReprType el_ty
       arg    <- newLocalVar (fsLit "xs") arg_ty
 
       pdata_co <- mkBuiltinCo pdataTyCon
-      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
-          co           = mkAppCo pdata_co
+      let co           = mkAppCo pdata_co
                        . mkSymCo
                        $ mkAxInstCo repr_co ty_args
 
@@ -291,13 +279,12 @@ buildToArrPRepr vect_tc prepr_tc pdata_tc _ r
 -- |Build the 'fromArrPRepr' method for the PA class.
 --
 buildFromArrPRepr :: PAInstanceBuilder
-buildFromArrPRepr vect_tc prepr_tc pdata_tc _ r
+buildFromArrPRepr vect_tc repr_co pdata_tc _ r
  = do arg_ty <- mkPDataType =<< mkPReprType el_ty
       res_ty <- mkPDataType el_ty
       arg    <- newLocalVar (fsLit "xs") arg_ty
 
       pdata_co <- mkBuiltinCo pdataTyCon
-      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
       let co           = mkAppCo pdata_co
                        $ mkAxInstCo repr_co var_tys
 
@@ -367,7 +354,7 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc _ r
 -- | Build the 'toArrPReprs' instance for the PA class.
 --   This converts a PData of elements into the generic representation.
 buildToArrPReprs :: PAInstanceBuilder
-buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
+buildToArrPReprs vect_tc repr_co _ pdatas_tc r
  = do
     -- The argument type of the instance.
     --  eg: 'PDatas (Tree a b)'
@@ -383,7 +370,6 @@ buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
 
     -- Coersion to case between the (PRepr a) type and its instance.
     pdatas_co <- mkBuiltinCo pdatasTyCon
-    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
     let co           = mkAppCo pdatas_co
                      . mkSymCo
                      $ mkAxInstCo repr_co ty_args
@@ -457,7 +443,7 @@ buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
 
 -- buildFromArrPReprs ---------------------------------------------------------
 buildFromArrPReprs :: PAInstanceBuilder
-buildFromArrPReprs vect_tc prepr_tc _ pdatas_tc r
+buildFromArrPReprs vect_tc repr_co _ pdatas_tc r
  = do   
     -- The argument type of the instance.
     --  eg: 'PDatas (PRepr (Tree a b))'
@@ -471,9 +457,8 @@ buildFromArrPReprs vect_tc prepr_tc _ pdatas_tc r
     -- eg: (xss :: PDatas (PRepr (Tree a b)))
     varg        <- newLocalVar (fsLit "xss") arg_ty
         
-    -- Build the coersion between PRepr and the instance type
+    -- Build the coercion between PRepr and the instance type
     pdatas_co <- mkBuiltinCo pdatasTyCon
-    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
     let co           = mkAppCo pdatas_co
                      $ mkAxInstCo repr_co var_tys
 
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index 3587452951..1026e95029 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -18,6 +18,7 @@ import BuildTyCl
 import DataCon
 import TyCon
 import Type
+import FamInstEnv
 import Name
 import Util
 import MonadUtils
@@ -26,27 +27,36 @@ import Control.Monad
 
 -- buildPDataTyCon ------------------------------------------------------------
 -- | Build the PData instance tycon for a given type constructor.
-buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDataTyCon orig_tc vect_tc repr 
- = fixV $ \repr_tc ->
- do name' <- mkLocalisedName mkPDataTyConOcc orig_name
-    rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
-    pdata <- builtin pdataTyCon
+ = fixV $ \fam_inst ->
+   do let repr_tc = dataFamInstRepTyCon fam_inst
+      name' <- mkLocalisedName mkPDataTyConOcc orig_name
+      rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
+      pdata <- builtin pdataTyCon
+      buildDataFamInst name' pdata vect_tc rhs
+ where
+    orig_name = tyConName orig_tc
 
-    liftDs $ buildAlgTyCon name'
+buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM FamInst
+buildDataFamInst name' fam_tc vect_tc rhs
+ = do { axiom_name <- mkDerivedName mkInstTyCoOcc name'
+
+      ; let fam_inst = mkDataFamInst axiom_name tyvars fam_tc pat_tys rep_tc
+            ax       = famInstAxiom fam_inst
+            pat_tys  = [mkTyConApp vect_tc (mkTyVarTys tyvars)]
+            rep_tc   = buildAlgTyCon name'
                            tyvars
                            []          -- no stupid theta
                            rhs
                            rec_flag    -- FIXME: is this ok?
                            False       -- not GADT syntax
-                           NoParentTyCon
-                           (Just $ mk_fam_inst pdata vect_tc)
+                           (FamInstTyCon ax fam_tc pat_tys)
+      ; return fam_inst }
  where
-    orig_name = tyConName orig_tc
     tyvars    = tyConTyVars vect_tc
     rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
 
-
 buildPDataTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
 buildPDataTyConRhs orig_name vect_tc repr_tc repr
  = do data_con <- buildPDataDataCon orig_name vect_tc repr_tc repr
@@ -74,26 +84,16 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
 
 -- buildPDatasTyCon -----------------------------------------------------------
 -- | Build the PDatas instance tycon for a given type constructor.
-buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDatasTyCon orig_tc vect_tc repr 
- = fixV $ \repr_tc ->
- do name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
-    rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
-    pdatas      <- builtin pdatasTyCon
-
-    liftDs $ buildAlgTyCon name'
-                           tyvars
-                           []          -- no stupid theta
-                           rhs
-                           rec_flag    -- FIXME: is this ok?
-                           False       -- not GADT syntax
-                           NoParentTyCon
-                           (Just $ mk_fam_inst pdatas vect_tc)
+ = fixV $ \fam_inst ->
+   do let repr_tc = dataFamInstRepTyCon fam_inst
+      name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
+      rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
+      pdatas     <- builtin pdatasTyCon
+      buildDataFamInst name' pdatas vect_tc rhs
  where
-    orig_name = tyConName   orig_tc
-    tyvars    = tyConTyVars vect_tc
-    rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
-
+    orig_name = tyConName orig_tc
 
 buildPDatasTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
 buildPDatasTyConRhs orig_name vect_tc repr_tc repr
@@ -145,7 +145,8 @@ mkSumTys repr_selX_ty mkTc repr
 
     comp_ty r = mkTc (compOrigType r)
 
-
+{-
 mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
 mk_fam_inst fam_tc arg_tc
   = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
+-}
\ No newline at end of file
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
index c36f179229..971fd8ff1f 100644
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -57,7 +57,8 @@ lookupFamInst tycon tys
   = ASSERT( isFamilyTyCon tycon )
     do { instEnv <- readGEnv global_fam_inst_env
        ; case lookupFamInstEnv instEnv tycon tys of
-           [(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys)
+           [(fam_inst, rep_tys)] -> return ( dataFamInstRepTyCon fam_inst
+                                           , rep_tys)
            _other                -> 
              cantVectorise "VectMonad.lookupFamInst: not found: " 
                            (ppr $ mkTyConApp tycon tys)
diff --git a/compiler/vectorise/Vectorise/Monad/Naming.hs b/compiler/vectorise/Vectorise/Monad/Naming.hs
index ecf0e81306..30b8a0e1e4 100644
--- a/compiler/vectorise/Vectorise/Monad/Naming.hs
+++ b/compiler/vectorise/Vectorise/Monad/Naming.hs
@@ -2,6 +2,7 @@
 
 module Vectorise.Monad.Naming
   ( mkLocalisedName
+  , mkDerivedName
   , mkVectId
   , cloneVar
   , newExportedVar
@@ -35,16 +36,25 @@ import Control.Monad
 -- always an internal system name.
 --
 mkLocalisedName :: (Maybe String -> OccName -> OccName) -> Name -> VM Name
-mkLocalisedName mk_occ name = 
-  do { mod <- liftDs getModuleDs
-     ; u   <- liftDs newUnique
-     ; let occ_name = mkLocalisedOccName mod mk_occ name
-
-           new_name | isExternalName name = mkExternalName u mod occ_name (nameSrcSpan name)
-                    | otherwise           = mkSystemName   u     occ_name
-
-     ; return new_name
-     }
+mkLocalisedName mk_occ name
+  = do { mod <- liftDs getModuleDs
+       ; u   <- liftDs newUnique
+       ; let occ_name = mkLocalisedOccName mod mk_occ name
+
+             new_name | isExternalName name = mkExternalName u mod occ_name (nameSrcSpan name)
+                      | otherwise           = mkSystemName   u     occ_name
+
+       ; return new_name }
+
+mkDerivedName :: (OccName -> OccName) -> Name -> VM Name
+-- Similar to mkLocalisedName, but assumes the
+-- incoming name is from this module.  
+-- Works on External names only
+mkDerivedName mk_occ name 
+  = do { u   <- liftDs newUnique
+       ; return (mkExternalName u (nameModule name)  
+                                  (mk_occ (nameOccName name))
+                                  (nameSrcSpan name)) }
 
 -- |Produce the vectorised variant of an `Id` with the given vectorised type, while taking care that
 -- vectorised dfun ids must be dfuns again.
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 5d2213ac26..a6f77bb9db 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -229,12 +229,15 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
            -- Build 'PRepr' and 'PData' instance type constructors and family instances for all
            -- type constructors with vectorised representations.
        ; reprs      <- mapM tyConRepr vect_tcs
-       ; repr_tcs   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
-       ; pdata_tcs  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
-       ; pdatas_tcs <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
-
-       ; let inst_tcs  = repr_tcs ++ pdata_tcs ++ pdatas_tcs
-             fam_insts = map mkLocalFamInst inst_tcs
+       ; repr_fis   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
+       ; pdata_fis  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
+       ; pdatas_fis <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
+
+       ; let fam_insts  = repr_fis ++ pdata_fis ++ pdatas_fis
+             repr_axs   = map famInstAxiom repr_fis
+             pdata_tcs  = famInstsRepTyCons pdata_fis
+             pdatas_tcs = famInstsRepTyCons pdatas_fis
+             
        ; updGEnv $ extendFamEnv fam_insts
 
            -- Generate workers for the vectorised data constructors, dfuns for the 'PA' instances of
@@ -262,7 +265,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
               ; dfuns <- sequence $
                            zipWith4 buildTyConPADict
                                     vect_tcs
-                                    repr_tcs
+                                    repr_axs
                                     pdata_tcs
                                     pdatas_tcs
 
@@ -272,7 +275,8 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
 
            -- Return the vectorised variants of type constructors as well as the generated instance
            -- type constructors, family instances, and dfun bindings.
-       ; return (new_tcs ++ inst_tcs ++ syn_tcs, fam_insts, binds)
+       ; return ( new_tcs ++ pdata_tcs ++ pdatas_tcs ++ syn_tcs
+                , fam_insts, binds)
        }
   where
     fst3 (a, _, _) = a
@@ -319,9 +323,9 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
 
 -- Helpers --------------------------------------------------------------------
 
-buildTyConPADict :: TyCon -> TyCon -> TyCon -> TyCon -> VM Var
-buildTyConPADict vect_tc prepr_tc pdata_tc pdatas_tc
- = tyConRepr vect_tc >>= buildPADict vect_tc prepr_tc pdata_tc pdatas_tc
+buildTyConPADict :: TyCon -> CoAxiom -> TyCon -> TyCon -> VM Var
+buildTyConPADict vect_tc prepr_ax pdata_tc pdatas_tc
+ = tyConRepr vect_tc >>= buildPADict vect_tc prepr_ax pdata_tc pdatas_tc
 
 -- Produce a custom-made worker for the data constructors of a vectorised data type.  This includes
 -- all data constructors that may be used in vetcorised code — i.e., all data constructors of data
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 88ff686452..9b830446c8 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -93,7 +93,7 @@ vectTyConDecl tycon name'
              gadt_flag = isGadtSyntaxTyCon tycon
 
            -- build the vectorised type constructor
-       ; liftDs $ buildAlgTyCon 
+       ; return $ buildAlgTyCon 
                     name'                   -- new name
                     (tyConTyVars tycon)     -- keep original type vars
                     []                      -- no stupid theta
@@ -101,7 +101,6 @@ vectTyConDecl tycon name'
                     rec_flag                -- whether recursive
                     gadt_flag               -- whether in GADT syntax
                     NoParentTyCon           
-                    Nothing                 -- not a family instance
        }
 
   -- some other crazy thing that we don't handle
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index 0c111f49c7..2b47ddfb9b 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -36,7 +36,6 @@ import DataCon
 import MkId
 import FastString
 
-
 -- Simple Types ---------------------------------------------------------------
 
 voidType :: VM Type
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
index 164ebae229..dfc08bcf58 100644
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ b/compiler/vectorise/Vectorise/Utils/PADict.hs
@@ -113,20 +113,17 @@ paMethod method _ ty
 --
 -- Note that @ty@ is only used for error messages
 --
-prDictOfPReprInstTyCon :: Type -> TyCon -> [Type] -> VM CoreExpr
-prDictOfPReprInstTyCon ty prepr_tc prepr_args
-  | Just rhs <- coreView (mkTyConApp prepr_tc prepr_args)
+prDictOfPReprInstTyCon :: Type -> CoAxiom -> [Type] -> VM CoreExpr
+prDictOfPReprInstTyCon _ty prepr_ax prepr_args
   = do
+      let rhs = mkAxInstRHS prepr_ax prepr_args
       dict <- prDictOfReprType' rhs
       pr_co <- mkBuiltinCo prTyCon
-      let Just arg_co = tyConFamilyCoercion_maybe prepr_tc
       let co = mkAppCo pr_co
              $ mkSymCo
-             $ mkAxInstCo arg_co prepr_args
+             $ mkAxInstCo prepr_ax prepr_args
       return $ mkCast dict co
 
-  | otherwise = cantVectorise "Invalid PRepr type instance" (ppr ty)
-
 -- |Get the PR dictionary for a type. The argument must be a representation
 -- type.
 --