Add an explicit TopLevelFlag to FamilyDeclwip/az/famdecl-toplevel-flag

Similar to LexicalFixity, the flag keeps track of whether a FamilyDecl
was declared at the top level or as an associated type.

This simplifies pretty-printing.

As an unexpected bonus, it reduces compile-time memory usage (in my
local compile)

Performance Metrics (test environment: local):

T12234(optasm)            compile_time/bytes allocated                 77844224.000
                          (baseline @ HEAD~2)                          79620216.000  [decreased, -2.2%]
T12425(optasm)            compile_time/bytes allocated                132384800.000
                          (baseline @ HEAD~2)                         134023808.000  [decreased, -1.2%]
T13035(normal)            compile_time/bytes allocated                119133312.000
                          (baseline @ HEAD~2)                         120843728.000  [decreased, -1.4%]
T5837(normal)             compile_time/bytes allocated                 49912328.000
                          (baseline @ HEAD~2)                          51603824.000  [decreased, -3.3%]

Some stats have changed If this is expected, allow changes by
appending the git commit message with this:

-------------------------
Metric Decrease:
    T12234
    T12425
    T13035
    T5837
-------------------------

19 files changed, 37 insertions, 26 deletions

diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 41876b8957..3478964c3e 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -30,6 +30,7 @@ module GHC.Hs (
         module GHC.Hs.Doc,
         module GHC.Hs.Extension,
         Fixity,
+        TopLevelFlag(..),
 
         HsModule(..),
 ) where
@@ -45,7 +46,7 @@ import GHC.Hs.Lit
 import GHC.Hs.Extension
 import GHC.Hs.Pat
 import GHC.Hs.Type
-import GHC.Types.Basic ( Fixity, WarningTxt )
+import GHC.Types.Basic ( Fixity, WarningTxt, TopLevelFlag(..) )
 import GHC.Hs.Utils
 import GHC.Hs.Doc
 import GHC.Hs.Instances () -- For Data instances
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index c4d457d808..831fd47488 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -776,7 +776,7 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where
 
       | otherwise       -- Laid out
       = vcat [ top_matter <+> text "where"
-             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
+             , nest 2 $ pprDeclList (map (pprFamilyDecl . unLoc) ats ++
                                      map (pprTyFamDefltDecl . unLoc) at_defs ++
                                      pprLHsBindsForUser methods sigs) ]
       where
@@ -1085,6 +1085,7 @@ data FamilyDecl pass = FamilyDecl
   , fdTyVars         :: LHsQTyVars pass              -- type variables
                        -- See Note [TyVar binders for associated declarations]
   , fdFixity         :: LexicalFixity                -- Fixity used in the declaration
+  , fdTopLevel       :: TopLevelFlag                 -- Not top level in class decl
   , fdResultSig      :: LFamilyResultSig pass        -- result signature
   , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
   }
@@ -1153,15 +1154,16 @@ resultVariableName _                = Nothing
 
 instance OutputableBndrId p
        => Outputable (FamilyDecl (GhcPass p)) where
-  ppr = pprFamilyDecl TopLevel
+  ppr = pprFamilyDecl
 
 pprFamilyDecl :: (OutputableBndrId p)
-              => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
-pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
-                                    , fdTyVars = tyvars
-                                    , fdFixity = fixity
-                                    , fdResultSig = L _ result
-                                    , fdInjectivityAnn = mb_inj })
+              => FamilyDecl (GhcPass p) -> SDoc
+pprFamilyDecl (FamilyDecl { fdInfo = info, fdLName = ltycon
+                          , fdTyVars = tyvars
+                          , fdFixity = fixity
+                          , fdTopLevel = top_level
+                          , fdResultSig = L _ result
+                          , fdInjectivityAnn = mb_inj })
   = vcat [ pprFlavour info <+> pp_top_level <+>
            pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+>
            pp_kind <+> pp_inj <+> pp_where
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 7c9c37efe2..5dc7c7f7d5 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1427,7 +1427,7 @@ instance ToHie (LTyClDecl GhcRn) where
 
 instance ToHie (LFamilyDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
-      FamilyDecl _ info name vars _ sig inj ->
+      FamilyDecl _ info name vars _ _ sig inj ->
         [ toHie $ C (Decl FamDec $ getRealSpan span) name
         , toHie $ TS (ResolvedScopes [rhsSpan]) vars
         , toHie info
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 041b25d586..fa2bcb7e9b 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1136,7 +1136,7 @@ ty_decl :: { LTyClDecl GhcPs }
                           where_type_family
                 -- Note the use of type for the head; this allows
                 -- infix type constructors to be declared
-                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
+                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) TopLevel (snd $ unLoc $6) $3
                                    (snd $ unLoc $4) (snd $ unLoc $5))
                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
                            ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
@@ -1163,7 +1163,7 @@ ty_decl :: { LTyClDecl GhcPs }
 
           -- data/newtype family
         | 'data' 'family' type opt_datafam_kind_sig
-                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
+                {% amms (mkFamDecl (comb3 $1 $2 $4) TopLevel DataFamily $3
                                    (snd $ unLoc $4) Nothing)
                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
 
@@ -1321,7 +1321,7 @@ ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) }
 at_decl_cls :: { LHsDecl GhcPs }
         :  -- data family declarations, with optional 'family' keyword
           'data' opt_family type opt_datafam_kind_sig
-                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
+                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) NotTopLevel DataFamily $3
                                                   (snd $ unLoc $4) Nothing))
                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
 
@@ -1329,13 +1329,13 @@ at_decl_cls :: { LHsDecl GhcPs }
            -- (can't use opt_instance because you get shift/reduce errors
         | 'type' type opt_at_kind_inj_sig
                {% amms (liftM mkTyClD
-                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2
+                        (mkFamDecl (comb3 $1 $2 $3) NotTopLevel OpenTypeFamily $2
                                    (fst . snd $ unLoc $3)
                                    (snd . snd $ unLoc $3)))
                        (mj AnnType $1:(fst $ unLoc $3)) }
         | 'type' 'family' type opt_at_kind_inj_sig
                {% amms (liftM mkTyClD
-                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3
+                        (mkFamDecl (comb3 $1 $3 $4) NotTopLevel OpenTypeFamily $3
                                    (fst . snd $ unLoc $4)
                                    (snd . snd $ unLoc $4)))
                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 398bd78ddc..f12b5e2393 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -310,12 +310,13 @@ mkTyFamInst loc eqn
   = return (L loc (TyFamInstD noExtField (TyFamInstDecl eqn)))
 
 mkFamDecl :: SrcSpan
+          -> TopLevelFlag
           -> FamilyInfo GhcPs
           -> LHsType GhcPs                   -- LHS
           -> Located (FamilyResultSig GhcPs) -- Optional result signature
           -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation
           -> P (LTyClDecl GhcPs)
-mkFamDecl loc info lhs ksig injAnn
+mkFamDecl loc top_lvl info lhs ksig injAnn
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
        ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams
@@ -325,6 +326,7 @@ mkFamDecl loc info lhs ksig injAnn
                                            , fdInfo      = info, fdLName = tc
                                            , fdTyVars    = tyvars
                                            , fdFixity    = fixity
+                                           , fdTopLevel  = top_lvl
                                            , fdResultSig = ksig
                                            , fdInjectivityAnn = injAnn }))) }
   where
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index e425fd9457..9e3eaa5296 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -69,7 +69,7 @@ import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Utils.Error  ( MsgDoc )
 import GHC.Builtin.Names( rOOT_MAIN )
-import GHC.Types.Basic  ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
+import GHC.Types.Basic  ( pprWarningTxtForMsg, TupleSort(..) )
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique.Set ( uniqSetAny )
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index aeb94f5d10..0155001dac 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1937,6 +1937,7 @@ rnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested
           -> RnM (FamilyDecl GhcRn, FreeVars)
 rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
                              , fdFixity = fixity
+                             , fdTopLevel = top_lvl
                              , fdInfo = info, fdResultSig = res_sig
                              , fdInjectivityAnn = injectivity })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
@@ -1951,6 +1952,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
        ; return (FamilyDecl { fdExt = noExtField
                             , fdLName = tycon', fdTyVars = tyvars'
                             , fdFixity = fixity
+                            , fdTopLevel = top_lvl
                             , fdInfo = info', fdResultSig = res_sig'
                             , fdInjectivityAnn = injectivity' }
                 , fv1 `plusFV` fv2) }
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 677e695420..78c73514a1 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -56,7 +56,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
 import GHC.Utils.Outputable as Outputable
 import GHC.Data.Maybe
 import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Basic  ( TopLevelFlag(..), StringLiteral(..) )
+import GHC.Types.Basic  ( StringLiteral(..) )
 import GHC.Utils.Misc
 import GHC.Data.FastString
 import GHC.Data.FastString.Env
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 48a663952a..f934088dcb 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -27,7 +27,7 @@ import GHC.Rename.Utils   ( HsDocContext(..), newLocalBndrRn )
 import GHC.Rename.Unbound ( isUnboundName )
 import GHC.Rename.Module  ( rnSrcDecls, findSplice )
 import GHC.Rename.Pat     ( rnPat )
-import GHC.Types.Basic    ( TopLevelFlag, isTopLevel, SourceText(..) )
+import GHC.Types.Basic    ( isTopLevel, SourceText(..) )
 import GHC.Utils.Outputable
 import GHC.Unit.Module
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index f76939493f..c4b1946475 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -47,7 +47,6 @@ import GHC.Core.DataCon
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Utils.Outputable
 import GHC.Utils.Misc
-import GHC.Types.Basic  ( TopLevelFlag(..) )
 import GHC.Data.List.SetOps ( removeDups )
 import GHC.Driver.Session
 import GHC.Data.FastString
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index f99f99d1a5..82fc3e947a 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -120,7 +120,6 @@ import GHC.Types.SrcLoc
 import GHC.Types.Var.Set
 import GHC.Utils.Error
 import GHC.Types.Unique.FM
-import GHC.Types.Basic
 import GHC.Data.Bag
 import GHC.Driver.Session
 import GHC.Utils.Outputable
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index e8640a08dc..66d9a0cd33 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -104,7 +104,6 @@ import GHC.Types.Var.Env
 import GHC.Driver.Types
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
-import GHC.Types.Basic hiding( SuccessFlag(..) )
 import GHC.Unit.Module
 import GHC.Utils.Outputable
 import GHC.Utils.Encoding
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index c65879a8b4..a2e765a40a 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -184,7 +184,7 @@ import GHC.Data.FastString
 import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Types.Annotations
-import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) )
+import GHC.Types.Basic( TypeOrKind(..) )
 import GHC.Data.Maybe
 import GHC.Types.CostCentre.State
 
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 58add2b135..964943c86e 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -311,7 +311,7 @@ cvtDec (DataFamilyD tc tvs kind)
   = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
        ; result <- cvtMaybeKindToFamilyResultSig kind
        ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
-         FamilyDecl noExtField DataFamily tc' tvs' Prefix result Nothing }
+         FamilyDecl noExtField DataFamily tc' tvs' Prefix TopLevel result Nothing }
 
 cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
   = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
@@ -363,7 +363,7 @@ cvtDec (TySynInstD eqn)
 cvtDec (OpenTypeFamilyD head)
   = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
        ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
-         FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix result' injectivity'
+         FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix TopLevel result' injectivity'
        }
 
 cvtDec (ClosedTypeFamilyD head eqns)
@@ -371,7 +371,7 @@ cvtDec (ClosedTypeFamilyD head eqns)
        ; eqns' <- mapM cvtTySynEqn eqns
        ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
          FamilyDecl noExtField (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
-                           result' injectivity' }
+                           TopLevel result' injectivity' }
 
 cvtDec (TH.RoleAnnotD tc roles)
   = do { tc' <- tconNameL tc
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index cf373f76d5..1c9a877c48 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -566,6 +566,7 @@ instance Outputable LexicalFixity where
 data TopLevelFlag
   = TopLevel
   | NotTopLevel
+  deriving (Data)
 
 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index b14b69dc04..a056e41a6b 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -194,6 +194,7 @@
                 (Unqual
                  {OccName: k}))))))))])
        (Prefix)
+       (TopLevel)
        ({ DumpParsedAst.hs:9:32-39 }
         (KindSig
          (NoExtField)
@@ -406,6 +407,7 @@
                 (Unqual
                  {OccName: Type}))))))))])
        (Prefix)
+       (TopLevel)
        ({ DumpParsedAst.hs:16:42-48 }
         (KindSig
          (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 220a2ecd0b..cd7c0f20c4 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -221,6 +221,7 @@
                  ({ DumpRenamedAst.hs:11:28 }
                   {Name: k})))))))])
          (Prefix)
+         (TopLevel)
          ({ DumpRenamedAst.hs:11:32-39 }
           (KindSig
            (NoExtField)
@@ -248,6 +249,7 @@
           [{Name: k}]
           [])
          (Prefix)
+         (TopLevel)
          ({ DumpRenamedAst.hs:15:17-33 }
           (KindSig
            (NoExtField)
@@ -634,6 +636,7 @@
                  ({ DumpRenamedAst.hs:23:36-39 }
                   {Name: GHC.Types.Type})))))))])
          (Prefix)
+         (TopLevel)
          ({ DumpRenamedAst.hs:23:42-48 }
           (KindSig
            (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 689cc4187f..2ba7e63ce6 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -77,6 +77,7 @@
             (Unqual
              {OccName: a}))))])
        (Prefix)
+       (TopLevel)
        ({ <no location info> }
         (NoSig
          (NoExtField)))
diff --git a/utils/haddock b/utils/haddock
-Subproject 075067254fc30ef56bad67ac65dd3c5f4101f8f
+Subproject 117b3ae92883f513abd5f9ee72098a881d95ef0