GHC/Hs/Type.hs

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

    {-# OPTIONS_GHC -Wno-orphans #-} -- NamedThing, Outputable, OutputableBndrId

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

    GHC.Hs.Type: Abstract syntax: user-defined types
    -}

    module GHC.Hs.Type (
            Mult, HsScaled(..),
            hsMult, hsScaledThing,
            HsArrow(..), arrowToHsType,
            hsLinear, hsUnrestricted, isUnrestricted,

            HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
            HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
            LHsQTyVars(..),
            HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
            HsWildCardBndrs(..),
            HsPatSigType(..), HsPSRn(..),
            HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType,
            HsTupleSort(..),
            HsContext, LHsContext, fromMaybeContext,
            HsTyLit(..),
            HsIPName(..), hsIPNameFS,
            HsArg(..), numVisibleArgs,
            LHsTypeArg, lhsTypeArgSrcSpan,
            OutputableBndrFlag,

            LBangType, BangType,
            HsSrcBang(..), HsImplBang(..),
            SrcStrictness(..), SrcUnpackedness(..),
            getBangType, getBangStrictness,

            ConDeclField(..), LConDeclField, pprConDeclFields,

            HsConDetails(..), noTypeArgs,

            FieldOcc(..), LFieldOcc, mkFieldOcc,
            AmbiguousFieldOcc(..), mkAmbiguousFieldOcc,
            rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
            unambiguousFieldOcc, ambiguousFieldOcc,

            mkAnonWildCardTy, pprAnonWildCard,

            hsOuterTyVarNames, hsOuterExplicitBndrs, mapHsOuterImplicit,
            mkHsOuterImplicit, mkHsOuterExplicit,
            mkHsImplicitSigType, mkHsExplicitSigType,
            mkHsWildCardBndrs, mkHsPatSigType,
            mkEmptyWildCardBndrs,
            mkHsForAllVisTele, mkHsForAllInvisTele,
            mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,
            isHsKindedTyVar, hsTvbAllKinded,
            hsScopedTvs, hsWcScopedTvs, dropWildCards,
            hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
            hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,
            splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
            splitLHsPatSynTy,
            splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy,
            splitLHsSigmaTyInvis, splitLHsGadtTy,
            splitHsFunType, hsTyGetAppHead_maybe,
            mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
            ignoreParens, hsSigWcType, hsPatSigType,
            hsTyKindSig,
            setHsTyVarBndrFlag, hsTyVarBndrFlag,

            -- Printing
            pprHsType, pprHsForAll,
            pprHsOuterFamEqnTyVarBndrs, pprHsOuterSigTyVarBndrs,
            pprLHsContext,
            hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import Language.Haskell.Syntax.Type

    import {-# SOURCE #-} GHC.Hs.Expr ( pprSplice )

    import Language.Haskell.Syntax.Extension
    import GHC.Hs.Extension
    import GHC.Parser.Annotation

    import GHC.Types.Id ( Id )
    import GHC.Types.SourceText
    import GHC.Types.Name( Name, NamedThing(getName) )
    import GHC.Types.Name.Reader ( RdrName )
    import GHC.Types.Var ( VarBndr )
    import GHC.Core.TyCo.Rep ( Type(..) )
    import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr )
    import GHC.Core.Type
    import GHC.Hs.Doc
    import GHC.Types.Basic
    import GHC.Types.SrcLoc
    import GHC.Utils.Outputable

    import Data.Maybe

    import qualified Data.Semigroup as S

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Bang annotations}
    *                                                                      *
    ************************************************************************
    -}

    getBangType :: LHsType (GhcPass p) -> LHsType (GhcPass p)
    getBangType                 (L _ (HsBangTy _ _ lty))       = lty
    getBangType (L _ (HsDocTy x (L _ (HsBangTy _ _ lty)) lds)) =
      addCLocA lty lds (HsDocTy x lty lds)
    getBangType lty                                            = lty

    getBangStrictness :: LHsType (GhcPass p) -> HsSrcBang
    getBangStrictness                 (L _ (HsBangTy _ s _))     = s
    getBangStrictness (L _ (HsDocTy _ (L _ (HsBangTy _ s _)) _)) = s
    getBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Data types}
    *                                                                      *
    ************************************************************************
    -}

    fromMaybeContext :: Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
    fromMaybeContext mctxt = unLoc $ fromMaybe (noLocA []) mctxt

    type instance XHsForAllVis   (GhcPass _) = EpAnnForallTy
                                               -- Location of 'forall' and '->'
    type instance XHsForAllInvis (GhcPass _) = EpAnnForallTy
                                               -- Location of 'forall' and '.'

    type instance XXHsForAllTelescope (GhcPass _) = NoExtCon

    type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn)
      -- ^ Location of 'forall' and '->' for HsForAllVis
      -- Location of 'forall' and '.' for HsForAllInvis

    type HsQTvsRn = [Name]  -- Implicit variables
      -- For example, in   data T (a :: k1 -> k2) = ...
      -- the 'a' is explicit while 'k1', 'k2' are implicit

    type instance XHsQTvs GhcPs = NoExtField
    type instance XHsQTvs GhcRn = HsQTvsRn
    type instance XHsQTvs GhcTc = HsQTvsRn

    type instance XXLHsQTyVars  (GhcPass _) = NoExtCon

    mkHsForAllVisTele ::EpAnnForallTy ->
      [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
    mkHsForAllVisTele an vis_bndrs =
      HsForAllVis { hsf_xvis = an, hsf_vis_bndrs = vis_bndrs }

    mkHsForAllInvisTele :: EpAnnForallTy
      -> [LHsTyVarBndr Specificity (GhcPass p)] -> HsForAllTelescope (GhcPass p)
    mkHsForAllInvisTele an invis_bndrs =
      HsForAllInvis { hsf_xinvis = an, hsf_invis_bndrs = invis_bndrs }

    mkHsQTvs :: [LHsTyVarBndr () GhcPs] -> LHsQTyVars GhcPs
    mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }

    emptyLHsQTvs :: LHsQTyVars GhcRn
    emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] }

    ------------------------------------------------
    --            HsOuterTyVarBndrs

    type instance XHsOuterImplicit GhcPs = NoExtField
    type instance XHsOuterImplicit GhcRn = [Name]
    type instance XHsOuterImplicit GhcTc = [TyVar]

    type instance XHsOuterExplicit GhcPs _    = EpAnnForallTy
    type instance XHsOuterExplicit GhcRn _    = NoExtField
    type instance XHsOuterExplicit GhcTc flag = [VarBndr TyVar flag]

    type instance XXHsOuterTyVarBndrs (GhcPass _) = NoExtCon

    type instance XHsWC              GhcPs b = NoExtField
    type instance XHsWC              GhcRn b = [Name]
    type instance XHsWC              GhcTc b = [Name]

    type instance XXHsWildCardBndrs (GhcPass _) _ = NoExtCon

    type instance XHsPS GhcPs = EpAnn EpaLocation
    type instance XHsPS GhcRn = HsPSRn
    type instance XHsPS GhcTc = HsPSRn

    type instance XXHsPatSigType (GhcPass _) = NoExtCon

    type instance XHsSig (GhcPass _) = NoExtField
    type instance XXHsSigType (GhcPass _) = NoExtCon

    hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
    hsSigWcType = sig_body . unXRec @p . hswc_body

    dropWildCards :: LHsSigWcType pass -> LHsSigType pass
    -- Drop the wildcard part of a LHsSigWcType
    dropWildCards sig_ty = hswc_body sig_ty

    hsOuterTyVarNames :: HsOuterTyVarBndrs flag GhcRn -> [Name]
    hsOuterTyVarNames (HsOuterImplicit{hso_ximplicit = imp_tvs}) = imp_tvs
    hsOuterTyVarNames (HsOuterExplicit{hso_bndrs = bndrs})       = hsLTyVarNames bndrs

    hsOuterExplicitBndrs :: HsOuterTyVarBndrs flag (GhcPass p)
                         -> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
    hsOuterExplicitBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = bndrs
    hsOuterExplicitBndrs (HsOuterImplicit{})                  = []

    mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs
    mkHsOuterImplicit = HsOuterImplicit{hso_ximplicit = noExtField}

    mkHsOuterExplicit :: EpAnnForallTy -> [LHsTyVarBndr flag GhcPs]
                      -> HsOuterTyVarBndrs flag GhcPs
    mkHsOuterExplicit an bndrs = HsOuterExplicit { hso_xexplicit = an
                                                 , hso_bndrs     = bndrs }

    mkHsImplicitSigType :: LHsType GhcPs -> HsSigType GhcPs
    mkHsImplicitSigType body =
      HsSig { sig_ext   = noExtField
            , sig_bndrs = mkHsOuterImplicit, sig_body = body }

    mkHsExplicitSigType :: EpAnnForallTy
                        -> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs
                        -> HsSigType GhcPs
    mkHsExplicitSigType an bndrs body =
      HsSig { sig_ext = noExtField
            , sig_bndrs = mkHsOuterExplicit an bndrs, sig_body = body }

    mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
    mkHsWildCardBndrs x = HsWC { hswc_body = x
                               , hswc_ext  = noExtField }

    mkHsPatSigType :: EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
    mkHsPatSigType ann x = HsPS { hsps_ext  = ann
                                , hsps_body = x }

    mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
    mkEmptyWildCardBndrs x = HsWC { hswc_body = x
                                  , hswc_ext  = [] }

    --------------------------------------------------

    type instance XUserTyVar    (GhcPass _) = EpAnn [AddEpAnn]
    type instance XKindedTyVar  (GhcPass _) = EpAnn [AddEpAnn]

    type instance XXTyVarBndr   (GhcPass _) = NoExtCon

    -- | Return the attached flag
    hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
    hsTyVarBndrFlag (UserTyVar _ fl _)     = fl
    hsTyVarBndrFlag (KindedTyVar _ fl _ _) = fl

    -- | Set the attached flag
    setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
      -> HsTyVarBndr flag (GhcPass pass)
    setHsTyVarBndrFlag f (UserTyVar x _ l)     = UserTyVar x f l
    setHsTyVarBndrFlag f (KindedTyVar x _ l k) = KindedTyVar x f l k

    -- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
    hsTvbAllKinded :: LHsQTyVars (GhcPass p) -> Bool
    hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit

    instance NamedThing (HsTyVarBndr flag GhcRn) where
      getName (UserTyVar _ _ v) = unLoc v
      getName (KindedTyVar _ _ v _) = unLoc v

    type instance XForAllTy        (GhcPass _) = NoExtField
    type instance XQualTy          (GhcPass _) = NoExtField
    type instance XTyVar           (GhcPass _) = EpAnn [AddEpAnn]
    type instance XAppTy           (GhcPass _) = NoExtField
    type instance XFunTy           (GhcPass _) = EpAnn TrailingAnn -- For the AnnRarrow or AnnLolly
    type instance XListTy          (GhcPass _) = EpAnn AnnParen
    type instance XTupleTy         (GhcPass _) = EpAnn AnnParen
    type instance XSumTy           (GhcPass _) = EpAnn AnnParen
    type instance XOpTy            (GhcPass _) = NoExtField
    type instance XParTy           (GhcPass _) = EpAnn AnnParen
    type instance XIParamTy        (GhcPass _) = EpAnn [AddEpAnn]
    type instance XStarTy          (GhcPass _) = NoExtField
    type instance XKindSig         (GhcPass _) = EpAnn [AddEpAnn]

    type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives

    type instance XSpliceTy        GhcPs = NoExtField
    type instance XSpliceTy        GhcRn = NoExtField
    type instance XSpliceTy        GhcTc = Kind

    type instance XDocTy           (GhcPass _) = EpAnn [AddEpAnn]
    type instance XBangTy          (GhcPass _) = EpAnn [AddEpAnn]

    type instance XRecTy           GhcPs = EpAnn AnnList
    type instance XRecTy           GhcRn = NoExtField
    type instance XRecTy           GhcTc = NoExtField

    type instance XExplicitListTy  GhcPs = EpAnn [AddEpAnn]
    type instance XExplicitListTy  GhcRn = NoExtField
    type instance XExplicitListTy  GhcTc = Kind

    type instance XExplicitTupleTy GhcPs = EpAnn [AddEpAnn]
    type instance XExplicitTupleTy GhcRn = NoExtField
    type instance XExplicitTupleTy GhcTc = [Kind]

    type instance XTyLit           (GhcPass _) = NoExtField

    type instance XWildCardTy      (GhcPass _) = NoExtField

    type instance XXType         (GhcPass _) = HsCoreTy

    oneDataConHsTy :: HsType GhcRn
    oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)

    manyDataConHsTy :: HsType GhcRn
    manyDataConHsTy = HsTyVar noAnn NotPromoted (noLocA manyDataConName)

    isUnrestricted :: HsArrow GhcRn -> Bool
    isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName
    isUnrestricted _ = False

    -- | Convert an arrow into its corresponding multiplicity. In essence this
    -- erases the information of whether the programmer wrote an explicit
    -- multiplicity or a shorthand.
    arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
    arrowToHsType (HsUnrestrictedArrow _) = noLocA manyDataConHsTy
    arrowToHsType (HsLinearArrow _ _) = noLocA oneDataConHsTy
    arrowToHsType (HsExplicitMult _ _ p) = p

    instance
          (OutputableBndrId pass) =>
          Outputable (HsArrow (GhcPass pass)) where
      ppr arr = parens (pprHsArrow arr)

    -- See #18846
    pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc
    pprHsArrow (HsUnrestrictedArrow _) = arrow
    pprHsArrow (HsLinearArrow _ _) = lollipop
    pprHsArrow (HsExplicitMult _ _ p) = (mulArrow (ppr p))

    type instance XConDeclField  (GhcPass _) = EpAnn [AddEpAnn]
    type instance XXConDeclField (GhcPass _) = NoExtCon

    instance OutputableBndrId p
           => Outputable (ConDeclField (GhcPass p)) where
      ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty

    ---------------------
    hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]
    -- Get the lexically-scoped type variables of an LHsSigWcType:
    --  - the explicitly-given forall'd type variables;
    --    see Note [Lexically scoped type variables]
    --  - the named wildcards; see Note [Scoping of named wildcards]
    -- because they scope in the same way
    hsWcScopedTvs sig_wc_ty
      | HsWC { hswc_ext = nwcs, hswc_body = sig_ty }  <- sig_wc_ty
      , L _ (HsSig{sig_bndrs = outer_bndrs}) <- sig_ty
      = nwcs ++ hsLTyVarNames (hsOuterExplicitBndrs outer_bndrs)
        -- See Note [hsScopedTvs and visible foralls]

    hsScopedTvs :: LHsSigType GhcRn -> [Name]
    -- Same as hsWcScopedTvs, but for a LHsSigType
    hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs}))
      = hsLTyVarNames (hsOuterExplicitBndrs outer_bndrs)
        -- See Note [hsScopedTvs and visible foralls]

    ---------------------
    hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
    hsTyVarName (UserTyVar _ _ (L _ n))     = n
    hsTyVarName (KindedTyVar _ _ (L _ n) _) = n

    hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
    hsLTyVarName = hsTyVarName . unLoc

    hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
    hsLTyVarNames = map hsLTyVarName

    hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
    -- Explicit variables only
    hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)

    hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
    -- All variables
    hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
                             , hsq_explicit = tvs })
      = kvs ++ hsLTyVarNames tvs

    hsLTyVarLocName :: LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
    hsLTyVarLocName (L l a) = L (l2l l) (hsTyVarName a)

    hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
    hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)

    -- | Get the kind signature of a type, ignoring parentheses:
    --
    --   hsTyKindSig   `Maybe                    `   =   Nothing
    --   hsTyKindSig   `Maybe ::   Type -> Type  `   =   Just  `Type -> Type`
    --   hsTyKindSig   `Maybe :: ((Type -> Type))`   =   Just  `Type -> Type`
    --
    -- This is used to extract the result kind of type synonyms with a CUSK:
    --
    --  type S = (F :: res_kind)
    --                 ^^^^^^^^
    --
    hsTyKindSig :: LHsType (GhcPass p) -> Maybe (LHsKind (GhcPass p))
    hsTyKindSig lty =
      case unLoc lty of
        HsParTy _ lty'    -> hsTyKindSig lty'
        HsKindSig _ _ k   -> Just k
        _                 -> Nothing

    ---------------------
    ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p)
    ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty
    ignoreParens ty                   = ty

    {-
    ************************************************************************
    *                                                                      *
                    Building types
    *                                                                      *
    ************************************************************************
    -}

    mkAnonWildCardTy :: HsType GhcPs
    mkAnonWildCardTy = HsWildCardTy noExtField

    mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
             => LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
             -> LHsType (GhcPass p) -> HsType (GhcPass p)
    mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2

    mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
    mkHsAppTy t1 t2
      = addCLocAA t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))

    mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
               -> LHsType (GhcPass p)
    mkHsAppTys = foldl' mkHsAppTy

    mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
                  -> LHsType (GhcPass p)
    mkHsAppKindTy ext ty k
      = addCLocAA ty k (HsAppKindTy ext ty k)

    {-
    ************************************************************************
    *                                                                      *
                    Decomposing HsTypes
    *                                                                      *
    ************************************************************************
    -}

    ---------------------------------
    -- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
    -- Breaks up any parens in the result type:
    --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
    -- It returns API Annotations for any parens removed
    splitHsFunType ::
         LHsType (GhcPass p)
      -> ( [AddEpAnn], EpAnnComments -- The locations of any parens and
                                      -- comments discarded
         , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
    splitHsFunType ty = go ty
      where
        go (L l (HsParTy an ty))
          = let
              (anns, cs, args, res) = splitHsFunType ty
              anns' = anns ++ annParen2AddEpAnn an
              cs' = cs S.<> epAnnComments (ann l) S.<> epAnnComments an
            in (anns', cs', args, res)

        go (L ll (HsFunTy (EpAnn _ an cs) mult x y))
          | (anns, csy, args, res) <- splitHsFunType y
          = (anns, csy S.<> epAnnComments (ann ll), HsScaled mult x':args, res)
          where
            (L (SrcSpanAnn a l) t) = x
            an' = addTrailingAnnToA l an cs a
            x' = L (SrcSpanAnn an' l) t

        go other = ([], emptyComments, [], other)

    -- | Retrieve the name of the \"head\" of a nested type application.
    -- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more
    -- thorough. The purpose of this function is to examine instance heads, so it
    -- doesn't handle *all* cases (like lists, tuples, @(~)@, etc.).
    hsTyGetAppHead_maybe :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
                         => LHsType (GhcPass p)
                         -> Maybe (LocatedN (IdP (GhcPass p)))
    hsTyGetAppHead_maybe = go
      where
        go (L _ (HsTyVar _ _ ln))          = Just ln
        go (L _ (HsAppTy _ l _))           = go l
        go (L _ (HsAppKindTy _ t _))       = go t
        go (L _ (HsOpTy _ _ ln _))         = Just ln
        go (L _ (HsParTy _ t))             = go t
        go (L _ (HsKindSig _ t _))         = go t
        go _                               = Nothing

    ------------------------------------------------------------

    -- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'.
    lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan
    lhsTypeArgSrcSpan arg = case arg of
      HsValArg  tm    -> getLocA tm
      HsTypeArg at ty -> at `combineSrcSpans` getLocA ty
      HsArgPar  sp    -> sp

    --------------------------------

    -- | Decompose a pattern synonym type signature into its constituent parts.
    --
    -- Note that this function looks through parentheses, so it will work on types
    -- such as @(forall a. <...>)@. The downside to this is that it is not
    -- generally possible to take the returned types and reconstruct the original
    -- type (parentheses and all) from them.
    splitLHsPatSynTy ::
         LHsSigType (GhcPass p)
      -> ( [LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))] -- universals
         , Maybe (LHsContext (GhcPass p))                       -- required constraints
         , [LHsTyVarBndr Specificity (GhcPass p)]               -- existentials
         , Maybe (LHsContext (GhcPass p))                       -- provided constraints
         , LHsType (GhcPass p))                                 -- body type
    splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
      where
        -- split_sig_ty ::
        --      LHsSigType (GhcPass p)
        --   -> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))], LHsType (GhcPass p))
        split_sig_ty (L _ HsSig{sig_bndrs = outer_bndrs, sig_body = body}) =
          case outer_bndrs of
            -- NB: Use ignoreParens here in order to be consistent with the use of
            -- splitLHsForAllTyInvis below, which also looks through parentheses.
            HsOuterImplicit{}                      -> ([], ignoreParens body)
            HsOuterExplicit{hso_bndrs = exp_bndrs} -> (exp_bndrs, body)

        (univs,       ty1) = split_sig_ty ty
        (reqs,        ty2) = splitLHsQualTy ty1
        ((_an, exis), ty3) = splitLHsForAllTyInvis ty2
        (provs,       ty4) = splitLHsQualTy ty3

    -- | Decompose a sigma type (of the form @forall <tvs>. context => body@)
    -- into its constituent parts.
    -- Only splits type variable binders that were
    -- quantified invisibly (e.g., @forall a.@, with a dot).
    --
    -- This function is used to split apart certain types, such as instance
    -- declaration types, which disallow visible @forall@s. For instance, if GHC
    -- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that
    -- declaration would mistakenly be accepted!
    --
    -- Note that this function looks through parentheses, so it will work on types
    -- such as @(forall a. <...>)@. The downside to this is that it is not
    -- generally possible to take the returned types and reconstruct the original
    -- type (parentheses and all) from them.
    splitLHsSigmaTyInvis :: LHsType (GhcPass p)
                         -> ([LHsTyVarBndr Specificity (GhcPass p)]
                            , Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
    splitLHsSigmaTyInvis ty
      | ((_an,tvs), ty1) <- splitLHsForAllTyInvis ty
      , (ctxt,      ty2) <- splitLHsQualTy ty1
      = (tvs, ctxt, ty2)

    -- | Decompose a GADT type into its constituent parts.
    -- Returns @(outer_bndrs, mb_ctxt, body)@, where:
    --
    -- * @outer_bndrs@ are 'HsOuterExplicit' if the type has explicit, outermost
    --   type variable binders. Otherwise, they are 'HsOuterImplicit'.
    --
    -- * @mb_ctxt@ is @Just@ the context, if it is provided.
    --   Otherwise, it is @Nothing@.
    --
    -- * @body@ is the body of the type after the optional @forall@s and context.
    --
    -- This function is careful not to look through parentheses.
    -- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
    -- "GHC.Hs.Decls" for why this is important.
    splitLHsGadtTy ::
         LHsSigType GhcPs
      -> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs), LHsType GhcPs)
    splitLHsGadtTy (L _ sig_ty)
      | (outer_bndrs, rho_ty) <- split_bndrs sig_ty
      , (mb_ctxt, tau_ty)     <- splitLHsQualTy_KP rho_ty
      = (outer_bndrs, mb_ctxt, tau_ty)
      where
        split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
        split_bndrs (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) =
          (outer_bndrs, body_ty)

    -- | Decompose a type of the form @forall <tvs>. body@ into its constituent
    -- parts. Only splits type variable binders that
    -- were quantified invisibly (e.g., @forall a.@, with a dot).
    --
    -- This function is used to split apart certain types, such as instance
    -- declaration types, which disallow visible @forall@s. For instance, if GHC
    -- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that
    -- declaration would mistakenly be accepted!
    --
    -- Note that this function looks through parentheses, so it will work on types
    -- such as @(forall a. <...>)@. The downside to this is that it is not
    -- generally possible to take the returned types and reconstruct the original
    -- type (parentheses and all) from them.
    -- Unlike 'splitLHsSigmaTyInvis', this function does not look through
    -- parentheses, hence the suffix @_KP@ (short for \"Keep Parentheses\").
    splitLHsForAllTyInvis ::
      LHsType (GhcPass pass) -> ( (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
                                , LHsType (GhcPass pass))
    splitLHsForAllTyInvis ty
      | ((mb_tvbs), body) <- splitLHsForAllTyInvis_KP (ignoreParens ty)
      = (fromMaybe (EpAnnNotUsed,[]) mb_tvbs, body)

    -- | Decompose a type of the form @forall <tvs>. body@ into its constituent
    -- parts. Only splits type variable binders that
    -- were quantified invisibly (e.g., @forall a.@, with a dot).
    --
    -- This function is used to split apart certain types, such as instance
    -- declaration types, which disallow visible @forall@s. For instance, if GHC
    -- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that
    -- declaration would mistakenly be accepted!
    --
    -- Unlike 'splitLHsForAllTyInvis', this function does not look through
    -- parentheses, hence the suffix @_KP@ (short for \"Keep Parentheses\").
    splitLHsForAllTyInvis_KP ::
      LHsType (GhcPass pass) -> (Maybe (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
                                , LHsType (GhcPass pass))
    splitLHsForAllTyInvis_KP lty@(L _ ty) =
      case ty of
        HsForAllTy { hst_tele = HsForAllInvis { hsf_xinvis = an
                                              , hsf_invis_bndrs = tvs }
                   , hst_body = body }
          -> (Just (an, tvs), body)
        _ -> (Nothing, lty)

    -- | Decompose a type of the form @context => body@ into its constituent parts.
    --
    -- Note that this function looks through parentheses, so it will work on types
    -- such as @(context => <...>)@. The downside to this is that it is not
    -- generally possible to take the returned types and reconstruct the original
    -- type (parentheses and all) from them.
    splitLHsQualTy :: LHsType (GhcPass pass)
                   -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
    splitLHsQualTy ty
      | (mb_ctxt, body) <- splitLHsQualTy_KP (ignoreParens ty)
      = (mb_ctxt, body)

    -- | Decompose a type of the form @context => body@ into its constituent parts.
    --
    -- Unlike 'splitLHsQualTy', this function does not look through
    -- parentheses, hence the suffix @_KP@ (short for \"Keep Parentheses\").
    splitLHsQualTy_KP :: LHsType (GhcPass pass) -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
    splitLHsQualTy_KP (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body }))
                           = (ctxt, body)
    splitLHsQualTy_KP body = (Nothing, body)

    -- | Decompose a type class instance type (of the form
    -- @forall <tvs>. context => instance_head@) into its constituent parts.
    -- Note that the @[Name]@s returned correspond to either:
    --
    -- * The implicitly bound type variables (if the type lacks an outermost
    --   @forall@), or
    --
    -- * The explicitly bound type variables (if the type has an outermost
    --   @forall@).
    --
    -- This function is careful not to look through parentheses.
    -- See @Note [No nested foralls or contexts in instance types]@
    -- for why this is important.
    splitLHsInstDeclTy :: LHsSigType GhcRn
                       -> ([Name], Maybe (LHsContext GhcRn), LHsType GhcRn)
    splitLHsInstDeclTy (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = inst_ty})) =
      (hsOuterTyVarNames outer_bndrs, mb_cxt, body_ty)
      where
        (mb_cxt, body_ty) = splitLHsQualTy_KP inst_ty

    -- | Decompose a type class instance type (of the form
    -- @forall <tvs>. context => instance_head@) into the @instance_head@.
    getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    getLHsInstDeclHead (L _ (HsSig{sig_body = qual_ty}))
      | (_mb_cxt, body_ty) <- splitLHsQualTy_KP qual_ty
      = body_ty

    -- | Decompose a type class instance type (of the form
    -- @forall <tvs>. context => instance_head@) into the @instance_head@ and
    -- retrieve the underlying class type constructor (if it exists).
    getLHsInstDeclClass_maybe :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
                              => LHsSigType (GhcPass p)
                              -> Maybe (LocatedN (IdP (GhcPass p)))
    -- Works on (LHsSigType GhcPs)
    getLHsInstDeclClass_maybe inst_ty
      = do { let head_ty = getLHsInstDeclHead inst_ty
           ; hsTyGetAppHead_maybe head_ty
           }

    {-
    Note [No nested foralls or contexts in instance types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The type at the top of an instance declaration is one of the few places in GHC
    where nested `forall`s or contexts are not permitted, even with RankNTypes
    enabled. For example, the following will be rejected:

      instance forall a. forall b. Show (Either a b) where ...
      instance Eq a => Eq b => Show (Either a b) where ...
      instance (forall a. Show (Maybe a)) where ...
      instance (Eq a => Show (Maybe a)) where ...

    This restriction is partly motivated by an unusual quirk of instance
    declarations. Namely, if ScopedTypeVariables is enabled, then the type
    variables from the top of an instance will scope over the bodies of the
    instance methods, /even if the type variables are implicitly quantified/.
    For example, GHC will accept the following:

      instance Monoid a => Monoid (Identity a) where
        mempty = Identity (mempty @a)

    Moreover, the type in the top of an instance declaration must obey the
    forall-or-nothing rule (see Note [forall-or-nothing rule]).
    If instance types allowed nested `forall`s, this could
    result in some strange interactions. For example, consider the following:

      class C a where
        m :: Proxy a
      instance (forall a. C (Either a b)) where
        m = Proxy @(Either a b)

    Somewhat surprisingly, old versions of GHC would accept the instance above.
    Even though the `forall` only quantifies `a`, the outermost parentheses mean
    that the `forall` is nested, and per the forall-or-nothing rule, this means
    that implicit quantification would occur. Therefore, the `a` is explicitly
    bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would
    bring /both/ sorts of type variables into scope over the body of `m`.
    How utterly confusing!

    To avoid this sort of confusion, we simply disallow nested `forall`s in
    instance types, which makes things like the instance above become illegal.
    For the sake of consistency, we also disallow nested contexts, even though they
    don't have the same strange interaction with ScopedTypeVariables.

    Just as we forbid nested `forall`s and contexts in normal instance
    declarations, we also forbid them in SPECIALISE instance pragmas (#18455).
    Unlike normal instance declarations, ScopedTypeVariables don't have any impact
    on SPECIALISE instance pragmas, but we use the same validity checks for
    SPECIALISE instance pragmas anyway to be consistent.

    -----
    -- Wrinkle: Derived instances
    -----

    `deriving` clauses and standalone `deriving` declarations also permit bringing
    type variables into scope, either through explicit or implicit quantification.
    Unlike in the tops of instance declarations, however, one does not need to
    enable ScopedTypeVariables for this to take effect.

    Just as GHC forbids nested `forall`s in the top of instance declarations, it
    also forbids them in types involved with `deriving`:

    1. In the `via` types in DerivingVia. For example, this is rejected:

         deriving via (forall x. V x) instance C (S x)

       Just like the types in instance declarations, `via` types can also bring
       both implicitly and explicitly bound type variables into scope. As a result,
       we adopt the same no-nested-`forall`s rule in `via` types to avoid confusing
       behavior like in the example below:

         deriving via (forall x. T x y) instance W x y (Foo a b)
         -- Both x and y are brought into scope???
    2. In the classes in `deriving` clauses. For example, this is rejected:

         data T = MkT deriving (C1, (forall x. C2 x y))

       This is because the generated instance would look like:

         instance forall x y. C2 x y T where ...

       So really, the same concerns as instance declarations apply here as well.
    -}

    {-
    ************************************************************************
    *                                                                      *
                    FieldOcc
    *                                                                      *
    ************************************************************************
    -}

    type instance XCFieldOcc GhcPs = NoExtField
    type instance XCFieldOcc GhcRn = Name
    type instance XCFieldOcc GhcTc = Id

    type instance XXFieldOcc (GhcPass _) = NoExtCon

    mkFieldOcc :: LocatedN RdrName -> FieldOcc GhcPs
    mkFieldOcc rdr = FieldOcc noExtField rdr

    type instance XUnambiguous GhcPs = NoExtField
    type instance XUnambiguous GhcRn = Name
    type instance XUnambiguous GhcTc = Id

    type instance XAmbiguous GhcPs = NoExtField
    type instance XAmbiguous GhcRn = NoExtField
    type instance XAmbiguous GhcTc = Id

    type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon

    instance Outputable (AmbiguousFieldOcc (GhcPass p)) where
      ppr = ppr . rdrNameAmbiguousFieldOcc

    instance OutputableBndr (AmbiguousFieldOcc (GhcPass p)) where
      pprInfixOcc  = pprInfixOcc . rdrNameAmbiguousFieldOcc
      pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc

    mkAmbiguousFieldOcc :: LocatedN RdrName -> AmbiguousFieldOcc GhcPs
    mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr

    rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr
    rdrNameAmbiguousFieldOcc (Ambiguous   _ (L _ rdr)) = rdr

    selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
    selectorAmbiguousFieldOcc (Unambiguous sel _) = sel
    selectorAmbiguousFieldOcc (Ambiguous   sel _) = sel

    unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
    unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
    unambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel

    ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
    ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Pretty printing}
    *                                                                      *
    ************************************************************************
    -}

    class OutputableBndrFlag flag p where
        pprTyVarBndr :: OutputableBndrId p
                     => HsTyVarBndr flag (GhcPass p) -> SDoc

    instance OutputableBndrFlag () p where
        pprTyVarBndr (UserTyVar _ _ n) --     = pprIdP n
          = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n
        pprTyVarBndr (KindedTyVar _ _ n k) = parens $ hsep [ppr_n, dcolon, ppr k]
          where
            ppr_n = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n

    instance OutputableBndrFlag Specificity p where
        pprTyVarBndr (UserTyVar _ SpecifiedSpec n) --     = pprIdP n
          = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n
        pprTyVarBndr (UserTyVar _ InferredSpec n)      = braces $ ppr_n
          where
            ppr_n = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n
        pprTyVarBndr (KindedTyVar _ SpecifiedSpec n k) = parens $ hsep [ppr_n, dcolon, ppr k]
          where
            ppr_n = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n
        pprTyVarBndr (KindedTyVar _ InferredSpec n k)  = braces $ hsep [ppr_n, dcolon, ppr k]
          where
            ppr_n = case ghcPass @p of
              GhcPs -> ppr n
              GhcRn -> ppr n
              GhcTc -> ppr n

    instance OutputableBndrId p => Outputable (HsSigType (GhcPass p)) where
        ppr (HsSig { sig_bndrs = outer_bndrs, sig_body = body }) =
          pprHsOuterSigTyVarBndrs outer_bndrs <+> ppr body

    instance OutputableBndrId p => Outputable (HsType (GhcPass p)) where
        ppr ty = pprHsType ty

    instance OutputableBndrId p
           => Outputable (LHsQTyVars (GhcPass p)) where
        ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs

    instance (OutputableBndrFlag flag p,
              OutputableBndrFlag flag (NoGhcTcPass p),
              OutputableBndrId p)
           => Outputable (HsOuterTyVarBndrs flag (GhcPass p)) where
        ppr (HsOuterImplicit{hso_ximplicit = imp_tvs}) =
          text "HsOuterImplicit:" <+> case ghcPass @p of
            GhcPs -> ppr imp_tvs
            GhcRn -> ppr imp_tvs
            GhcTc -> ppr imp_tvs
        ppr (HsOuterExplicit{hso_bndrs = exp_tvs}) =
          text "HsOuterExplicit:" <+> ppr exp_tvs

    instance OutputableBndrId p
           => Outputable (HsForAllTelescope (GhcPass p)) where
        ppr (HsForAllVis { hsf_vis_bndrs = bndrs }) =
          text "HsForAllVis:" <+> ppr bndrs
        ppr (HsForAllInvis { hsf_invis_bndrs = bndrs }) =
          text "HsForAllInvis:" <+> ppr bndrs

    instance (OutputableBndrId p, OutputableBndrFlag flag p)
           => Outputable (HsTyVarBndr flag (GhcPass p)) where
        ppr = pprTyVarBndr

    instance Outputable thing
           => Outputable (HsWildCardBndrs (GhcPass p) thing) where
        ppr (HsWC { hswc_body = ty }) = ppr ty

    instance (OutputableBndrId p)
           => Outputable (HsPatSigType (GhcPass p)) where
        ppr (HsPS { hsps_body = ty }) = ppr ty

    pprAnonWildCard :: SDoc
    pprAnonWildCard = char '_'

    -- | Prints the explicit @forall@ in a type family equation if one is written.
    -- If there is no explicit @forall@, nothing is printed.
    pprHsOuterFamEqnTyVarBndrs :: OutputableBndrId p
                               => HsOuterFamEqnTyVarBndrs (GhcPass p) -> SDoc
    pprHsOuterFamEqnTyVarBndrs (HsOuterImplicit{}) = empty
    pprHsOuterFamEqnTyVarBndrs (HsOuterExplicit{hso_bndrs = qtvs}) =
      forAllLit <+> interppSP qtvs <> dot

    -- | Prints the outermost @forall@ in a type signature if one is written.
    -- If there is no outermost @forall@, nothing is printed.
    pprHsOuterSigTyVarBndrs :: OutputableBndrId p
                            => HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
    pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty
    pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) =
      pprHsForAll (mkHsForAllInvisTele noAnn bndrs) Nothing

    -- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@
    -- only when @-dppr-debug@ is enabled.
    pprHsForAll :: forall p. OutputableBndrId p
                => HsForAllTelescope (GhcPass p)
                -> Maybe (LHsContext (GhcPass p)) -> SDoc
    pprHsForAll tele cxt
      = pp_tele tele <+> pprLHsContext cxt
      where
        pp_tele :: HsForAllTelescope (GhcPass p) -> SDoc
        pp_tele tele = case tele of
          HsForAllVis   { hsf_vis_bndrs   = qtvs } -> pp_forall (space <> arrow) qtvs
          HsForAllInvis { hsf_invis_bndrs = qtvs } -> pp_forall dot qtvs

        pp_forall :: forall flag p. (OutputableBndrId p, OutputableBndrFlag flag p)
                  => SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
        pp_forall separator qtvs
          | null qtvs = whenPprDebug (forAllLit <> separator)
      -- Note: to fix the PprRecordDotSyntax1 ppr roundtrip test, the <>
      -- below needs to be <+>. But it means 94 other test results need to
      -- be updated to match.
          | otherwise = forAllLit <+> interppSP qtvs <> separator

    pprLHsContext :: (OutputableBndrId p)
                  => Maybe (LHsContext (GhcPass p)) -> SDoc
    pprLHsContext Nothing = empty
    pprLHsContext (Just lctxt)
      | null (unLoc lctxt) = empty
      | otherwise          = pprLHsContextAlways (Just lctxt)

    -- For use in a HsQualTy, which always gets printed if it exists.
    pprLHsContextAlways :: (OutputableBndrId p)
                        => Maybe (LHsContext (GhcPass p)) -> SDoc
    pprLHsContextAlways Nothing = parens empty <+> darrow
    pprLHsContextAlways (Just (L _ ctxt))
      = case ctxt of
          []       -> parens empty             <+> darrow
          [L _ ty] -> ppr_mono_ty ty           <+> darrow
          _        -> parens (interpp'SP ctxt) <+> darrow

    pprConDeclFields :: OutputableBndrId p
                     => [LConDeclField (GhcPass p)] -> SDoc
    pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
      where
        ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,
                                     cd_fld_doc = doc }))
            = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc

        ppr_names :: [LFieldOcc (GhcPass p)] -> SDoc
        ppr_names [n] = pprPrefixOcc n
        ppr_names ns = sep (punctuate comma (map pprPrefixOcc ns))

    {-
    Note [Printing KindedTyVars]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #3830 reminded me that we should really only print the kind
    signature on a KindedTyVar if the kind signature was put there by the
    programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,
    rather than converting to KindedTyVars as before.

    (As it happens, the message in #3830 comes out a different way now,
    and the problem doesn't show up; but having the flag on a KindedTyVar
    seems like the Right Thing anyway.)
    -}

    -- Printing works more-or-less as for Types

    pprHsType :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
    pprHsType ty = ppr_mono_ty ty

    ppr_mono_lty :: OutputableBndrId p
                 => LHsType (GhcPass p) -> SDoc
    ppr_mono_lty ty = ppr_mono_ty (unLoc ty)

    ppr_mono_ty :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
    ppr_mono_ty (HsForAllTy { hst_tele = tele, hst_body = ty })
      = sep [pprHsForAll tele Nothing, ppr_mono_lty ty]

    ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty })
      = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty]

    ppr_mono_ty (HsBangTy _ b ty)   = ppr b <> ppr_mono_lty ty
    ppr_mono_ty (HsRecTy _ flds)      = pprConDeclFields flds
    ppr_mono_ty (HsTyVar _ prom (L _ name))
      | isPromoted prom = quote (pprPrefixOcc name)
      | otherwise       = pprPrefixOcc name
    ppr_mono_ty (HsFunTy _ mult ty1 ty2)   = ppr_fun_ty mult ty1 ty2
    ppr_mono_ty (HsTupleTy _ con tys)
        -- Special-case unary boxed tuples so that they are pretty-printed as
        -- `Solo x`, not `(x)`
      | [ty] <- tys
      , BoxedTuple <- std_con
      = sep [text (mkTupleStr Boxed 1), ppr_mono_lty ty]
      | otherwise
      = tupleParens std_con (pprWithCommas ppr tys)
      where std_con = case con of
                        HsUnboxedTuple -> UnboxedTuple
                        _              -> BoxedTuple
    ppr_mono_ty (HsSumTy _ tys)
      = tupleParens UnboxedTuple (pprWithBars ppr tys)
    ppr_mono_ty (HsKindSig _ ty kind)
      = ppr_mono_lty ty <+> dcolon <+> ppr kind
    ppr_mono_ty (HsListTy _ ty)       = brackets (ppr_mono_lty ty)
    ppr_mono_ty (HsIParamTy _ n ty)   = (ppr n <+> dcolon <+> ppr_mono_lty ty)
    ppr_mono_ty (HsSpliceTy _ s)      = pprSplice s
    ppr_mono_ty (HsExplicitListTy _ prom tys)
      | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)
      | otherwise       = brackets (interpp'SP tys)
    ppr_mono_ty (HsExplicitTupleTy _ tys)
        -- Special-case unary boxed tuples so that they are pretty-printed as
        -- `'Solo x`, not `'(x)`
      | [ty] <- tys
      = quote $ sep [text (mkTupleStr Boxed 1), ppr_mono_lty ty]
      | otherwise
      = quote $ parens (maybeAddSpace tys $ interpp'SP tys)
    ppr_mono_ty (HsTyLit _ t)       = ppr t
    ppr_mono_ty (HsWildCardTy {})   = char '_'

    ppr_mono_ty (HsStarTy _ isUni)  = char (if isUni then '★' else '*')

    ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
      = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
    ppr_mono_ty (HsAppKindTy _ ty k)
      = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
    ppr_mono_ty (HsOpTy _ ty1 (L _ op) ty2)
      = sep [ ppr_mono_lty ty1
            , sep [pprInfixOcc op, ppr_mono_lty ty2 ] ]

    ppr_mono_ty (HsParTy _ ty)
      = parens (ppr_mono_lty ty)
      -- Put the parens in where the user did
      -- But we still use the precedence stuff to add parens because
      --    toHsType doesn't put in any HsParTys, so we may still need them

    ppr_mono_ty (HsDocTy _ ty doc)
      -- AZ: Should we add parens?  Should we introduce "-- ^"?
      = ppr_mono_lty ty <+> ppr (unLoc doc)
      -- we pretty print Haddock comments on types as if they were
      -- postfix operators

    ppr_mono_ty (XHsType t) = ppr t

    --------------------------
    ppr_fun_ty :: (OutputableBndrId p)
               => HsArrow (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
    ppr_fun_ty mult ty1 ty2
      = let p1 = ppr_mono_lty ty1
            p2 = ppr_mono_lty ty2
            arr = pprHsArrow mult
        in
        sep [p1, arr <+> p2]

    --------------------------
    -- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses
    -- under precedence @p@.
    hsTypeNeedsParens :: PprPrec -> HsType (GhcPass p) -> Bool
    hsTypeNeedsParens p = go_hs_ty
      where
        go_hs_ty (HsForAllTy{})           = p >= funPrec
        go_hs_ty (HsQualTy{})             = p >= funPrec
        go_hs_ty (HsBangTy{})             = p > topPrec
        go_hs_ty (HsRecTy{})              = False
        go_hs_ty (HsTyVar{})              = False
        go_hs_ty (HsFunTy{})              = p >= funPrec
        -- Special-case unary boxed tuple applications so that they are
        -- parenthesized as `Identity (Solo x)`, not `Identity Solo x` (#18612)
        -- See Note [One-tuples] in GHC.Builtin.Types
        go_hs_ty (HsTupleTy _ con [_])
          = case con of
              HsBoxedOrConstraintTuple   -> p >= appPrec
              HsUnboxedTuple             -> False
        go_hs_ty (HsTupleTy{})            = False
        go_hs_ty (HsSumTy{})              = False
        go_hs_ty (HsKindSig{})            = p >= sigPrec
        go_hs_ty (HsListTy{})             = False
        go_hs_ty (HsIParamTy{})           = p > topPrec
        go_hs_ty (HsSpliceTy{})           = False
        go_hs_ty (HsExplicitListTy{})     = False
        -- Special-case unary boxed tuple applications so that they are
        -- parenthesized as `Proxy ('Solo x)`, not `Proxy 'Solo x` (#18612)
        -- See Note [One-tuples] in GHC.Builtin.Types
        go_hs_ty (HsExplicitTupleTy _ [_])
                                          = p >= appPrec
        go_hs_ty (HsExplicitTupleTy{})    = False
        go_hs_ty (HsTyLit{})              = False
        go_hs_ty (HsWildCardTy{})         = False
        go_hs_ty (HsStarTy{})             = p >= starPrec
        go_hs_ty (HsAppTy{})              = p >= appPrec
        go_hs_ty (HsAppKindTy{})          = p >= appPrec
        go_hs_ty (HsOpTy{})               = p >= opPrec
        go_hs_ty (HsParTy{})              = False
        go_hs_ty (HsDocTy _ (L _ t) _)    = go_hs_ty t
        go_hs_ty (XHsType ty)             = go_core_ty ty

        go_core_ty (TyVarTy{})    = False
        go_core_ty (AppTy{})      = p >= appPrec
        go_core_ty (TyConApp _ args)
          | null args             = False
          | otherwise             = p >= appPrec
        go_core_ty (ForAllTy{})   = p >= funPrec
        go_core_ty (FunTy{})      = p >= funPrec
        go_core_ty (LitTy{})      = False
        go_core_ty (CastTy t _)   = go_core_ty t
        go_core_ty (CoercionTy{}) = False

    maybeAddSpace :: [LHsType (GhcPass p)] -> SDoc -> SDoc
    -- See Note [Printing promoted type constructors]
    -- in GHC.Iface.Type.  This code implements the same
    -- logic for printing HsType
    maybeAddSpace tys doc
      | (ty : _) <- tys
      , lhsTypeHasLeadingPromotionQuote ty = space <> doc
      | otherwise                          = doc

    lhsTypeHasLeadingPromotionQuote :: LHsType (GhcPass p) -> Bool
    lhsTypeHasLeadingPromotionQuote ty
      = goL ty
      where
        goL (L _ ty) = go ty

        go (HsForAllTy{})        = False
        go (HsQualTy{ hst_ctxt = ctxt, hst_body = body})
          | Just (L _ (c:_)) <- ctxt = goL c
          | otherwise            = goL body
        go (HsBangTy{})          = False
        go (HsRecTy{})           = False
        go (HsTyVar _ p _)       = isPromoted p
        go (HsFunTy _ _ arg _)   = goL arg
        go (HsListTy{})          = False
        go (HsTupleTy{})         = False
        go (HsSumTy{})           = False
        go (HsOpTy _ t1 _ _)     = goL t1
        go (HsKindSig _ t _)     = goL t
        go (HsIParamTy{})        = False
        go (HsSpliceTy{})        = False
        go (HsExplicitListTy _ p _) = isPromoted p
        go (HsExplicitTupleTy{}) = True
        go (HsTyLit{})           = False
        go (HsWildCardTy{})      = False
        go (HsStarTy{})          = False
        go (HsAppTy _ t _)       = goL t
        go (HsAppKindTy _ t _)   = goL t
        go (HsParTy{})           = False
        go (HsDocTy _ t _)       = goL t
        go (XHsType{})           = False

    -- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is
    -- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply
    -- returns @ty@.
    parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
    parenthesizeHsType p lty@(L loc ty)
      | hsTypeNeedsParens p ty = L loc (HsParTy noAnn lty)
      | otherwise              = lty

    -- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint
    -- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@
    -- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply
    -- returns @ctxt@ unchanged.
    parenthesizeHsContext :: PprPrec
                          -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
    parenthesizeHsContext p lctxt@(L loc ctxt) =
      case ctxt of
        [c] -> L loc [parenthesizeHsType p c]
        _   -> lctxt -- Other contexts are already "parenthesized" by virtue of
                     -- being tuples.
    {-
    ************************************************************************
    *                                                                      *
    \subsection{Anno instances}
    *                                                                      *
    ************************************************************************
    -}

    type instance Anno (BangType (GhcPass p)) = SrcSpanAnnA
    type instance Anno [LocatedA (HsType (GhcPass p))] = SrcSpanAnnC
    type instance Anno (HsType (GhcPass p)) = SrcSpanAnnA
    type instance Anno (HsSigType (GhcPass p)) = SrcSpanAnnA
    type instance Anno (HsKind (GhcPass p)) = SrcSpanAnnA

    type instance Anno (HsTyVarBndr _flag (GhcPass _)) = SrcSpanAnnA
      -- Explicit pass Anno instances needed because of the NoGhcTc field
    type instance Anno (HsTyVarBndr _flag GhcPs) = SrcSpanAnnA
    type instance Anno (HsTyVarBndr _flag GhcRn) = SrcSpanAnnA
    type instance Anno (HsTyVarBndr _flag GhcTc) = SrcSpanAnnA

    type instance Anno (HsOuterTyVarBndrs _ (GhcPass _)) = SrcSpanAnnA
    type instance Anno HsIPName = SrcSpan
    type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA
    type instance Anno (FieldOcc (GhcPass p)) = SrcSpan