GHC/Hs/Decls.hs

    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE ConstraintKinds     #-}
    {-# LANGUAGE DeriveDataTypeable  #-}
    {-# LANGUAGE DeriveTraversable   #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE FlexibleInstances   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StandaloneDeriving  #-}
    {-# LANGUAGE TypeApplications    #-}
    {-# LANGUAGE TypeFamilies        #-}
    {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                          -- in module Language.Haskell.Syntax.Extension

    {-# OPTIONS_GHC -Wno-orphans     #-} -- Outputable

    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    -}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    -- | Abstract syntax of global declarations.
    --
    -- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
    -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
    module GHC.Hs.Decls (
      -- * Toplevel declarations
      HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
      HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
      NewOrData(..), newOrDataToFlavour,
      StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName,

      -- ** Class or type declarations
      TyClDecl(..), LTyClDecl, DataDeclRn(..),
      TyClGroup(..),
      tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
      tyClGroupKindSigs,
      isClassDecl, isDataDecl, isSynDecl, tcdName,
      isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
      isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
      tyFamInstDeclName, tyFamInstDeclLName,
      countTyClDecls, pprTyClDeclFlavour,
      tyClDeclLName, tyClDeclTyVars,
      hsDeclHasCusk, famResultKindSignature,
      FamilyDecl(..), LFamilyDecl,
      FunDep(..),

      -- ** Instance declarations
      InstDecl(..), LInstDecl, FamilyInfo(..),
      TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
      TyFamDefltDecl, LTyFamDefltDecl,
      DataFamInstDecl(..), LDataFamInstDecl,
      pprDataFamInstFlavour, pprTyFamInstDecl, pprHsFamInstLHS,
      FamEqn(..), TyFamInstEqn, LTyFamInstEqn, HsTyPats,
      LClsInstDecl, ClsInstDecl(..),

      -- ** Standalone deriving declarations
      DerivDecl(..), LDerivDecl,
      -- ** Deriving strategies
      DerivStrategy(..), LDerivStrategy,
      derivStrategyName, foldDerivStrategy, mapDerivStrategy,
      XViaStrategyPs(..),
      -- ** @RULE@ declarations
      LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),
      HsRuleAnn(..),
      RuleBndr(..),LRuleBndr,
      collectRuleBndrSigTys,
      flattenRuleDecls, pprFullRuleName,
      -- ** @default@ declarations
      DefaultDecl(..), LDefaultDecl,
      -- ** Template haskell declaration splice
      SpliceExplicitFlag(..),
      SpliceDecl(..), LSpliceDecl,
      -- ** Foreign function interface declarations
      ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
      CImportSpec(..),
      -- ** Data-constructor declarations
      ConDecl(..), LConDecl,
      HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta,
      getConNames, getRecConArgs_maybe,
      -- ** Document comments
      DocDecl(..), LDocDecl, docDeclDoc,
      -- ** Deprecations
      WarnDecl(..),  LWarnDecl,
      WarnDecls(..), LWarnDecls,
      -- ** Annotations
      AnnDecl(..), LAnnDecl,
      AnnProvenance(..), annProvenanceName_maybe,
      -- ** Role annotations
      RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
      -- ** Injective type families
      FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
      resultVariableName, familyDeclLName, familyDeclName,

      -- * Grouping
      HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls,
      hsGroupTopLevelFixitySigs,

      partitionBindsAndSigs,
        ) where

    -- friends:
    import GHC.Prelude

    import Language.Haskell.Syntax.Decls

    import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprSpliceDecl )
            -- Because Expr imports Decls via HsBracket

    import GHC.Hs.Binds
    import GHC.Hs.Type
    import GHC.Hs.Doc
    import GHC.Types.Basic
    import GHC.Core.Coercion
    import Language.Haskell.Syntax.Extension
    import GHC.Hs.Extension
    import GHC.Parser.Annotation
    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Types.Fixity

    -- others:
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.SrcLoc
    import GHC.Types.SourceText
    import GHC.Core.Type
    import GHC.Types.ForeignCall

    import GHC.Data.Bag
    import GHC.Data.Maybe
    import Data.Data (Data)

    {-
    ************************************************************************
    *                                                                      *
    \subsection[HsDecl]{Declarations}
    *                                                                      *
    ************************************************************************
    -}

    type instance XTyClD      (GhcPass _) = NoExtField
    type instance XInstD      (GhcPass _) = NoExtField
    type instance XDerivD     (GhcPass _) = NoExtField
    type instance XValD       (GhcPass _) = NoExtField
    type instance XSigD       (GhcPass _) = NoExtField
    type instance XKindSigD   (GhcPass _) = NoExtField
    type instance XDefD       (GhcPass _) = NoExtField
    type instance XForD       (GhcPass _) = NoExtField
    type instance XWarningD   (GhcPass _) = NoExtField
    type instance XAnnD       (GhcPass _) = NoExtField
    type instance XRuleD      (GhcPass _) = NoExtField
    type instance XSpliceD    (GhcPass _) = NoExtField
    type instance XDocD       (GhcPass _) = NoExtField
    type instance XRoleAnnotD (GhcPass _) = NoExtField
    type instance XXHsDecl    (GhcPass _) = NoExtCon

    -- | Partition a list of HsDecls into function/pattern bindings, signatures,
    -- type family declarations, type family instances, and documentation comments.
    --
    -- Panics when given a declaration that cannot be put into any of the output
    -- groups.
    --
    -- The primary use of this function is to implement
    -- 'GHC.Parser.PostProcess.cvBindsAndSigs'.
    partitionBindsAndSigs
      :: [LHsDecl GhcPs]
      -> (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
          [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
    partitionBindsAndSigs = go
      where
        go [] = (emptyBag, [], [], [], [], [])
        go ((L l decl) : ds) =
          let (bs, ss, ts, tfis, dfis, docs) = go ds in
          case decl of
            ValD _ b
              -> (L l b `consBag` bs, ss, ts, tfis, dfis, docs)
            SigD _ s
              -> (bs, L l s : ss, ts, tfis, dfis, docs)
            TyClD _ (FamDecl _ t)
              -> (bs, ss, L l t : ts, tfis, dfis, docs)
            InstD _ (TyFamInstD { tfid_inst = tfi })
              -> (bs, ss, ts, L l tfi : tfis, dfis, docs)
            InstD _ (DataFamInstD { dfid_inst = dfi })
              -> (bs, ss, ts, tfis, L l dfi : dfis, docs)
            DocD _ d
              -> (bs, ss, ts, tfis, dfis, L l d : docs)
            _ -> pprPanic "partitionBindsAndSigs" (ppr decl)

    type instance XCHsGroup (GhcPass _) = NoExtField
    type instance XXHsGroup (GhcPass _) = NoExtCon

    emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
    emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
    emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

    emptyGroup = HsGroup { hs_ext = noExtField,
                           hs_tyclds = [],
                           hs_derivds = [],
                           hs_fixds = [], hs_defds = [], hs_annds = [],
                           hs_fords = [], hs_warnds = [], hs_ruleds = [],
                           hs_valds = error "emptyGroup hs_valds: Can't happen",
                           hs_splcds = [],
                           hs_docs = [] }

    -- | The fixity signatures for each top-level declaration and class method
    -- in an 'HsGroup'.
    -- See Note [Top-level fixity signatures in an HsGroup]
    hsGroupTopLevelFixitySigs :: HsGroup (GhcPass p) -> [LFixitySig (GhcPass p)]
    hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) =
        fixds ++ cls_fixds
      where
        cls_fixds = [ L loc sig
                    | L _ ClassDecl{tcdSigs = sigs} <- tyClGroupTyClDecls tyclds
                    , L loc (FixSig _ sig) <- sigs
                    ]

    appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
                 -> HsGroup (GhcPass p)
    appendGroups
        HsGroup {
            hs_valds  = val_groups1,
            hs_splcds = spliceds1,
            hs_tyclds = tyclds1,
            hs_derivds = derivds1,
            hs_fixds  = fixds1,
            hs_defds  = defds1,
            hs_annds  = annds1,
            hs_fords  = fords1,
            hs_warnds = warnds1,
            hs_ruleds = rulds1,
            hs_docs   = docs1 }
        HsGroup {
            hs_valds  = val_groups2,
            hs_splcds = spliceds2,
            hs_tyclds = tyclds2,
            hs_derivds = derivds2,
            hs_fixds  = fixds2,
            hs_defds  = defds2,
            hs_annds  = annds2,
            hs_fords  = fords2,
            hs_warnds = warnds2,
            hs_ruleds = rulds2,
            hs_docs   = docs2 }
      =
        HsGroup {
            hs_ext    = noExtField,
            hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
            hs_splcds = spliceds1 ++ spliceds2,
            hs_tyclds = tyclds1 ++ tyclds2,
            hs_derivds = derivds1 ++ derivds2,
            hs_fixds  = fixds1 ++ fixds2,
            hs_annds  = annds1 ++ annds2,
            hs_defds  = defds1 ++ defds2,
            hs_fords  = fords1 ++ fords2,
            hs_warnds = warnds1 ++ warnds2,
            hs_ruleds = rulds1 ++ rulds2,
            hs_docs   = docs1  ++ docs2 }

    instance (OutputableBndrId p) => Outputable (HsDecl (GhcPass p)) where
        ppr (TyClD _ dcl)             = ppr dcl
        ppr (ValD _ binds)            = ppr binds
        ppr (DefD _ def)              = ppr def
        ppr (InstD _ inst)            = ppr inst
        ppr (DerivD _ deriv)          = ppr deriv
        ppr (ForD _ fd)               = ppr fd
        ppr (SigD _ sd)               = ppr sd
        ppr (KindSigD _ ksd)          = ppr ksd
        ppr (RuleD _ rd)              = ppr rd
        ppr (WarningD _ wd)           = ppr wd
        ppr (AnnD _ ad)               = ppr ad
        ppr (SpliceD _ dd)            = ppr dd
        ppr (DocD _ doc)              = ppr doc
        ppr (RoleAnnotD _ ra)         = ppr ra

    instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where
        ppr (HsGroup { hs_valds  = val_decls,
                       hs_tyclds = tycl_decls,
                       hs_derivds = deriv_decls,
                       hs_fixds  = fix_decls,
                       hs_warnds = deprec_decls,
                       hs_annds  = ann_decls,
                       hs_fords  = foreign_decls,
                       hs_defds  = default_decls,
                       hs_ruleds = rule_decls })
            = vcat_mb empty
                [ppr_ds fix_decls, ppr_ds default_decls,
                 ppr_ds deprec_decls, ppr_ds ann_decls,
                 ppr_ds rule_decls,
                 if isEmptyValBinds val_decls
                    then Nothing
                    else Just (ppr val_decls),
                 ppr_ds (tyClGroupRoleDecls tycl_decls),
                 ppr_ds (tyClGroupKindSigs  tycl_decls),
                 ppr_ds (tyClGroupTyClDecls tycl_decls),
                 ppr_ds (tyClGroupInstDecls tycl_decls),
                 ppr_ds deriv_decls,
                 ppr_ds foreign_decls]
            where
              ppr_ds :: Outputable a => [a] -> Maybe SDoc
              ppr_ds [] = Nothing
              ppr_ds ds = Just (vcat (map ppr ds))

              vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
              -- Concatenate vertically with white-space between non-blanks
              vcat_mb _    []             = empty
              vcat_mb gap (Nothing : ds) = vcat_mb gap ds
              vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds

    type instance XSpliceDecl      (GhcPass _) = NoExtField
    type instance XXSpliceDecl     (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (SpliceDecl (GhcPass p)) where
       ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f

    {-
    ************************************************************************
    *                                                                      *
                Type and class declarations
    *                                                                      *
    ************************************************************************
    -}

    type instance XFamDecl      (GhcPass _) = NoExtField

    type instance XSynDecl      GhcPs = EpAnn [AddEpAnn]
    type instance XSynDecl      GhcRn = NameSet -- FVs
    type instance XSynDecl      GhcTc = NameSet -- FVs

    type instance XDataDecl     GhcPs = EpAnn [AddEpAnn]
    type instance XDataDecl     GhcRn = DataDeclRn
    type instance XDataDecl     GhcTc = DataDeclRn

    type instance XClassDecl    GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo)  -- See Note [Class LayoutInfo]
      -- TODO:AZ:tidy up AnnSortKey above
    type instance XClassDecl    GhcRn = NameSet -- FVs
    type instance XClassDecl    GhcTc = NameSet -- FVs

    type instance XXTyClDecl    (GhcPass _) = NoExtCon

    type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXTyFamInstDecl (GhcPass _) = NoExtCon

    -- Dealing with names

    tyFamInstDeclName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                      => TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
    tyFamInstDeclName = unLoc . tyFamInstDeclLName

    tyFamInstDeclLName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                       => TyFamInstDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
    tyFamInstDeclLName (TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = ln }})
      = ln

    tyClDeclLName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                  => TyClDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
    tyClDeclLName (FamDecl { tcdFam = fd })     = familyDeclLName fd
    tyClDeclLName (SynDecl { tcdLName = ln })   = ln
    tyClDeclLName (DataDecl { tcdLName = ln })  = ln
    tyClDeclLName (ClassDecl { tcdLName = ln }) = ln

    -- FIXME: tcdName is commonly used by both GHC and third-party tools, so it
    -- needs to be polymorphic in the pass
    tcdName :: Anno (IdGhcP p) ~ SrcSpanAnnN
            => TyClDecl (GhcPass p) -> IdP (GhcPass p)
    tcdName = unLoc . tyClDeclLName

    -- | Does this declaration have a complete, user-supplied kind signature?
    -- See Note [CUSKs: complete user-supplied kind signatures]
    hsDeclHasCusk :: TyClDecl GhcRn -> Bool
    hsDeclHasCusk (FamDecl { tcdFam =
        FamilyDecl { fdInfo      = fam_info
                   , fdTyVars    = tyvars
                   , fdResultSig = L _ resultSig } }) =
        case fam_info of
          ClosedTypeFamily {} -> hsTvbAllKinded tyvars
                              && isJust (famResultKindSignature resultSig)
          _ -> True -- Un-associated open type/data families have CUSKs
    hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
      = hsTvbAllKinded tyvars && isJust (hsTyKindSig rhs)
    hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
    hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars

    -- Pretty-printing TyClDecl
    -- ~~~~~~~~~~~~~~~~~~~~~~~~

    instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where

        ppr (FamDecl { tcdFam = decl }) = ppr decl
        ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                     , tcdRhs = rhs })
          = hang (text "type" <+>
                  pp_vanilla_decl_head ltycon tyvars fixity Nothing <+> equals)
              4 (ppr rhs)

        ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                      , tcdDataDefn = defn })
          = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn

        ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
                        tcdFixity = fixity,
                        tcdFDs  = fds,
                        tcdSigs = sigs, tcdMeths = methods,
                        tcdATs = ats, tcdATDefs = at_defs})
          | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
          = top_matter

          | otherwise       -- Laid out
          = vcat [ top_matter <+> text "where"
                 , nest 2 $ pprDeclList (map (ppr . unLoc) ats ++
                                         map (pprTyFamDefltDecl . unLoc) at_defs ++
                                         pprLHsBindsForUser methods sigs) ]
          where
            top_matter = text "class"
                        <+> pp_vanilla_decl_head lclas tyvars fixity context
                        <+> pprFundeps (map unLoc fds)

    instance OutputableBndrId p
           => Outputable (TyClGroup (GhcPass p)) where
      ppr (TyClGroup { group_tyclds = tyclds
                     , group_roles = roles
                     , group_kisigs = kisigs
                     , group_instds = instds
                     }
          )
        = hang (text "TyClGroup") 2 $
          ppr kisigs $$
          ppr tyclds $$
          ppr roles $$
          ppr instds

    pp_vanilla_decl_head :: (OutputableBndrId p)
       => XRec (GhcPass p) (IdP (GhcPass p))
       -> LHsQTyVars (GhcPass p)
       -> LexicalFixity
       -> Maybe (LHsContext (GhcPass p))
       -> SDoc
    pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
     = hsep [pprLHsContext context, pp_tyvars tyvars]
      where
        pp_tyvars (varl:varsr)
          | fixity == Infix && length varsr > 1
             = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
                    , (ppr.unLoc) (head varsr), char ')'
                    , hsep (map (ppr.unLoc) (tail varsr))]
          | fixity == Infix
             = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
             , hsep (map (ppr.unLoc) varsr)]
          | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                      , hsep (map (ppr.unLoc) (varl:varsr))]
        pp_tyvars [] = pprPrefixOcc (unLoc thing)

    pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
    pprTyClDeclFlavour (ClassDecl {})   = text "class"
    pprTyClDeclFlavour (SynDecl {})     = text "type"
    pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
      = pprFlavour info <+> text "family"
    pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
      = ppr nd

    instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where
      ppr = pprFunDep

    type instance XCFunDep    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXFunDep    (GhcPass _) = NoExtCon

    pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc
    pprFundeps []  = empty
    pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds))

    pprFunDep :: OutputableBndrId p => FunDep (GhcPass p) -> SDoc
    pprFunDep (FunDep _ us vs) = hsep [interppSP us, arrow, interppSP vs]

    {- *********************************************************************
    *                                                                      *
                             TyClGroup
            Strongly connected components of
          type, class, instance, and role declarations
    *                                                                      *
    ********************************************************************* -}

    type instance XCTyClGroup (GhcPass _) = NoExtField
    type instance XXTyClGroup (GhcPass _) = NoExtCon

    {- *********************************************************************
    *                                                                      *
                   Data and type family declarations
    *                                                                      *
    ********************************************************************* -}

    type instance XNoSig            (GhcPass _) = NoExtField
    type instance XCKindSig         (GhcPass _) = NoExtField

    type instance XTyVarSig         (GhcPass _) = NoExtField
    type instance XXFamilyResultSig (GhcPass _) = NoExtCon

    type instance XCFamilyDecl    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXFamilyDecl    (GhcPass _) = NoExtCon

    ------------- Functions over FamilyDecls -----------

    familyDeclLName :: FamilyDecl (GhcPass p) -> XRec (GhcPass p) (IdP (GhcPass p))
    familyDeclLName (FamilyDecl { fdLName = n }) = n

    familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p)
    familyDeclName = unLoc . familyDeclLName

    famResultKindSignature :: FamilyResultSig (GhcPass p) -> Maybe (LHsKind (GhcPass p))
    famResultKindSignature (NoSig _) = Nothing
    famResultKindSignature (KindSig _ ki) = Just ki
    famResultKindSignature (TyVarSig _ bndr) =
      case unLoc bndr of
        UserTyVar _ _ _ -> Nothing
        KindedTyVar _ _ _ ki -> Just ki

    -- | Maybe return name of the result type variable
    resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
    resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
    resultVariableName _                = Nothing

    ------------- Pretty printing FamilyDecls -----------

    type instance XCInjectivityAnn  (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXInjectivityAnn  (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (FamilyDecl (GhcPass p)) where
      ppr (FamilyDecl { fdInfo = info, fdLName = ltycon
                      , fdTopLevel = top_level
                      , fdTyVars = tyvars
                      , fdFixity = fixity
                      , fdResultSig = L _ result
                      , fdInjectivityAnn = mb_inj })
        = vcat [ pprFlavour info <+> pp_top_level <+>
                 pp_vanilla_decl_head ltycon tyvars fixity Nothing <+>
                 pp_kind <+> pp_inj <+> pp_where
               , nest 2 $ pp_eqns ]
        where
          pp_top_level = case top_level of
                           TopLevel    -> text "family"
                           NotTopLevel -> empty

          pp_kind = case result of
                      NoSig    _         -> empty
                      KindSig  _ kind    -> dcolon <+> ppr kind
                      TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
          pp_inj = case mb_inj of
                     Just (L _ (InjectivityAnn _ lhs rhs)) ->
                       hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
                     Nothing -> empty
          (pp_where, pp_eqns) = case info of
            ClosedTypeFamily mb_eqns ->
              ( text "where"
              , case mb_eqns of
                  Nothing   -> text ".."
                  Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
            _ -> (empty, empty)

    {- *********************************************************************
    *                                                                      *
                   Data types and data constructors
    *                                                                      *
    ********************************************************************* -}

    type instance XCHsDataDefn    (GhcPass _) = NoExtField
    type instance XXHsDataDefn    (GhcPass _) = NoExtCon

    type instance XCHsDerivingClause    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXHsDerivingClause    (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (HsDerivingClause (GhcPass p)) where
      ppr (HsDerivingClause { deriv_clause_strategy = dcs
                            , deriv_clause_tys      = L _ dct })
        = hsep [ text "deriving"
               , pp_strat_before
               , ppr dct
               , pp_strat_after ]
          where
            -- @via@ is unique in that in comes /after/ the class being derived,
            -- so we must special-case it.
            (pp_strat_before, pp_strat_after) =
              case dcs of
                Just (L _ via@ViaStrategy{}) -> (empty, ppr via)
                _                            -> (ppDerivStrategy dcs, empty)

    type instance XDctSingle (GhcPass _) = NoExtField
    type instance XDctMulti  (GhcPass _) = NoExtField
    type instance XXDerivClauseTys (GhcPass _) = NoExtCon

    instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where
      ppr (DctSingle _ ty) = ppr ty
      ppr (DctMulti _ tys) = parens (interpp'SP tys)

    type instance XStandaloneKindSig GhcPs = EpAnn [AddEpAnn]
    type instance XStandaloneKindSig GhcRn = NoExtField
    type instance XStandaloneKindSig GhcTc = NoExtField

    type instance XXStandaloneKindSig (GhcPass p) = NoExtCon

    standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
    standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname

    type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn]
    type instance XConDeclH98  (GhcPass _) = EpAnn [AddEpAnn]

    type instance XXConDecl (GhcPass _) = NoExtCon

    getConNames :: ConDecl GhcRn -> [LocatedN Name]
    getConNames ConDeclH98  {con_name  = name}  = [name]
    getConNames ConDeclGADT {con_names = names} = names

    -- | Return @'Just' fields@ if a data constructor declaration uses record
    -- syntax (i.e., 'RecCon'), where @fields@ are the field selectors.
    -- Otherwise, return 'Nothing'.
    getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (LocatedL [LConDeclField GhcRn])
    getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
      PrefixCon{} -> Nothing
      RecCon flds -> Just flds
      InfixCon{}  -> Nothing
    getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
      PrefixConGADT{} -> Nothing
      RecConGADT flds -> Just flds

    hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
    hsConDeclTheta Nothing            = []
    hsConDeclTheta (Just (L _ theta)) = theta

    pp_data_defn :: (OutputableBndrId p)
                      => (Maybe (LHsContext (GhcPass p)) -> SDoc)   -- Printing the header
                      -> HsDataDefn (GhcPass p)
                      -> SDoc
    pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context
                                    , dd_cType = mb_ct
                                    , dd_kindSig = mb_sig
                                    , dd_cons = condecls, dd_derivs = derivings })
      | null condecls
      = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig
        <+> pp_derivings derivings

      | otherwise
      = hang (ppr new_or_data <+> pp_ct  <+> pp_hdr context <+> pp_sig)
           2 (pp_condecls condecls $$ pp_derivings derivings)
      where
        pp_ct = case mb_ct of
                   Nothing   -> empty
                   Just ct -> ppr ct
        pp_sig = case mb_sig of
                   Nothing   -> empty
                   Just kind -> dcolon <+> ppr kind
        pp_derivings ds = vcat (map ppr ds)

    instance OutputableBndrId p
           => Outputable (HsDataDefn (GhcPass p)) where
       ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d

    instance OutputableBndrId p
           => Outputable (StandaloneKindSig (GhcPass p)) where
      ppr (StandaloneKindSig _ v ki)
        = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki

    pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc
    pp_condecls cs
      | gadt_syntax                  -- In GADT syntax
      = hang (text "where") 2 (vcat (map ppr cs))
      | otherwise                    -- In H98 syntax
      = equals <+> sep (punctuate (text " |") (map ppr cs))
      where
        gadt_syntax = case cs of
          []                      -> False
          (L _ ConDeclH98{}  : _) -> False
          (L _ ConDeclGADT{} : _) -> True

    instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where
        ppr = pprConDecl

    pprConDecl :: forall p. OutputableBndrId p => ConDecl (GhcPass p) -> SDoc
    pprConDecl (ConDeclH98 { con_name = L _ con
                           , con_ex_tvs = ex_tvs
                           , con_mb_cxt = mcxt
                           , con_args = args
                           , con_doc = doc })
      = sep [ ppr_mbDoc doc
            , pprHsForAll (mkHsForAllInvisTele noAnn ex_tvs) mcxt
            , ppr_details args ]
      where
        -- In ppr_details: let's not print the multiplicities (they are always 1, by
        -- definition) as they do not appear in an actual declaration.
        ppr_details (InfixCon t1 t2) = hsep [ppr (hsScaledThing t1),
                                             pprInfixOcc con,
                                             ppr (hsScaledThing t2)]
        ppr_details (PrefixCon _ tys) = hsep (pprPrefixOcc con
                                        : map (pprHsType . unLoc . hsScaledThing) tys)
        ppr_details (RecCon fields)  = pprPrefixOcc con
                                     <+> pprConDeclFields (unLoc fields)

    pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs
                            , con_mb_cxt = mcxt, con_g_args = args
                            , con_res_ty = res_ty, con_doc = doc })
      = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
        <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt,
                  ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])
      where
        get_args (PrefixConGADT args) = map ppr args
        get_args (RecConGADT fields)  = [pprConDeclFields (unLoc fields)]

        ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
        ppr_arrow_chain []     = empty

    ppr_con_names :: (OutputableBndr a) => [GenLocated l a] -> SDoc
    ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)

    {-
    ************************************************************************
    *                                                                      *
                    Instance declarations
    *                                                                      *
    ************************************************************************
    -}

    type instance XCFamEqn    (GhcPass _) r = EpAnn [AddEpAnn]
    type instance XXFamEqn    (GhcPass _) r = NoExtCon

    type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA

    ----------------- Class instances -------------

    type instance XCClsInstDecl    GhcPs = (EpAnn [AddEpAnn], AnnSortKey) -- TODO:AZ:tidy up
    type instance XCClsInstDecl    GhcRn = NoExtField
    type instance XCClsInstDecl    GhcTc = NoExtField

    type instance XXClsInstDecl    (GhcPass _) = NoExtCon

    ----------------- Instances of all kinds -------------

    type instance XClsInstD     (GhcPass _) = NoExtField

    type instance XDataFamInstD GhcPs = EpAnn [AddEpAnn]
    type instance XDataFamInstD GhcRn = NoExtField
    type instance XDataFamInstD GhcTc = NoExtField

    type instance XTyFamInstD   GhcPs = NoExtField
    type instance XTyFamInstD   GhcRn = NoExtField
    type instance XTyFamInstD   GhcTc = NoExtField

    type instance XXInstDecl    (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (TyFamInstDecl (GhcPass p)) where
      ppr = pprTyFamInstDecl TopLevel

    pprTyFamInstDecl :: (OutputableBndrId p)
                     => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
    pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
       = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn

    ppr_instance_keyword :: TopLevelFlag -> SDoc
    ppr_instance_keyword TopLevel    = text "instance"
    ppr_instance_keyword NotTopLevel = empty

    pprTyFamDefltDecl :: (OutputableBndrId p)
                      => TyFamDefltDecl (GhcPass p) -> SDoc
    pprTyFamDefltDecl = pprTyFamInstDecl NotTopLevel

    ppr_fam_inst_eqn :: (OutputableBndrId p)
                     => TyFamInstEqn (GhcPass p) -> SDoc
    ppr_fam_inst_eqn (FamEqn { feqn_tycon  = L _ tycon
                             , feqn_bndrs  = bndrs
                             , feqn_pats   = pats
                             , feqn_fixity = fixity
                             , feqn_rhs    = rhs })
        = pprHsFamInstLHS tycon bndrs pats fixity Nothing <+> equals <+> ppr rhs

    instance OutputableBndrId p
           => Outputable (DataFamInstDecl (GhcPass p)) where
      ppr = pprDataFamInstDecl TopLevel

    pprDataFamInstDecl :: (OutputableBndrId p)
                       => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
    pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn =
                                (FamEqn { feqn_tycon  = L _ tycon
                                        , feqn_bndrs  = bndrs
                                        , feqn_pats   = pats
                                        , feqn_fixity = fixity
                                        , feqn_rhs    = defn })})
      = pp_data_defn pp_hdr defn
      where
        pp_hdr mctxt = ppr_instance_keyword top_lvl
                  <+> pprHsFamInstLHS tycon bndrs pats fixity mctxt
                      -- pp_data_defn pretty-prints the kind sig. See #14817.

    pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc
    pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn =
                           (FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }})})
      = ppr nd

    pprHsFamInstLHS :: (OutputableBndrId p)
       => IdP (GhcPass p)
       -> HsOuterFamEqnTyVarBndrs (GhcPass p)
       -> HsTyPats (GhcPass p)
       -> LexicalFixity
       -> Maybe (LHsContext (GhcPass p))
       -> SDoc
    pprHsFamInstLHS thing bndrs typats fixity mb_ctxt
       = hsep [ pprHsOuterFamEqnTyVarBndrs bndrs
              , pprLHsContext mb_ctxt
              , pp_pats typats ]
       where
         pp_pats (patl:patr:pats)
           | Infix <- fixity
           = let pp_op_app = hsep [ ppr patl, pprInfixOcc thing, ppr patr ] in
             case pats of
               [] -> pp_op_app
               _  -> hsep (parens pp_op_app : map ppr pats)

         pp_pats pats = hsep [ pprPrefixOcc thing
                             , hsep (map ppr pats)]

    instance OutputableBndrId p
           => Outputable (ClsInstDecl (GhcPass p)) where
        ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                         , cid_sigs = sigs, cid_tyfam_insts = ats
                         , cid_overlap_mode = mbOverlap
                         , cid_datafam_insts = adts })
          | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
          = top_matter

          | otherwise       -- Laid out
          = vcat [ top_matter <+> text "where"
                 , nest 2 $ pprDeclList $
                   map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++
                   map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
                   pprLHsBindsForUser binds sigs ]
          where
            top_matter = text "instance" <+> ppOverlapPragma mbOverlap
                                                 <+> ppr inst_ty

    ppDerivStrategy :: OutputableBndrId p
                    => Maybe (LDerivStrategy (GhcPass p)) -> SDoc
    ppDerivStrategy mb =
      case mb of
        Nothing       -> empty
        Just (L _ ds) -> ppr ds

    ppOverlapPragma :: Maybe (LocatedP OverlapMode) -> SDoc
    ppOverlapPragma mb =
      case mb of
        Nothing           -> empty
        Just (L _ (NoOverlap s))    -> maybe_stext s "{-# NO_OVERLAP #-}"
        Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
        Just (L _ (Overlapping s))  -> maybe_stext s "{-# OVERLAPPING #-}"
        Just (L _ (Overlaps s))     -> maybe_stext s "{-# OVERLAPS #-}"
        Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"
      where
        maybe_stext NoSourceText     alt = text alt
        maybe_stext (SourceText src) _   = text src <+> text "#-}"

    instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where
        ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
        ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
        ppr (DataFamInstD { dfid_inst = decl }) = ppr decl

    -- Extract the declarations of associated data types from an instance

    instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)]
    instDeclDataFamInsts inst_decls
      = concatMap do_one inst_decls
      where
        do_one :: LInstDecl (GhcPass p) -> [DataFamInstDecl (GhcPass p)]
        do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))
          = map unLoc fam_insts
        do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]
        do_one (L _ (TyFamInstD {}))                              = []

    {-
    ************************************************************************
    *                                                                      *
    \subsection[DerivDecl]{A stand-alone instance deriving declaration}
    *                                                                      *
    ************************************************************************
    -}

    type instance XCDerivDecl    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXDerivDecl    (GhcPass _) = NoExtCon

    type instance Anno OverlapMode = SrcSpanAnnP

    instance OutputableBndrId p
           => Outputable (DerivDecl (GhcPass p)) where
        ppr (DerivDecl { deriv_type = ty
                       , deriv_strategy = ds
                       , deriv_overlap_mode = o })
            = hsep [ text "deriving"
                   , ppDerivStrategy ds
                   , text "instance"
                   , ppOverlapPragma o
                   , ppr ty ]

    {-
    ************************************************************************
    *                                                                      *
                    Deriving strategies
    *                                                                      *
    ************************************************************************
    -}

    type instance XStockStrategy    GhcPs = EpAnn [AddEpAnn]
    type instance XStockStrategy    GhcRn = NoExtField
    type instance XStockStrategy    GhcTc = NoExtField

    type instance XAnyClassStrategy GhcPs = EpAnn [AddEpAnn]
    type instance XAnyClassStrategy GhcRn = NoExtField
    type instance XAnyClassStrategy GhcTc = NoExtField

    type instance XNewtypeStrategy  GhcPs = EpAnn [AddEpAnn]
    type instance XNewtypeStrategy  GhcRn = NoExtField
    type instance XNewtypeStrategy  GhcTc = NoExtField

    type instance XViaStrategy GhcPs = XViaStrategyPs
    type instance XViaStrategy GhcRn = LHsSigType GhcRn
    type instance XViaStrategy GhcTc = Type

    data XViaStrategyPs = XViaStrategyPs (EpAnn [AddEpAnn]) (LHsSigType GhcPs)

    instance OutputableBndrId p
            => Outputable (DerivStrategy (GhcPass p)) where
        ppr (StockStrategy    _) = text "stock"
        ppr (AnyclassStrategy _) = text "anyclass"
        ppr (NewtypeStrategy  _) = text "newtype"
        ppr (ViaStrategy ty)     = text "via" <+> case ghcPass @p of
                                                    GhcPs -> ppr ty
                                                    GhcRn -> ppr ty
                                                    GhcTc -> ppr ty

    instance Outputable XViaStrategyPs where
        ppr (XViaStrategyPs _ t) = ppr t

    -- | Eliminate a 'DerivStrategy'.
    foldDerivStrategy :: (p ~ GhcPass pass)
                      => r -> (XViaStrategy p -> r) -> DerivStrategy p -> r
    foldDerivStrategy other _   (StockStrategy    _) = other
    foldDerivStrategy other _   (AnyclassStrategy _) = other
    foldDerivStrategy other _   (NewtypeStrategy  _) = other
    foldDerivStrategy _     via (ViaStrategy t)  = via t

    -- | Map over the @via@ type if dealing with 'ViaStrategy'. Otherwise,
    -- return the 'DerivStrategy' unchanged.
    mapDerivStrategy :: (p ~ GhcPass pass)
                     => (XViaStrategy p -> XViaStrategy p)
                     -> DerivStrategy p -> DerivStrategy p
    mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds

    {-
    ************************************************************************
    *                                                                      *
    \subsection[DefaultDecl]{A @default@ declaration}
    *                                                                      *
    ************************************************************************
    -}

    type instance XCDefaultDecl    GhcPs = EpAnn [AddEpAnn]
    type instance XCDefaultDecl    GhcRn = NoExtField
    type instance XCDefaultDecl    GhcTc = NoExtField

    type instance XXDefaultDecl    (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (DefaultDecl (GhcPass p)) where
        ppr (DefaultDecl _ tys)
          = text "default" <+> parens (interpp'SP tys)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Foreign function interface declaration}
    *                                                                      *
    ************************************************************************
    -}

    type instance XForeignImport   GhcPs = EpAnn [AddEpAnn]
    type instance XForeignImport   GhcRn = NoExtField
    type instance XForeignImport   GhcTc = Coercion

    type instance XForeignExport   GhcPs = EpAnn [AddEpAnn]
    type instance XForeignExport   GhcRn = NoExtField
    type instance XForeignExport   GhcTc = Coercion

    type instance XXForeignDecl    (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (ForeignDecl (GhcPass p)) where
      ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
        = hang (text "foreign import" <+> ppr fimport <+> ppr n)
             2 (dcolon <+> ppr ty)
      ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
        hang (text "foreign export" <+> ppr fexport <+> ppr n)
           2 (dcolon <+> ppr ty)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Rewrite rules}
    *                                                                      *
    ************************************************************************
    -}

    type instance XCRuleDecls    GhcPs = EpAnn [AddEpAnn]
    type instance XCRuleDecls    GhcRn = NoExtField
    type instance XCRuleDecls    GhcTc = NoExtField

    type instance XXRuleDecls    (GhcPass _) = NoExtCon

    type instance XHsRule       GhcPs = EpAnn HsRuleAnn
    type instance XHsRule       GhcRn = HsRuleRn
    type instance XHsRule       GhcTc = HsRuleRn

    type instance XXRuleDecl    (GhcPass _) = NoExtCon

    type instance Anno (SourceText, RuleName) = SrcSpan

    data HsRuleAnn
      = HsRuleAnn
           { ra_tyanns :: Maybe (AddEpAnn, AddEpAnn)
                     -- ^ The locations of 'forall' and '.' for forall'd type vars
                     -- Using AddEpAnn to capture possible unicode variants
           , ra_tmanns :: Maybe (AddEpAnn, AddEpAnn)
                     -- ^ The locations of 'forall' and '.' for forall'd term vars
                     -- Using AddEpAnn to capture possible unicode variants
           , ra_rest :: [AddEpAnn]
           } deriving (Data, Eq)

    flattenRuleDecls :: [LRuleDecls (GhcPass p)] -> [LRuleDecl (GhcPass p)]
    flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls

    type instance XCRuleBndr    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XRuleBndrSig  (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXRuleBndr    (GhcPass _) = NoExtCon

    instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where
      ppr (HsRules { rds_src = st
                   , rds_rules = rules })
        = pprWithSourceText st (text "{-# RULES")
              <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"

    instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where
      ppr (HsRule { rd_name = name
                  , rd_act  = act
                  , rd_tyvs = tys
                  , rd_tmvs = tms
                  , rd_lhs  = lhs
                  , rd_rhs  = rhs })
            = sep [pprFullRuleName name <+> ppr act,
                   nest 4 (pp_forall_ty tys <+> pp_forall_tm tys
                                            <+> pprExpr (unLoc lhs)),
                   nest 6 (equals <+> pprExpr (unLoc rhs)) ]
            where
              pp_forall_ty Nothing     = empty
              pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot
              pp_forall_tm Nothing | null tms = empty
              pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot

    instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where
       ppr (RuleBndr _ name) = ppr name
       ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)

    {-
    ************************************************************************
    *                                                                      *
    \subsection[DeprecDecl]{Deprecations}
    *                                                                      *
    ************************************************************************
    -}

    type instance XWarnings      GhcPs = EpAnn [AddEpAnn]
    type instance XWarnings      GhcRn = NoExtField
    type instance XWarnings      GhcTc = NoExtField

    type instance XXWarnDecls    (GhcPass _) = NoExtCon

    type instance XWarning      (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXWarnDecl    (GhcPass _) = NoExtCon

    instance OutputableBndrId p
            => Outputable (WarnDecls (GhcPass p)) where
        ppr (Warnings _ (SourceText src) decls)
          = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
        ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"

    instance OutputableBndrId p
           => Outputable (WarnDecl (GhcPass p)) where
        ppr (Warning _ thing txt)
          = hsep ( punctuate comma (map ppr thing))
                  <+> ppr txt

    {-
    ************************************************************************
    *                                                                      *
    \subsection[AnnDecl]{Annotations}
    *                                                                      *
    ************************************************************************
    -}

    type instance XHsAnnotation (GhcPass _) = EpAnn AnnPragma
    type instance XXAnnDecl     (GhcPass _) = NoExtCon

    instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where
        ppr (HsAnnotation _ _ provenance expr)
          = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]

    pprAnnProvenance :: OutputableBndrId p => AnnProvenance (GhcPass p) -> SDoc
    pprAnnProvenance ModuleAnnProvenance       = text "ANN module"
    pprAnnProvenance (ValueAnnProvenance (L _ name))
      = text "ANN" <+> ppr name
    pprAnnProvenance (TypeAnnProvenance (L _ name))
      = text "ANN type" <+> ppr name

    {-
    ************************************************************************
    *                                                                      *
    \subsection[RoleAnnot]{Role annotations}
    *                                                                      *
    ************************************************************************
    -}

    type instance XCRoleAnnotDecl GhcPs = EpAnn [AddEpAnn]
    type instance XCRoleAnnotDecl GhcRn = NoExtField
    type instance XCRoleAnnotDecl GhcTc = NoExtField

    type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon

    type instance Anno (Maybe Role) = SrcSpan

    instance OutputableBndr (IdP (GhcPass p))
           => Outputable (RoleAnnotDecl (GhcPass p)) where
      ppr (RoleAnnotDecl _ ltycon roles)
        = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+>
          hsep (map (pp_role . unLoc) roles)
        where
          pp_role Nothing  = underscore
          pp_role (Just r) = ppr r

    roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
    roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Anno instances}
    *                                                                      *
    ************************************************************************
    -}

    type instance Anno (HsDecl (GhcPass _)) = SrcSpanAnnA
    type instance Anno (SpliceDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (TyClDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA
    type instance Anno (FamilyResultSig (GhcPass p)) = SrcSpan
    type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (InjectivityAnn (GhcPass p)) = SrcSpan
    type instance Anno CType = SrcSpanAnnP
    type instance Anno (HsDerivingClause (GhcPass p)) = SrcSpan
    type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnC
    type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA
    type instance Anno (ConDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno Bool = SrcSpan
    type instance Anno [LocatedA (ConDeclField (GhcPass _))] = SrcSpanAnnL
    type instance Anno (FamEqn p (LocatedA (HsType p))) = SrcSpanAnnA
    type instance Anno (TyFamInstDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (DataFamInstDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA
    type instance Anno (ClsInstDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (InstDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno DocDecl = SrcSpanAnnA
    type instance Anno (DerivDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno OverlapMode = SrcSpanAnnP
    type instance Anno (DerivStrategy (GhcPass p)) = SrcSpan
    type instance Anno (DefaultDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (ForeignDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (RuleDecls (GhcPass p)) = SrcSpanAnnA
    type instance Anno (RuleDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (SourceText, RuleName) = SrcSpan
    type instance Anno (RuleBndr (GhcPass p)) = SrcSpan
    type instance Anno (WarnDecls (GhcPass p)) = SrcSpanAnnA
    type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA
    type instance Anno (Maybe Role) = SrcSpan