diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index e0ab8791883c..fa0742d7eda1 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -27,7 +27,7 @@ module HsDecls (
   InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
   TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
   DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour,
-  TyFamInstEqn(..), LTyFamInstEqn,
+  TyFamInstEqn(..), LTyFamInstEqn, TyFamInstSpace(..), LTyFamInstSpace,
   LClsInstDecl, ClsInstDecl(..),
 
   -- ** Standalone deriving declarations
@@ -861,6 +861,7 @@ data TyFamInstSpace name
       { tfis_tycon :: Located name
       , tfis_pats  :: HsWithBndrs [LHsType name]
       }
+  deriving( Typeable, Data )
 
 type LTyFamInstDecl name = Located (TyFamInstDecl name)
 data TyFamInstDecl name 
@@ -871,7 +872,8 @@ data TyFamInstDecl name
   | TyFamInstBranched
        { tfid_eqns  :: [LTyFamInstEqn name]    -- ^ list of (possibly-overlapping) eqns 
                                                -- Always non-empty
-       , tfid_space :: Maybe LTyFamInstSpace  -- ^ The (optional) region of the type
+       , tfid_space :: Maybe (LTyFamInstSpace name)
+                                              -- ^ The (optional) region of the type
                                               -- space this group sits in.
        , tfid_fvs   :: NameSet }            -- The group is type-checked as one,
                                             --   so one NameSet will do
@@ -966,6 +968,11 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc
 ppr_instance_keyword TopLevel    = ptext (sLit "instance")
 ppr_instance_keyword NotTopLevel = empty
 
+instance (OutputableBndr name) => Outputable (TyFamInstSpace name) where
+  ppr (TyFamInstSpace { tfis_tycon = tycon
+                      , tfis_pats  = pats })
+    = pp_fam_inst_lhs tycon pats []
+
 instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where
   ppr (TyFamInstEqn { tfie_tycon = tycon
                     , tfie_pats  = pats
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index e6d2297d3521..35d3b616f368 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -26,6 +26,7 @@ import PrelInfo   (wiredInThings, basicKnownKeyNames)
 import Id         (idName, isDataConWorkId_maybe)
 import CoreSyn    (DFunArg(..))
 import Coercion   (LeftOrRight(..))
+import CoAxiom    (BranchFlag(..))
 import TysWiredIn
 import IfaceEnv
 import HscTypes
@@ -1366,7 +1367,17 @@ instance Binary IfaceFamInst where
         tys      <- get bh
         name     <- get bh
         orph     <- get bh
-        return (IfaceFamInst fam group tys name orph)
+        return (IfaceFamInst fam group space tys name orph)
+
+instance Binary BranchFlag where
+    put_ bh Branched   = putByte bh 0
+    put_ bh Unbranched = putByte bh 1
+    get bh = do
+        b <- getByte bh
+        case b of
+            0 -> return Branched
+            1 -> return Unbranched
+            _ -> panic ("get BranchFlag " ++ show b)
 
 instance Binary IfaceFamInstSpace where
     put_ bh IfaceNoFamInstSpace = putByte bh 0
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 06f8133111e1..e318388e528f 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -20,7 +20,7 @@ module IfaceSyn (
         IfaceBinding(..), IfaceConAlt(..),
         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
-        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), 
+        IfaceClsInst(..), IfaceFamInst(..), IfaceFamInstSpace(..), IfaceTickish(..), 
         IfaceBang(..), IfaceAxBranch(..),
 
         -- Misc
@@ -43,6 +43,7 @@ import PprCore()            -- Printing DFunArgs
 import Demand
 import Annotations
 import Class
+import CoAxiom ( BranchFlag(..) )
 import NameSet
 import Name
 import CostCentre
@@ -633,11 +634,11 @@ instance Outputable IfaceClsInst where
 
 instance Outputable IfaceFamInst where
   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcss,
-                     ifFamInstAxiom = tycon_ax})
+                     ifFamInstAxiom = tycon_ax, ifFamInstSpace = space})
     = hang (ptext (sLit "family instance") <+>
             ppr fam <+> pprWithCommas (brackets . pprWithCommas ppr_rough) mb_tcss)
          2 ((equals <+> ppr tycon_ax) $$
-           ppr_space)
+           ppr_space space)
 
 ppr_rough :: Maybe IfaceTyCon -> SDoc
 ppr_rough Nothing   = dot
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index ce1c478d2dd9..fce5cafed9b5 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1673,16 +1673,15 @@ famInstToIfaceFamInst (FamInst { fi_axiom    = axiom,
          = Nothing
 
     iface_space
-      | NoFamInstSpace <- space
-      = IfaceNoFamInstSpace
-
-      | FamInstSpace { fis_tvs = tvs
-                     , fis_tys = tys
-                     , fis_tcs = tcs } <- space
-      = let (env, tv_bndrs) = tidyTyVarBndrs emptyTidyEnv tvs in
-        IfaceFamInstSpace { ifFamInstSpaceTvs = toIfaceTvBndrs tv_bndrs
-                          , ifFamInstSpaceTys = map (tidyToIfaceType env) tys
-                          , ifFamInstSpaceRoughMatch = map do_rough fis_tcs }
+      = case space of
+          NoFamInstSpace -> IfaceNoFamInstSpace
+          FamInstSpace { fis_tvs = tvs
+                       , fis_tys = tys
+                       , fis_tcs = tcs } ->
+            let (env, tv_bndrs) = tidyTyVarBndrs emptyTidyEnv tvs in
+            IfaceFamInstSpace { ifFamInstSpaceTvs = toIfaceTvBndrs tv_bndrs
+                              , ifFamInstSpaceTys = map (tidyToIfaceType env) tys
+                              , ifFamInstSpaceRoughMatch = map do_rough tcs }
 
 --------------------------
 toIfaceLetBndr :: Id -> IfaceLetBndr
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 1cdd527dbfaa..f1541fba2d63 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -663,7 +663,7 @@ tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcss
                              , ifFamInstSpace = space } )
     = do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
                      tcIfaceCoAxiom axiom_name
-         ; space' <- tccIfaceFamInstSpace space
+         ; space' <- tcIfaceFamInstSpace space
          ; let mb_tcss' = map (map (fmap ifaceTyConName)) mb_tcss
          ; return (mkImportedFamInst fam branched space' mb_tcss' axiom') }
 
@@ -674,7 +674,7 @@ tcIfaceFamInstSpace (IfaceFamInstSpace { ifFamInstSpaceTvs = tvs
                                        , ifFamInstSpaceRoughMatch = tcs })
   = bindIfaceTyVars tvs $ \tvs' -> do
     { tys' <- mapM tcIfaceType tys
-    ; return $ mkImportedFamInstSpace tvs' tys' (map (fmap ifaceTyConName) tcs)
+    ; return $ mkImportedFamInstSpace tvs' tys' (map (fmap ifaceTyConName) tcs) }
 \end{code}
 
 
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index f3a0a9113f3e..58f1bde87a02 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -192,13 +192,13 @@ mkTyFamInst :: SrcSpan
             -> LTyFamInstEqn RdrName
             -> P (LTyFamInstDecl RdrName)
 mkTyFamInst loc eqn
-  = return (L loc (TyFamInstSingle { tfid_eqn  = [eqn]
+  = return (L loc (TyFamInstSingle { tfid_eqn   = eqn
                                    , tfid_fvs   = placeHolderNames }))
 
 mkTyFamInstGroup :: SrcSpan
                  -> Maybe (LHsType RdrName)
                  -> [LTyFamInstEqn RdrName]
-                 -> P TyFamInstDecl RdrName
+                 -> P (LTyFamInstDecl RdrName)
 mkTyFamInstGroup loc mspace eqns
   = do { mspace' <- mkTyFamInstSpace mspace
        ; return $ L loc (TyFamInstBranched { tfid_eqns  = eqns
@@ -208,10 +208,11 @@ mkTyFamInstGroup loc mspace eqns
 mkTyFamInstSpace :: Maybe (LHsType RdrName)
                  -> P (Maybe (LTyFamInstSpace RdrName))
 mkTyFamInstSpace Nothing = return Nothing
-mkTyFamInstSpace (Just ty)
-  = do { (tycon, pats) <- checkTyClHdr ty
-       ; return (TyFamInstSpace { tfis_tycon = tycon
-                                , tfis_pats  = mkHsWithBndrs pats }) }
+mkTyFamInstSpace (Just lty@(L loc _))
+  = do { (tycon, pats) <- checkTyClHdr lty
+       ; return (Just $ L loc
+                          (TyFamInstSpace { tfis_tycon = tycon
+                                          , tfis_pats  = mkHsWithBndrs pats }) ) }
 
 mkFamDecl :: SrcSpan
           -> FamilyFlavour
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index f0464431aefc..c923badb9614 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -520,7 +520,7 @@ rnFamInstLHS doc mb_cls tycon pats
 
        ; return ( tycon'
                 , HsWB { hswb_cts = pats', hswb_kvs = kv_names, hswb_tvs = tv_names }
-                , fvs `addOneFV` unLoc tycon' )
+                , fvs `addOneFV` unLoc tycon' ) }
 
 rnFamInstDecl :: HsDocContext
               -> Maybe (Name, [Name])
@@ -548,23 +548,24 @@ rnFamInstDecl doc mb_cls tycon pats payload rnPayload
 rnTyFamInstDecl :: Maybe (Name, [Name])
                 -> TyFamInstDecl RdrName
                 -> RnM (TyFamInstDecl Name, FreeVars)
-rnTyFamInstDecl mb_cls (TyFamInstSingle { tfid_eqn = eqn })
-  = do { (eqn', fvs) <- rnTyFamInstEqn mb_cls) eqn
-       ; return (TyFamInstSingle { tfid_eqn = eqn'
-                                 , tfid_fvs = fvs }, fvs)
+rnTyFamInstDecl mb_cls (TyFamInstSingle { tfid_eqn = L loc eqn })
+  = do { (eqn', fvs) <- rnTyFamInstEqn mb_cls eqn
+       ; return (TyFamInstSingle { tfid_eqn = L loc eqn'
+                                 , tfid_fvs = fvs }, fvs) }
 rnTyFamInstDecl Nothing (TyFamInstBranched { tfid_eqns = eqns, tfid_space = mspace })
   = do { (eqns', fvs1) <- rnList (rnTyFamInstEqn Nothing) eqns
        ; (space', fvs2) <- rn_space mspace
-       ; let fvs = fvs1 `plusFVs` fvs2
+       ; let fvs = fvs1 `plusFV` fvs2
        ; return (TyFamInstBranched { tfid_eqns  = eqns'
                                    , tfid_space = space'
                                    , tfid_fvs   = fvs }, fvs) }
-  where rn_space Nothing = (Nothing, emptyFVs)
-        rn_space (Just (TyFamInstSpace { tfis_tycon = tycon
-                                       , tfis_pats  = pats }))
+  where rn_space Nothing = return (Nothing, emptyFVs)
+        rn_space (Just (L loc (TyFamInstSpace { tfis_tycon = tycon
+                                              , tfis_pats  = HsWB { hswb_cts = pats } })))
           = do { (tycon', pats', fvs) <- rnFamInstLHS (TySynCtx tycon) Nothing tycon pats
-               ; return (TyFamInstSpace { tfis_tycon = tycon'
-                                        , tfis_pats  = pats' }, fvs) }
+               ; return (Just $ L loc $ TyFamInstSpace { tfis_tycon = tycon'
+                                                       , tfis_pats  = pats' }, fvs) }
+rnTyFamInstDecl _ _ = panic "rnTyFamInstDecl" -- branched instance in a class
 
 rnTyFamInstEqn :: Maybe (Name, [Name])
                -> TyFamInstEqn RdrName
diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index 73f1b32af877..5d6a02f5dc7a 100644
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -13,18 +13,18 @@ module FamInst (
         checkFamInstConsistency, tcExtendLocalFamInstEnv,
 	tcLookupFamInst, tcLookupDataFamInst,
         tcGetFamInstEnvs,
-        newFamInst
+        newFamInst, mkFamInstSpace
     ) where
 
 import HscTypes
 import FamInstEnv
 import InstEnv( roughMatchTcs )
-import Coercion( pprCoAxBranchHdr )
 import LoadIface
 import TypeRep
 import TcRnMonad
 import TyCon
 import CoAxiom
+import Type
 import DynFlags
 import Module
 import Outputable
@@ -33,7 +33,7 @@ import FastString
 import Util
 import Maybes
 import TcMType
-import TcType
+import SrcLoc
 import Name
 import Control.Monad
 import Data.Map (Map)
@@ -75,7 +75,7 @@ newFamInst flavor is_branched space axiom@(CoAxiom { co_ax_tc       = fam_tc
                              ; return (FirstBranch br') }
     go (NextBranch br brs) = do { br' <- go_branch br
                                 ; brs' <- go brs
-                                ;return (NextBranch br' brs') }
+                                ; return (NextBranch br' brs') }
     go_branch :: CoAxBranch -> TcRnIf gbl lcl FamInstBranch 
     go_branch (CoAxBranch { cab_tvs = tvs1
                           , cab_lhs = lhs
@@ -89,10 +89,12 @@ newFamInst flavor is_branched space axiom@(CoAxiom { co_ax_tc       = fam_tc
 
     mk_space :: BranchList FamInstBranch br -> FamInstSpace
     mk_space fam_branches
-      | False <- is_branched
+      | Unbranched <- is_branched
       , FirstBranch (FamInstBranch { fib_tvs = tvs, fib_lhs = lhs, fib_tcs = tcs })
           <- fam_branches
-      = FamInstSpace { fis_tvs = tvs, fis_tys = lhs, fis_tcs = tcs }
+      , FirstBranch co_ax_branch <- ax_branches
+      = FamInstSpace { fis_tvs = tvs, fis_tys = lhs, fis_tcs = tcs
+                     , fis_loc = coAxBranchSpan co_ax_branch  }
 
       | otherwise
       = space
@@ -370,27 +372,24 @@ environments (one for the EPS and one for the HPT).
 
 \begin{code}
 checkForConflicts :: FamInstEnvs -> FamInst Branched -> TcM Bool
-checkForConflicts inst_envs fam_inst@(FamInst { fi_branches = branches })
+checkForConflicts inst_envs fam_inst
   = do { let conflicts = lookupFamInstEnvConflicts inst_envs fam_inst
-             no_conflicts = all null conflicts
+             no_conflicts = null conflicts
        ; traceTc "checkForConflicts" (ppr conflicts $$ ppr fam_inst $$ ppr inst_envs)
        ; unless no_conflicts $ conflictInstErr fam_inst conflicts
        ; return no_conflicts }
-    where fam_tc = famInstTyCon fam_inst
 
 conflictInstErr :: FamInst Branched -> [FamInst Branched] -> TcRn ()
 conflictInstErr fam_inst confInsts
   = addFamInstsErr (ptext (sLit "Conflicting family instance declarations:"))
                    (fam_inst : confInsts)
-  | otherwise -- no conflict on this branch; see Trac #7560
-  = return ()
 
 addFamInstsErr :: SDoc -> [FamInst Branched] -> TcRn ()
 addFamInstsErr herald insts
   = ASSERT( not (null insts) )
     setSrcSpan srcSpan $ addErr $
     hang herald
-       2 (vcat [ pprCoAxBranchHdr (famInstAxiom fi) index 
+       2 (vcat [ pprFamInst fi 
                | fi <- sorted ])
  where
    getSpan   = getSrcLoc . famInstAxiom
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index a96b5b640d87..5c5928a52eb0 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -29,7 +29,7 @@ import DataCon
 import TyCon
 import CoAxiom
 import Coercion         ( mkSingleCoAxiom )
-import FamInstEnv       ( FamInst, FamFlavor(..) )
+import FamInstEnv
 import FamInst
 import Module           ( Module, moduleName, moduleNameString )
 import IfaceEnv         ( newGlobalBinder )
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index d56ba5b5c775..84ffd58a13a2 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -638,7 +638,7 @@ tcTyFamInstDecl mb_clsinfo (L loc decl)
        ; (space, co_ax_branches) <- tcSynFamInstDecl fam_tc decl
 
          -- (2) check for validity and inaccessibility
-       ; checkValidTypeSpace space
+       ; checkValidTypeSpace fam_tc space
        ; foldlM_ (check_valid_branch fam_tc space) [] co_ax_branches
 
          -- (3) construct coercion axiom
@@ -648,15 +648,13 @@ tcTyFamInstDecl mb_clsinfo (L loc decl)
        ; let axiom = mkBranchedCoAxiom rep_tc_name fam_tc co_ax_branches
        ; newFamInst SynFamilyInst branched space axiom }
     where
-      eqn1
-        | TyFamInstSingle { tfid_eqn = eqn } <- decl        = eqn
-        | TyFamInstBranched { tfid_eqns = (eqn:_) } <- decl = eqn
+      (eqn1, branched)
+        = case decl of
+            TyFamInstSingle { tfid_eqn = eqn }        -> (eqn, Unbranched)
+            TyFamInstBranched { tfid_eqns = (eqn:_) } -> (eqn, Branched)
+            _                                         -> panic "tcTyfamInstDecl"
       fam_lname = tfie_tycon (unLoc eqn1)
 
-      branched
-        | TyFamInstSingle {} <- decl   = Unbranched
-        | TyFamInstBranched {} <- decl = Branched
-
       check_valid_branch :: TyCon
                          -> FamInstSpace
                          -> [CoAxBranch]     -- previous
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 27a832aaf792..3a98f4048e1f 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -36,6 +36,7 @@ import TcHsType
 import TcMType
 import TcType
 import TysWiredIn( unitTy )
+import FamInstEnv
 import FamInst
 import Coercion( mkCoAxBranch )
 import Type
@@ -782,7 +783,7 @@ tcDefaultAssocDecl fam_tc (L loc decl)
     tcAddTyFamInstCtxt decl $
     do { traceTc "tcDefaultAssocDecl" (ppr decl)
        ; (_space, branches) <- tcSynFamInstDecl fam_tc decl
-       ; ASSERT( isNothing _space )
+       ; ASSERT( case _space of { NoFamInstSpace -> True ; _ -> False }  )
          return branches }
     -- We check for well-formedness and validity later, in checkValidClass
 
@@ -804,12 +805,12 @@ tcSynFamInstDecl fam_tc (TyFamInstBranched { tfid_eqns  = eqns
        ; checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
        ; space' <- check_space mspace
        ; eqns' <- mapM (tcTyFamInstEqn fam_tc) eqns
-       ; return (mspace', eqns') }
+       ; return (space', eqns') }
   where
     names = map (tfie_tycon . unLoc) eqns
     first = head names
 
-    check_space :: Maybe LTyFamInstSpace -> TcM FamInstSpace
+    check_space :: Maybe (LTyFamInstSpace Name) -> TcM FamInstSpace
     check_space Nothing = return NoFamInstSpace
     check_space (Just (L loc (TyFamInstSpace { tfis_tycon = tycon
                                              , tfis_pats  = pats })))
@@ -909,7 +910,7 @@ tcFamTyPats fam_tc (HsWB { hswb_cts = arg_pats, hswb_kvs = kvars, hswb_tvs = tva
          -- Kind-check and quantify
          -- See Note [Quantifying over family patterns]
        ; typats <- tcHsTyVarBndrs hs_tvs $ \ _ ->
-                   do { maybe_do kind_checker res_kind
+                   do { maybe_do mb_kind_checker res_kind
                       ; tcHsArgTys (quotes (ppr fam_tc)) arg_pats arg_kinds }
        ; let all_args = fam_arg_kinds ++ typats
 
@@ -1492,7 +1493,7 @@ checkValidClass cls
 
     check_at_defs (fam_tc, defs)
       = tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $
-        mapM_ (checkValidTyFamInst mb_clsinfo Nothing fam_tc) defs
+        mapM_ (checkValidTyFamInst mb_clsinfo NoFamInstSpace Unbranched fam_tc) defs
 
     mb_clsinfo = Just (cls, mkVarEnv [ (tv, mkTyVarTy tv) | tv <- tyvars ])
 
@@ -1738,6 +1739,9 @@ tcAddTyFamInstCtxt decl
   | otherwise
   = tcAddFamInstCtxt (ptext (sLit "type instance group")) (tyFamInstDeclName decl)
 
+tcAddTyFamInstSpaceCtxt :: TcM a -> TcM a
+tcAddTyFamInstSpaceCtxt = addErrCtxt (ptext (sLit "In the type space declaration"))
+
 tcAddDataFamInstCtxt :: DataFamInstDecl Name -> TcM a -> TcM a
 tcAddDataFamInstCtxt decl
   = tcAddFamInstCtxt (pprDataFamInstFlavour decl <+> ptext (sLit "instance"))
@@ -1872,6 +1876,11 @@ wrongKindOfFamily family
                  | isAlgTyCon family = ptext (sLit "data type")
                  | otherwise = pprPanic "wrongKindOfFamily" (ppr family)
 
+badTypeSpace :: Located Name -> Located Name -> SDoc
+badTypeSpace (L _ tspace) (L _ inst)
+  = ptext (sLit "Type space declaration is for") <+> (ppr tspace) $$
+      ptext (sLit "but instance is for") <+> (ppr inst)
+
 wrongNamesInInstGroup :: Name -> Name -> SDoc
 wrongNamesInInstGroup first cur
   = ptext (sLit "Mismatched family names in instance group.") $$
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index 895bd2dacb13..965de4c012cf 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -7,7 +7,7 @@
 module TcValidity (
   Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType,
   expectedKindInCtxt, 
-  checkValidTheta, checkValidFamPats,
+  checkValidTheta, checkValidFamPats, checkValidTypeSpace,
   checkValidInstance, validDerivPred,
   checkInstTermination, checkValidTyFamInst, checkTyFamFreeness, 
   checkConsistentFamInst,
@@ -23,7 +23,7 @@ import TypeRep
 import TcType
 import TcMType
 import Type
-import Unify( tcMatchTyX )
+import Unify
 import Kind
 import CoAxiom
 import Class
@@ -33,6 +33,8 @@ import TyCon
 import HsSyn            -- HsType
 import TcRnMonad        -- TcType, amongst others
 import FunDeps
+import Var
+import FamInstEnv
 import Name
 import VarEnv
 import VarSet
@@ -1073,14 +1075,14 @@ wrongATArgErr ty instTy =
 --
 checkValidTyFamInst :: Maybe ( Class, VarEnv Type )
                     -> FamInstSpace
-                    -> Bool          -- is this part of a branched instance?
+                    -> BranchFlag
                     -> TyCon -> CoAxBranch -> TcM ()
 checkValidTyFamInst mb_clsinfo space branched fam_tc 
                     (CoAxBranch { cab_tvs = tvs, cab_lhs = typats
                                 , cab_rhs = rhs, cab_loc = loc })
-  = ASSERT( not (isFamInstSpace space && not branched) )
+  = ASSERT( not (isFamInstSpace space && not (isBranched branched)) )
     setSrcSpan loc $ 
-    do { checkValidFamPats branched fam_tc tvs typats
+    do { checkValidFamPats (isBranched branched) fam_tc tvs typats
 
          -- The right-hand side is a tau type
        ; checkValidMonoType rhs
@@ -1112,7 +1114,7 @@ checkPatsWithinTypeSpace :: FamInstSpace
 checkPatsWithinTypeSpace NoFamInstSpace _ _ = return ()
 checkPatsWithinTypeSpace (FamInstSpace { fis_tvs = space_tvs, fis_tys = space_tys })
                          fam_tc pats
-  = checkTc (isJust $ tcMatchTys space_tvs space_tys pats) $
+  = checkTc (isJust $ tcMatchTys (mkVarSet space_tvs) space_tys pats) $
       branchOutOfTypeSpace fam_tc space_tys pats
 
 -- Make sure that each type family application is 
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 4e77a61d3d74..590646380eff 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -15,10 +15,13 @@ module FamInstEnv (
         famInstsRepTyCons, famInstNthBranch, famInstSingleBranch,
         famInstBranchLHS, famInstBranches, 
         toBranchedFamInst, toUnbranchedFamInst,
-        famInstTyCon, famInstRepTyCon_maybe, dataFamInstRepTyCon, 
+        famInstTyCon, famInstRepTyCon_maybe, 
+        isFamInstSpace,
+        dataFamInstRepTyCon, 
         pprFamInst, pprFamInsts, 
         pprFamFlavor, 
-        mkImportedFamInst, 
+
+        mkImportedFamInst, mkImportedFamInstSpace,
 
         FamInstEnv, FamInstEnvs,
         emptyFamInstEnvs, emptyFamInstEnv, famInstEnvElts, familyInstances,
@@ -252,11 +255,10 @@ pprFamInst (FamInst { fi_branches = brs, fi_flavor = SynFamilyInst
                     , fi_space = space })
   = hang (ptext (sLit "type instance") <+> ppr_space <+> ptext (sLit "where"))
        2 (vcat [pprCoAxBranchHdr axiom i | i <- brListIndices brs])
-  where ppr_space
-          | NoFamInstSpace <- space = empty
-
-          | FamInstSpace { fis_tys = tys } <- space
-          = pprTypeApp (coAxiomTyCon axiom) tys
+  where ppr_space = case space of
+                      NoFamInstSpace -> empty
+                      FamInstSpace { fis_tys = tys } ->
+                        pprTypeApp (coAxiomTyCon axiom) tys
 
 pprFamInst fi@(FamInst { fi_flavor = flavor
                        , fi_branched = Unbranched, fi_axiom = ax })
@@ -653,9 +655,9 @@ find match_tys (inst@(FamInst { fi_branches = branches }) : rest)
                -> BranchIndex      -- index of the first of the "still looking" list
                -> (Maybe FamInstMatch, ContSearch)
     findBranch [] _ = (Nothing, KeepSearching)
-    findBranch (branch@(FamInstBranch { fib_tvs = tvs
-                                      , fib_lhs = tpl_tys
-                                      , fib_tcs = mb_tcs }) : rest) ind
+    findBranch (FamInstBranch { fib_tvs = tvs
+                              , fib_lhs = tpl_tys
+                              , fib_tcs = mb_tcs } : rest) ind
       | instanceCantMatch rough_tcs mb_tcs
       = findBranch rest (ind+1)
       | otherwise
@@ -705,7 +707,8 @@ lookupFamInstEnvConflicts' ie fi@(FamInst { fi_space = space, fi_branched = bran
     fam = famInstTyCon fi
     mb_rhs
       | Branched <- branched = Nothing
-      | otherwise            = Just $ famInstBranchRHS $ famInstSingleBranch fi
+      | otherwise            = Just $ famInstBranchRHS $ 
+                                      famInstSingleBranch $ toUnbranchedFamInst fi
 
 conflictsWith :: [Type]           -- type patterns of the new instance
               -> [Maybe Name]     -- rough match tycons of the new instance