{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# 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, HsArrowOf(..), arrowToHsType, expandHsArrow,
        EpLinearArrow(..),
        hsLinear, hsUnrestricted, isUnrestricted,
        pprHsArrow,

        HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
        HsForAllTelescope(..), EpAnnForallTy,
        HsTyVarBndr(..), LHsTyVarBndr,
        HsBndrKind(..),
        HsBndrVar(..),
        HsBndrVis(..), isHsBndrInvisible,
        LHsQTyVars(..),
        HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
        HsWildCardBndrs(..),
        HsPatSigType(..), HsPSRn(..),
        HsTyPat(..), HsTyPatRn(..),
        HsTyPatRnBuilder(..), tpBuilderExplicitTV, tpBuilderPatSig, buildHsTyPatRn, builderFromHsTyPatRn,
        HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType,
        HsTupleSort(..),
        HsContext, LHsContext, fromMaybeContext,
        HsTyLit(..),
        HsIPName(..), hsIPNameFS,
        HsArg(..), numVisibleArgs, pprHsArgsApp,
        LHsTypeArg, lhsTypeArgSrcSpan,
        OutputableBndrFlag,

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

        ConDeclField(..), LConDeclField, pprConDeclFields,

        HsConDetails(..), noTypeArgs,

        FieldOcc(..), LFieldOcc, mkFieldOcc,
        AmbiguousFieldOcc(..), LAmbiguousFieldOcc, mkAmbiguousFieldOcc,
        ambiguousFieldOccRdrName, ambiguousFieldOccLRdrName,
        selectorAmbiguousFieldOcc,
        unambiguousFieldOcc, ambiguousFieldOcc,

        OpName(..),

        mkAnonWildCardTy, pprAnonWildCard,

        hsOuterTyVarNames, hsOuterExplicitBndrs, mapHsOuterImplicit,
        mkHsOuterImplicit, mkHsOuterExplicit,
        mkHsImplicitSigType, mkHsExplicitSigType,
        mkHsWildCardBndrs, mkHsPatSigType, mkHsTyPat,
        mkEmptyWildCardBndrs,
        mkHsForAllVisTele, mkHsForAllInvisTele,
        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,
        isHsKindedTyVar, hsBndrVar, hsBndrKind, hsTvbAllKinded,
        hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards,
        hsTyVarLName, hsTyVarName,
        hsAllLTyVarNames, hsLTyVarLocNames,
        hsLTyVarName, hsLTyVarNames, hsForAllTelescopeNames,
        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, updateHsTyVarBndrFlag,

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

import GHC.Prelude

import Language.Haskell.Syntax.Type

import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) )

import Language.Haskell.Syntax.Extension
import GHC.Core.DataCon ( SrcStrictness(..), SrcUnpackedness(..)
                        , HsSrcBang(..), HsImplBang(..)
                        , mkHsSrcBang
                        )
import GHC.Hs.Extension
import GHC.Parser.Annotation

import GHC.Types.Fixity ( LexicalFixity(..) )
import GHC.Types.Id ( Id )
import GHC.Types.SourceText
import GHC.Types.Name
import GHC.Types.Name.Reader ( RdrName )
import GHC.Types.Var ( VarBndr, visArgTypeLike )
import GHC.Core.TyCo.Rep ( Type(..) )
import GHC.Builtin.Names ( negateName )
import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr )
import GHC.Core.Ppr ( pprOccWithTick)
import GHC.Core.Type
import GHC.Core.Multiplicity( pprArrowWithMultiplicity )
import GHC.Hs.Doc
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Misc (count)

import Data.Maybe
import Data.Data (Data)

import qualified Data.Semigroup as S
import GHC.Data.Bag

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

getBangType :: LHsType (GhcPass p) -> LHsType (GhcPass p)
getBangType :: forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
getBangType                 (L SrcSpanAnnA
_ (HsBangTy XBangTy (GhcPass p)
_ HsBang
_ LHsType (GhcPass p)
lty))       = LHsType (GhcPass p)
lty
getBangType (L SrcSpanAnnA
_ (HsDocTy XDocTy (GhcPass p)
x (L SrcSpanAnnA
_ (HsBangTy XBangTy (GhcPass p)
_ HsBang
_ LHsType (GhcPass p)
lty)) LHsDoc (GhcPass p)
lds)) =
  GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> LHsDoc (GhcPass p)
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
lty LHsDoc (GhcPass p)
lds (XDocTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsDoc (GhcPass p) -> HsType (GhcPass p)
forall pass.
XDocTy pass -> LHsType pass -> LHsDoc pass -> HsType pass
HsDocTy XDocTy (GhcPass p)
x LHsType (GhcPass p)
lty LHsDoc (GhcPass p)
lds)
getBangType LHsType (GhcPass p)
lty                                            = LHsType (GhcPass p)
lty

getBangStrictness :: LHsType (GhcPass p) -> HsSrcBang
getBangStrictness :: forall (p :: Pass). LHsType (GhcPass p) -> HsSrcBang
getBangStrictness                 (L SrcSpanAnnA
_ (HsBangTy ([AddEpAnn]
_, SourceText
s) HsBang
b LHsType (GhcPass p)
_))     = SourceText -> HsBang -> HsSrcBang
HsSrcBang SourceText
s HsBang
b
getBangStrictness (L SrcSpanAnnA
_ (HsDocTy XDocTy (GhcPass p)
_ (L SrcSpanAnnA
_ (HsBangTy ([AddEpAnn]
_, SourceText
s) HsBang
b LHsType (GhcPass p)
_)) LHsDoc (GhcPass p)
_)) = SourceText -> HsBang -> HsSrcBang
HsSrcBang SourceText
s HsBang
b
getBangStrictness LHsType (GhcPass p)
_ = (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
mkHsSrcBang SourceText
NoSourceText SrcUnpackedness
NoSrcUnpack SrcStrictness
NoSrcStrict)

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

fromMaybeContext :: Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext :: forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext Maybe (LHsContext (GhcPass p))
mctxt = GenLocated SrcSpanAnnC (HsContext (GhcPass p))
-> HsContext (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnC (HsContext (GhcPass p))
 -> HsContext (GhcPass p))
-> GenLocated SrcSpanAnnC (HsContext (GhcPass p))
-> HsContext (GhcPass p)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnC (HsContext (GhcPass p))
-> Maybe (GenLocated SrcSpanAnnC (HsContext (GhcPass p)))
-> GenLocated SrcSpanAnnC (HsContext (GhcPass p))
forall a. a -> Maybe a -> a
fromMaybe ([GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA []) Maybe (LHsContext (GhcPass p))
Maybe (GenLocated SrcSpanAnnC (HsContext (GhcPass p)))
mctxt

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

type instance XXHsForAllTelescope (GhcPass _) = DataConCantHappen

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 _) = DataConCantHappen

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

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

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

emptyLHsQTvs :: LHsQTyVars GhcRn
emptyLHsQTvs :: LHsQTyVars GhcRn
emptyLHsQTvs = HsQTvs { hsq_ext :: XHsQTvs GhcRn
hsq_ext = [], hsq_explicit :: [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn]
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 _) = DataConCantHappen

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

type instance XXHsWildCardBndrs (GhcPass _) _ = DataConCantHappen

type instance XHsPS GhcPs = EpAnnCO
type instance XHsPS GhcRn = HsPSRn
type instance XHsPS GhcTc = HsPSRn

type instance XHsTP GhcPs = NoExtField
type instance XHsTP GhcRn = HsTyPatRn
type instance XHsTP GhcTc = DataConCantHappen

-- | The extension field for 'HsPatSigType', which is only used in the
-- renamer onwards. See @Note [Pattern signature binders and scoping]@.
data HsPSRn = HsPSRn
  { HsPSRn -> [Name]
hsps_nwcs    :: [Name] -- ^ Wildcard names
  , HsPSRn -> [Name]
hsps_imp_tvs :: [Name] -- ^ Implicitly bound variable names
  }
  deriving Typeable HsPSRn
Typeable HsPSRn =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> HsPSRn -> c HsPSRn)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HsPSRn)
-> (HsPSRn -> Constr)
-> (HsPSRn -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HsPSRn))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsPSRn))
-> ((forall b. Data b => b -> b) -> HsPSRn -> HsPSRn)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r)
-> (forall u. (forall d. Data d => d -> u) -> HsPSRn -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> HsPSRn -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn)
-> Data HsPSRn
HsPSRn -> Constr
HsPSRn -> DataType
(forall b. Data b => b -> b) -> HsPSRn -> HsPSRn
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HsPSRn -> u
forall u. (forall d. Data d => d -> u) -> HsPSRn -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsPSRn
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsPSRn -> c HsPSRn
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsPSRn)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsPSRn)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsPSRn -> c HsPSRn
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsPSRn -> c HsPSRn
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsPSRn
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsPSRn
$ctoConstr :: HsPSRn -> Constr
toConstr :: HsPSRn -> Constr
$cdataTypeOf :: HsPSRn -> DataType
dataTypeOf :: HsPSRn -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsPSRn)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsPSRn)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsPSRn)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsPSRn)
$cgmapT :: (forall b. Data b => b -> b) -> HsPSRn -> HsPSRn
gmapT :: (forall b. Data b => b -> b) -> HsPSRn -> HsPSRn
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HsPSRn -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsPSRn -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsPSRn -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsPSRn -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsPSRn -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsPSRn -> m HsPSRn
Data

-- HsTyPatRn is the extension field for `HsTyPat`, after renaming
-- E.g. pattern K @(Maybe (_x, a, b::Proxy k)
-- In the type pattern @(Maybe ...):
--    '_x' is a named wildcard
--    'a'  is explicitly bound
--    'k'  is implicitly bound
-- See Note [Implicit and explicit type variable binders] in GHC.Rename.Pat
data HsTyPatRn = HsTPRn
  { HsTyPatRn -> [Name]
hstp_nwcs    :: [Name] -- ^ Wildcard names
  , HsTyPatRn -> [Name]
hstp_imp_tvs :: [Name] -- ^ Implicitly bound variable names
  , HsTyPatRn -> [Name]
hstp_exp_tvs :: [Name] -- ^ Explicitly bound variable names
  }
  deriving Typeable HsTyPatRn
Typeable HsTyPatRn =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> HsTyPatRn -> c HsTyPatRn)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HsTyPatRn)
-> (HsTyPatRn -> Constr)
-> (HsTyPatRn -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HsTyPatRn))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsTyPatRn))
-> ((forall b. Data b => b -> b) -> HsTyPatRn -> HsTyPatRn)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r)
-> (forall u. (forall d. Data d => d -> u) -> HsTyPatRn -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HsTyPatRn -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn)
-> Data HsTyPatRn
HsTyPatRn -> Constr
HsTyPatRn -> DataType
(forall b. Data b => b -> b) -> HsTyPatRn -> HsTyPatRn
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HsTyPatRn -> u
forall u. (forall d. Data d => d -> u) -> HsTyPatRn -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsTyPatRn
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsTyPatRn -> c HsTyPatRn
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsTyPatRn)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsTyPatRn)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsTyPatRn -> c HsTyPatRn
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsTyPatRn -> c HsTyPatRn
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsTyPatRn
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsTyPatRn
$ctoConstr :: HsTyPatRn -> Constr
toConstr :: HsTyPatRn -> Constr
$cdataTypeOf :: HsTyPatRn -> DataType
dataTypeOf :: HsTyPatRn -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsTyPatRn)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsTyPatRn)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsTyPatRn)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HsTyPatRn)
$cgmapT :: (forall b. Data b => b -> b) -> HsTyPatRn -> HsTyPatRn
gmapT :: (forall b. Data b => b -> b) -> HsTyPatRn -> HsTyPatRn
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsTyPatRn -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsTyPatRn -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsTyPatRn -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsTyPatRn -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsTyPatRn -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsTyPatRn -> m HsTyPatRn
Data

-- | A variant of HsTyPatRn that uses Bags for efficient concatenation.
-- See Note [Implicit and explicit type variable binders]  in GHC.Rename.Pat
data HsTyPatRnBuilder =
  HsTPRnB {
    HsTyPatRnBuilder -> Bag Name
hstpb_nwcs :: Bag Name,
    HsTyPatRnBuilder -> Bag Name
hstpb_imp_tvs :: Bag Name,
    HsTyPatRnBuilder -> Bag Name
hstpb_exp_tvs :: Bag Name
  }

tpBuilderExplicitTV :: Name -> HsTyPatRnBuilder
tpBuilderExplicitTV :: Name -> HsTyPatRnBuilder
tpBuilderExplicitTV Name
name = HsTyPatRnBuilder
forall a. Monoid a => a
mempty {hstpb_exp_tvs = unitBag name}

tpBuilderPatSig :: HsPSRn -> HsTyPatRnBuilder
tpBuilderPatSig :: HsPSRn -> HsTyPatRnBuilder
tpBuilderPatSig HsPSRn {[Name]
hsps_nwcs :: HsPSRn -> [Name]
hsps_nwcs :: [Name]
hsps_nwcs, [Name]
hsps_imp_tvs :: HsPSRn -> [Name]
hsps_imp_tvs :: [Name]
hsps_imp_tvs} =
  HsTyPatRnBuilder
forall a. Monoid a => a
mempty {
    hstpb_nwcs = listToBag hsps_nwcs,
    hstpb_imp_tvs = listToBag hsps_imp_tvs
  }

instance Semigroup HsTyPatRnBuilder where
  HsTPRnB Bag Name
nwcs1 Bag Name
imp_tvs1 Bag Name
exptvs1 <> :: HsTyPatRnBuilder -> HsTyPatRnBuilder -> HsTyPatRnBuilder
<> HsTPRnB Bag Name
nwcs2 Bag Name
imp_tvs2 Bag Name
exptvs2 =
    Bag Name -> Bag Name -> Bag Name -> HsTyPatRnBuilder
HsTPRnB
      (Bag Name
nwcs1    Bag Name -> Bag Name -> Bag Name
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag Name
nwcs2)
      (Bag Name
imp_tvs1 Bag Name -> Bag Name -> Bag Name
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag Name
imp_tvs2)
      (Bag Name
exptvs1  Bag Name -> Bag Name -> Bag Name
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag Name
exptvs2)

instance Monoid HsTyPatRnBuilder where
  mempty :: HsTyPatRnBuilder
mempty = Bag Name -> Bag Name -> Bag Name -> HsTyPatRnBuilder
HsTPRnB Bag Name
forall a. Bag a
emptyBag Bag Name
forall a. Bag a
emptyBag Bag Name
forall a. Bag a
emptyBag

buildHsTyPatRn :: HsTyPatRnBuilder -> HsTyPatRn
buildHsTyPatRn :: HsTyPatRnBuilder -> HsTyPatRn
buildHsTyPatRn HsTPRnB {Bag Name
hstpb_nwcs :: HsTyPatRnBuilder -> Bag Name
hstpb_nwcs :: Bag Name
hstpb_nwcs, Bag Name
hstpb_imp_tvs :: HsTyPatRnBuilder -> Bag Name
hstpb_imp_tvs :: Bag Name
hstpb_imp_tvs, Bag Name
hstpb_exp_tvs :: HsTyPatRnBuilder -> Bag Name
hstpb_exp_tvs :: Bag Name
hstpb_exp_tvs} =
  HsTPRn {
    hstp_nwcs :: [Name]
hstp_nwcs =    Bag Name -> [Name]
forall a. Bag a -> [a]
bagToList Bag Name
hstpb_nwcs,
    hstp_imp_tvs :: [Name]
hstp_imp_tvs = Bag Name -> [Name]
forall a. Bag a -> [a]
bagToList Bag Name
hstpb_imp_tvs,
    hstp_exp_tvs :: [Name]
hstp_exp_tvs = Bag Name -> [Name]
forall a. Bag a -> [a]
bagToList Bag Name
hstpb_exp_tvs
  }

builderFromHsTyPatRn :: HsTyPatRn -> HsTyPatRnBuilder
builderFromHsTyPatRn :: HsTyPatRn -> HsTyPatRnBuilder
builderFromHsTyPatRn HsTPRn{[Name]
hstp_nwcs :: HsTyPatRn -> [Name]
hstp_nwcs :: [Name]
hstp_nwcs, [Name]
hstp_imp_tvs :: HsTyPatRn -> [Name]
hstp_imp_tvs :: [Name]
hstp_imp_tvs, [Name]
hstp_exp_tvs :: HsTyPatRn -> [Name]
hstp_exp_tvs :: [Name]
hstp_exp_tvs} =
  HsTPRnB {
    hstpb_nwcs :: Bag Name
hstpb_nwcs =    [Name] -> Bag Name
forall a. [a] -> Bag a
listToBag [Name]
hstp_nwcs,
    hstpb_imp_tvs :: Bag Name
hstpb_imp_tvs = [Name] -> Bag Name
forall a. [a] -> Bag a
listToBag [Name]
hstp_imp_tvs,
    hstpb_exp_tvs :: Bag Name
hstpb_exp_tvs = [Name] -> Bag Name
forall a. [a] -> Bag a
listToBag [Name]
hstp_exp_tvs
  }

type instance XXHsPatSigType (GhcPass _) = DataConCantHappen
type instance XXHsTyPat      (GhcPass _) = DataConCantHappen

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

hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
hsSigWcType = HsSigType p -> XRec p (HsType p)
forall pass. HsSigType pass -> LHsType pass
sig_body (HsSigType p -> XRec p (HsType p))
-> (HsWildCardBndrs p (XRec p (HsSigType p)) -> HsSigType p)
-> HsWildCardBndrs p (XRec p (HsSigType p))
-> XRec p (HsType p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p (XRec p (HsSigType p) -> HsSigType p)
-> (HsWildCardBndrs p (XRec p (HsSigType p))
    -> XRec p (HsSigType p))
-> HsWildCardBndrs p (XRec p (HsSigType p))
-> HsSigType p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsWildCardBndrs p (XRec p (HsSigType p)) -> XRec p (HsSigType p)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body

dropWildCards :: LHsSigWcType pass -> LHsSigType pass
-- Drop the wildcard part of a LHsSigWcType
dropWildCards :: forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType pass
sig_ty = LHsSigWcType pass -> XRec pass (HsSigType pass)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType pass
sig_ty

hsOuterTyVarNames :: HsOuterTyVarBndrs flag GhcRn -> [Name]
hsOuterTyVarNames :: forall flag. HsOuterTyVarBndrs flag GhcRn -> [Name]
hsOuterTyVarNames (HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit GhcRn
imp_tvs}) = [Name]
XHsOuterImplicit GhcRn
imp_tvs
hsOuterTyVarNames (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc GhcRn)]
bndrs})       = [LHsTyVarBndr flag GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr flag (NoGhcTc GhcRn)]
[LHsTyVarBndr flag GhcRn]
bndrs

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

mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit :: forall flag. HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit = HsOuterImplicit{hso_ximplicit :: XHsOuterImplicit GhcPs
hso_ximplicit = XHsOuterImplicit GhcPs
NoExtField
noExtField}

mkHsOuterExplicit :: EpAnnForallTy -> [LHsTyVarBndr flag GhcPs]
                  -> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit :: forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit EpAnnForallTy
an [LHsTyVarBndr flag GhcPs]
bndrs = HsOuterExplicit { hso_xexplicit :: XHsOuterExplicit GhcPs flag
hso_xexplicit = XHsOuterExplicit GhcPs flag
EpAnnForallTy
an
                                             , hso_bndrs :: [LHsTyVarBndr flag (NoGhcTc GhcPs)]
hso_bndrs     = [LHsTyVarBndr flag (NoGhcTc GhcPs)]
[LHsTyVarBndr flag GhcPs]
bndrs }

mkHsImplicitSigType :: LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType :: LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType LHsType GhcPs
body =
  HsSig { sig_ext :: XHsSig GhcPs
sig_ext   = XHsSig GhcPs
NoExtField
noExtField
        , sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
forall flag. HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit, sig_body :: LHsType GhcPs
sig_body = LHsType GhcPs
body }

mkHsExplicitSigType :: EpAnnForallTy
                    -> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs
                    -> HsSigType GhcPs
mkHsExplicitSigType :: EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs]
-> LHsType GhcPs
-> HsSigType GhcPs
mkHsExplicitSigType EpAnnForallTy
an [LHsTyVarBndr Specificity GhcPs]
bndrs LHsType GhcPs
body =
  HsSig { sig_ext :: XHsSig GhcPs
sig_ext = XHsSig GhcPs
NoExtField
noExtField
        , sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_bndrs = EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs] -> HsOuterSigTyVarBndrs GhcPs
forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit EpAnnForallTy
an [LHsTyVarBndr Specificity GhcPs]
bndrs, sig_body :: LHsType GhcPs
sig_body = LHsType GhcPs
body }

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

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

mkHsTyPat :: LHsType GhcPs -> HsTyPat GhcPs
mkHsTyPat :: LHsType GhcPs -> HsTyPat GhcPs
mkHsTyPat LHsType GhcPs
x = HsTP { hstp_ext :: XHsTP GhcPs
hstp_ext  = XHsTP GhcPs
NoExtField
noExtField
                   , hstp_body :: LHsType GhcPs
hstp_body = LHsType GhcPs
x }

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

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

type instance XTyVarBndr    (GhcPass _) = [AddEpAnn]
type instance XXTyVarBndr   (GhcPass _) = DataConCantHappen

type instance XBndrKind   (GhcPass p) = NoExtField
type instance XBndrNoKind (GhcPass p) = NoExtField
type instance XXBndrKind  (GhcPass p) = DataConCantHappen

type instance XBndrVar (GhcPass p) = NoExtField
type instance XBndrWildCard (GhcPass p) = NoExtField
type instance XXBndrVar (GhcPass p) = DataConCantHappen

-- | Return the attached flag
hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag :: forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag = HsTyVarBndr flag (GhcPass pass) -> flag
forall flag pass. HsTyVarBndr flag pass -> flag
tvb_flag
-- By specialising to (GhcPass p) we know that XXTyVarBndr is DataConCantHappen
-- so the equation is exhaustive: extension construction can't happen

-- | Set the attached flag
setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
  -> HsTyVarBndr flag (GhcPass pass)
setHsTyVarBndrFlag :: forall flag flag' (pass :: Pass).
flag
-> HsTyVarBndr flag' (GhcPass pass)
-> HsTyVarBndr flag (GhcPass pass)
setHsTyVarBndrFlag flag
fl HsTyVarBndr flag' (GhcPass pass)
tvb = HsTyVarBndr flag' (GhcPass pass)
tvb { tvb_flag = fl }

-- | Update the attached flag
updateHsTyVarBndrFlag
  :: (flag -> flag')
  -> HsTyVarBndr flag  (GhcPass pass)
  -> HsTyVarBndr flag' (GhcPass pass)
updateHsTyVarBndrFlag :: forall flag flag' (pass :: Pass).
(flag -> flag')
-> HsTyVarBndr flag (GhcPass pass)
-> HsTyVarBndr flag' (GhcPass pass)
updateHsTyVarBndrFlag flag -> flag'
f HsTyVarBndr flag (GhcPass pass)
tvb = HsTyVarBndr flag (GhcPass pass)
tvb { tvb_flag = f (tvb_flag tvb) }

-- | Get the variable of the type variable binder
hsBndrVar :: HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar :: forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar = HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
forall flag pass. HsTyVarBndr flag pass -> HsBndrVar pass
tvb_var

-- | Get the kind of the type variable binder
hsBndrKind :: HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)
hsBndrKind :: forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)
hsBndrKind = HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)
forall flag pass. HsTyVarBndr flag pass -> HsBndrKind pass
tvb_kind

-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
hsTvbAllKinded :: LHsQTyVars (GhcPass p) -> Bool
hsTvbAllKinded :: forall (p :: Pass). LHsQTyVars (GhcPass p) -> Bool
hsTvbAllKinded = (GenLocated
   SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
 -> Bool)
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p) -> Bool
forall flag pass. HsTyVarBndr flag pass -> Bool
isHsKindedTyVar (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p) -> Bool)
-> (GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
    -> HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> GenLocated
     SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)
forall l e. GenLocated l e -> e
unLoc) ([GenLocated
    SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
 -> Bool)
-> (LHsQTyVars (GhcPass p)
    -> [GenLocated
          SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))])
-> LHsQTyVars (GhcPass p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsQTyVars (GhcPass p)
-> [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
LHsQTyVars (GhcPass p)
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit

type instance XBndrRequired (GhcPass _) = NoExtField

type instance XBndrInvisible GhcPs = EpToken "@"
type instance XBndrInvisible GhcRn = NoExtField
type instance XBndrInvisible GhcTc = NoExtField

type instance XXBndrVis (GhcPass _) = DataConCantHappen

{- Note [Wildcard binders in disallowed contexts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In contexts where a type variable binder is expected (HsTyVarBndr), we usually
allow both named binders and wildcards, e.g.

  type Const1 a b = a     -- ok
  type Const2 a _ = a     -- ok, too

This applies to LHSs of data, newtype, type, class, type family and data family
declarations. However, we choose to reject wildcards in forall telescopes and
type family result variables (the latter being part of TypeFamilyDependencies):

  type family Fd a = _    -- disallowed  (WildcardBndrInTyFamResultVar)
  fn :: forall _. Int     -- disallowed  (WildcardBndrInForallTelescope)

This restriction is placed solely because such binders have not been proposed
and there is no known use case for them. If we see user demand for wildcard
binders in these contexts, adding support for them would be as easy as dropping
the checks that reject them. The rest of the compiler can handle all wildcard
binders regardless of context by generating a fresh name (see `tcHsBndrVarName`
in GHC.Tc.Gen.HsType and `repHsBndrVar` in GHC.HsToCore.Quote).

That is, in type declarations we have:

  type F _  = ...  -- equivalent to ...
  type F _a = ...  -- where _a is fresh

and the same principle could be applied to foralls:

  fn :: forall _.  Int   -- equivalent to ...
  fn :: forall _a. Int   -- where _a is fresh

except the `forall _.` example is rejected by checkForAllTelescopeWildcardBndrs.
-}

type instance XForAllTy        (GhcPass _) = NoExtField
type instance XQualTy          (GhcPass _) = NoExtField
type instance XTyVar           (GhcPass _) = [AddEpAnn]
type instance XAppTy           (GhcPass _) = NoExtField
type instance XFunTy           (GhcPass _) = NoExtField
type instance XListTy          (GhcPass _) = AnnParen
type instance XTupleTy         (GhcPass _) = AnnParen
type instance XSumTy           (GhcPass _) = AnnParen
type instance XOpTy            (GhcPass _) = [AddEpAnn]
type instance XParTy           (GhcPass _) = AnnParen
type instance XIParamTy        (GhcPass _) = [AddEpAnn]
type instance XStarTy          (GhcPass _) = NoExtField
type instance XKindSig         (GhcPass _) = [AddEpAnn]

type instance XAppKindTy       GhcPs = EpToken "@"
type instance XAppKindTy       GhcRn = NoExtField
type instance XAppKindTy       GhcTc = NoExtField

type instance XSpliceTy        GhcPs = NoExtField
type instance XSpliceTy        GhcRn = HsUntypedSpliceResult (LHsType GhcRn)
type instance XSpliceTy        GhcTc = Kind

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

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

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

type instance XExplicitTupleTy GhcPs = [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

-- An escape hatch for tunnelling a Core 'Type' through 'HsType'.
-- For more details on how this works, see:
--
-- * @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType"
--
-- * @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType"
type HsCoreTy = Type

type instance XNumTy         (GhcPass _) = SourceText
type instance XStrTy         (GhcPass _) = SourceText
type instance XCharTy        (GhcPass _) = SourceText
type instance XXTyLit        (GhcPass _) = DataConCantHappen

data EpLinearArrow
  = EpPct1 !(EpToken "%1") !(EpUniToken "->" "→")
  | EpLolly !(EpToken "⊸")
  deriving Typeable EpLinearArrow
Typeable EpLinearArrow =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EpLinearArrow -> c EpLinearArrow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EpLinearArrow)
-> (EpLinearArrow -> Constr)
-> (EpLinearArrow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EpLinearArrow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EpLinearArrow))
-> ((forall b. Data b => b -> b) -> EpLinearArrow -> EpLinearArrow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r)
-> (forall u. (forall d. Data d => d -> u) -> EpLinearArrow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EpLinearArrow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow)
-> Data EpLinearArrow
EpLinearArrow -> Constr
EpLinearArrow -> DataType
(forall b. Data b => b -> b) -> EpLinearArrow -> EpLinearArrow
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EpLinearArrow -> u
forall u. (forall d. Data d => d -> u) -> EpLinearArrow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpLinearArrow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpLinearArrow -> c EpLinearArrow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpLinearArrow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpLinearArrow)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpLinearArrow -> c EpLinearArrow
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpLinearArrow -> c EpLinearArrow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpLinearArrow
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpLinearArrow
$ctoConstr :: EpLinearArrow -> Constr
toConstr :: EpLinearArrow -> Constr
$cdataTypeOf :: EpLinearArrow -> DataType
dataTypeOf :: EpLinearArrow -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpLinearArrow)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpLinearArrow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpLinearArrow)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpLinearArrow)
$cgmapT :: (forall b. Data b => b -> b) -> EpLinearArrow -> EpLinearArrow
gmapT :: (forall b. Data b => b -> b) -> EpLinearArrow -> EpLinearArrow
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpLinearArrow -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EpLinearArrow -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EpLinearArrow -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpLinearArrow -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpLinearArrow -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpLinearArrow -> m EpLinearArrow
Data

instance NoAnn EpLinearArrow where
  noAnn :: EpLinearArrow
noAnn = EpToken "%1" -> EpUniToken "->" "\8594" -> EpLinearArrow
EpPct1 EpToken "%1"
forall a. NoAnn a => a
noAnn EpUniToken "->" "\8594"
forall a. NoAnn a => a
noAnn

type instance XUnrestrictedArrow _ GhcPs = EpUniToken "->" "→"
type instance XUnrestrictedArrow _ GhcRn = NoExtField
type instance XUnrestrictedArrow _ GhcTc = NoExtField

type instance XLinearArrow       _ GhcPs = EpLinearArrow
type instance XLinearArrow       _ GhcRn = NoExtField
type instance XLinearArrow       _ GhcTc = NoExtField

type instance XExplicitMult      _ GhcPs = (EpToken "%", EpUniToken "->" "→")
type instance XExplicitMult      _ GhcRn = NoExtField
type instance XExplicitMult      _ GhcTc = NoExtField

type instance XXArrow            _ (GhcPass _) = DataConCantHappen

hsLinear :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear :: forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear = HsArrow (GhcPass p) -> a -> HsScaled (GhcPass p) a
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled (XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
-> HsArrowOf
     (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
forall mult pass. XLinearArrow mult pass -> HsArrowOf mult pass
HsLinearArrow XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
x)
  where
    x :: XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
x = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
EpLinearArrow
forall a. NoAnn a => a
noAnn
      GhcPass p
GhcRn -> NoExtField
XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
noExtField
      GhcPass p
GhcTc -> NoExtField
XLinearArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
noExtField

hsUnrestricted :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a
hsUnrestricted :: forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsUnrestricted = HsArrow (GhcPass p) -> a -> HsScaled (GhcPass p) a
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled (XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
-> HsArrowOf
     (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
forall mult pass.
XUnrestrictedArrow mult pass -> HsArrowOf mult pass
HsUnrestrictedArrow XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
x)
  where
    x :: XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
x = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> EpUniToken "->" "\8594"
XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
forall a. NoAnn a => a
noAnn
      GhcPass p
GhcRn -> NoExtField
XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
noExtField
      GhcPass p
GhcTc -> NoExtField
XUnrestrictedArrow
  (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
noExtField

isUnrestricted :: HsArrow GhcRn -> Bool
isUnrestricted :: HsArrow GhcRn -> Bool
isUnrestricted (HsArrow GhcRn -> LHsType GhcRn
arrowToHsType -> L SrcSpanAnnA
_ (HsTyVar XTyVar GhcRn
_ PromotionFlag
_ (L SrcSpanAnnN
_ Name
n))) = Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
manyDataConName
isUnrestricted HsArrow GhcRn
_ = Bool
False

arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
arrowToHsType = (GenLocated SrcSpanAnnN Name -> HsType GhcRn)
-> HsArrowOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall (t :: * -> *).
(GenLocated SrcSpanAnnN Name -> t GhcRn)
-> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn)
expandHsArrow (XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar [AddEpAnn]
XTyVar GhcRn
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted)

-- | Convert an arrow into its corresponding multiplicity. In essence this
-- erases the information of whether the programmer wrote an explicit
-- multiplicity or a shorthand.
expandHsArrow :: (LocatedN Name -> t GhcRn) -> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn)
expandHsArrow :: forall (t :: * -> *).
(GenLocated SrcSpanAnnN Name -> t GhcRn)
-> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn)
expandHsArrow GenLocated SrcSpanAnnN Name -> t GhcRn
mk_var (HsUnrestrictedArrow XUnrestrictedArrow (LocatedA (t GhcRn)) GhcRn
_) = t GhcRn -> LocatedA (t GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (GenLocated SrcSpanAnnN Name -> t GhcRn
mk_var (Name -> GenLocated SrcSpanAnnN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA Name
manyDataConName))
expandHsArrow GenLocated SrcSpanAnnN Name -> t GhcRn
mk_var (HsLinearArrow XLinearArrow (LocatedA (t GhcRn)) GhcRn
_) = t GhcRn -> LocatedA (t GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (GenLocated SrcSpanAnnN Name -> t GhcRn
mk_var (Name -> GenLocated SrcSpanAnnN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA Name
oneDataConName))
expandHsArrow GenLocated SrcSpanAnnN Name -> t GhcRn
_mk_var (HsExplicitMult XExplicitMult (LocatedA (t GhcRn)) GhcRn
_ LocatedA (t GhcRn)
p) = LocatedA (t GhcRn)
p

instance
      (Outputable mult, OutputableBndrId pass) =>
      Outputable (HsArrowOf mult (GhcPass pass)) where
  ppr :: HsArrowOf mult (GhcPass pass) -> SDoc
ppr HsArrowOf mult (GhcPass pass)
arr = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (HsArrowOf mult (GhcPass pass) -> SDoc
forall mult (pass :: Pass).
(Outputable mult, OutputableBndrId pass) =>
HsArrowOf mult (GhcPass pass) -> SDoc
pprHsArrow HsArrowOf mult (GhcPass pass)
arr)

-- See #18846
pprHsArrow :: (Outputable mult, OutputableBndrId pass) => HsArrowOf mult (GhcPass pass) -> SDoc
pprHsArrow :: forall mult (pass :: Pass).
(Outputable mult, OutputableBndrId pass) =>
HsArrowOf mult (GhcPass pass) -> SDoc
pprHsArrow (HsUnrestrictedArrow XUnrestrictedArrow mult (GhcPass pass)
_) = FunTyFlag -> Either Bool SDoc -> SDoc
pprArrowWithMultiplicity FunTyFlag
visArgTypeLike (Bool -> Either Bool SDoc
forall a b. a -> Either a b
Left Bool
False)
pprHsArrow (HsLinearArrow XLinearArrow mult (GhcPass pass)
_)       = FunTyFlag -> Either Bool SDoc -> SDoc
pprArrowWithMultiplicity FunTyFlag
visArgTypeLike (Bool -> Either Bool SDoc
forall a b. a -> Either a b
Left Bool
True)
pprHsArrow (HsExplicitMult XExplicitMult mult (GhcPass pass)
_ mult
p)    = FunTyFlag -> Either Bool SDoc -> SDoc
pprArrowWithMultiplicity FunTyFlag
visArgTypeLike (SDoc -> Either Bool SDoc
forall a b. b -> Either a b
Right (mult -> SDoc
forall a. Outputable a => a -> SDoc
ppr mult
p))

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

instance OutputableBndrId p
       => Outputable (ConDeclField (GhcPass p)) where
  ppr :: ConDeclField (GhcPass p) -> SDoc
ppr (ConDeclField XConDeclField (GhcPass p)
_ [LFieldOcc (GhcPass p)]
fld_n LBangType (GhcPass p)
fld_ty Maybe (LHsDoc (GhcPass p))
_) = [GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LFieldOcc (GhcPass p)]
[GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))]
fld_n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LBangType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
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 :: LHsSigWcType GhcRn -> [Name]
hsWcScopedTvs LHsSigWcType GhcRn
sig_wc_ty
  | HsWC { hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
hswc_ext = XHsWC GhcRn (LHsSigType GhcRn)
nwcs, hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = LHsSigType GhcRn
sig_ty }  <- LHsSigWcType GhcRn
sig_wc_ty
  , L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs}) <- LHsSigType GhcRn
sig_ty
  = [Name]
XHsWC GhcRn (LHsSigType GhcRn)
nwcs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames (HsOuterSigTyVarBndrs GhcRn
-> [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcRn
outer_bndrs)
    -- See Note [hsScopedTvs and visible foralls]

hsScopedTvs :: LHsSigType GhcRn -> [Name]
-- Same as hsWcScopedTvs, but for a LHsSigType
hsScopedTvs :: LHsSigType GhcRn -> [Name]
hsScopedTvs (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs}))
  = [LHsTyVarBndr Specificity GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames (HsOuterSigTyVarBndrs GhcRn
-> [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcRn
outer_bndrs)
    -- See Note [hsScopedTvs and visible foralls]

hsScopedKvs :: LHsKind GhcRn -> [Name]
-- Same as hsScopedTvs, but for a LHsKind
hsScopedKvs :: LHsType GhcRn -> [Name]
hsScopedKvs  (L SrcSpanAnnA
_ HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcRn]
bndrs }})
  = [LHsTyVarBndr Specificity GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr Specificity GhcRn]
bndrs
    -- See Note [hsScopedTvs and visible foralls]
hsScopedKvs LHsType GhcRn
_ = []

---------------------
hsTyVarLName :: HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
hsTyVarLName :: forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
hsTyVarLName HsTyVarBndr flag (GhcPass p)
tvb =
  case HsTyVarBndr flag (GhcPass p) -> HsBndrVar (GhcPass p)
forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar HsTyVarBndr flag (GhcPass p)
tvb of
    HsBndrVar      XBndrVar (GhcPass p)
_ LIdP (GhcPass p)
n -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
-> Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
forall a. a -> Maybe a
Just LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n
    HsBndrWildCard XBndrWildCard (GhcPass p)
_   -> Maybe (LIdP (GhcPass p))
Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
forall a. Maybe a
Nothing

hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsTyVarName :: forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsTyVarName = (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p)
-> Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> Maybe (IdGhcP p)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc (Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
 -> Maybe (IdGhcP p))
-> (HsTyVarBndr flag (GhcPass p)
    -> Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p)))
-> HsTyVarBndr flag (GhcPass p)
-> Maybe (IdGhcP p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
HsTyVarBndr flag (GhcPass p)
-> Maybe (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
hsTyVarLName

hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsLTyVarName :: forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsLTyVarName = HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
HsTyVarBndr flag (GhcPass p) -> Maybe (IdGhcP p)
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsTyVarName (HsTyVarBndr flag (GhcPass p) -> Maybe (IdGhcP p))
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
    -> HsTyVarBndr flag (GhcPass p))
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
-> Maybe (IdGhcP p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
-> HsTyVarBndr flag (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames :: forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames = (GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
 -> Maybe (IdGhcP p))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))]
-> [IdGhcP p]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe XRec (GhcPass p) (HsTyVarBndr flag (GhcPass p))
-> Maybe (IdP (GhcPass p))
GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
-> Maybe (IdGhcP p)
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> Maybe (IdP (GhcPass p))
hsLTyVarName

hsForAllTelescopeNames :: HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)]
hsForAllTelescopeNames :: forall (p :: Pass).
HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)]
hsForAllTelescopeNames (HsForAllVis XHsForAllVis (GhcPass p)
_ [LHsTyVarBndr () (GhcPass p)]
bndrs) = [LHsTyVarBndr () (GhcPass p)] -> [IdP (GhcPass p)]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr () (GhcPass p)]
bndrs
hsForAllTelescopeNames (HsForAllInvis XHsForAllInvis (GhcPass p)
_ [LHsTyVarBndr Specificity (GhcPass p)]
bndrs) = [LHsTyVarBndr Specificity (GhcPass p)] -> [IdP (GhcPass p)]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr Specificity (GhcPass p)]
bndrs

hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
-- Explicit variables only
hsExplicitLTyVarNames :: forall (p :: Pass). LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
hsExplicitLTyVarNames LHsQTyVars (GhcPass p)
qtvs = [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
-> [IdP (GhcPass p)]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames (LHsQTyVars (GhcPass p)
-> [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit LHsQTyVars (GhcPass p)
qtvs)

hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
-- All variables
hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
hsAllLTyVarNames (HsQTvs { hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass
hsq_ext = XHsQTvs GhcRn
kvs
                         , hsq_explicit :: forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit = [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn]
tvs })
  = [Name]
XHsQTvs GhcRn
kvs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn]
tvs

hsLTyVarLocName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                => LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName :: forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName (L SrcSpanAnnA
_ HsTyVarBndr flag (GhcPass p)
a) = HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> Maybe (LIdP (GhcPass p))
hsTyVarLName HsTyVarBndr flag (GhcPass p)
a

hsLTyVarLocNames :: Anno (IdGhcP p) ~ SrcSpanAnnN
                 => LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames LHsQTyVars (GhcPass p)
qtvs = (GenLocated
   SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
 -> Maybe (LocatedN (IdGhcP p)))
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
-> [LocatedN (IdGhcP p)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)
-> Maybe (GenLocated SrcSpanAnnN (IdP (GhcPass p)))
GenLocated
  SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> Maybe (LocatedN (IdGhcP p))
forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName (LHsQTyVars (GhcPass p)
-> [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit LHsQTyVars (GhcPass p)
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 :: forall (p :: Pass).
LHsType (GhcPass p) -> Maybe (LHsType (GhcPass p))
hsTyKindSig LHsType (GhcPass p)
lty =
  case GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> HsType (GhcPass p)
forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
lty of
    HsParTy XParTy (GhcPass p)
_ LHsType (GhcPass p)
lty'    -> LHsType (GhcPass p) -> Maybe (LHsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p) -> Maybe (LHsType (GhcPass p))
hsTyKindSig LHsType (GhcPass p)
lty'
    HsKindSig XKindSig (GhcPass p)
_ LHsType (GhcPass p)
_ LHsType (GhcPass p)
k   -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall a. a -> Maybe a
Just LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k
    HsType (GhcPass p)
_                 -> Maybe (LHsType (GhcPass p))
Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall a. Maybe a
Nothing

---------------------
ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens :: forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens (L SrcSpanAnnA
_ (HsParTy XParTy (GhcPass p)
_ LHsType (GhcPass p)
ty)) = LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType (GhcPass p)
ty
ignoreParens LHsType (GhcPass p)
ty                   = LHsType (GhcPass p)
ty

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

mkAnonWildCardTy :: HsType GhcPs
mkAnonWildCardTy :: HsType GhcPs
mkAnonWildCardTy = XWildCardTy GhcPs -> HsType GhcPs
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcPs
NoExtField
noExtField

mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
         => PromotionFlag
         -> LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
         -> LHsType (GhcPass p) -> HsType (GhcPass p)
mkHsOpTy :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
PromotionFlag
-> LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy PromotionFlag
prom LHsType (GhcPass p)
ty1 LocatedN (IdP (GhcPass p))
op LHsType (GhcPass p)
ty2 = XOpTy (GhcPass p)
-> PromotionFlag
-> LHsType (GhcPass p)
-> LIdP (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy [AddEpAnn]
XOpTy (GhcPass p)
forall a. NoAnn a => a
noAnn PromotionFlag
prom LHsType (GhcPass p)
ty1 LIdP (GhcPass p)
LocatedN (IdP (GhcPass p))
op LHsType (GhcPass p)
ty2

mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy :: forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy LHsType (GhcPass p)
t1 LHsType (GhcPass p)
t2 = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
t1 LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
t2 (XAppTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
t1 LHsType (GhcPass p)
t2)

mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
           -> LHsType (GhcPass p)
mkHsAppTys :: forall (p :: Pass).
LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
mkHsAppTys = (GenLocated SrcSpanAnnA (HsType (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsType (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' XRec (GhcPass p) (HsType (GhcPass p))
-> XRec (GhcPass p) (HsType (GhcPass p))
-> XRec (GhcPass p) (HsType (GhcPass p))
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy

mkHsAppKindTy :: XAppKindTy (GhcPass p)
              -> LHsType (GhcPass p) -> LHsType (GhcPass p)
              -> LHsType (GhcPass p)
mkHsAppKindTy :: forall (p :: Pass).
XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
mkHsAppKindTy XAppKindTy (GhcPass p)
at LHsType (GhcPass p)
ty LHsType (GhcPass p)
k = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a b l c.
(HasLoc a, HasLoc b, HasAnnotation l) =>
a -> b -> c -> GenLocated l c
addCLocA LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k (XAppKindTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass p)
at LHsType (GhcPass p)
ty LHsType (GhcPass p)
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 :: forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType (GhcPass p)
ty = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> ([AddEpAnn], EpAnnComments,
    [HsScaled
       (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall {p :: Pass}.
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> ([AddEpAnn], EpAnnComments,
    [HsScaled
       (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
go LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty
  where
    go :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> ([AddEpAnn], EpAnnComments,
    [HsScaled
       (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
go (L SrcSpanAnnA
l (HsParTy XParTy (GhcPass p)
an LHsType (GhcPass p)
ty))
      = let
          ([AddEpAnn]
anns, EpAnnComments
cs, [HsScaled (GhcPass p) (LHsType (GhcPass p))]
args, LHsType (GhcPass p)
res) = LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType (GhcPass p)
ty
          anns' :: [AddEpAnn]
anns' = [AddEpAnn]
anns [AddEpAnn] -> [AddEpAnn] -> [AddEpAnn]
forall a. [a] -> [a] -> [a]
++ AnnParen -> [AddEpAnn]
annParen2AddEpAnn XParTy (GhcPass p)
AnnParen
an
          cs' :: EpAnnComments
cs' = EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
S.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments SrcSpanAnnA
l
        in ([AddEpAnn]
anns', EpAnnComments
cs', [HsScaled (GhcPass p) (LHsType (GhcPass p))]
[HsScaled
   (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))]
args, LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
res)

    go (L SrcSpanAnnA
ll (HsFunTy XFunTy (GhcPass p)
_ HsArrow (GhcPass p)
mult LHsType (GhcPass p)
x LHsType (GhcPass p)
y))
      | ([AddEpAnn]
anns, EpAnnComments
csy, [HsScaled (GhcPass p) (LHsType (GhcPass p))]
args, LHsType (GhcPass p)
res) <- LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType (GhcPass p)
y
      = ([AddEpAnn]
anns, EpAnnComments
csy EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
S.<> SrcSpanAnnA -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments SrcSpanAnnA
ll, HsArrow (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> HsScaled
     (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow (GhcPass p)
mult LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
xHsScaled (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
-> [HsScaled
      (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))]
-> [HsScaled
      (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))]
forall a. a -> [a] -> [a]
:[HsScaled (GhcPass p) (LHsType (GhcPass p))]
[HsScaled
   (GhcPass p) (GenLocated SrcSpanAnnA (HsType (GhcPass p)))]
args, LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
res)

    go GenLocated SrcSpanAnnA (HsType (GhcPass p))
other = ([], EpAnnComments
emptyComments, [], GenLocated SrcSpanAnnA (HsType (GhcPass p))
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 :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsTyGetAppHead_maybe = XRec (GhcPass p) (HsType (GhcPass p))
-> Maybe (GenLocated SrcSpanAnnN (IdP (GhcPass p)))
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> Maybe (XRec (GhcPass p) (IdP (GhcPass p)))
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go
  where
    go :: GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go (L l
_ (HsTyVar XTyVar pass
_ PromotionFlag
_ XRec pass (IdP pass)
ln))          = XRec pass (IdP pass) -> Maybe (XRec pass (IdP pass))
forall a. a -> Maybe a
Just XRec pass (IdP pass)
ln
    go (L l
_ (HsAppTy XAppTy pass
_ XRec pass (HsType pass)
l XRec pass (HsType pass)
_))           = GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go XRec pass (HsType pass)
GenLocated l (HsType pass)
l
    go (L l
_ (HsAppKindTy XAppKindTy pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_))       = GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (L l
_ (HsOpTy XOpTy pass
_ PromotionFlag
_ XRec pass (HsType pass)
_ XRec pass (IdP pass)
ln XRec pass (HsType pass)
_))       = XRec pass (IdP pass) -> Maybe (XRec pass (IdP pass))
forall a. a -> Maybe a
Just XRec pass (IdP pass)
ln
    go (L l
_ (HsParTy XParTy pass
_ XRec pass (HsType pass)
t))             = GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (L l
_ (HsKindSig XKindSig pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_))         = GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go GenLocated l (HsType pass)
_                               = Maybe (XRec pass (IdP pass))
forall a. Maybe a
Nothing

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

type instance XValArg (GhcPass _) = NoExtField

type instance XTypeArg GhcPs = EpToken "@"
type instance XTypeArg GhcRn = NoExtField
type instance XTypeArg GhcTc = NoExtField

type instance XArgPar (GhcPass _) = SrcSpan

type instance XXArg (GhcPass _) = DataConCantHappen

-- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'.
lhsTypeArgSrcSpan :: LHsTypeArg GhcPs -> SrcSpan
lhsTypeArgSrcSpan :: LHsTypeArg GhcPs -> SrcSpan
lhsTypeArgSrcSpan LHsTypeArg GhcPs
arg = case LHsTypeArg GhcPs
arg of
  HsValArg  XValArg GhcPs
_  LHsType GhcPs
tm -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
tm
  HsTypeArg XTypeArg GhcPs
at LHsType GhcPs
ty -> EpToken "@" -> SrcSpan
forall (tok :: Symbol). EpToken tok -> SrcSpan
getEpTokenSrcSpan EpToken "@"
XTypeArg GhcPs
at SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
  HsArgPar  XArgPar GhcPs
sp    -> SrcSpan
XArgPar GhcPs
sp

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

numVisibleArgs :: [HsArg p tm ty] -> Arity
numVisibleArgs :: forall p tm ty. [HsArg p tm ty] -> Int
numVisibleArgs = (HsArg p tm ty -> Bool) -> [HsArg p tm ty] -> Int
forall a. (a -> Bool) -> [a] -> Int
count HsArg p tm ty -> Bool
forall {p} {tm} {ty}. HsArg p tm ty -> Bool
is_vis
  where is_vis :: HsArg p tm ty -> Bool
is_vis (HsValArg XValArg p
_ tm
_) = Bool
True
        is_vis HsArg p tm ty
_              = Bool
False

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

-- | @'pprHsArgsApp' id fixity args@ pretty-prints an application of @id@
-- to @args@, using the @fixity@ to tell whether @id@ should be printed prefix
-- or infix. Examples:
--
-- @
-- pprHsArgsApp T Prefix [HsTypeArg Bool, HsValArg Int]                        = T \@Bool Int
-- pprHsArgsApp T Prefix [HsTypeArg Bool, HsArgPar, HsValArg Int]              = (T \@Bool) Int
-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double]                    = Char ++ Double
-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
-- @
pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
             => id -> LexicalFixity -> [HsArg (GhcPass p) tm ty] -> SDoc
pprHsArgsApp :: forall id tm ty (p :: Pass).
(OutputableBndr id, Outputable tm, Outputable ty) =>
id -> LexicalFixity -> [HsArg (GhcPass p) tm ty] -> SDoc
pprHsArgsApp id
thing LexicalFixity
fixity (HsArg (GhcPass p) tm ty
argl:HsArg (GhcPass p) tm ty
argr:[HsArg (GhcPass p) tm ty]
args)
  | LexicalFixity
Infix <- LexicalFixity
fixity
  = let pp_op_app :: SDoc
pp_op_app = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ HsArg (GhcPass p) tm ty -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg HsArg (GhcPass p) tm ty
argl
                         , id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc id
thing
                         , HsArg (GhcPass p) tm ty -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg HsArg (GhcPass p) tm ty
argr ] in
    case [HsArg (GhcPass p) tm ty]
args of
      [] -> SDoc
pp_op_app
      [HsArg (GhcPass p) tm ty]
_  -> SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
pp_op_app) [HsArg (GhcPass p) tm ty]
args

pprHsArgsApp id
thing LexicalFixity
_fixity [HsArg (GhcPass p) tm ty]
args
  = SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app (id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc id
thing) [HsArg (GhcPass p) tm ty]
args

-- | Pretty-print a prefix identifier to a list of 'HsArg's.
ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
                        => SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app :: forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app SDoc
acc []         = SDoc
acc
ppr_hs_args_prefix_app SDoc
acc (HsArg (GhcPass p) tm ty
arg:[HsArg (GhcPass p) tm ty]
args) =
  case HsArg (GhcPass p) tm ty
arg of
    HsValArg{}  -> SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc
acc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArg (GhcPass p) tm ty -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg HsArg (GhcPass p) tm ty
arg) [HsArg (GhcPass p) tm ty]
args
    HsTypeArg{} -> SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc
acc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArg (GhcPass p) tm ty -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg HsArg (GhcPass p) tm ty
arg) [HsArg (GhcPass p) tm ty]
args
    HsArgPar{}  -> SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
acc) [HsArg (GhcPass p) tm ty]
args

-- | Pretty-print an 'HsArg' in isolation.
ppr_single_hs_arg :: (Outputable tm, Outputable ty)
                  => HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg :: forall tm ty (p :: Pass).
(Outputable tm, Outputable ty) =>
HsArg (GhcPass p) tm ty -> SDoc
ppr_single_hs_arg (HsValArg XValArg (GhcPass p)
_ tm
tm)  = tm -> SDoc
forall a. Outputable a => a -> SDoc
ppr tm
tm
ppr_single_hs_arg (HsTypeArg XTypeArg (GhcPass p)
_ ty
ty) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ty -> SDoc
forall a. Outputable a => a -> SDoc
ppr ty
ty
-- GHC shouldn't be constructing ASTs such that this case is ever reached.
-- Still, it's possible some wily user might construct their own AST that
-- allows this to be reachable, so don't fail here.
ppr_single_hs_arg (HsArgPar{})     = SDoc
forall doc. IsOutput doc => doc
empty

-- | This instance is meant for debug-printing purposes. If you wish to
-- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where
  ppr :: HsArg (GhcPass p) tm ty -> SDoc
ppr (HsValArg XValArg (GhcPass p)
_ tm
tm)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsValArg"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> tm -> SDoc
forall a. Outputable a => a -> SDoc
ppr tm
tm
  ppr (HsTypeArg XTypeArg (GhcPass p)
_ ty
ty)  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsTypeArg" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ty -> SDoc
forall a. Outputable a => a -> SDoc
ppr ty
ty
  ppr (HsArgPar XArgPar (GhcPass p)
sp)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsArgPar"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
XArgPar (GhcPass p)
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 :: forall (p :: Pass).
LHsSigType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))],
    Maybe (LHsContext (GhcPass p)),
    [LHsTyVarBndr Specificity (GhcPass p)],
    Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
splitLHsPatSynTy LHsSigType (GhcPass p)
ty = ([XRec
   (GhcPass (NoGhcTcPass p))
   (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))]
univs, Maybe (LHsContext (GhcPass p))
reqs, [LHsTyVarBndr Specificity (GhcPass p)]
exis, Maybe (LHsContext (GhcPass p))
provs, LHsType (GhcPass p)
ty4)
  where
    -- split_sig_ty ::
    --      LHsSigType (GhcPass p)
    --   -> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))], LHsType (GhcPass p))
    split_sig_ty :: GenLocated l (HsSigType (GhcPass p))
-> ([GenLocated
       SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
split_sig_ty (L l
_ HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs (GhcPass p)
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass p)
body}) =
      case HsOuterSigTyVarBndrs (GhcPass p)
outer_bndrs of
        -- NB: Use ignoreParens here in order to be consistent with the use of
        -- splitLHsForAllTyInvis below, which also looks through parentheses.
        HsOuterImplicit{}                      -> ([], LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType (GhcPass p)
body)
        HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
exp_bndrs} -> ([LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))]
exp_bndrs, LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
body)

    ([GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))]
univs, GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty1) = GenLocated SrcSpanAnnA (HsSigType (GhcPass p))
-> ([GenLocated
       SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall {l} {p :: Pass}.
GenLocated l (HsSigType (GhcPass p))
-> ([GenLocated
       SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))],
    GenLocated SrcSpanAnnA (HsType (GhcPass p)))
split_sig_ty LHsSigType (GhcPass p)
GenLocated SrcSpanAnnA (HsSigType (GhcPass p))
ty
    (Maybe (LHsContext (GhcPass p))
reqs,  LHsType (GhcPass p)
ty2) = LHsType (GhcPass p)
-> (Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty1
    ([LHsTyVarBndr Specificity (GhcPass p)]
exis,  LHsType (GhcPass p)
ty3) = LHsType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass p)], LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> ([LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
splitLHsForAllTyInvis LHsType (GhcPass p)
ty2
    (Maybe (LHsContext (GhcPass p))
provs, LHsType (GhcPass p)
ty4) = LHsType (GhcPass p)
-> (Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass p)
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 :: forall (p :: Pass).
LHsType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass p)],
    Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
splitLHsSigmaTyInvis LHsType (GhcPass p)
ty
  | ([LHsTyVarBndr Specificity (GhcPass p)]
tvs,  LHsType (GhcPass p)
ty1) <- LHsType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass p)], LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> ([LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
splitLHsForAllTyInvis LHsType (GhcPass p)
ty
  , (Maybe (LHsContext (GhcPass p))
ctxt, LHsType (GhcPass p)
ty2) <- LHsType (GhcPass p)
-> (Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass p)
ty1
  = ([LHsTyVarBndr Specificity (GhcPass p)]
tvs, Maybe (LHsContext (GhcPass p))
ctxt, LHsType (GhcPass p)
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 :: LHsSigType GhcPs
-> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs),
    LHsType GhcPs)
splitLHsGadtTy (L SrcSpanAnnA
_ HsSigType GhcPs
sig_ty)
  | (HsOuterSigTyVarBndrs GhcPs
outer_bndrs, LHsType GhcPs
rho_ty) <- HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
split_bndrs HsSigType GhcPs
sig_ty
  , (Maybe (LHsContext GhcPs)
mb_ctxt, LHsType GhcPs
tau_ty)     <- LHsType GhcPs -> (Maybe (LHsContext GhcPs), LHsType GhcPs)
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP LHsType GhcPs
rho_ty
  = (HsOuterSigTyVarBndrs GhcPs
outer_bndrs, Maybe (LHsContext GhcPs)
mb_ctxt, LHsType GhcPs
tau_ty)
  where
    split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
    split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
split_bndrs (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body_ty}) =
      (HsOuterSigTyVarBndrs GhcPs
outer_bndrs, LHsType GhcPs
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) -> ( [LHsTyVarBndr Specificity (GhcPass pass)]
                            , LHsType (GhcPass pass))
splitLHsForAllTyInvis :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> ([LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
splitLHsForAllTyInvis LHsType (GhcPass pass)
ty
  | ((Maybe [LHsTyVarBndr Specificity (GhcPass pass)]
mb_tvbs), LHsType (GhcPass pass)
body) <- LHsType (GhcPass pass)
-> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
splitLHsForAllTyInvis_KP (LHsType (GhcPass pass) -> LHsType (GhcPass pass)
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType (GhcPass pass)
ty)
  = ([GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
-> Maybe
     [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr Specificity (GhcPass pass)]
Maybe
  [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
mb_tvbs, LHsType (GhcPass pass)
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 ([LHsTyVarBndr Specificity (GhcPass pass)])
                            , LHsType (GhcPass pass))
splitLHsForAllTyInvis_KP :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)],
    LHsType (GhcPass pass))
splitLHsForAllTyInvis_KP lty :: LHsType (GhcPass pass)
lty@(L SrcSpanAnnA
_ HsType (GhcPass pass)
ty) =
  case HsType (GhcPass pass)
ty of
    HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllInvis {hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity (GhcPass pass)]
tvs }
               , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass pass)
body }
      -> ([GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
-> Maybe
     [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
forall a. a -> Maybe a
Just [LHsTyVarBndr Specificity (GhcPass pass)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
tvs, LHsType (GhcPass pass)
body)
    HsType (GhcPass pass)
_ -> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)]
Maybe
  [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
forall a. Maybe a
Nothing, LHsType (GhcPass pass)
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 :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass pass)
ty
  | (Maybe (LHsContext (GhcPass pass))
mb_ctxt, LHsType (GhcPass pass)
body) <- LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP (LHsType (GhcPass pass) -> LHsType (GhcPass pass)
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType (GhcPass pass)
ty)
  = (Maybe (LHsContext (GhcPass pass))
mb_ctxt, LHsType (GhcPass pass)
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 :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP (L SrcSpanAnnA
_ (HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext (GhcPass pass)
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass pass)
body }))
                       = (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass pass))]
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass pass))])
forall a. a -> Maybe a
Just LHsContext (GhcPass pass)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass pass))]
ctxt, LHsType (GhcPass pass)
body)
splitLHsQualTy_KP LHsType (GhcPass pass)
body = (Maybe (LHsContext (GhcPass pass))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass pass))])
forall a. Maybe a
Nothing, LHsType (GhcPass pass)
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 :: LHsSigType GhcRn
-> ([Name], Maybe (LHsContext GhcRn), LHsType GhcRn)
splitLHsInstDeclTy (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcRn
inst_ty})) =
  (HsOuterSigTyVarBndrs GhcRn -> [Name]
forall flag. HsOuterTyVarBndrs flag GhcRn -> [Name]
hsOuterTyVarNames HsOuterSigTyVarBndrs GhcRn
outer_bndrs, Maybe (LHsContext GhcRn)
mb_cxt, LHsType GhcRn
body_ty)
  where
    (Maybe (LHsContext GhcRn)
mb_cxt, LHsType GhcRn
body_ty) = LHsType GhcRn -> (Maybe (LHsContext GhcRn), LHsType GhcRn)
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP LHsType GhcRn
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 :: forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead (L SrcSpanAnnA
_ (HsSig{sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass p)
qual_ty}))
  | (Maybe (LHsContext (GhcPass p))
_mb_cxt, LHsType (GhcPass p)
body_ty) <- LHsType (GhcPass p)
-> (Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP LHsType (GhcPass p)
qual_ty
  = LHsType (GhcPass p)
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 :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsSigType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
getLHsInstDeclClass_maybe LHsSigType (GhcPass p)
inst_ty
  = do { let head_ty :: LHsType (GhcPass p)
head_ty = LHsSigType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead LHsSigType (GhcPass p)
inst_ty
       ; LHsType (GhcPass p)
-> Maybe (GenLocated SrcSpanAnnN (IdP (GhcPass p)))
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsType (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsTyGetAppHead_maybe LHsType (GhcPass p)
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 _) = DataConCantHappen

mkFieldOcc :: LocatedN RdrName -> FieldOcc GhcPs
mkFieldOcc :: GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcPs
mkFieldOcc GenLocated SrcSpanAnnN RdrName
rdr = XCFieldOcc GhcPs -> XRec GhcPs RdrName -> FieldOcc GhcPs
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcPs
NoExtField
noExtField XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
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 _) = DataConCantHappen

instance Outputable (AmbiguousFieldOcc (GhcPass p)) where
  ppr :: AmbiguousFieldOcc (GhcPass p) -> SDoc
ppr = RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> SDoc)
-> (AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> AmbiguousFieldOcc (GhcPass p)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName

instance OutputableBndr (AmbiguousFieldOcc (GhcPass p)) where
  pprInfixOcc :: AmbiguousFieldOcc (GhcPass p) -> SDoc
pprInfixOcc  = RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (RdrName -> SDoc)
-> (AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> AmbiguousFieldOcc (GhcPass p)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName
  pprPrefixOcc :: AmbiguousFieldOcc (GhcPass p) -> SDoc
pprPrefixOcc = RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (RdrName -> SDoc)
-> (AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> AmbiguousFieldOcc (GhcPass p)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName

instance OutputableBndr (Located (AmbiguousFieldOcc (GhcPass p))) where
  pprInfixOcc :: Located (AmbiguousFieldOcc (GhcPass p)) -> SDoc
pprInfixOcc  = AmbiguousFieldOcc (GhcPass p) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (AmbiguousFieldOcc (GhcPass p) -> SDoc)
-> (Located (AmbiguousFieldOcc (GhcPass p))
    -> AmbiguousFieldOcc (GhcPass p))
-> Located (AmbiguousFieldOcc (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc
  pprPrefixOcc :: Located (AmbiguousFieldOcc (GhcPass p)) -> SDoc
pprPrefixOcc = AmbiguousFieldOcc (GhcPass p) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (AmbiguousFieldOcc (GhcPass p) -> SDoc)
-> (Located (AmbiguousFieldOcc (GhcPass p))
    -> AmbiguousFieldOcc (GhcPass p))
-> Located (AmbiguousFieldOcc (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

mkAmbiguousFieldOcc :: LocatedN RdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc :: GenLocated SrcSpanAnnN RdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc GenLocated SrcSpanAnnN RdrName
rdr = XUnambiguous GhcPs -> XRec GhcPs RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
Unambiguous XUnambiguous GhcPs
NoExtField
noExtField XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
rdr

ambiguousFieldOccRdrName :: AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName :: forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName = GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> (AmbiguousFieldOcc (GhcPass p)
    -> GenLocated SrcSpanAnnN RdrName)
-> AmbiguousFieldOcc (GhcPass p)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbiguousFieldOcc (GhcPass p) -> GenLocated SrcSpanAnnN RdrName
forall (p :: Pass).
AmbiguousFieldOcc (GhcPass p) -> GenLocated SrcSpanAnnN RdrName
ambiguousFieldOccLRdrName

ambiguousFieldOccLRdrName :: AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
ambiguousFieldOccLRdrName :: forall (p :: Pass).
AmbiguousFieldOcc (GhcPass p) -> GenLocated SrcSpanAnnN RdrName
ambiguousFieldOccLRdrName (Unambiguous XUnambiguous (GhcPass p)
_ XRec (GhcPass p) RdrName
rdr) = XRec (GhcPass p) RdrName
GenLocated SrcSpanAnnN RdrName
rdr
ambiguousFieldOccLRdrName (Ambiguous   XAmbiguous (GhcPass p)
_ XRec (GhcPass p) RdrName
rdr) = XRec (GhcPass p) RdrName
GenLocated SrcSpanAnnN RdrName
rdr

selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
selectorAmbiguousFieldOcc (Unambiguous XUnambiguous GhcTc
sel XRec GhcTc RdrName
_) = XUnambiguous GhcTc
Id
sel
selectorAmbiguousFieldOcc (Ambiguous   XAmbiguous GhcTc
sel XRec GhcTc RdrName
_) = XAmbiguous GhcTc
Id
sel

unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc (Unambiguous XUnambiguous GhcTc
rdr XRec GhcTc RdrName
sel) = XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcTc
XUnambiguous GhcTc
rdr XRec GhcTc RdrName
sel
unambiguousFieldOcc (Ambiguous   XAmbiguous GhcTc
rdr XRec GhcTc RdrName
sel) = XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc GhcTc
XAmbiguous GhcTc
rdr XRec GhcTc RdrName
sel

ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc (FieldOcc XCFieldOcc GhcTc
sel XRec GhcTc RdrName
rdr) = XUnambiguous GhcTc -> XRec GhcTc RdrName -> AmbiguousFieldOcc GhcTc
forall pass.
XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
Unambiguous XCFieldOcc GhcTc
XUnambiguous GhcTc
sel XRec GhcTc RdrName
rdr

{-
************************************************************************
*                                                                      *
                OpName
*                                                                      *
************************************************************************
-}

-- | Name of an operator in an operator application or section
data OpName = NormalOp Name             -- ^ A normal identifier
            | NegateOp                  -- ^ Prefix negation
            | UnboundOp RdrName         -- ^ An unbound identifier
            | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence

instance Outputable OpName where
  ppr :: OpName -> SDoc
ppr (NormalOp Name
n)   = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
  ppr OpName
NegateOp       = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
negateName
  ppr (UnboundOp RdrName
uv) = RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
uv
  ppr (RecFldOp FieldOcc GhcRn
fld) = FieldOcc GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldOcc GhcRn
fld

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

instance OutputableBndrId p => Outputable (HsBndrVar (GhcPass p)) where
  ppr :: HsBndrVar (GhcPass p) -> SDoc
ppr (HsBndrVar XBndrVar (GhcPass p)
_ LIdP (GhcPass p)
name) = GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
name
  ppr (HsBndrWildCard XBndrWildCard (GhcPass p)
_) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_'

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

instance OutputableBndrFlag () p where
  pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr () (GhcPass p) -> SDoc
pprTyVarBndr (HsTvb XTyVarBndr (GhcPass p)
_ ()
_ HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind) = SDoc -> SDoc
decorate (HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
ppr_hs_tvb HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind)
    where decorate :: SDoc -> SDoc
          decorate :: SDoc -> SDoc
decorate SDoc
d = HsBndrKind (GhcPass p) -> SDoc -> SDoc
forall (p :: Pass). HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind HsBndrKind (GhcPass p)
bkind SDoc
d

instance OutputableBndrFlag Specificity p where
  pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr Specificity (GhcPass p) -> SDoc
pprTyVarBndr (HsTvb XTyVarBndr (GhcPass p)
_ Specificity
spec HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind) = SDoc -> SDoc
decorate (HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
ppr_hs_tvb HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind)
    where decorate :: SDoc -> SDoc
          decorate :: SDoc -> SDoc
decorate SDoc
d = case Specificity
spec of
            Specificity
InferredSpec  -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces SDoc
d
            Specificity
SpecifiedSpec -> HsBndrKind (GhcPass p) -> SDoc -> SDoc
forall (p :: Pass). HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind HsBndrKind (GhcPass p)
bkind SDoc
d

instance OutputableBndrFlag (HsBndrVis (GhcPass p')) p where
  pprTyVarBndr :: OutputableBndrId p =>
HsTyVarBndr (HsBndrVis (GhcPass p')) (GhcPass p) -> SDoc
pprTyVarBndr (HsTvb XTyVarBndr (GhcPass p)
_ HsBndrVis (GhcPass p')
bvis HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind) = SDoc -> SDoc
decorate (HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
ppr_hs_tvb HsBndrVar (GhcPass p)
bvar HsBndrKind (GhcPass p)
bkind)
    where decorate :: SDoc -> SDoc
          decorate :: SDoc -> SDoc
decorate SDoc
d = case HsBndrVis (GhcPass p')
bvis of
            HsBndrRequired  XBndrRequired (GhcPass p')
_ -> HsBndrKind (GhcPass p) -> SDoc -> SDoc
forall (p :: Pass). HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind HsBndrKind (GhcPass p)
bkind SDoc
d
            HsBndrInvisible XBndrInvisible (GhcPass p')
_ -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HsBndrKind (GhcPass p) -> SDoc -> SDoc
forall (p :: Pass). HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind HsBndrKind (GhcPass p)
bkind SDoc
d

ppr_hs_tvb :: OutputableBndrId p => HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
ppr_hs_tvb :: forall (p :: Pass).
OutputableBndrId p =>
HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc
ppr_hs_tvb HsBndrVar (GhcPass p)
bvar (HsBndrNoKind XBndrNoKind (GhcPass p)
_) = HsBndrVar (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBndrVar (GhcPass p)
bvar
ppr_hs_tvb HsBndrVar (GhcPass p)
bvar (HsBndrKind XBndrKind (GhcPass p)
_ LHsKind (GhcPass p)
k) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [HsBndrVar (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBndrVar (GhcPass p)
bvar, SDoc
dcolon, GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k]

parens_if_kind :: HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind :: forall (p :: Pass). HsBndrKind (GhcPass p) -> SDoc -> SDoc
parens_if_kind (HsBndrNoKind XBndrNoKind (GhcPass p)
_) SDoc
d = SDoc
d
parens_if_kind (HsBndrKind XBndrKind (GhcPass p)
_ LHsKind (GhcPass p)
_) SDoc
d = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
d

instance OutputableBndrId p => Outputable (HsSigType (GhcPass p)) where
    ppr :: HsSigType (GhcPass p) -> SDoc
ppr (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs (GhcPass p)
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass p)
body }) =
      HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
pprHsOuterSigTyVarBndrs HsOuterSigTyVarBndrs (GhcPass p)
outer_bndrs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
body

instance OutputableBndrId p => Outputable (HsType (GhcPass p)) where
    ppr :: HsType (GhcPass p) -> SDoc
ppr HsType (GhcPass p)
ty = HsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
pprHsType HsType (GhcPass p)
ty

instance OutputableBndrId p
       => Outputable (LHsQTyVars (GhcPass p)) where
    ppr :: LHsQTyVars (GhcPass p) -> SDoc
ppr (HsQTvs { hsq_explicit :: forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit = [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
tvs }) = [GenLocated
   SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
-> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
tvs

instance (OutputableBndrFlag flag p,
          OutputableBndrFlag flag (NoGhcTcPass p),
          OutputableBndrId p)
       => Outputable (HsOuterTyVarBndrs flag (GhcPass p)) where
    ppr :: HsOuterTyVarBndrs flag (GhcPass p) -> SDoc
ppr (HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit (GhcPass p)
imp_tvs}) =
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsOuterImplicit:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
        GhcPass p
GhcPs -> NoExtField -> SDoc
forall a. Outputable a => a -> SDoc
ppr XHsOuterImplicit (GhcPass p)
NoExtField
imp_tvs
        GhcPass p
GhcRn -> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
XHsOuterImplicit (GhcPass p)
imp_tvs
        GhcPass p
GhcTc -> [Id] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Id]
XHsOuterImplicit (GhcPass p)
imp_tvs
    ppr (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
exp_tvs}) =
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsOuterExplicit:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated
   SrcSpanAnnA (HsTyVarBndr flag (GhcPass (NoGhcTcPass p)))]
-> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr flag (GhcPass (NoGhcTcPass p)))]
exp_tvs

instance OutputableBndrId p
       => Outputable (HsForAllTelescope (GhcPass p)) where
    ppr :: HsForAllTelescope (GhcPass p) -> SDoc
ppr (HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () (GhcPass p)]
bndrs }) =
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsForAllVis:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass p))] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () (GhcPass p)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass p))]
bndrs
    ppr (HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity (GhcPass p)]
bndrs }) =
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsForAllInvis:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass p))]
-> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr Specificity (GhcPass p)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass p))]
bndrs

instance (OutputableBndrId p, OutputableBndrFlag flag p)
       => Outputable (HsTyVarBndr flag (GhcPass p)) where
    ppr :: HsTyVarBndr flag (GhcPass p) -> SDoc
ppr = HsTyVarBndr flag (GhcPass p) -> SDoc
forall flag (p :: Pass).
(OutputableBndrFlag flag p, OutputableBndrId p) =>
HsTyVarBndr flag (GhcPass p) -> SDoc
pprTyVarBndr

instance Outputable thing
       => Outputable (HsWildCardBndrs (GhcPass p) thing) where
    ppr :: HsWildCardBndrs (GhcPass p) thing -> SDoc
ppr (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = thing
ty }) = thing -> SDoc
forall a. Outputable a => a -> SDoc
ppr thing
ty

instance (OutputableBndrId p)
       => Outputable (HsPatSigType (GhcPass p)) where
    ppr :: HsPatSigType (GhcPass p) -> SDoc
ppr (HsPS { hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body = LHsType (GhcPass p)
ty }) = GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty


instance (OutputableBndrId p)
       => Outputable (HsTyPat (GhcPass p)) where
    ppr :: HsTyPat (GhcPass p) -> SDoc
ppr (HsTP { hstp_body :: forall pass. HsTyPat pass -> LHsType pass
hstp_body = LHsType (GhcPass p)
ty }) = GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty


instance (OutputableBndrId p)
       => Outputable (HsTyLit (GhcPass p)) where
    ppr :: HsTyLit (GhcPass p) -> SDoc
ppr = HsTyLit (GhcPass p) -> SDoc
forall (p :: Pass). HsTyLit (GhcPass p) -> SDoc
ppr_tylit

instance Outputable HsIPName where
    ppr :: HsIPName -> SDoc
ppr (HsIPName FastString
n) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'?' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
n -- Ordinary implicit parameters

instance OutputableBndr HsIPName where
    pprBndr :: BindingSite -> HsIPName -> SDoc
pprBndr BindingSite
_ HsIPName
n   = HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
n         -- Simple for now
    pprInfixOcc :: HsIPName -> SDoc
pprInfixOcc  HsIPName
n = HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
n
    pprPrefixOcc :: HsIPName -> SDoc
pprPrefixOcc HsIPName
n = HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
n

instance (Outputable tyarg, Outputable arg, Outputable rec)
         => Outputable (HsConDetails tyarg arg rec) where
  ppr :: HsConDetails tyarg arg rec -> SDoc
ppr (PrefixCon [tyarg]
tyargs [arg]
args) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PrefixCon:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((tyarg -> SDoc) -> [tyarg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\tyarg
t -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> tyarg -> SDoc
forall a. Outputable a => a -> SDoc
ppr tyarg
t) [tyarg]
tyargs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [arg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [arg]
args
  ppr (RecCon rec
rec)            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecCon:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> rec -> SDoc
forall a. Outputable a => a -> SDoc
ppr rec
rec
  ppr (InfixCon arg
l arg
r)          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InfixCon:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [arg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [arg
l, arg
r]

instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where
  ppr :: FieldOcc pass -> SDoc
ppr = XRec pass RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (XRec pass RdrName -> SDoc)
-> (FieldOcc pass -> XRec pass RdrName) -> FieldOcc pass -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc pass -> XRec pass RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel

instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where
  pprInfixOcc :: FieldOcc pass -> SDoc
pprInfixOcc  = RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (RdrName -> SDoc)
-> (FieldOcc pass -> RdrName) -> FieldOcc pass -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @pass (XRec pass RdrName -> RdrName)
-> (FieldOcc pass -> XRec pass RdrName) -> FieldOcc pass -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc pass -> XRec pass RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel
  pprPrefixOcc :: FieldOcc pass -> SDoc
pprPrefixOcc = RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (RdrName -> SDoc)
-> (FieldOcc pass -> RdrName) -> FieldOcc pass -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @pass (XRec pass RdrName -> RdrName)
-> (FieldOcc pass -> XRec pass RdrName) -> FieldOcc pass -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc pass -> XRec pass RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel

instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
  pprInfixOcc :: GenLocated SrcSpan (FieldOcc pass) -> SDoc
pprInfixOcc  = FieldOcc pass -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (FieldOcc pass -> SDoc)
-> (GenLocated SrcSpan (FieldOcc pass) -> FieldOcc pass)
-> GenLocated SrcSpan (FieldOcc pass)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (FieldOcc pass) -> FieldOcc pass
forall l e. GenLocated l e -> e
unLoc
  pprPrefixOcc :: GenLocated SrcSpan (FieldOcc pass) -> SDoc
pprPrefixOcc = FieldOcc pass -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (FieldOcc pass -> SDoc)
-> (GenLocated SrcSpan (FieldOcc pass) -> FieldOcc pass)
-> GenLocated SrcSpan (FieldOcc pass)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (FieldOcc pass) -> FieldOcc pass
forall l e. GenLocated l e -> e
unLoc


ppr_tylit :: (HsTyLit (GhcPass p)) -> SDoc
ppr_tylit :: forall (p :: Pass). HsTyLit (GhcPass p) -> SDoc
ppr_tylit (HsNumTy XNumTy (GhcPass p)
source Integer
i) = SourceText -> SDoc -> SDoc
pprWithSourceText XNumTy (GhcPass p)
SourceText
source (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i)
ppr_tylit (HsStrTy XStrTy (GhcPass p)
source FastString
s) = SourceText -> SDoc -> SDoc
pprWithSourceText XStrTy (GhcPass p)
SourceText
source (String -> SDoc
forall doc. IsLine doc => String -> doc
text (FastString -> String
forall a. Show a => a -> String
show FastString
s))
ppr_tylit (HsCharTy XCharTy (GhcPass p)
source Char
c) = SourceText -> SDoc -> SDoc
pprWithSourceText XCharTy (GhcPass p)
SourceText
source (String -> SDoc
forall doc. IsLine doc => String -> doc
text (Char -> String
forall a. Show a => a -> String
show Char
c))

pprAnonWildCard :: SDoc
pprAnonWildCard :: SDoc
pprAnonWildCard = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char 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 :: forall (p :: Pass).
OutputableBndrId p =>
HsOuterFamEqnTyVarBndrs (GhcPass p) -> SDoc
pprHsOuterFamEqnTyVarBndrs (HsOuterImplicit{}) = SDoc
forall doc. IsOutput doc => doc
empty
pprHsOuterFamEqnTyVarBndrs (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr () (NoGhcTc (GhcPass p))]
qtvs}) =
  SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass (NoGhcTcPass p)))]
-> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr () (NoGhcTc (GhcPass p))]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass (NoGhcTcPass p)))]
qtvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
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 :: forall (p :: Pass).
OutputableBndrId p =>
HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = SDoc
forall doc. IsOutput doc => doc
empty
pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
bndrs}) =
  HsForAllTelescope (GhcPass (NoGhcTcPass p))
-> Maybe (LHsContext (GhcPass (NoGhcTcPass p))) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll (EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))]
-> HsForAllTelescope (GhcPass (NoGhcTcPass p))
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallTy
forall a. NoAnn a => a
noAnn [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
[LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))]
bndrs) Maybe (LHsContext (GhcPass (NoGhcTcPass p)))
Maybe
  (GenLocated
     SrcSpanAnnC
     [GenLocated SrcSpanAnnA (HsType (GhcPass (NoGhcTcPass p)))])
forall a. Maybe a
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 :: forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll HsForAllTelescope (GhcPass p)
tele Maybe (LHsContext (GhcPass p))
cxt
  = HsForAllTelescope (GhcPass p) -> SDoc
pp_tele HsForAllTelescope (GhcPass p)
tele SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe (LHsContext (GhcPass p)) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContext Maybe (LHsContext (GhcPass p))
cxt
  where
    pp_tele :: HsForAllTelescope (GhcPass p) -> SDoc
    pp_tele :: HsForAllTelescope (GhcPass p) -> SDoc
pp_tele HsForAllTelescope (GhcPass p)
tele = case HsForAllTelescope (GhcPass p)
tele of
      HsForAllVis   { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs   = [LHsTyVarBndr () (GhcPass p)]
qtvs } -> SDoc -> [LHsTyVarBndr () (GhcPass p)] -> SDoc
forall flag (p :: Pass).
(OutputableBndrId p, OutputableBndrFlag flag p) =>
SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
pp_forall (SDoc
forall doc. IsLine doc => doc
space SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
arrow) [LHsTyVarBndr () (GhcPass p)]
qtvs
      HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity (GhcPass p)]
qtvs } -> SDoc -> [LHsTyVarBndr Specificity (GhcPass p)] -> SDoc
forall flag (p :: Pass).
(OutputableBndrId p, OutputableBndrFlag flag p) =>
SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
pp_forall SDoc
forall doc. IsLine doc => doc
dot [LHsTyVarBndr Specificity (GhcPass p)]
qtvs

    pp_forall :: forall flag p. (OutputableBndrId p, OutputableBndrFlag flag p)
              => SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
    pp_forall :: forall flag (p :: Pass).
(OutputableBndrId p, OutputableBndrFlag flag p) =>
SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
pp_forall SDoc
separator [LHsTyVarBndr flag (GhcPass p)]
qtvs
      | [GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr flag (GhcPass p)]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))]
qtvs = SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
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.
      | Bool
otherwise = SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr flag (GhcPass p)]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))]
qtvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
separator

pprLHsContext :: (OutputableBndrId p)
              => Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContext :: forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContext Maybe (LHsContext (GhcPass p))
Nothing = SDoc
forall doc. IsOutput doc => doc
empty
pprLHsContext (Just LHsContext (GhcPass p)
lctxt) = LHsContext (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsContext (GhcPass p) -> SDoc
pprLHsContextAlways LHsContext (GhcPass p)
lctxt

-- For use in a HsQualTy, which always gets printed if it exists.
pprLHsContextAlways :: (OutputableBndrId p)
                    => LHsContext (GhcPass p) -> SDoc
pprLHsContextAlways :: forall (p :: Pass).
OutputableBndrId p =>
LHsContext (GhcPass p) -> SDoc
pprLHsContextAlways (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt)
  = case [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt of
      []       -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
forall doc. IsOutput doc => doc
empty             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
      [L SrcSpanAnnA
_ HsType (GhcPass p)
ty] -> HsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
ppr_mono_ty HsType (GhcPass p)
ty           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
      [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
_        -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow

pprConDeclFields :: OutputableBndrId p
                 => [LConDeclField (GhcPass p)] -> SDoc
pprConDeclFields :: forall (p :: Pass).
OutputableBndrId p =>
[LConDeclField (GhcPass p)] -> SDoc
pprConDeclFields [LConDeclField (GhcPass p)]
fields = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((GenLocated SrcSpanAnnA (ConDeclField (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (ConDeclField (GhcPass p)) -> SDoc
forall {p :: Pass} {l}.
(OutputableBndr (IdGhcP p),
 OutputableBndr (IdGhcP (NoGhcTcPass p)), IsPass p,
 Outputable (GenLocated (Anno (IdGhcP p)) (IdGhcP p)),
 Outputable
   (GenLocated
      (Anno (IdGhcP (NoGhcTcPass p))) (IdGhcP (NoGhcTcPass p)))) =>
GenLocated l (ConDeclField (GhcPass p)) -> SDoc
ppr_fld [LConDeclField (GhcPass p)]
[GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))]
fields)))
  where
    ppr_fld :: GenLocated l (ConDeclField (GhcPass p)) -> SDoc
ppr_fld (L l
_ (ConDeclField { cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names = [LFieldOcc (GhcPass p)]
ns, cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type = LBangType (GhcPass p)
ty,
                                 cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
cd_fld_doc = Maybe (LHsDoc (GhcPass p))
doc }))
        = Maybe (LHsDoc (GhcPass p)) -> SDoc -> SDoc
forall name. Maybe (LHsDoc name) -> SDoc -> SDoc
pprMaybeWithDoc Maybe (LHsDoc (GhcPass p))
doc ([LFieldOcc (GhcPass p)] -> SDoc
forall (p :: Pass). [LFieldOcc (GhcPass p)] -> SDoc
ppr_names [LFieldOcc (GhcPass p)]
ns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LBangType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty)

    ppr_names :: [LFieldOcc (GhcPass p)] -> SDoc
    ppr_names :: forall (p :: Pass). [LFieldOcc (GhcPass p)] -> SDoc
ppr_names [LFieldOcc (GhcPass p)
n] = GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc LFieldOcc (GhcPass p)
GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))
n
    ppr_names [LFieldOcc (GhcPass p)]
ns = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (FieldOcc (GhcPass p)) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc [LFieldOcc (GhcPass p)]
[GenLocated SrcSpanAnnA (FieldOcc (GhcPass p))]
ns))

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

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

ppr_mono_lty :: OutputableBndrId p
             => LHsType (GhcPass p) -> SDoc
ppr_mono_lty :: forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty = HsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
ppr_mono_ty (GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> HsType (GhcPass p)
forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty)

ppr_mono_ty :: forall p. (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
ppr_mono_ty :: forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
ppr_mono_ty (HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope (GhcPass p)
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass p)
ty })
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll HsForAllTelescope (GhcPass p)
tele Maybe (LHsContext (GhcPass p))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass p))])
forall a. Maybe a
Nothing, LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty]

ppr_mono_ty (HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext (GhcPass p)
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass p)
ty })
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [LHsContext (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsContext (GhcPass p) -> SDoc
pprLHsContextAlways LHsContext (GhcPass p)
ctxt, LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty]

ppr_mono_ty (HsBangTy XBangTy (GhcPass p)
_ HsBang
b LHsType (GhcPass p)
ty)           = HsBang -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBang
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty
ppr_mono_ty (HsRecTy XRecTy (GhcPass p)
_ [LConDeclField (GhcPass p)]
flds)            = [LConDeclField (GhcPass p)] -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
[LConDeclField (GhcPass p)] -> SDoc
pprConDeclFields [LConDeclField (GhcPass p)]
flds
ppr_mono_ty (HsTyVar XTyVar (GhcPass p)
_ PromotionFlag
prom (L Anno (IdGhcP p)
_ IdGhcP p
name)) = LexicalFixity -> PromotionFlag -> IdGhcP p -> SDoc
forall a.
OutputableBndr a =>
LexicalFixity -> PromotionFlag -> a -> SDoc
pprOccWithTick LexicalFixity
Prefix PromotionFlag
prom IdGhcP p
name
ppr_mono_ty (HsFunTy XFunTy (GhcPass p)
_ HsArrow (GhcPass p)
mult LHsType (GhcPass p)
ty1 LHsType (GhcPass p)
ty2)    = HsArrow (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsArrow (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
ppr_fun_ty HsArrow (GhcPass p)
mult LHsType (GhcPass p)
ty1 LHsType (GhcPass p)
ty2
ppr_mono_ty (HsTupleTy XTupleTy (GhcPass p)
_ HsTupleSort
con [LHsType (GhcPass p)]
tys)
    -- Special-case unary boxed tuples so that they are pretty-printed as
    -- `Solo x`, not `(x)`
  | [LHsType (GhcPass p)
ty] <- [LHsType (GhcPass p)]
tys
  , TupleSort
BoxedTuple <- TupleSort
std_con
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text (Boxity -> NameSpace -> Int -> String
mkTupleStr Boxity
Boxed NameSpace
tcName Int
1), LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty]
  | Bool
otherwise
  = TupleSort -> SDoc -> SDoc
tupleParens TupleSort
std_con ((GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsType (GhcPass p)]
[GenLocated SrcSpanAnnA (HsType (GhcPass p))]
tys)
  where std_con :: TupleSort
std_con = case HsTupleSort
con of
                    HsTupleSort
HsUnboxedTuple -> TupleSort
UnboxedTuple
                    HsTupleSort
_              -> TupleSort
BoxedTuple
ppr_mono_ty (HsSumTy XSumTy (GhcPass p)
_ [LHsType (GhcPass p)]
tys)
  = TupleSort -> SDoc -> SDoc
tupleParens TupleSort
UnboxedTuple ((GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsType (GhcPass p)]
[GenLocated SrcSpanAnnA (HsType (GhcPass p))]
tys)
ppr_mono_ty (HsKindSig XKindSig (GhcPass p)
_ LHsType (GhcPass p)
ty LHsType (GhcPass p)
kind)
  = LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
kind
ppr_mono_ty (HsListTy XListTy (GhcPass p)
_ LHsType (GhcPass p)
ty)       = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty)
ppr_mono_ty (HsIParamTy XIParamTy (GhcPass p)
_ XRec (GhcPass p) HsIPName
n LHsType (GhcPass p)
ty)   = (GenLocated EpAnnCO HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) HsIPName
GenLocated EpAnnCO HsIPName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty)
ppr_mono_ty (HsSpliceTy XSpliceTy (GhcPass p)
ext HsUntypedSplice (GhcPass p)
s)    =
    case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True Maybe Name
forall a. Maybe a
Nothing HsUntypedSplice (GhcPass p)
s
      GhcPass p
GhcRn | HsUntypedSpliceNested Name
n <- XSpliceTy (GhcPass p)
ext -> Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n) HsUntypedSplice (GhcPass p)
s
      GhcPass p
GhcRn | HsUntypedSpliceTop ThModFinalizers
_ GenLocated SrcSpanAnnA (HsType GhcRn)
t  <- XSpliceTy (GhcPass p)
ext -> GenLocated SrcSpanAnnA (HsType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (HsType GhcRn)
t
      GhcPass p
GhcTc -> Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True Maybe Name
forall a. Maybe a
Nothing HsUntypedSplice (GhcPass p)
s
ppr_mono_ty (HsExplicitListTy XExplicitListTy (GhcPass p)
_ PromotionFlag
prom [LHsType (GhcPass p)]
tys)
  | PromotionFlag -> Bool
isPromoted PromotionFlag
prom = SDoc -> SDoc
quote (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([LHsType (GhcPass p)] -> SDoc -> SDoc
forall (p :: Pass). [LHsType (GhcPass p)] -> SDoc -> SDoc
maybeAddSpace [LHsType (GhcPass p)]
tys (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (GhcPass p)]
[GenLocated SrcSpanAnnA (HsType (GhcPass p))]
tys)
  | Bool
otherwise       = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (GhcPass p)]
[GenLocated SrcSpanAnnA (HsType (GhcPass p))]
tys)
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy (GhcPass p)
_ [LHsType (GhcPass p)]
tys)
    -- Special-case unary boxed tuples so that they are pretty-printed as
    -- `'MkSolo x`, not `'(x)`
  | [LHsType (GhcPass p)
ty] <- [LHsType (GhcPass p)]
tys
  = SDoc -> SDoc
quoteIfPunsEnabled (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text (Boxity -> NameSpace -> Int -> String
mkTupleStr Boxity
Boxed NameSpace
dataName Int
1), LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty]
  | Bool
otherwise
  = SDoc -> SDoc
quoteIfPunsEnabled (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([LHsType (GhcPass p)] -> SDoc -> SDoc
forall (p :: Pass). [LHsType (GhcPass p)] -> SDoc -> SDoc
maybeAddSpace [LHsType (GhcPass p)]
tys (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsType (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (GhcPass p)]
[GenLocated SrcSpanAnnA (HsType (GhcPass p))]
tys)
ppr_mono_ty (HsTyLit XTyLit (GhcPass p)
_ HsTyLit (GhcPass p)
t)       = HsTyLit (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyLit (GhcPass p)
t
ppr_mono_ty (HsWildCardTy {})   = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_'

ppr_mono_ty (HsStarTy XStarTy (GhcPass p)
_ Bool
isUni)  = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char (if Bool
isUni then Char
'★' else Char
'*')

ppr_mono_ty (HsAppTy XAppTy (GhcPass p)
_ LHsType (GhcPass p)
fun_ty LHsType (GhcPass p)
arg_ty)
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
fun_ty, LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
arg_ty]
ppr_mono_ty (HsAppKindTy XAppKindTy (GhcPass p)
_ LHsType (GhcPass p)
ty LHsType (GhcPass p)
k)
  = LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
k
ppr_mono_ty (HsOpTy XOpTy (GhcPass p)
_ PromotionFlag
prom LHsType (GhcPass p)
ty1 (L Anno (IdGhcP p)
_ IdGhcP p
op) LHsType (GhcPass p)
ty2)
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty1
        , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [LexicalFixity -> PromotionFlag -> IdGhcP p -> SDoc
forall a.
OutputableBndr a =>
LexicalFixity -> PromotionFlag -> a -> SDoc
pprOccWithTick LexicalFixity
Infix PromotionFlag
prom IdGhcP p
op, LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty2 ] ]
ppr_mono_ty (HsParTy XParTy (GhcPass p)
_ LHsType (GhcPass p)
ty)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
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 XDocTy (GhcPass p)
_ LHsType (GhcPass p)
ty LHsDoc (GhcPass p)
doc)
  = LHsDoc (GhcPass p) -> SDoc -> SDoc
forall name. LHsDoc name -> SDoc -> SDoc
pprWithDoc LHsDoc (GhcPass p)
doc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty

ppr_mono_ty (XHsType XXType (GhcPass p)
t) = HsCoreTy -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXType (GhcPass p)
HsCoreTy
t

--------------------------
ppr_fun_ty :: (OutputableBndrId p)
           => HsArrow (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
ppr_fun_ty :: forall (p :: Pass).
OutputableBndrId p =>
HsArrow (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc
ppr_fun_ty HsArrow (GhcPass p)
mult LHsType (GhcPass p)
ty1 LHsType (GhcPass p)
ty2
  = let p1 :: SDoc
p1 = LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty1
        p2 :: SDoc
p2 = LHsType (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty2
        arr :: SDoc
arr = HsArrowOf (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
-> SDoc
forall mult (pass :: Pass).
(Outputable mult, OutputableBndrId pass) =>
HsArrowOf mult (GhcPass pass) -> SDoc
pprHsArrow HsArrow (GhcPass p)
HsArrowOf (GenLocated SrcSpanAnnA (HsType (GhcPass p))) (GhcPass p)
mult
    in
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
p1, SDoc
arr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
p2]

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

    go_core_ty :: HsCoreTy -> Bool
go_core_ty (TyVarTy{})    = Bool
False
    go_core_ty (AppTy{})      = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_core_ty (TyConApp TyCon
_ [HsCoreTy]
args)
      | [HsCoreTy] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsCoreTy]
args             = Bool
False
      | Bool
otherwise             = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_core_ty (ForAllTy{})   = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
funPrec
    go_core_ty (FunTy{})      = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
funPrec
    go_core_ty (LitTy{})      = Bool
False
    go_core_ty (CastTy HsCoreTy
t KindCoercion
_)   = HsCoreTy -> Bool
go_core_ty HsCoreTy
t
    go_core_ty (CoercionTy{}) = Bool
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 :: forall (p :: Pass). [LHsType (GhcPass p)] -> SDoc -> SDoc
maybeAddSpace [LHsType (GhcPass p)]
tys SDoc
doc
  | (LHsType (GhcPass p)
ty : [LHsType (GhcPass p)]
_) <- [LHsType (GhcPass p)]
tys
  , LHsType (GhcPass p) -> Bool
forall (p :: Pass). LHsType (GhcPass p) -> Bool
lhsTypeHasLeadingPromotionQuote LHsType (GhcPass p)
ty = SDoc
forall doc. IsLine doc => doc
space SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
doc
  | Bool
otherwise                          = SDoc
doc

lhsTypeHasLeadingPromotionQuote :: LHsType (GhcPass p) -> Bool
lhsTypeHasLeadingPromotionQuote :: forall (p :: Pass). LHsType (GhcPass p) -> Bool
lhsTypeHasLeadingPromotionQuote XRec (GhcPass p) (HsType (GhcPass p))
ty
  = GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> Bool
forall {pass} {l} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass),
 XRec pass [GenLocated l (HsType pass)]
 ~ GenLocated l [GenLocated l (HsType pass)]) =>
GenLocated l (HsType pass) -> Bool
goL XRec (GhcPass p) (HsType (GhcPass p))
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty
  where
    goL :: GenLocated l (HsType pass) -> Bool
goL (L l
_ HsType pass
ty) = HsType pass -> Bool
go HsType pass
ty

    go :: HsType pass -> Bool
go (HsForAllTy{})        = Bool
False
    go (HsQualTy{ hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext pass
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
body})
      | (L l
_ (GenLocated l (HsType pass)
c:[GenLocated l (HsType pass)]
_)) <- LHsContext pass
ctxt = GenLocated l (HsType pass) -> Bool
goL GenLocated l (HsType pass)
c
      | Bool
otherwise            = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
body
    go (HsBangTy{})          = Bool
False
    go (HsRecTy{})           = Bool
False
    go (HsTyVar XTyVar pass
_ PromotionFlag
p LIdP pass
_)       = PromotionFlag -> Bool
isPromoted PromotionFlag
p
    go (HsFunTy XFunTy pass
_ HsArrow pass
_ XRec pass (HsType pass)
arg XRec pass (HsType pass)
_)   = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
arg
    go (HsListTy{})          = Bool
False
    go (HsTupleTy{})         = Bool
False
    go (HsSumTy{})           = Bool
False
    go (HsOpTy XOpTy pass
_ PromotionFlag
_ XRec pass (HsType pass)
t1 LIdP pass
_ XRec pass (HsType pass)
_)   = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
t1
    go (HsKindSig XKindSig pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_)     = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (HsIParamTy{})        = Bool
False
    go (HsSpliceTy{})        = Bool
False
    go (HsExplicitListTy XExplicitListTy pass
_ PromotionFlag
p [XRec pass (HsType pass)]
_) = PromotionFlag -> Bool
isPromoted PromotionFlag
p
    go (HsExplicitTupleTy{}) = Bool
True
    go (HsTyLit{})           = Bool
False
    go (HsWildCardTy{})      = Bool
False
    go (HsStarTy{})          = Bool
False
    go (HsAppTy XAppTy pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_)       = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (HsAppKindTy XAppKindTy pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_)   = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (HsParTy{})           = Bool
False
    go (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
t LHsDoc pass
_)       = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
GenLocated l (HsType pass)
t
    go (XHsType{})           = Bool
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 :: forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
p lty :: LHsType (GhcPass p)
lty@(L SrcSpanAnnA
loc HsType (GhcPass p)
ty)
  | PprPrec -> HsType (GhcPass p) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
p HsType (GhcPass p)
ty = SrcSpanAnnA
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
AnnParen
forall a. NoAnn a => a
noAnn LHsType (GhcPass p)
lty)
  | Bool
otherwise              = LHsType (GhcPass p)
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 :: forall (p :: Pass).
PprPrec -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
parenthesizeHsContext PprPrec
p lctxt :: LHsContext (GhcPass p)
lctxt@(L SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt) =
  case [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt of
    [GenLocated SrcSpanAnnA (HsType (GhcPass p))
c] -> SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
loc [PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
p LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
c]
    [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
_   -> LHsContext (GhcPass p)
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 = EpAnnCO
type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA

type instance Anno (FieldOcc (GhcPass p)) = SrcSpanAnnA
type instance Anno (AmbiguousFieldOcc (GhcPass p)) = SrcSpanAnnA