{-# 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(..), arrowToHsType,
        HsLinearArrowTokens(..),
        hsLinear, hsUnrestricted, isUnrestricted,
        pprHsArrow,

        HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
        HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
        HsBndrVis(..), isHsBndrInvisible,
        LHsQTyVars(..),
        HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
        HsWildCardBndrs(..),
        HsPatSigType(..), HsPSRn(..),
        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,
        mkEmptyWildCardBndrs,
        mkHsForAllVisTele, mkHsForAllInvisTele,
        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,
        isHsKindedTyVar, hsTvbAllKinded,
        hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards,
        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,
        splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
        splitLHsPatSynTy,
        splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy,
        splitLHsSigmaTyInvis, splitLHsGadtTy,
        splitHsFunType, hsTyGetAppHead_maybe,
        mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
        ignoreParens, hsSigWcType, hsPatSigType,
        hsTyKindSig,
        setHsTyVarBndrFlag, hsTyVarBndrFlag, 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.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Core.DataCon( SrcStrictness(..), SrcUnpackedness(..), HsImplBang(..) )
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

{-
************************************************************************
*                                                                      *
\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)
_ HsSrcBang
_ LHsType (GhcPass p)
lty))       = LHsType (GhcPass p)
lty
getBangType (L SrcSpanAnnA
_ (HsDocTy XDocTy (GhcPass p)
x (L SrcSpanAnnA
_ (HsBangTy XBangTy (GhcPass p)
_ HsSrcBang
_ 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 e1 e2 e3 ann.
GenLocated (SrcSpanAnn' a) e1
-> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3
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 XBangTy (GhcPass p)
_ HsSrcBang
s LHsType (GhcPass p)
_))     = HsSrcBang
s
getBangStrictness (L SrcSpanAnnA
_ (HsDocTy XDocTy (GhcPass p)
_ (L SrcSpanAnnA
_ (HsBangTy XBangTy (GhcPass p)
_ HsSrcBang
s LHsType (GhcPass p)
_)) LHsDoc (GhcPass p)
_)) = HsSrcBang
s
getBangStrictness LHsType (GhcPass p)
_ = (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang 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 (SrcAnn AnnContext) (HsContext (GhcPass p))
-> HsContext (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated (SrcAnn AnnContext) (HsContext (GhcPass p))
 -> HsContext (GhcPass p))
-> GenLocated (SrcAnn AnnContext) (HsContext (GhcPass p))
-> HsContext (GhcPass p)
forall a b. (a -> b) -> a -> b
$ LocatedAn AnnContext [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> Maybe
     (LocatedAn
        AnnContext [GenLocated SrcSpanAnnA (HsType (GhcPass p))])
-> LocatedAn
     AnnContext [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
forall a. a -> Maybe a -> a
fromMaybe ([GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> LocatedAn
     AnnContext [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
forall a an. a -> LocatedAn an a
noLocA []) Maybe (LHsContext (GhcPass p))
Maybe
  (LocatedAn
     AnnContext [GenLocated SrcSpanAnnA (HsType (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

-- | 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

type instance XXHsPatSigType (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 }

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 XUserTyVar    (GhcPass _) = EpAnn [AddEpAnn]
type instance XKindedTyVar  (GhcPass _) = EpAnn [AddEpAnn]

type instance XXTyVarBndr   (GhcPass _) = DataConCantHappen

-- | Return the attached flag
hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag :: forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag (UserTyVar XUserTyVar (GhcPass pass)
_ flag
fl LIdP (GhcPass pass)
_)     = flag
fl
hsTyVarBndrFlag (KindedTyVar XKindedTyVar (GhcPass pass)
_ flag
fl LIdP (GhcPass pass)
_ LHsKind (GhcPass pass)
_) = flag
fl
-- By specialising to (GhcPass p) we know that XXTyVarBndr is DataConCantHappen
-- so these two equations are 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
f (UserTyVar XUserTyVar (GhcPass pass)
x flag'
_ LIdP (GhcPass pass)
l)     = XUserTyVar (GhcPass pass)
-> flag -> LIdP (GhcPass pass) -> HsTyVarBndr flag (GhcPass pass)
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar (GhcPass pass)
x flag
f LIdP (GhcPass pass)
l
setHsTyVarBndrFlag flag
f (KindedTyVar XKindedTyVar (GhcPass pass)
x flag'
_ LIdP (GhcPass pass)
l LHsKind (GhcPass pass)
k) = XKindedTyVar (GhcPass pass)
-> flag
-> LIdP (GhcPass pass)
-> LHsKind (GhcPass pass)
-> HsTyVarBndr flag (GhcPass pass)
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar (GhcPass pass)
x flag
f LIdP (GhcPass pass)
l LHsKind (GhcPass pass)
k

-- | 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 (UserTyVar   XUserTyVar (GhcPass pass)
x flag
flag LIdP (GhcPass pass)
name)    = XUserTyVar (GhcPass pass)
-> flag' -> LIdP (GhcPass pass) -> HsTyVarBndr flag' (GhcPass pass)
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar   XUserTyVar (GhcPass pass)
x (flag -> flag'
f flag
flag) LIdP (GhcPass pass)
name
updateHsTyVarBndrFlag flag -> flag'
f (KindedTyVar XKindedTyVar (GhcPass pass)
x flag
flag LIdP (GhcPass pass)
name LHsKind (GhcPass pass)
ki) = XKindedTyVar (GhcPass pass)
-> flag'
-> LIdP (GhcPass pass)
-> LHsKind (GhcPass pass)
-> HsTyVarBndr flag' (GhcPass pass)
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar (GhcPass pass)
x (flag -> flag'
f flag
flag) LIdP (GhcPass pass)
name LHsKind (GhcPass pass)
ki

-- | 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

instance NamedThing (HsTyVarBndr flag GhcRn) where
  getName :: HsTyVarBndr flag GhcRn -> Name
getName (UserTyVar XUserTyVar GhcRn
_ flag
_ LIdP GhcRn
v) = GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
v
  getName (KindedTyVar XKindedTyVar GhcRn
_ flag
_ LIdP GhcRn
v LHsKind GhcRn
_) = GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
v

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

type instance XAppKindTy       (GhcPass _) = NoExtField

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

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

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

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

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

type instance XTyLit           (GhcPass _) = NoExtField

type instance XWildCardTy      (GhcPass _) = NoExtField

type instance XXType         (GhcPass _) = HsCoreTy

-- 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


oneDataConHsTy :: HsType GhcRn
oneDataConHsTy :: HsType GhcRn
oneDataConHsTy = XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted (Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
oneDataConName)

manyDataConHsTy :: HsType GhcRn
manyDataConHsTy :: HsType GhcRn
manyDataConHsTy = XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted (Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
manyDataConName)

hsLinear :: a -> HsScaled (GhcPass p) a
hsLinear :: forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear = HsArrow (GhcPass p) -> a -> HsScaled (GhcPass p) a
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled (HsLinearArrowTokens (GhcPass p) -> HsArrow (GhcPass p)
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "%1" (GhcPass p)
-> LHsUniToken "->" "\8594" (GhcPass p)
-> HsLinearArrowTokens (GhcPass p)
forall pass.
LHsToken "%1" pass
-> LHsUniToken "->" "\8594" pass -> HsLinearArrowTokens pass
HsPct1 LHsToken "%1" (GhcPass p)
GenLocated TokenLocation (HsToken "%1")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsUniToken "->" "\8594" (GhcPass p)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok))

hsUnrestricted :: a -> HsScaled (GhcPass p) a
hsUnrestricted :: forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsUnrestricted = HsArrow (GhcPass p) -> a -> HsScaled (GhcPass p) a
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled (LHsUniToken "->" "\8594" (GhcPass p) -> HsArrow (GhcPass p)
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" (GhcPass p)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok)

isUnrestricted :: HsArrow GhcRn -> Bool
isUnrestricted :: HsArrow GhcRn -> Bool
isUnrestricted (HsArrow GhcRn -> LHsKind 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

-- | Convert an arrow into its corresponding multiplicity. In essence this
-- erases the information of whether the programmer wrote an explicit
-- multiplicity or a shorthand.
arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
arrowToHsType :: HsArrow GhcRn -> LHsKind GhcRn
arrowToHsType (HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcRn
_) = HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
manyDataConHsTy
arrowToHsType (HsLinearArrow HsLinearArrowTokens GhcRn
_) = HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
oneDataConHsTy
arrowToHsType (HsExplicitMult LHsToken "%" GhcRn
_ LHsKind GhcRn
p LHsUniToken "->" "\8594" GhcRn
_) = LHsKind GhcRn
p

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

-- See #18846
pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc
pprHsArrow :: forall (pass :: Pass).
OutputableBndrId pass =>
HsArrow (GhcPass pass) -> SDoc
pprHsArrow (HsUnrestrictedArrow LHsUniToken "->" "\8594" (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 HsLinearArrowTokens (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 LHsToken "%" (GhcPass pass)
_ LHsType (GhcPass pass)
p LHsUniToken "->" "\8594" (GhcPass pass)
_)  = FunTyFlag -> Either Bool SDoc -> SDoc
pprArrowWithMultiplicity FunTyFlag
visArgTypeLike (SDoc -> Either Bool SDoc
forall a b. b -> Either a b
Right (GenLocated SrcSpanAnnA (HsType (GhcPass pass)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass pass)
GenLocated SrcSpanAnnA (HsType (GhcPass pass))
p))

type instance XConDeclField  (GhcPass _) = EpAnn [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 (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LFieldOcc (GhcPass p)]
[GenLocated (SrcAnn NoEpAnns) (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 :: LHsKind 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 LHsKind GhcRn
_ = []

---------------------
hsTyVarLName :: HsTyVarBndr flag (GhcPass p) -> LIdP (GhcPass p)
hsTyVarLName :: forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> LIdP (GhcPass p)
hsTyVarLName (UserTyVar XUserTyVar (GhcPass p)
_ flag
_ LIdP (GhcPass p)
n)     = LIdP (GhcPass p)
n
hsTyVarLName (KindedTyVar XKindedTyVar (GhcPass p)
_ flag
_ LIdP (GhcPass p)
n LHsKind (GhcPass p)
_) = LIdP (GhcPass p)
n

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

hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName :: forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
HsTyVarBndr flag (GhcPass p) -> IdGhcP p
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName (HsTyVarBndr flag (GhcPass p) -> IdGhcP p)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
    -> HsTyVarBndr flag (GhcPass p))
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))
-> 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)) -> IdGhcP p)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))]
-> [IdGhcP p]
forall a b. (a -> b) -> [a] -> [b]
map XRec (GhcPass p) (HsTyVarBndr flag (GhcPass p)) -> IdP (GhcPass p)
GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p)) -> IdGhcP p
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName

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 = (GenLocated
   SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
 -> IdGhcP p)
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
-> [IdGhcP p]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p) -> IdP (GhcPass p)
GenLocated
  SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> IdGhcP p
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName (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) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName :: forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName (L SrcSpanAnnA
_ HsTyVarBndr flag (GhcPass p)
a) = HsTyVarBndr flag (GhcPass p) -> LIdP (GhcPass p)
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> 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))
 -> LocatedN (IdGhcP p))
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))]
-> [LocatedN (IdGhcP p)]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)
-> GenLocated SrcSpanAnnN (IdP (GhcPass p))
GenLocated
  SrcSpanAnnA (HsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p))
-> LocatedN (IdGhcP p)
forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> 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 XOpTy (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn 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 a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA 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 (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec 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 :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p)
              -> LHsType (GhcPass p)
mkHsAppKindTy :: forall (p :: Pass).
LHsType (GhcPass p)
-> LHsToken "@" (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
mkHsAppKindTy LHsType (GhcPass p)
ty LHsToken "@" (GhcPass p)
at LHsType (GhcPass p)
k
  = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k (XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsToken "@" (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XAppKindTy pass
-> LHsType pass -> LHsToken "@" pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
ty LHsToken "@" (GhcPass p)
at 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]
++ EpAnn AnnParen -> [AddEpAnn]
annParen2AddEpAnn XParTy (GhcPass p)
EpAnn AnnParen
an
          cs' :: EpAnnComments
cs' = EpAnnComments
cs EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
S.<> EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments (SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
l) EpAnnComments -> EpAnnComments -> EpAnnComments
forall a. Semigroup a => a -> a -> a
S.<> EpAnn AnnParen -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments XParTy (GhcPass p)
EpAnn AnnParen
an
        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 (EpAnn Anchor
_ NoEpAnns
_ EpAnnComments
cs) 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.<> EpAnn AnnListItem -> EpAnnComments
forall an. EpAnn an -> EpAnnComments
epAnnComments (SrcSpanAnnA -> EpAnn AnnListItem
forall a. SrcSpanAnn' a -> a
ann 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 GenLocated SrcSpanAnnA (HsType (GhcPass p))
x'HsScaled (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)
      where
        L SrcSpanAnnA
l HsType (GhcPass p)
t = LHsType (GhcPass p)
x
        x' :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
x' = SrcSpanAnnA
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> EpAnnComments -> SrcSpanAnnA
forall ann. Monoid ann => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn SrcSpanAnnA
l EpAnnComments
cs) HsType (GhcPass p)
t

    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 LHsToken "@" pass
_ 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

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

-- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'.
lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan
lhsTypeArgSrcSpan :: forall (pass :: Pass). LHsTypeArg (GhcPass pass) -> SrcSpan
lhsTypeArgSrcSpan LHsTypeArg (GhcPass pass)
arg = case LHsTypeArg (GhcPass pass)
arg of
  HsValArg  LHsType (GhcPass pass)
tm    -> GenLocated SrcSpanAnnA (HsType (GhcPass pass)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType (GhcPass pass)
GenLocated SrcSpanAnnA (HsType (GhcPass pass))
tm
  HsTypeArg LHsToken "@" (GhcPass pass)
at LHsType (GhcPass pass)
ty -> TokenLocation -> SrcSpan
getTokenSrcSpan (GenLocated TokenLocation (HsToken "@") -> TokenLocation
forall l e. GenLocated l e -> l
getLoc LHsToken "@" (GhcPass pass)
GenLocated TokenLocation (HsToken "@")
at) SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` GenLocated SrcSpanAnnA (HsType (GhcPass pass)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType (GhcPass pass)
GenLocated SrcSpanAnnA (HsType (GhcPass pass))
ty
  HsArgPar  SrcSpan
sp    -> SrcSpan
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 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 p tm ty] -> SDoc
pprHsArgsApp :: forall id tm ty p.
(OutputableBndr id, Outputable tm, Outputable ty) =>
id -> LexicalFixity -> [HsArg p tm ty] -> SDoc
pprHsArgsApp id
thing LexicalFixity
fixity (HsArg p tm ty
argl:HsArg p tm ty
argr:[HsArg 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 p tm ty -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
HsArg p tm ty -> SDoc
ppr_single_hs_arg HsArg p tm ty
argl
                         , id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc id
thing
                         , HsArg p tm ty -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
HsArg p tm ty -> SDoc
ppr_single_hs_arg HsArg p tm ty
argr ] in
    case [HsArg p tm ty]
args of
      [] -> SDoc
pp_op_app
      [HsArg p tm ty]
_  -> SDoc -> [HsArg p tm ty] -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
pp_op_app) [HsArg p tm ty]
args

pprHsArgsApp id
thing LexicalFixity
_fixity [HsArg p tm ty]
args
  = SDoc -> [HsArg p tm ty] -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app (id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc id
thing) [HsArg 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 p tm ty] -> SDoc
ppr_hs_args_prefix_app :: forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app SDoc
acc []         = SDoc
acc
ppr_hs_args_prefix_app SDoc
acc (HsArg p tm ty
arg:[HsArg p tm ty]
args) =
  case HsArg p tm ty
arg of
    HsValArg{}  -> SDoc -> [HsArg p tm ty] -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc
acc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArg p tm ty -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
HsArg p tm ty -> SDoc
ppr_single_hs_arg HsArg p tm ty
arg) [HsArg p tm ty]
args
    HsTypeArg{} -> SDoc -> [HsArg p tm ty] -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc
acc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArg p tm ty -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
HsArg p tm ty -> SDoc
ppr_single_hs_arg HsArg p tm ty
arg) [HsArg p tm ty]
args
    HsArgPar{}  -> SDoc -> [HsArg p tm ty] -> SDoc
forall tm ty p.
(Outputable tm, Outputable ty) =>
SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
acc) [HsArg p tm ty]
args

-- | Pretty-print an 'HsArg' in isolation.
ppr_single_hs_arg :: (Outputable tm, Outputable ty)
                  => HsArg p tm ty -> SDoc
ppr_single_hs_arg :: forall tm ty p.
(Outputable tm, Outputable ty) =>
HsArg p tm ty -> SDoc
ppr_single_hs_arg (HsValArg tm
tm)    = tm -> SDoc
forall a. Outputable a => a -> SDoc
ppr tm
tm
ppr_single_hs_arg (HsTypeArg LHsToken "@" 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 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 LHsToken "@" (GhcPass p)
at ty
ty) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsTypeArg" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated TokenLocation (HsToken "@") -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsToken "@" (GhcPass p)
GenLocated TokenLocation (HsToken "@")
at SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ty -> SDoc
forall a. Outputable a => a -> SDoc
ppr ty
ty
  ppr (HsArgPar SrcSpan
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
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
    ((EpAnnForallTy
_an, [LHsTyVarBndr Specificity (GhcPass p)]
exis), LHsType (GhcPass p)
ty3) = LHsType (GhcPass p)
-> ((EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass p)]),
    LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> ((EpAnnForallTy, [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
  | ((EpAnnForallTy
_an,[LHsTyVarBndr Specificity (GhcPass p)]
tvs), LHsType (GhcPass p)
ty1) <- LHsType (GhcPass p)
-> ((EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass p)]),
    LHsType (GhcPass p))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> ((EpAnnForallTy, [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) -> ( (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
                            , LHsType (GhcPass pass))
splitLHsForAllTyInvis :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> ((EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)]),
    LHsType (GhcPass pass))
splitLHsForAllTyInvis LHsType (GhcPass pass)
ty
  | ((Maybe (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
mb_tvbs), LHsType (GhcPass pass)
body) <- LHsType (GhcPass pass)
-> (Maybe
      (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)]),
    LHsType (GhcPass pass))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe
      (EpAnnForallTy, [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)
  = ((EpAnnForallTy,
 [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))])
-> Maybe
     (EpAnnForallTy,
      [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))])
-> (EpAnnForallTy,
    [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))])
forall a. a -> Maybe a -> a
fromMaybe (EpAnnForallTy
forall a. EpAnn a
EpAnnNotUsed,[]) Maybe (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
Maybe
  (EpAnnForallTy,
   [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 (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
                            , LHsType (GhcPass pass))
splitLHsForAllTyInvis_KP :: forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe
      (EpAnnForallTy, [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_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_xinvis = XHsForAllInvis (GhcPass pass)
an
                                          , 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 }
      -> ((EpAnnForallTy,
 [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))])
-> Maybe
     (EpAnnForallTy,
      [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))])
forall a. a -> Maybe a
Just (XHsForAllInvis (GhcPass pass)
EpAnnForallTy
an, [LHsTyVarBndr Specificity (GhcPass pass)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass pass))]
tvs), LHsType (GhcPass pass)
body)
    HsType (GhcPass pass)
_ -> (Maybe (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)])
Maybe
  (EpAnnForallTy,
   [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
  (SrcAnn AnnContext)
  [GenLocated SrcSpanAnnA (HsType (GhcPass pass))]
-> Maybe
     (GenLocated
        (SrcAnn AnnContext)
        [GenLocated SrcSpanAnnA (HsType (GhcPass pass))])
forall a. a -> Maybe a
Just LHsContext (GhcPass pass)
GenLocated
  (SrcAnn AnnContext)
  [GenLocated SrcSpanAnnA (HsType (GhcPass pass))]
ctxt, LHsType (GhcPass pass)
body)
splitLHsQualTy_KP LHsType (GhcPass pass)
body = (Maybe (LHsContext (GhcPass pass))
Maybe
  (GenLocated
     (SrcAnn AnnContext)
     [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), LHsKind 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 = LHsKind GhcRn
inst_ty})) =
  (HsOuterSigTyVarBndrs GhcRn -> [Name]
forall flag. HsOuterTyVarBndrs flag GhcRn -> [Name]
hsOuterTyVarNames HsOuterSigTyVarBndrs GhcRn
outer_bndrs, Maybe (LHsContext GhcRn)
mb_cxt, LHsKind GhcRn
body_ty)
  where
    (Maybe (LHsContext GhcRn)
mb_cxt, LHsKind GhcRn
body_ty) = LHsKind GhcRn -> (Maybe (LHsContext GhcRn), LHsKind GhcRn)
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP LHsKind 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 (LocatedN (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}
*                                                                      *
************************************************************************
-}

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 (UserTyVar XUserTyVar (GhcPass p)
_ ()
_ LIdP (GhcPass p)
n)     = GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ ()
_ LIdP (GhcPass p)
n LHsKind (GhcPass p)
k) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n, SDoc
dcolon, GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k]

instance OutputableBndrFlag Specificity p where
    pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr Specificity (GhcPass p) -> SDoc
pprTyVarBndr (UserTyVar XUserTyVar (GhcPass p)
_ Specificity
SpecifiedSpec LIdP (GhcPass p)
n)     = GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n
    pprTyVarBndr (UserTyVar XUserTyVar (GhcPass p)
_ Specificity
InferredSpec LIdP (GhcPass p)
n)      = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ Specificity
SpecifiedSpec LIdP (GhcPass p)
n LHsKind (GhcPass p)
k) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n, SDoc
dcolon, GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k]
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ Specificity
InferredSpec LIdP (GhcPass p)
n LHsKind (GhcPass p)
k)  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n, SDoc
dcolon, GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k]

instance OutputableBndrFlag (HsBndrVis p') p where
    pprTyVarBndr :: OutputableBndrId p =>
HsTyVarBndr (HsBndrVis p') (GhcPass p) -> SDoc
pprTyVarBndr (UserTyVar XUserTyVar (GhcPass p)
_ HsBndrVis p'
vis LIdP (GhcPass p)
n) = HsBndrVis p' -> SDoc -> SDoc
forall pass. HsBndrVis pass -> SDoc -> SDoc
pprHsBndrVis HsBndrVis p'
vis (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ HsBndrVis p'
vis LIdP (GhcPass p)
n LHsKind (GhcPass p)
k) =
      HsBndrVis p' -> SDoc -> SDoc
forall pass. HsBndrVis pass -> SDoc -> SDoc
pprHsBndrVis HsBndrVis p'
vis (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
n, SDoc
dcolon, GenLocated SrcSpanAnnA (HsType (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
k]

pprHsBndrVis :: HsBndrVis pass -> SDoc -> SDoc
pprHsBndrVis :: forall pass. HsBndrVis pass -> SDoc -> SDoc
pprHsBndrVis HsBndrVis pass
HsBndrRequired SDoc
d = SDoc
d
pprHsBndrVis (HsBndrInvisible LHsToken "@" pass
_) SDoc
d = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> 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 (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. EpAnn a
noAnn [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
[LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))]
bndrs) Maybe (LHsContext (GhcPass (NoGhcTcPass p)))
Maybe
  (GenLocated
     (SrcAnn AnnContext)
     [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 SrcAnn AnnContext
_ [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 (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc LFieldOcc (GhcPass p)
GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)) -> SDoc)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc [LFieldOcc (GhcPass p)]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
ns))

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

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

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

pprHsType :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
pprHsType :: 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
     (SrcAnn AnnContext) [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)
_ HsSrcBang
b LHsType (GhcPass p)
ty)           = HsSrcBang -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSrcBang
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 (SrcAnn NoEpAnns) HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) HsIPName
GenLocated (SrcAnn NoEpAnns) 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
quote (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
quote (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 LHsToken "@" (GhcPass p)
_ 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 = HsArrow (GhcPass p) -> SDoc
forall (pass :: Pass).
OutputableBndrId pass =>
HsArrow (GhcPass pass) -> SDoc
pprHsArrow HsArrow (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 LHsToken "@" pass
_ 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)
EpAnn AnnParen
forall a. EpAnn 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 SrcAnn AnnContext
loc [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt) =
  case [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt of
    [GenLocated SrcSpanAnnA (HsType (GhcPass p))
c] -> SrcAnn AnnContext
-> [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
-> GenLocated
     (SrcAnn AnnContext) [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
forall l e. l -> e -> GenLocated l e
L SrcAnn AnnContext
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 = SrcAnn NoEpAnns
type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA

type instance Anno (FieldOcc (GhcPass p)) = SrcAnn NoEpAnns
type instance Anno (AmbiguousFieldOcc (GhcPass p)) = SrcAnn NoEpAnns