Merge branch 'master' of http://darcs.haskell.org//haddock

10 files changed, 217 insertions, 165 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 55f6ac1d..4417dc52 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -112,9 +112,8 @@ operator x = x
 ppExport :: DynFlags -> ExportItem Name -> [String]
 ppExport dflags (ExportDecl decl dc subdocs _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
     where
-        f (TyClD d@TyDecl{})
-            | isDataDecl d      = ppData dflags d subdocs
-            | otherwise         = ppSynonym dflags d
+        f (TyClD d@DataDecl{})  = ppData dflags d subdocs
+        f (TyClD d@SynDecl{})   = ppSynonym dflags d
         f (TyClD d@ClassDecl{}) = ppClass dflags d
         f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
         f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
@@ -145,8 +144,8 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
         f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
         f t = HsForAllTy Implicit emptyHsQTvs (reL [context]) (reL t)
 
-        context = nlHsTyConApp (unL $ tcdLName x)
-            (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tcdTyVars x)))
+        context = nlHsTyConApp (tcdName x)
+            (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
 
 
 ppInstance :: DynFlags -> ClsInst -> [String]
@@ -157,9 +156,9 @@ ppSynonym :: DynFlags -> TyClDecl Name -> [String]
 ppSynonym dflags x = [out dflags x]
 
 ppData :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
-ppData dflags decl@(TyDecl { tcdTyDefn = defn }) subdocs
-    = showData decl{ tcdTyDefn = defn { td_cons=[],td_derivs=Nothing }} :
-      concatMap (ppCtor dflags decl subdocs . unL) (td_cons defn)
+ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
+    = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=Nothing }} :
+      concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
     where
         
         -- GHC gives out "data Bar =", we want to delete the equals
@@ -167,7 +166,7 @@ ppData dflags decl@(TyDecl { tcdTyDefn = defn }) subdocs
         showData d = unwords $ map f $ if last xs == "=" then init xs else xs
             where
                 xs = words $ out dflags d
-                nam = out dflags $ tcdLName d
+                nam = out dflags $ tyClDeclLName d
                 f w = if w == nam then operator nam else w
 ppData _ _ _ = panic "ppData"
 
@@ -196,7 +195,7 @@ ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)
 
         resType = case con_res con of
             ResTyH98 -> apps $ map (reL . HsTyVar) $ 
-                        unL (tcdLName dat) : [hsTyVarName v | L _ (v@UserTyVar {}) <- hsQTvBndrs $ tcdTyVars dat]
+                        (tcdName dat) : [hsTyVarName v | L _ (v@UserTyVar {}) <- hsQTvBndrs $ tyClDeclTyVars dat]
             ResTyGADT x -> x
 
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index ee304073..6df9062e 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -243,7 +243,7 @@ ppDocGroup lev doc = sec lev <> braces doc
 
 declNames :: LHsDecl DocName -> [DocName]
 declNames (L _ decl) = case decl of
-  TyClD d  -> [unLoc $ tcdLName d]
+  TyClD d  -> [tcdName d]
   SigD (TypeSig lnames _) -> map unLoc lnames
   _ -> error "declaration not supported by declNames"
 
@@ -275,10 +275,10 @@ ppDecl :: LHsDecl DocName
        -> LaTeX
 
 ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
-  TyClD d@(TyFamily {})          -> ppTyFam False loc doc d unicode
-  TyClD d@(TyDecl{ tcdTyDefn = defn })   
-      | isHsDataDefn defn        -> ppDataDecl instances subdocs loc doc d unicode
-      | otherwise                -> ppTySyn loc (doc, fnArgsDoc) d unicode
+  TyClD d@(FamDecl {})          -> ppTyFam False loc doc d unicode
+  TyClD d@(DataDecl {})   
+                                -> ppDataDecl instances subdocs loc doc d unicode
+  TyClD d@(SynDecl {})          -> ppTySyn loc (doc, fnArgsDoc) d unicode
 -- Family instances happen via FamInst now
 --  TyClD d@(TySynonym {})         
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
@@ -311,8 +311,8 @@ ppFor _ _ _ _ =
 -- we skip type patterns for now
 ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX
 
-ppTySyn loc doc (TyDecl { tcdLName = L _ name, tcdTyVars = ltyvars
-                        , tcdTyDefn = TySynonym { td_synRhs = ltype } }) unicode
+ppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                         , tcdRhs = ltype }) unicode
   = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
   where
     hdr  = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars)
@@ -549,7 +549,7 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
    $$ instancesBit
 
   where
-    cons      = td_cons (tcdTyDefn dataDecl)
+    cons      = dd_cons (tcdDataDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
     body = catMaybes [constrBit, documentationToLaTeX doc]
@@ -694,8 +694,8 @@ ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: TyClDecl DocName -> Bool -> LaTeX
-ppDataHeader (TyDecl { tcdLName = L _ name, tcdTyVars = tyvars
-                     , tcdTyDefn = TyData { td_ND = nd, td_ctxt = ctxt } }) unicode
+ppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars
+                       , tcdDataDefn = HsDataDefn { dd_ND = nd, dd_ctxt = ctxt } }) unicode
   = -- newtype or data
     (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
     -- context
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index c68b7cbc..3251477a 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -556,10 +556,10 @@ processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName
 processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts) =
   ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of
     TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
-        (TyFamily{}) -> [ppTyFamHeader True False d unicode qual]
-        (TyDecl{ tcdTyDefn = TyData {} }) -> [keyword "data" <+> b]
-        (TyDecl{ tcdTyDefn = TySynonym {} }) -> [keyword "type" <+> b]
-        (ClassDecl {})    -> [keyword "class" <+> b]
+        (FamDecl decl)    -> [ppTyFamHeader True False decl unicode qual]
+        (DataDecl{})   -> [keyword "data" <+> b]
+        (SynDecl{})    -> [keyword "type" <+> b]
+        (ClassDecl {}) -> [keyword "class" <+> b]
         _ -> []
     SigD (TypeSig lnames (L _ _)) ->
       map (ppNameMini mdl . nameOccName . getName . unLoc) lnames
@@ -578,8 +578,8 @@ ppNameMini mdl nm =
 
 ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html
 ppTyClBinderWithVarsMini mdl decl =
-  let n = unLoc $ tcdLName decl
-      ns = tyvarNames $ tcdTyVars decl
+  let n = tcdName decl
+      ns = tyvarNames $ tcdTyVars decl -- it's safe to use tcdTyVars, see code above
   in ppTypeApp n ns (ppNameMini mdl . nameOccName . getName) ppTyName
 
 
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 59be34f7..db39ccca 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -39,10 +39,9 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
           DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] ->
           Bool -> Qualification -> Html
 ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of
-  TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d unicode qual
-  TyClD d@(TyDecl{ tcdTyDefn = defn })   
-      | isHsDataDefn defn        -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
-      | otherwise                -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
+  TyClD (FamDecl d)              -> ppTyFam summ False links loc mbDoc d unicode qual
+  TyClD d@(DataDecl {})          -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
+  TyClD d@(SynDecl {})           -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
   TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual
   SigD (TypeSig lnames (L _ t))  -> ppFunSig summ links loc (mbDoc, fnArgsDoc) (map unLoc lnames) t unicode qual
   ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode qual
@@ -115,8 +114,8 @@ ppFor _ _ _ _ _ _ _ = error "ppFor"
 -- we skip type patterns for now
 ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool
         -> Qualification -> Html
-ppTySyn summary links loc doc (TyDecl { tcdLName = L _ name, tcdTyVars = ltyvars
-                                      , tcdTyDefn = TySynonym { td_synRhs = ltype } }) 
+ppTySyn summary links loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                                       , tcdRhs = ltype }) 
         unicode qual
   = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
                    (full, hdr, spaceHtml +++ equals) unicode qual
@@ -145,10 +144,10 @@ ppTyName name
 --------------------------------------------------------------------------------
 
 
-ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyFamHeader summary associated decl unicode qual =
-
-  (case tcdFlavour decl of
+ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName -> Bool -> Qualification -> Html
+ppTyFamHeader summary associated d@(FamilyDecl { fdFlavour = flav
+                                               , fdKindSig = mkind }) unicode qual =
+  (case flav of
      TypeFamily
        | associated -> keyword "type"
        | otherwise  -> keyword "type family"
@@ -157,22 +156,22 @@ ppTyFamHeader summary associated decl unicode qual =
        | otherwise  -> keyword "data family"
   ) <+>
 
-  ppTyClBinderWithVars summary decl <+>
+  ppFamDeclBinderWithVars summary d <+>
 
-  case tcdKindSig decl of
+  case mkind of
     Just kind -> dcolon unicode  <+> ppLKind unicode qual kind
     Nothing   -> noHtml
 
 
 ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
-              TyClDecl DocName -> Bool -> Qualification -> Html
+              FamilyDecl DocName -> Bool -> Qualification -> Html
 ppTyFam summary associated links loc doc decl unicode qual
 
   | summary   = ppTyFamHeader True associated decl unicode qual
   | otherwise = header_ +++ docSection qual doc +++ instancesBit
 
   where
-    docname = tcdName decl
+    docname = unLoc $ fdLName decl
 
     header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
 
@@ -187,23 +186,25 @@ ppTyFam summary associated links loc doc decl unicode qual
 --------------------------------------------------------------------------------
 
 
-ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LTyClDecl DocName -> Bool
+ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName -> Bool
             -> Qualification -> Html
 ppAssocType summ links doc (L loc decl) unicode qual =
-  case decl of
-    TyFamily  {} -> ppTyFam summ True links loc (fst doc) decl unicode qual
-    _            -> error "declaration type not supported by ppAssocType"
+   ppTyFam summ True links loc (fst doc) decl unicode qual
 
 
 --------------------------------------------------------------------------------
 -- * TyClDecl helpers
 --------------------------------------------------------------------------------
 
+-- | Print a type family and its variables 
+ppFamDeclBinderWithVars :: Bool -> FamilyDecl DocName -> Html
+ppFamDeclBinderWithVars summ (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
+  ppAppDocNameNames summ (unLoc lname) (tyvarNames tvs)
 
--- | Print a type family / newtype / data / class binder and its variables 
-ppTyClBinderWithVars :: Bool -> TyClDecl DocName -> Html
-ppTyClBinderWithVars summ decl =
-  ppAppDocNameNames summ (unLoc $ tcdLName decl) (tyvarNames $ tcdTyVars decl)
+-- | Print a newtype / data binder and its variables 
+ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html
+ppDataBinderWithVars summ decl =
+  ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl)
 
 
 --------------------------------------------------------------------------------
@@ -303,7 +304,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
       +++ shortSubDecls
           (
             [ ppAssocType summary links doc at unicode qual | at <- ats
-              , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]  ++
+              , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++
 
                 -- ToDo: add associated type defaults
 
@@ -336,14 +337,14 @@ ppClassDecl summary links instances loc d subdocs
       | null lsigs = topDeclElem links loc [nm] (hdr unicode qual)
       | otherwise  = topDeclElem links loc [nm] (hdr unicode qual <+> keyword "where")
 
-    nm   = unLoc $ tcdLName decl
+    nm   = tcdName decl
 
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
     -- ToDo: add assocatied typ defaults
     atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode qual
                       | at <- ats
-                      , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]
+                      , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]
 
     methodBit = subMethods [ ppFunSig summary links loc doc names typ unicode qual
                            | L _ (TypeSig lnames (L _ typ)) <- lsigs
@@ -401,7 +402,7 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
     doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
     doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
 
-    cons      = td_cons (tcdTyDefn dataDecl)
+    cons      = dd_cons (tcdDataDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
 
@@ -415,8 +416,8 @@ ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
   | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
 
   where
-    docname   = unLoc . tcdLName $ dataDecl
-    cons      = td_cons (tcdTyDefn dataDecl)
+    docname   = tcdName dataDecl
+    cons      = dd_cons (tcdDataDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
     header_ = topDeclElem links loc [docname] (ppDataHeader summary dataDecl unicode qual
@@ -570,14 +571,15 @@ ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppDataHeader summary decl@(TyDecl { tcdTyDefn = TyData { td_ND = nd, td_ctxt = ctxt } }) 
+ppDataHeader summary decl@(DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd
+                                                               , dd_ctxt = ctxt } }) 
              unicode qual
   = -- newtype or data
     (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
     -- context
     ppLContext ctxt unicode qual <+>
     -- T a b c ..., or a :+: b
-    ppTyClBinderWithVars summary decl
+    ppDataBinderWithVars summary decl
 ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
 
 
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 28f43a0a..b4cf86f0 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -18,7 +18,7 @@ module Haddock.Convert where
 
 
 import HsSyn
-import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy )
+import TcType ( tcSplitSigmaTy )
 import TypeRep
 import Type(isStrLitTy)
 import Kind ( splitKindFunTys, synTyConResKind )
@@ -26,6 +26,7 @@ import Name
 import Var
 import Class
 import TyCon
+import CoAxiom
 import DataCon
 import BasicTypes ( TupleSort(..) )
 import TysPrim ( alphaTyVars )
@@ -53,7 +54,14 @@ tyThingToLHsDecl t = noLoc $ case t of
   -- later in the file (also it's used for class associated-types too.)
   ATyCon tc
     | Just cl <- tyConClass_maybe tc -- classes are just a little tedious
-    -> TyClD $ ClassDecl
+    -> let extractFamilyDecl :: TyClDecl a -> LFamilyDecl a
+           extractFamilyDecl (FamDecl d) = noLoc d
+           extractFamilyDecl _           =
+             error "tyThingToLHsDecl: impossible associated tycon"
+
+           atTyClDecls = [synifyTyCon at_tc | (at_tc, _) <- classATItems cl]
+           atFamDecls  = map extractFamilyDecl atTyClDecls in
+       TyClD $ ClassDecl
          { tcdCtxt = synifyCtx (classSCTheta cl)
          , tcdLName = synifyName cl
          , tcdTyVars = synifyTyVars (classTyVars cl)
@@ -64,7 +72,7 @@ tyThingToLHsDecl t = noLoc $ case t of
                          (classMethods cl)
          , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
          -- class associated-types are a subset of TyCon:
-         , tcdATs = [noLoc (synifyTyCon at_tc) | (at_tc, _) <- classATItems cl]
+         , tcdATs = atFamDecls
          , tcdATDefs = [] --ignore associated type defaults
          , tcdDocs = [] --we don't have any docs at this point
          , tcdFVs = placeHolderNames }
@@ -73,36 +81,40 @@ tyThingToLHsDecl t = noLoc $ case t of
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
-  ACoAxiom ax -> InstD (FamInstD { lid_inst = synifyAxiom ax })
+  ACoAxiom ax -> InstD (TyFamInstD { tfid_inst = synifyAxiom ax })
 
   -- a data-constructor alone just gets rendered as a function:
   ADataCon dc -> SigD (TypeSig [synifyName dc]
     (synifyType ImplicitizeForAll (dataConUserType dc)))
 
-synifyATDefault :: TyCon -> LFamInstDecl Name
+synifyATDefault :: TyCon -> LTyFamInstDecl Name
 synifyATDefault tc = noLoc (synifyAxiom ax)
   where Just ax = tyConFamilyCoercion_maybe tc
 
-synifyAxiom :: CoAxiom -> FamInstDecl Name
-synifyAxiom (CoAxiom { co_ax_tvs = tkvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
-  | Just (tc, args) <- tcSplitTyConApp_maybe lhs
-  = let name      = synifyName tc
-        typats    = map (synifyType WithinType) args
-        hs_rhs_ty = synifyType WithinType rhs
+synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn Name
+synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
+  = let name       = synifyName tc
+        typats     = map (synifyType WithinType) args
+        hs_rhs     = synifyType WithinType rhs
         (kvs, tvs) = partition isKindVar tkvs
-    in FamInstDecl { fid_tycon = name 
-                   , fid_pats = HsWB { hswb_cts = typats
-                                     , hswb_kvs = map tyVarName kvs
-                                     , hswb_tvs = map tyVarName tvs }
-                   , fid_defn = TySynonym hs_rhs_ty, fid_fvs = placeHolderNames }
-  | otherwise
-  = error "synifyAxiom" 
+    in TyFamInstEqn { tfie_tycon = name
+                    , tfie_pats  = HsWB { hswb_cts = typats
+                                        , hswb_kvs = map tyVarName kvs
+                                        , hswb_tvs = map tyVarName tvs }
+                    , tfie_rhs   = hs_rhs }
+
+synifyAxiom :: CoAxiom br -> TyFamInstDecl Name
+synifyAxiom (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
+  = let eqns = brListMap (noLoc . synifyAxBranch tc) branches
+    in TyFamInstDecl { tfid_eqns  = eqns
+                     , tfid_group = (brListLength branches /= 1)
+                     , tfid_fvs   = placeHolderNames }
 
 synifyTyCon :: TyCon -> TyClDecl Name
 synifyTyCon tc
   | isFunTyCon tc || isPrimTyCon tc 
-  = TyDecl { tcdLName = synifyName tc
-           , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
+  = DataDecl { tcdLName = synifyName tc
+             , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
                          let mk_hs_tv realKind fakeTyVar 
                                 = noLoc $ KindedTyVar (getName fakeTyVar) 
                                                       (synifyKindSig realKind)
@@ -111,37 +123,44 @@ synifyTyCon tc
                                                                 alphaTyVars --a, b, c... which are unfortunately all kind *
                                    }
                             
-           , tcdTyDefn = TyData { td_ND = DataType  -- arbitrary lie, they are neither 
+           , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither 
                                                     -- algebraic data nor newtype:
-                                , td_ctxt = noLoc []
-                                , td_cType = Nothing
-                                , td_kindSig = Just (synifyKindSig (tyConKind tc))
+                                      , dd_ctxt = noLoc []
+                                      , dd_cType = Nothing
+                                      , dd_kindSig = Just (synifyKindSig (tyConKind tc))
                                                -- we have their kind accurately:
-                                , td_cons = []  -- No constructors
-                                , td_derivs = Nothing }
+                                      , dd_cons = []  -- No constructors
+                                      , dd_derivs = Nothing }
            , tcdFVs = placeHolderNames }
   | isSynFamilyTyCon tc 
-  = TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
-               (Just (synifyKindSig (synTyConResKind tc)))
+  = case synTyConRhs_maybe tc of
+        Just (SynFamilyTyCon {}) ->
+          FamDecl (FamilyDecl TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
+                              (Just (synifyKindSig (synTyConResKind tc))))
+        _ -> error "synifyTyCon: impossible open type synonym?"
   | isDataFamilyTyCon tc 
   = --(why no "isOpenAlgTyCon"?)
     case algTyConRhs tc of
         DataFamilyTyCon ->
-          TyFamily DataFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
-               Nothing --always kind '*'
-               -- placeHolderKind
+          FamDecl (FamilyDecl DataFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
+                              Nothing) --always kind '*'
         _ -> error "synifyTyCon: impossible open data type?"
+  | isSynTyCon tc
+  = case synTyConRhs_maybe tc of
+        Just (SynonymTyCon ty) ->
+          SynDecl { tcdLName = synifyName tc
+                  , tcdTyVars = synifyTyVars (tyConTyVars tc)
+                  , tcdRhs = synifyType WithinType ty
+                  , tcdFVs = placeHolderNames }
+        _ -> error "synifyTyCon: impossible synTyCon"
   | otherwise =
-  -- (closed) type, newtype, and data
+  -- (closed) newtype and data
   let
-  -- alg_ only applies to newtype/data
-  -- syn_ only applies to type
-  -- others apply to both
   alg_nd = if isNewTyCon tc then NewType else DataType
   alg_ctx = synifyCtx (tyConStupidTheta tc)
   name = synifyName tc
   tyvars = synifyTyVars (tyConTyVars tc)
-  alg_kindSig = Just (tyConKind tc)
+  kindSig = Just (tyConKind tc)
   -- The data constructors.
   --
   -- Any data-constructors not exported from the module that *defines* the
@@ -158,19 +177,18 @@ synifyTyCon tc
   -- That seems like an acceptable compromise (they'll just be documented
   -- in prefix position), since, otherwise, the logic (at best) gets much more
   -- complicated. (would use dataConIsInfix.)
-  alg_use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc)
-  alg_cons = map (synifyDataCon alg_use_gadt_syntax) (tyConDataCons tc)
+  use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc)
+  cons = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc)
   -- "deriving" doesn't affect the signature, no need to specify any.
   alg_deriv = Nothing
-  defn | Just (_, syn_rhs) <- synTyConDefn_maybe tc 
-       = TySynonym (synifyType WithinType syn_rhs)
-       | otherwise = TyData { td_ND = alg_nd, td_ctxt = alg_ctx
-                            , td_cType = Nothing
-                            , td_kindSig = fmap synifyKindSig alg_kindSig
-                            , td_cons    = alg_cons 
-                            , td_derivs  = alg_deriv }
- in TyDecl { tcdLName = name, tcdTyVars = tyvars, tcdTyDefn = defn
-           , tcdFVs = placeHolderNames }
+  defn = HsDataDefn { dd_ND      = alg_nd
+                    , dd_ctxt    = alg_ctx
+                    , dd_cType   = Nothing
+                    , dd_kindSig = fmap synifyKindSig kindSig
+                    , dd_cons    = cons 
+                    , dd_derivs  = alg_deriv }
+ in DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn
+             , tcdFVs = placeHolderNames }
 
 -- User beware: it is your responsibility to pass True (use_gadt_syntax)
 -- for any constructor that would be misrepresented by omitting its
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index a841e567..82ccb590 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -147,7 +147,7 @@ isValD _ = False
 
 
 declATs :: HsDecl a -> [a]
-declATs (TyClD d) | isClassDecl d = map (tcdName . unL) $ tcdATs d
+declATs (TyClD d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d
 declATs _ = []
 
 
@@ -215,9 +215,9 @@ instance Parent (ConDecl Name) where
 
 instance Parent (TyClDecl Name) where
   children d
-    | isDataDecl  d = map (unL . con_name . unL) . td_cons . tcdTyDefn $ d
+    | isDataDecl  d = map (unL . con_name . unL) . dd_cons . tcdDataDefn $ d
     | isClassDecl d =
-        map (tcdName . unL) (tcdATs d) ++
+        map (unL . fdLName . unL) (tcdATs d) ++
         [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ]
     | otherwise = []
 
@@ -231,8 +231,8 @@ family = getName &&& children
 -- child to its grand-children, recursively.
 families :: TyClDecl Name -> [(Name, [Name])]
 families d
-  | isDataDecl  d = family d : map (family . unL) (td_cons (tcdTyDefn d))
-  | isClassDecl d = family d : concatMap (families . unL) (tcdATs d)
+  | isDataDecl  d = family d : map (family . unL) (dd_cons (tcdDataDefn d))
+  | isClassDecl d = [family d]
   | otherwise     = []
 
 
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index a4d4764e..86d1a7b8 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -53,7 +53,7 @@ attachToExportItem :: Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -
 attachToExportItem iface ifaceMap instIfaceMap export =
   case export of
     ExportDecl { expItemDecl = L _ (TyClD d) } -> do
-      mb_info <- getAllInfo (unLoc (tcdLName d))
+      mb_info <- getAllInfo (tcdName d)
       let export' =
             export {
               expItemInstances =
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 9fca453d..8f429d9c 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -268,7 +268,7 @@ mkMaps dflags gre instances decls = do
     instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ]
 
     names :: HsDecl Name -> [Name]
-    names (InstD (ClsInstD { cid_poly_ty = L l _ })) = maybeToList (M.lookup l instanceMap)  -- See note [2].
+    names (InstD (ClsInstD (ClsInstDecl { cid_poly_ty = L l _ }))) = maybeToList (M.lookup l instanceMap)  -- See note [2].
     names decl = getMainDeclBinder decl
 
 -- Note [2]:
@@ -296,7 +296,7 @@ subordinates (TyClD decl)
                 ]
     dataSubs = constrs ++ fields
       where
-        cons = map unL $ (td_cons (tcdTyDefn decl))
+        cons = map unL $ (dd_cons (tcdDataDefn decl))
         constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty)
                   | c <- cons ]
         fields  = [ (unL n, maybeToList $ fmap unL doc, M.empty)
@@ -312,7 +312,7 @@ typeDocs d =
   case d of
     SigD (TypeSig _ ty) -> docs (unLoc ty)
     ForD (ForeignImport _ ty _ _) -> docs (unLoc ty)
-    TyClD (TyDecl { tcdTyDefn = TySynonym {td_synRhs = ty}}) -> docs (unLoc ty)
+    TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
     _ -> M.empty
   where
     go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
@@ -331,7 +331,7 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
     docs  = mkDecls tcdDocs DocD class_
     defs  = mkDecls (bagToList . tcdMeths) ValD class_
     sigs  = mkDecls tcdSigs SigD class_
-    ats   = mkDecls tcdATs TyClD class_
+    ats   = mkDecls tcdATs (TyClD . FamDecl) class_
 
 
 -- | The top-level declarations of a module that we care about,
@@ -374,7 +374,11 @@ warnAboutFilteredDecls :: DynFlags -> Module -> [LHsDecl Name] -> ErrMsgM ()
 warnAboutFilteredDecls dflags mdl decls = do
   let modStr = moduleString mdl
   let typeInstances =
-        nub [ unLoc (fid_tycon d) | L _ (InstD (FamInstD { lid_inst = d })) <- decls ]
+        nub (concat [[ unLoc (tfie_tycon eqn)
+                     | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqns = eqns }))) <- decls
+                     , L _ eqn <- eqns ],
+                     [ unLoc (dfid_tycon d)
+                     | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ]])
 
   unless (null typeInstances) $
     tell [
@@ -383,8 +387,11 @@ warnAboutFilteredDecls dflags mdl decls = do
       ++ "will be filtered out:\n  " ++ (intercalate ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
-  let instances = nub [ pretty dflags i | L _ (InstD (ClsInstD { cid_poly_ty = i, cid_fam_insts = ats })) <- decls
-                                 , not (null ats) ]
+  let instances = nub [ pretty dflags i | L _ (InstD (ClsInstD (ClsInstDecl
+                                                { cid_poly_ty = i
+                                                , cid_tyfam_insts = ats
+                                                , cid_datafam_insts = adts }))) <- decls
+                                 , not (null ats) || not (null adts) ]
 
   unless (null instances) $
     tell [
@@ -734,11 +741,11 @@ extractDecl name mdl decl
           _ -> error "internal: extractDecl"
       TyClD d | isDataDecl d ->
         let (n, tyvar_names) = name_and_tyvars d
-            L pos sig = extractRecSel name mdl n tyvar_names (td_cons (tcdTyDefn d))
+            L pos sig = extractRecSel name mdl n tyvar_names (dd_cons (tcdDataDefn d))
         in L pos (SigD sig)
       _ -> error "internal: extractDecl"
   where
-    name_and_tyvars d = (unLoc (tcdLName d), hsLTyVarLocNames (tcdTyVars d))
+    name_and_tyvars d = (tcdName d, hsLTyVarLocNames (tyClDeclTyVars d))
 
 
 toTypeNoLoc :: Located Name -> LHsType Name
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 6109c341..b384886c 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -322,10 +322,8 @@ renameDecl decl = case decl of
     return (InstD d')
   _ -> error "renameDecl"
 
-
-renameLTyClD :: LTyClDecl Name -> RnM (LTyClDecl DocName)
-renameLTyClD (L loc d) = return . L loc =<< renameTyClD d
-
+renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName))
+renameLThing fn (L loc x) = return . L loc =<< fn x
 
 renameTyClD :: TyClDecl Name -> RnM (TyClDecl DocName)
 renameTyClD d = case d of
@@ -334,19 +332,21 @@ renameTyClD d = case d of
     return (ForeignType lname' b)
 
 --  TyFamily flav lname ltyvars kind tckind -> do
-  TyFamily flav lname ltyvars tckind -> do
-    lname'   <- renameL lname
-    ltyvars' <- renameLTyVarBndrs ltyvars
---    kind'    <- renameMaybeLKind kind
-    tckind'    <- renameMaybeLKind tckind
---    return (TyFamily flav lname' ltyvars' kind' tckind)
-    return (TyFamily flav lname' ltyvars' tckind')
+  FamDecl { tcdFam = decl } -> do
+    decl' <- renameFamilyDecl decl
+    return (FamDecl { tcdFam = decl' })
+
+  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = fvs } -> do
+    lname'    <- renameL lname
+    tyvars'   <- renameLTyVarBndrs tyvars
+    rhs'     <- renameLType rhs
+    return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = fvs })
 
-  TyDecl { tcdLName = lname, tcdTyVars = tyvars, tcdTyDefn = defn, tcdFVs = fvs } -> do
+  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = fvs } -> do
     lname'    <- renameL lname
     tyvars'   <- renameLTyVarBndrs tyvars
-    defn'     <- renameTyDefn defn
-    return (TyDecl { tcdLName = lname', tcdTyVars = tyvars', tcdTyDefn = defn', tcdFVs = fvs })
+    defn'     <- renameDataDefn defn
+    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = fvs })
 
   ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars
             , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
@@ -355,8 +355,8 @@ renameTyClD d = case d of
     ltyvars'  <- renameLTyVarBndrs ltyvars
     lfundeps' <- mapM renameLFunDep lfundeps
     lsigs'    <- mapM renameLSig lsigs
-    ats'      <- mapM renameLTyClD ats
-    at_defs'  <- mapM (mapM renameFamInstD) at_defs
+    ats'      <- mapM (renameLThing renameFamilyDecl) ats
+    at_defs'  <- mapM (mapM renameTyFamInstD) at_defs
     -- we don't need the default methods or the already collected doc entities
     return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'
                       , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag
@@ -370,19 +370,24 @@ renameTyClD d = case d of
 
     renameLSig (L loc sig) = return . L loc =<< renameSig sig
 
-renameTyDefn :: HsTyDefn Name -> RnM (HsTyDefn DocName)
-renameTyDefn (TyData { td_ND = nd, td_ctxt = lcontext, td_cType = cType
-                     , td_kindSig = k, td_cons = cons }) = do
+renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName)
+renameFamilyDecl (FamilyDecl { fdFlavour = flav, fdLName = lname
+                             , fdTyVars = ltyvars, fdKindSig = tckind }) = do
+    lname'   <- renameL lname
+    ltyvars' <- renameLTyVarBndrs ltyvars
+    tckind'  <- renameMaybeLKind tckind
+    return (FamilyDecl { fdFlavour = flav, fdLName = lname'
+                       , fdTyVars = ltyvars', fdKindSig = tckind' })
+
+renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)
+renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
+                           , dd_kindSig = k, dd_cons = cons }) = do
     lcontext' <- renameLContext lcontext
     k'        <- renameMaybeLKind k
     cons'     <- mapM (mapM renameCon) cons
     -- I don't think we need the derivings, so we return Nothing
-    return (TyData { td_ND = nd, td_ctxt = lcontext', td_cType = cType
-                   , td_kindSig = k', td_cons = cons', td_derivs = Nothing })
-
-renameTyDefn (TySynonym { td_synRhs = ltype }) = do
-    ltype'   <- renameLType ltype
-    return (TySynonym { td_synRhs = ltype' })
+    return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType
+                       , dd_kindSig = k', dd_cons = cons', dd_derivs = Nothing })
 
 renameCon :: ConDecl Name -> RnM (ConDecl DocName)
 renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
@@ -435,24 +440,47 @@ renameForD (ForeignExport lname ltype co x) = do
 
 
 renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
-renameInstD (ClsInstD { cid_poly_ty =ltype, cid_fam_insts = lATs }) = do
+renameInstD (ClsInstD { cid_inst = d }) = do
+  d' <- renameClsInstD d
+  return (ClsInstD { cid_inst = d' })
+renameInstD (TyFamInstD { tfid_inst = d }) = do
+  d' <- renameTyFamInstD d
+  return (TyFamInstD { tfid_inst = d' })
+renameInstD (DataFamInstD { dfid_inst = d }) = do
+  d' <- renameDataFamInstD d
+  return (DataFamInstD { dfid_inst = d' })
+
+renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
+renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_datafam_insts = lADTs }) = do
   ltype' <- renameLType ltype
-  lATs' <- mapM (mapM renameFamInstD) lATs
-  return (ClsInstD { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = []
-                   , cid_fam_insts = lATs' })
+  lATs'  <- mapM (mapM renameTyFamInstD) lATs
+  lADTs' <- mapM (mapM renameDataFamInstD) lADTs
+  return (ClsInstDecl { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = []
+                      , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })
 
-renameInstD (FamInstD { lid_inst = d }) = do
-  d' <- renameFamInstD d
-  return (FamInstD { lid_inst = d' })
 
-renameFamInstD :: FamInstDecl Name -> RnM (FamInstDecl DocName)
-renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = pats_w_bndrs, fid_defn = defn })
+renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName)
+renameTyFamInstD (TyFamInstDecl { tfid_eqns = eqns , tfid_group = eqn_group })
+  = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns
+       ; return (TyFamInstDecl { tfid_eqns = eqns'
+                               , tfid_group = eqn_group
+                               , tfid_fvs = placeHolderNames }) }
+
+renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName)
+renameTyFamInstEqn (TyFamInstEqn { tfie_tycon = tc, tfie_pats = pats_w_bndrs, tfie_rhs = rhs })
   = do { tc' <- renameL tc
        ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
-       ; defn' <- renameTyDefn defn 
-       ; return (FamInstDecl { fid_tycon = tc', fid_pats = pats_w_bndrs { hswb_cts = pats' }
-                             , fid_defn = defn', fid_fvs = placeHolderNames }) }
+       ; rhs' <- renameLType rhs 
+       ; return (TyFamInstEqn { tfie_tycon = tc', tfie_pats = pats_w_bndrs { hswb_cts = pats' }
+                              , tfie_rhs = rhs' }) }
 
+renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName)
+renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, dfid_defn = defn })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
+       ; defn' <- renameDataDefn defn 
+       ; return (DataFamInstDecl { dfid_tycon = tc', dfid_pats = pats_w_bndrs { hswb_cts = pats' }
+                                 , dfid_defn = defn', dfid_fvs = placeHolderNames }) }
 
 renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
 renameExportItem item = case item of
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 53e8bba8..20f45c95 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -126,22 +126,20 @@ toInstalledDescription = hmi_description . instInfo
 restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name
 restrictTo names (L loc decl) = L loc $ case decl of
   TyClD d | isDataDecl d  -> 
-    TyClD (d { tcdTyDefn = restrictTyDefn names (tcdTyDefn d) })
+    TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
   TyClD d | isClassDecl d ->
     TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
                tcdATs = restrictATs names (tcdATs d) })
   _ -> decl
 
-restrictTyDefn :: [Name] -> HsTyDefn Name -> HsTyDefn Name
-restrictTyDefn _ defn@(TySynonym {})
-  = defn
-restrictTyDefn names defn@(TyData { td_ND = new_or_data, td_cons = cons })
+restrictDataDefn :: [Name] -> HsDataDefn Name -> HsDataDefn Name
+restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
   | DataType <- new_or_data
-  = defn { td_cons = restrictCons names cons }
+  = defn { dd_cons = restrictCons names cons }
   | otherwise    -- Newtype
   = case restrictCons names cons of
-      []    -> defn { td_ND = DataType, td_cons = [] }
-      [con] -> defn { td_cons = [con] }
+      []    -> defn { dd_ND = DataType, dd_cons = [] }
+      [con] -> defn { dd_cons = [con] }
       _ -> error "Should not happen"
 
 restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
@@ -169,8 +167,8 @@ restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]
 restrictDecls names = mapMaybe (filterLSigNames (`elem` names))
 
 
-restrictATs :: [Name] -> [LTyClDecl Name] -> [LTyClDecl Name]
-restrictATs names ats = [ at | at <- ats , tcdName (unL at) `elem` names ]
+restrictATs :: [Name] -> [LFamilyDecl Name] -> [LFamilyDecl Name]
+restrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ]
 
 emptyHsQTvs :: LHsTyVarBndrs Name
 -- This function is here, rather than in HsTypes, because it *renamed*, but