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

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

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


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

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

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

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

        ConDeclField(..), LConDeclField, pprConDeclFields,

        HsConDetails(..), noTypeArgs,

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

        mkAnonWildCardTy, pprAnonWildCard,

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

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

#include "HsVersions.h"

import GHC.Prelude

import Language.Haskell.Syntax.Type

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

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

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

import Data.Maybe

import qualified Data.Semigroup as S

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

getBangType :: LHsType (GhcPass p) -> LHsType (GhcPass p)
getBangType :: 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)) LHsDocString
lds)) =
  forall a e1 e2 e3 ann.
GenLocated (SrcSpanAnn' a) e1
-> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3
addCLocA LHsType (GhcPass p)
lty LHsDocString
lds (forall pass.
XDocTy pass -> LHsType pass -> LHsDocString -> HsType pass
HsDocTy XDocTy (GhcPass p)
x LHsType (GhcPass p)
lty LHsDocString
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)
_)) LHsDocString
_)) = 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 = forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a an. a -> LocatedAn an a
noLocA []) Maybe (LHsContext (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 _) = NoExtCon

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

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

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

type instance XXLHsQTyVars  (GhcPass _) = NoExtCon

mkHsForAllVisTele ::EpAnnForallTy ->
  [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele :: 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 = 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 = EpAnnForallTy
an, hsf_invis_bndrs :: [LHsTyVarBndr Specificity (GhcPass p)]
hsf_invis_bndrs = [LHsTyVarBndr Specificity (GhcPass p)]
invis_bndrs }

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

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

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

type instance XXHsWildCardBndrs (GhcPass _) _ = NoExtCon

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

type instance XXHsPatSigType (GhcPass _) = NoExtCon

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

hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p
hsSigWcType = forall pass. HsSigType pass -> LHsType pass
sig_body forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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}) = 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})       = forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr flag (NoGhcTc 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 = 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 = EpAnnForallTy
an
                                             , hso_bndrs :: [LHsTyVarBndr flag (NoGhcTc GhcPs)]
hso_bndrs     = [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   = NoExtField
noExtField
        , sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_bndrs = 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 = NoExtField
noExtField
        , sig_bndrs :: HsOuterSigTyVarBndrs GhcPs
sig_bndrs = 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  = NoExtField
noExtField }

mkHsPatSigType :: EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType :: EpAnn EpaLocation -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType EpAnn EpaLocation
ann LHsType GhcPs
x = HsPS { hsps_ext :: XHsPS GhcPs
hsps_ext  = EpAnn EpaLocation
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 _) = NoExtCon

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

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

-- | 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall flag pass. HsTyVarBndr flag pass -> Bool
isHsKindedTyVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsQTvExplicit

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

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

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

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

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

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

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

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

type instance XTyLit           (GhcPass _) = NoExtField

type instance XWildCardTy      (GhcPass _) = NoExtField

type instance XXType         (GhcPass _) = HsCoreTy


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

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

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 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 IsUnicodeSyntax
_) = forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
manyDataConHsTy
arrowToHsType (HsLinearArrow IsUnicodeSyntax
_ Maybe AddEpAnn
_) = forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
oneDataConHsTy
arrowToHsType (HsExplicitMult IsUnicodeSyntax
_ Maybe AddEpAnn
_ LHsKind GhcRn
p) = LHsKind GhcRn
p

instance
      (OutputableBndrId pass) =>
      Outputable (HsArrow (GhcPass pass)) where
  ppr :: HsArrow (GhcPass pass) -> SDoc
ppr HsArrow (GhcPass pass)
arr = SDoc -> SDoc
parens (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 IsUnicodeSyntax
_) = SDoc
arrow
pprHsArrow (HsLinearArrow IsUnicodeSyntax
_ Maybe AddEpAnn
_) = SDoc
lollipop
pprHsArrow (HsExplicitMult IsUnicodeSyntax
_ Maybe AddEpAnn
_ LHsType (GhcPass pass)
p) = (SDoc -> SDoc
mulArrow (forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass pass)
p))

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

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 LHsDocString
_) = forall a. Outputable a => a -> SDoc
ppr [LFieldOcc (GhcPass p)]
fld_n SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LBangType (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
  = XHsWC GhcRn (LHsSigType GhcRn)
nwcs forall a. [a] -> [a] -> [a]
++ forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames (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}))
  = forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames (forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcRn
outer_bndrs)
    -- See Note [hsScopedTvs and visible foralls]

---------------------
hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName :: forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName (UserTyVar XUserTyVar (GhcPass p)
_ flag
_ (L Anno (IdGhcP p)
_ IdGhcP p
n))     = IdGhcP p
n
hsTyVarName (KindedTyVar XKindedTyVar (GhcPass p)
_ flag
_ (L Anno (IdGhcP p)
_ IdGhcP p
n) LHsKind (GhcPass p)
_) = IdGhcP p
n

hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName :: forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a b. (a -> b) -> [a] -> [b]
map forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName (forall pass. LHsQTyVars pass -> [LHsTyVarBndr () 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 () pass]
hsq_explicit = [LHsTyVarBndr () GhcRn]
tvs })
  = XHsQTvs GhcRn
kvs forall a. [a] -> [a] -> [a]
++ forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr () GhcRn]
tvs

hsLTyVarLocName :: LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName :: forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName (L SrcSpanAnnA
l HsTyVarBndr flag (GhcPass p)
a) = forall l e. l -> e -> GenLocated l e
L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
l) (forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName HsTyVarBndr flag (GhcPass p)
a)

hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames :: forall (p :: Pass).
LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames LHsQTyVars (GhcPass p)
qtvs = forall a b. (a -> b) -> [a] -> [b]
map forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName (forall pass. LHsQTyVars pass -> [LHsTyVarBndr () 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 forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass p)
lty of
    HsParTy XParTy (GhcPass p)
_ LHsType (GhcPass p)
lty'    -> 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   -> forall a. a -> Maybe a
Just LHsType (GhcPass p)
k
    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)) = 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 = forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy NoExtField
noExtField

mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
         => LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
         -> LHsType (GhcPass p) -> HsType (GhcPass p)
mkHsOpTy :: forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy LHsType (GhcPass p)
ty1 LocatedN (IdP (GhcPass p))
op LHsType (GhcPass p)
ty2 = forall pass.
XOpTy pass
-> LHsType pass -> LIdP pass -> LHsType pass -> HsType pass
HsOpTy NoExtField
noExtField LHsType (GhcPass p)
ty1 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
  = forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsType (GhcPass p)
t1 LHsType (GhcPass p)
t2 (forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
noExtField LHsType (GhcPass p)
t1 (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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy

mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
              -> LHsType (GhcPass p)
mkHsAppKindTy :: forall (p :: Pass).
XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
mkHsAppKindTy XAppKindTy (GhcPass p)
ext LHsType (GhcPass p)
ty LHsType (GhcPass p)
k
  = forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsType (GhcPass p)
ty LHsType (GhcPass p)
k (forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass p)
ext LHsType (GhcPass p)
ty LHsType (GhcPass p)
k)

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

---------------------------------
-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
-- Breaks up any parens in the result type:
--      splitHsFunType (a -> (b -> c)) = ([a,b], c)
-- It returns API Annotations for any parens removed
splitHsFunType ::
     LHsType (GhcPass p)
  -> ( [AddEpAnn], EpAnnComments -- The locations of any parens and
                                  -- comments discarded
     , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType :: forall (p :: Pass).
LHsType (GhcPass p)
-> ([AddEpAnn], EpAnnComments,
    [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType LHsType (GhcPass p)
ty = 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)
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) = 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 forall a. [a] -> [a] -> [a]
++ EpAnn AnnParen -> [AddEpAnn]
annParen2AddEpAnn XParTy (GhcPass p)
an
          cs' :: EpAnnComments
cs' = EpAnnComments
cs forall a. Semigroup a => a -> a -> a
S.<> forall an. EpAnn an -> EpAnnComments
epAnnComments (forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
l) forall a. Semigroup a => a -> a -> a
S.<> forall an. EpAnn an -> EpAnnComments
epAnnComments XParTy (GhcPass p)
an
        in ([AddEpAnn]
anns', EpAnnComments
cs', [HsScaled (GhcPass p) (LHsType (GhcPass p))]
args, LHsType (GhcPass p)
res)

    go (L SrcSpanAnnA
ll (HsFunTy (EpAnn Anchor
_ TrailingAnn
an 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) <- 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 forall a. Semigroup a => a -> a -> a
S.<> forall an. EpAnn an -> EpAnnComments
epAnnComments (forall a. SrcSpanAnn' a -> a
ann SrcSpanAnnA
ll), forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow (GhcPass p)
mult GenLocated SrcSpanAnnA (HsType (GhcPass p))
x'forall a. a -> [a] -> [a]
:[HsScaled (GhcPass p) (LHsType (GhcPass p))]
args, LHsType (GhcPass p)
res)
      where
        (L (SrcSpanAnn EpAnn AnnListItem
a SrcSpan
l) HsType (GhcPass p)
t) = LHsType (GhcPass p)
x
        an' :: EpAnn AnnListItem
an' = SrcSpan
-> TrailingAnn
-> EpAnnComments
-> EpAnn AnnListItem
-> EpAnn AnnListItem
addTrailingAnnToA SrcSpan
l TrailingAnn
an EpAnnComments
cs EpAnn AnnListItem
a
        x' :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
x' = forall l e. l -> e -> GenLocated l e
L (forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn EpAnn AnnListItem
an' SrcSpan
l) 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 = 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))          = 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)
l
    go (L l
_ (HsAppKindTy XAppKindTy pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_))       = GenLocated l (HsType pass) -> Maybe (XRec pass (IdP pass))
go XRec pass (HsType pass)
t
    go (L l
_ (HsOpTy XOpTy pass
_ XRec pass (HsType pass)
_ XRec pass (IdP pass)
ln XRec pass (HsType 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)
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)
t
    go GenLocated l (HsType 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    -> forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType (GhcPass pass)
tm
  HsTypeArg SrcSpan
at LHsType (GhcPass pass)
ty -> SrcSpan
at SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType (GhcPass pass)
ty
  HsArgPar  SrcSpan
sp    -> 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 = ([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{}                      -> ([], 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))]
exp_bndrs, LHsType (GhcPass p)
body)

    ([GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass (NoGhcTcPass p)))]
univs,       GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty1) = 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)
ty
    (Maybe (LHsContext (GhcPass p))
reqs,        LHsType (GhcPass p)
ty2) = forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy GenLocated SrcSpanAnnA (HsType (GhcPass p))
ty1
    ((EpAnnForallTy
_an, [LHsTyVarBndr Specificity (GhcPass p)]
exis), LHsType (GhcPass p)
ty3) = 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) = 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) <- 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) <- 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)     <- 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) <- forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe
      (EpAnnForallTy, [LHsTyVarBndr Specificity (GhcPass pass)]),
    LHsType (GhcPass pass))
splitLHsForAllTyInvis_KP (forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType (GhcPass pass)
ty)
  = (forall a. a -> Maybe a -> a
fromMaybe (forall a. EpAnn a
EpAnnNotUsed,[]) Maybe (EpAnnForallTy, [LHsTyVarBndr 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 }
      -> (forall a. a -> Maybe a
Just (XHsForAllInvis (GhcPass pass)
an, [LHsTyVarBndr Specificity (GhcPass pass)]
tvs), LHsType (GhcPass pass)
body)
    HsType (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) <- forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy_KP (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 -> Maybe (LHsContext pass)
hst_ctxt = Maybe (LHsContext (GhcPass pass))
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass pass)
body }))
                       = (Maybe (LHsContext (GhcPass pass))
ctxt, LHsType (GhcPass pass)
body)
splitLHsQualTy_KP LHsType (GhcPass pass)
body = (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})) =
  (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) = 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) <- 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 = forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead LHsSigType (GhcPass p)
inst_ty
       ; 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 _) = NoExtCon

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

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

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

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

rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc :: forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (Unambiguous XUnambiguous (GhcPass p)
_ (L SrcSpanAnnN
_ RdrName
rdr)) = RdrName
rdr
rdrNameAmbiguousFieldOcc (Ambiguous   XAmbiguous (GhcPass p)
_ (L SrcSpanAnnN
_ RdrName
rdr)) = RdrName
rdr

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

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

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

{-
************************************************************************
*                                                                      *
\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) --     = pprIdP n
      = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ ()
_ LIdP (GhcPass p)
n LHsKind (GhcPass p)
k) = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [SDoc
ppr_n, SDoc
dcolon, forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
k]
      where
        ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n

instance OutputableBndrFlag Specificity p where
    pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr Specificity (GhcPass p) -> SDoc
pprTyVarBndr (UserTyVar XUserTyVar (GhcPass p)
_ Specificity
SpecifiedSpec LIdP (GhcPass p)
n) --     = pprIdP n
      = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
    pprTyVarBndr (UserTyVar XUserTyVar (GhcPass p)
_ Specificity
InferredSpec LIdP (GhcPass p)
n)      = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ SDoc
ppr_n
      where
        ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ Specificity
SpecifiedSpec LIdP (GhcPass p)
n LHsKind (GhcPass p)
k) = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [SDoc
ppr_n, SDoc
dcolon, forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
k]
      where
        ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
    pprTyVarBndr (KindedTyVar XKindedTyVar (GhcPass p)
_ Specificity
InferredSpec LIdP (GhcPass p)
n LHsKind (GhcPass p)
k)  = SDoc -> SDoc
braces forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [SDoc
ppr_n, SDoc
dcolon, forall a. Outputable a => a -> SDoc
ppr LHsKind (GhcPass p)
k]
      where
        ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
          GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
          GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n

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 }) =
      forall (p :: Pass).
OutputableBndrId p =>
HsOuterSigTyVarBndrs (GhcPass p) -> SDoc
pprHsOuterSigTyVarBndrs HsOuterSigTyVarBndrs (GhcPass p)
outer_bndrs SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
body

instance OutputableBndrId p => Outputable (HsType (GhcPass p)) where
    ppr :: HsType (GhcPass p) -> SDoc
ppr HsType (GhcPass p)
ty = 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 () pass]
hsq_explicit = [LHsTyVarBndr () (GhcPass p)]
tvs }) = forall a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr () (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
text String
"HsOuterImplicit:" SDoc -> SDoc -> SDoc
<+> case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
        GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr XHsOuterImplicit (GhcPass p)
imp_tvs
        GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr XHsOuterImplicit (GhcPass p)
imp_tvs
        GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr 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
text String
"HsOuterExplicit:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr flag (NoGhcTc (GhcPass 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
text String
"HsForAllVis:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () (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
text String
"HsForAllInvis:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr Specificity (GhcPass p)]
bndrs

instance (OutputableBndrId p, OutputableBndrFlag flag p)
       => Outputable (HsTyVarBndr flag (GhcPass p)) where
    ppr :: HsTyVarBndr flag (GhcPass p) -> SDoc
ppr = 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 }) = 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 }) = forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
ty

pprAnonWildCard :: SDoc
pprAnonWildCard :: SDoc
pprAnonWildCard = Char -> SDoc
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
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 a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr () (NoGhcTc (GhcPass p))]
qtvs SDoc -> SDoc -> SDoc
<> SDoc
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
empty
pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
bndrs}) =
  forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll (forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity (NoGhcTc (GhcPass p))]
bndrs) 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 (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 } -> forall flag (p :: Pass).
(OutputableBndrId p, OutputableBndrFlag flag p) =>
SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
pp_forall (SDoc
space SDoc -> SDoc -> SDoc
<> 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 } -> forall flag (p :: Pass).
(OutputableBndrId p, OutputableBndrFlag flag p) =>
SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc
pp_forall SDoc
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
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr flag (GhcPass p)]
qtvs = SDoc -> SDoc
whenPprDebug (SDoc
forAllLit SDoc -> SDoc -> SDoc
<> 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 a. Outputable a => [a] -> SDoc
interppSP [LHsTyVarBndr flag (GhcPass p)]
qtvs SDoc -> SDoc -> SDoc
<> 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
empty
pprLHsContext (Just LHsContext (GhcPass p)
lctxt)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall l e. GenLocated l e -> e
unLoc LHsContext (GhcPass p)
lctxt) = SDoc
empty
  | Bool
otherwise          = forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContextAlways (forall a. a -> Maybe a
Just LHsContext (GhcPass p)
lctxt)

-- For use in a HsQualTy, which always gets printed if it exists.
pprLHsContextAlways :: (OutputableBndrId p)
                    => Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContextAlways :: forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContextAlways Maybe (LHsContext (GhcPass p))
Nothing = SDoc -> SDoc
parens SDoc
empty SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprLHsContextAlways (Just (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt))
  = case [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt of
      []       -> SDoc -> SDoc
parens SDoc
empty             SDoc -> SDoc -> SDoc
<+> SDoc
darrow
      [L SrcSpanAnnA
_ HsType (GhcPass p)
ty] -> forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
ppr_mono_ty HsType (GhcPass p)
ty           SDoc -> SDoc -> SDoc
<+> SDoc
darrow
      [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
_        -> SDoc -> SDoc
parens (forall a. Outputable a => [a] -> SDoc
interpp'SP [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt) SDoc -> SDoc -> SDoc
<+> 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
braces ([SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map 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)]
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 LHsDocString
cd_fld_doc = Maybe LHsDocString
doc }))
        = forall (p :: Pass). [LFieldOcc (GhcPass p)] -> SDoc
ppr_names [LFieldOcc (GhcPass p)]
ns SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LBangType (GhcPass p)
ty SDoc -> SDoc -> SDoc
<+> Maybe LHsDocString -> SDoc
ppr_mbDoc Maybe LHsDocString
doc

    ppr_names :: [LFieldOcc (GhcPass p)] -> SDoc
    ppr_names :: forall (p :: Pass). [LFieldOcc (GhcPass p)] -> SDoc
ppr_names [LFieldOcc (GhcPass p)
n] = forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc LFieldOcc (GhcPass p)
n
    ppr_names [LFieldOcc (GhcPass p)]
ns = [SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc [LFieldOcc (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 = 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 = forall (p :: Pass).
OutputableBndrId p =>
HsType (GhcPass p) -> SDoc
ppr_mono_ty (forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass p)
ty)

ppr_mono_ty :: (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
sep [forall (p :: Pass).
OutputableBndrId p =>
HsForAllTelescope (GhcPass p)
-> Maybe (LHsContext (GhcPass p)) -> SDoc
pprHsForAll HsForAllTelescope (GhcPass p)
tele forall a. Maybe a
Nothing, 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 -> Maybe (LHsContext pass)
hst_ctxt = Maybe (LHsContext (GhcPass p))
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass p)
ty })
  = [SDoc] -> SDoc
sep [forall (p :: Pass).
OutputableBndrId p =>
Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContextAlways Maybe (LHsContext (GhcPass p))
ctxt, 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)   = forall a. Outputable a => a -> SDoc
ppr HsSrcBang
b SDoc -> SDoc -> 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)      = 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))
  | PromotionFlag -> Bool
isPromoted PromotionFlag
prom = SDoc -> SDoc
quote (forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IdGhcP p
name)
  | Bool
otherwise       = forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IdGhcP p
name
ppr_mono_ty (HsFunTy XFunTy (GhcPass p)
_ HsArrow (GhcPass p)
mult LHsType (GhcPass p)
ty1 LHsType (GhcPass p)
ty2)   = 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
sep [String -> SDoc
text (Boxity -> Int -> String
mkTupleStr Boxity
Boxed Int
1), 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 (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [LHsType (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 (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars forall a. Outputable a => a -> SDoc
ppr [LHsType (GhcPass p)]
tys)
ppr_mono_ty (HsKindSig XKindSig (GhcPass p)
_ LHsType (GhcPass p)
ty LHsType (GhcPass p)
kind)
  = forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass p)
kind
ppr_mono_ty (HsListTy XListTy (GhcPass p)
_ LHsType (GhcPass p)
ty)       = SDoc -> SDoc
brackets (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)   = (forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) HsIPName
n SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty)
ppr_mono_ty (HsSpliceTy XSpliceTy (GhcPass p)
_ HsSplice (GhcPass p)
s)      = forall (p :: Pass).
OutputableBndrId p =>
HsSplice (GhcPass p) -> SDoc
pprSplice HsSplice (GhcPass p)
s
ppr_mono_ty (HsExplicitListTy XExplicitListTy (GhcPass p)
_ PromotionFlag
prom [LHsType (GhcPass p)]
tys)
  | PromotionFlag -> Bool
isPromoted PromotionFlag
prom = SDoc -> SDoc
quote forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
brackets (forall (p :: Pass). [LHsType (GhcPass p)] -> SDoc -> SDoc
maybeAddSpace [LHsType (GhcPass p)]
tys forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (GhcPass p)]
tys)
  | Bool
otherwise       = SDoc -> SDoc
brackets (forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (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
    -- `'Solo x`, not `'(x)`
  | [LHsType (GhcPass p)
ty] <- [LHsType (GhcPass p)]
tys
  = SDoc -> SDoc
quote forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
sep [String -> SDoc
text (Boxity -> Int -> String
mkTupleStr Boxity
Boxed Int
1), forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty]
  | Bool
otherwise
  = SDoc -> SDoc
quote forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
parens (forall (p :: Pass). [LHsType (GhcPass p)] -> SDoc -> SDoc
maybeAddSpace [LHsType (GhcPass p)]
tys forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsType (GhcPass p)]
tys)
ppr_mono_ty (HsTyLit XTyLit (GhcPass p)
_ HsTyLit
t)       = forall a. Outputable a => a -> SDoc
ppr HsTyLit
t
ppr_mono_ty (HsWildCardTy {})   = Char -> SDoc
char Char
'_'

ppr_mono_ty (HsStarTy XStarTy (GhcPass p)
_ Bool
isUni)  = Char -> SDoc
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
hsep [forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
fun_ty, forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
arg_ty]
ppr_mono_ty (HsAppKindTy XAppKindTy (GhcPass p)
_ LHsType (GhcPass p)
ty LHsType (GhcPass p)
k)
  = forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
k
ppr_mono_ty (HsOpTy XOpTy (GhcPass p)
_ LHsType (GhcPass p)
ty1 (L Anno (IdGhcP p)
_ IdGhcP p
op) LHsType (GhcPass p)
ty2)
  = [SDoc] -> SDoc
sep [ forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty1
        , [SDoc] -> SDoc
sep [forall a. OutputableBndr a => a -> SDoc
pprInfixOcc IdGhcP p
op, 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
parens (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 LHsDocString
doc)
  -- AZ: Should we add parens?  Should we introduce "-- ^"?
  = forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall l e. GenLocated l e -> e
unLoc LHsDocString
doc)
  -- we pretty print Haddock comments on types as if they were
  -- postfix operators

ppr_mono_ty (XHsType XXType (GhcPass p)
t) = forall a. Outputable a => a -> SDoc
ppr XXType (GhcPass p)
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 = forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty1
        p2 :: SDoc
p2 = forall (p :: Pass).
OutputableBndrId p =>
LHsType (GhcPass p) -> SDoc
ppr_mono_lty LHsType (GhcPass p)
ty2
        arr :: SDoc
arr = forall (pass :: Pass).
OutputableBndrId pass =>
HsArrow (GhcPass pass) -> SDoc
pprHsArrow HsArrow (GhcPass p)
mult
    in
    [SDoc] -> SDoc
sep [SDoc
p1, SDoc
arr SDoc -> SDoc -> SDoc
<+> 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 forall a. Ord a => a -> a -> Bool
>= PprPrec
funPrec
    go_hs_ty (HsQualTy{})             = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
funPrec
    go_hs_ty (HsBangTy{})             = PprPrec
p 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 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 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 forall a. Ord a => a -> a -> Bool
>= PprPrec
sigPrec
    go_hs_ty (HsListTy{})             = Bool
False
    go_hs_ty (HsIParamTy{})           = PprPrec
p 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 ('Solo x)`, not `Proxy 'Solo x` (#18612)
    -- See Note [One-tuples] in GHC.Builtin.Types
    go_hs_ty (HsExplicitTupleTy XExplicitTupleTy (GhcPass p)
_ [LHsType (GhcPass p)
_])
                                      = PprPrec
p 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 forall a. Ord a => a -> a -> Bool
>= PprPrec
starPrec
    go_hs_ty (HsAppTy{})              = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_hs_ty (HsAppKindTy{})          = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_hs_ty (HsOpTy{})               = PprPrec
p 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) LHsDocString
_)    = 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)
ty

    go_core_ty :: HsCoreTy -> Bool
go_core_ty (TyVarTy{})    = Bool
False
    go_core_ty (AppTy{})      = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_core_ty (TyConApp TyCon
_ [HsCoreTy]
args)
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsCoreTy]
args             = Bool
False
      | Bool
otherwise             = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go_core_ty (ForAllTy{})   = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
funPrec
    go_core_ty (FunTy{})      = PprPrec
p 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
  , forall (p :: Pass). LHsType (GhcPass p) -> Bool
lhsTypeHasLeadingPromotionQuote LHsType (GhcPass p)
ty = SDoc
space SDoc -> SDoc -> SDoc
<> 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
  = forall {pass} {l} {l}.
(XRec pass [XRec pass (HsType pass)]
 ~ GenLocated l [GenLocated l (HsType pass)],
 XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
GenLocated l (HsType pass) -> Bool
goL XRec (GhcPass p) (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 -> Maybe (LHsContext pass)
hst_ctxt = Maybe (XRec pass [XRec pass (HsType pass)])
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec pass (HsType pass)
body})
      | Just (L l
_ (GenLocated l (HsType pass)
c:[GenLocated l (HsType pass)]
_)) <- Maybe (XRec pass [XRec pass (HsType 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)
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)
arg
    go (HsListTy{})          = Bool
False
    go (HsTupleTy{})         = Bool
False
    go (HsSumTy{})           = Bool
False
    go (HsOpTy XOpTy pass
_ XRec pass (HsType pass)
t1 LIdP pass
_ XRec pass (HsType pass)
_)     = GenLocated l (HsType pass) -> Bool
goL XRec pass (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)
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)
t
    go (HsAppKindTy XAppKindTy pass
_ XRec pass (HsType pass)
t XRec pass (HsType pass)
_)   = GenLocated l (HsType pass) -> Bool
goL XRec pass (HsType pass)
t
    go (HsParTy{})           = Bool
False
    go (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
t LHsDocString
_)       = GenLocated l (HsType pass) -> Bool
goL XRec pass (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)
  | forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
p HsType (GhcPass p)
ty = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy 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 SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt) =
  case [GenLocated SrcSpanAnnA (HsType (GhcPass p))]
ctxt of
    [GenLocated SrcSpanAnnA (HsType (GhcPass p))
c] -> forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
loc [forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
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 = SrcSpan
type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA
type instance Anno (FieldOcc (GhcPass p)) = SrcSpan