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


This module defines interface types and binders
-}


{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Iface.Type (
        IfExtName,
        IfLclName(..), mkIfLclName, ifLclNameFS,

        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
        IfaceAxiomRule(..),IfaceMCoercion(..),
        IfaceMult,
        IfaceTyCon(..),
        IfaceTyConInfo(..), mkIfaceTyConInfo,
        IfaceTyConSort(..),
        IfaceTyLit(..), IfaceAppArgs(..),
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
        IfaceForAllSpecBndr,
        IfaceForAllBndr, ForAllTyFlag(..), FunTyFlag(..), ShowForAllFlag(..),
        ShowSub(..), ShowHowMuch(..), AltPpr(..),
        mkIfaceForAllTvBndr,
        mkIfaceTyConKind,
        ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr,

        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
        ifTyConBinderVar, ifTyConBinderName,

        -- Binary utilities
        putIfaceType, getIfaceType, ifaceTypeSharedByte,
        -- Equality testing
        isIfaceLiftedTypeKind,

        -- Conversion from IfaceAppArgs to IfaceTypes/ForAllTyFlags
        appArgsIfaceTypes, appArgsIfaceTypesForAllTyFlags,

        -- Printing
        SuppressBndrSig(..),
        UseBndrParens(..),
        PrintExplicitKinds(..),
        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
        pprIfaceContext, pprIfaceContextArr,
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
        pprIfaceSigmaType, pprIfaceTyLit,
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
        isIfaceRhoType,

        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,

        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst,

        many_ty, pprTypeArrow
    ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.Builtin.Types
                                 ( coercibleTyCon, heqTyCon
                                 , constraintKindTyConName
                                 , tupleTyConName
                                 , tupleDataConName
                                 , manyDataConTyCon
                                 , liftedRepTyCon, liftedDataConTyCon
                                 , sumTyCon )
import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, funTyFlagTyCon )
import GHC.Core.TyCo.Rep( CoSel, UnivCoProvenance(..) )
import GHC.Core.TyCo.Compare( eqForAllVis )
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Types.Var
import GHC.Builtin.Names
import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyConName )
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar )

import Data.Maybe (isJust)
import Data.Proxy
import qualified Data.Semigroup as Semi
import Data.Word (Word8)
import Control.Arrow (first)
import Control.DeepSeq
import Control.Monad ((<$!>))

{-
************************************************************************
*                                                                      *
                Local (nested) binders
*                                                                      *
************************************************************************
-}

-- | A local name in iface syntax
newtype IfLclName = IfLclName
  { IfLclName -> LexicalFastString
getIfLclName :: LexicalFastString
  } deriving (IfLclName -> IfLclName -> Bool
(IfLclName -> IfLclName -> Bool)
-> (IfLclName -> IfLclName -> Bool) -> Eq IfLclName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfLclName -> IfLclName -> Bool
== :: IfLclName -> IfLclName -> Bool
$c/= :: IfLclName -> IfLclName -> Bool
/= :: IfLclName -> IfLclName -> Bool
Eq, Eq IfLclName
Eq IfLclName =>
(IfLclName -> IfLclName -> Ordering)
-> (IfLclName -> IfLclName -> Bool)
-> (IfLclName -> IfLclName -> Bool)
-> (IfLclName -> IfLclName -> Bool)
-> (IfLclName -> IfLclName -> Bool)
-> (IfLclName -> IfLclName -> IfLclName)
-> (IfLclName -> IfLclName -> IfLclName)
-> Ord IfLclName
IfLclName -> IfLclName -> Bool
IfLclName -> IfLclName -> Ordering
IfLclName -> IfLclName -> IfLclName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfLclName -> IfLclName -> Ordering
compare :: IfLclName -> IfLclName -> Ordering
$c< :: IfLclName -> IfLclName -> Bool
< :: IfLclName -> IfLclName -> Bool
$c<= :: IfLclName -> IfLclName -> Bool
<= :: IfLclName -> IfLclName -> Bool
$c> :: IfLclName -> IfLclName -> Bool
> :: IfLclName -> IfLclName -> Bool
$c>= :: IfLclName -> IfLclName -> Bool
>= :: IfLclName -> IfLclName -> Bool
$cmax :: IfLclName -> IfLclName -> IfLclName
max :: IfLclName -> IfLclName -> IfLclName
$cmin :: IfLclName -> IfLclName -> IfLclName
min :: IfLclName -> IfLclName -> IfLclName
Ord, Int -> IfLclName -> ShowS
[IfLclName] -> ShowS
IfLclName -> String
(Int -> IfLclName -> ShowS)
-> (IfLclName -> String)
-> ([IfLclName] -> ShowS)
-> Show IfLclName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IfLclName -> ShowS
showsPrec :: Int -> IfLclName -> ShowS
$cshow :: IfLclName -> String
show :: IfLclName -> String
$cshowList :: [IfLclName] -> ShowS
showList :: [IfLclName] -> ShowS
Show)

ifLclNameFS :: IfLclName -> FastString
ifLclNameFS :: IfLclName -> FastString
ifLclNameFS = LexicalFastString -> FastString
getLexicalFastString (LexicalFastString -> FastString)
-> (IfLclName -> LexicalFastString) -> IfLclName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfLclName -> LexicalFastString
getIfLclName

mkIfLclName :: FastString -> IfLclName
mkIfLclName :: FastString -> IfLclName
mkIfLclName = LexicalFastString -> IfLclName
IfLclName (LexicalFastString -> IfLclName)
-> (FastString -> LexicalFastString) -> FastString -> IfLclName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> LexicalFastString
LexicalFastString

type IfExtName = Name   -- An External or WiredIn Name can appear in Iface syntax
                        -- (However Internal or System Names never should)

data IfaceBndr          -- Local (non-top-level) binders
  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
  deriving (IfaceBndr -> IfaceBndr -> Bool
(IfaceBndr -> IfaceBndr -> Bool)
-> (IfaceBndr -> IfaceBndr -> Bool) -> Eq IfaceBndr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceBndr -> IfaceBndr -> Bool
== :: IfaceBndr -> IfaceBndr -> Bool
$c/= :: IfaceBndr -> IfaceBndr -> Bool
/= :: IfaceBndr -> IfaceBndr -> Bool
Eq, Eq IfaceBndr
Eq IfaceBndr =>
(IfaceBndr -> IfaceBndr -> Ordering)
-> (IfaceBndr -> IfaceBndr -> Bool)
-> (IfaceBndr -> IfaceBndr -> Bool)
-> (IfaceBndr -> IfaceBndr -> Bool)
-> (IfaceBndr -> IfaceBndr -> Bool)
-> (IfaceBndr -> IfaceBndr -> IfaceBndr)
-> (IfaceBndr -> IfaceBndr -> IfaceBndr)
-> Ord IfaceBndr
IfaceBndr -> IfaceBndr -> Bool
IfaceBndr -> IfaceBndr -> Ordering
IfaceBndr -> IfaceBndr -> IfaceBndr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceBndr -> IfaceBndr -> Ordering
compare :: IfaceBndr -> IfaceBndr -> Ordering
$c< :: IfaceBndr -> IfaceBndr -> Bool
< :: IfaceBndr -> IfaceBndr -> Bool
$c<= :: IfaceBndr -> IfaceBndr -> Bool
<= :: IfaceBndr -> IfaceBndr -> Bool
$c> :: IfaceBndr -> IfaceBndr -> Bool
> :: IfaceBndr -> IfaceBndr -> Bool
$c>= :: IfaceBndr -> IfaceBndr -> Bool
>= :: IfaceBndr -> IfaceBndr -> Bool
$cmax :: IfaceBndr -> IfaceBndr -> IfaceBndr
max :: IfaceBndr -> IfaceBndr -> IfaceBndr
$cmin :: IfaceBndr -> IfaceBndr -> IfaceBndr
min :: IfaceBndr -> IfaceBndr -> IfaceBndr
Ord)


type IfaceIdBndr  = (IfaceType, IfLclName, IfaceType)
type IfaceTvBndr  = (IfLclName, IfaceKind)

ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (IfLclName
n,IfaceType
_) = IfLclName
n

ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName (IfaceType
_,IfLclName
n,IfaceType
_) = IfLclName
n

ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName (IfaceTvBndr IfaceTvBndr
bndr) = IfaceTvBndr -> IfLclName
ifaceTvBndrName IfaceTvBndr
bndr
ifaceBndrName (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> IfLclName
ifaceIdBndrName IfaceIdBndr
bndr

ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType (IfaceIdBndr (IfaceType
_, IfLclName
_, IfaceType
t)) = IfaceType
t
ifaceBndrType (IfaceTvBndr (IfLclName
_, IfaceType
t)) = IfaceType
t

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)

data IfaceOneShot    -- See Note [Preserve OneShotInfo] in "GHC.Core.Tidy"
  = IfaceNoOneShot   -- and Note [oneShot magic] in "GHC.Types.Id.Make"
  | IfaceOneShot

instance Outputable IfaceOneShot where
  ppr :: IfaceOneShot -> SDoc
ppr IfaceOneShot
IfaceNoOneShot = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoOneShotInfo"
  ppr IfaceOneShot
IfaceOneShot = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OneShot"

{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

-------------------------------
type IfaceKind     = IfaceType

-- | A kind of universal type, used for types and kinds.
--
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
-- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr"
data IfaceType
  = IfaceFreeTyVar TyVar                -- See Note [Free TyVars and CoVars in IfaceType]
  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
  | IfaceLitTy     IfaceTyLit
  | IfaceAppTy     IfaceType IfaceAppArgs
                             -- See Note [Suppressing invisible arguments] for
                             -- an explanation of why the second field isn't
                             -- IfaceType, analogous to AppTy.
  | IfaceFunTy     FunTyFlag IfaceMult IfaceType IfaceType
  | IfaceForAllTy  IfaceForAllBndr IfaceType
  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated
                                            -- Includes newtypes, synonyms, tuples
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion

  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
       TupleSort                  -- What sort of tuple?
       PromotionFlag                 -- A bit like IfaceTyCon
       IfaceAppArgs               -- arity = length args
          -- For promoted data cons, the kind args are omitted
          -- Why have this? Only for efficiency: IfaceTupleTy can omit the
          -- type arguments, as they can be recreated when deserializing.
          -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression
          -- in interface file size (in GHC's boot libraries).
          -- See !3987.
  deriving (IfaceType -> IfaceType -> Bool
(IfaceType -> IfaceType -> Bool)
-> (IfaceType -> IfaceType -> Bool) -> Eq IfaceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceType -> IfaceType -> Bool
== :: IfaceType -> IfaceType -> Bool
$c/= :: IfaceType -> IfaceType -> Bool
/= :: IfaceType -> IfaceType -> Bool
Eq, Eq IfaceType
Eq IfaceType =>
(IfaceType -> IfaceType -> Ordering)
-> (IfaceType -> IfaceType -> Bool)
-> (IfaceType -> IfaceType -> Bool)
-> (IfaceType -> IfaceType -> Bool)
-> (IfaceType -> IfaceType -> Bool)
-> (IfaceType -> IfaceType -> IfaceType)
-> (IfaceType -> IfaceType -> IfaceType)
-> Ord IfaceType
IfaceType -> IfaceType -> Bool
IfaceType -> IfaceType -> Ordering
IfaceType -> IfaceType -> IfaceType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceType -> IfaceType -> Ordering
compare :: IfaceType -> IfaceType -> Ordering
$c< :: IfaceType -> IfaceType -> Bool
< :: IfaceType -> IfaceType -> Bool
$c<= :: IfaceType -> IfaceType -> Bool
<= :: IfaceType -> IfaceType -> Bool
$c> :: IfaceType -> IfaceType -> Bool
> :: IfaceType -> IfaceType -> Bool
$c>= :: IfaceType -> IfaceType -> Bool
>= :: IfaceType -> IfaceType -> Bool
$cmax :: IfaceType -> IfaceType -> IfaceType
max :: IfaceType -> IfaceType -> IfaceType
$cmin :: IfaceType -> IfaceType -> IfaceType
min :: IfaceType -> IfaceType -> IfaceType
Ord)
  -- See Note [Ord instance of IfaceType]

{-
Note [Ord instance of IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need an 'Ord' instance to have a 'Map' keyed by 'IfaceType'. This 'Map' is
required for implementing the deduplication table during interface file
serialisation.
See Note [Deduplication during iface binary serialisation] for the implementation details.

We experimented with a 'TrieMap' based implementation, but it seems to be
slower than using a straight-forward 'Map IfaceType'.
The experiments loaded the full agda library into a ghci session with the
following scenarios:

* normal: a plain ghci session.
* cold: a ghci session that uses '-fwrite-if-simplified-core -fforce-recomp',
  forcing a cold-cache.
* warm: a subsequent ghci session that uses a warm cache for
  '-fwrite-if-simplified-core', e.g. nothing needs to be recompiled.

The implementation was up to 5% slower in some execution runs. However, on
'lib:Cabal', the performance difference between 'Map IfaceType' and
'TrieMap IfaceType' was negligible.

We share our implementation of the 'TrieMap' in the ticket #24816, so that
further performance analysis and improvements don't need to start from scratch.
-}

type IfaceMult = IfaceType

type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]

data IfaceTyLit
  = IfaceNumTyLit Integer
  | IfaceStrTyLit LexicalFastString
  | IfaceCharTyLit Char
  deriving (IfaceTyLit -> IfaceTyLit -> Bool
(IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool) -> Eq IfaceTyLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyLit -> IfaceTyLit -> Bool
== :: IfaceTyLit -> IfaceTyLit -> Bool
$c/= :: IfaceTyLit -> IfaceTyLit -> Bool
/= :: IfaceTyLit -> IfaceTyLit -> Bool
Eq, Eq IfaceTyLit
Eq IfaceTyLit =>
(IfaceTyLit -> IfaceTyLit -> Ordering)
-> (IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> IfaceTyLit)
-> (IfaceTyLit -> IfaceTyLit -> IfaceTyLit)
-> Ord IfaceTyLit
IfaceTyLit -> IfaceTyLit -> Bool
IfaceTyLit -> IfaceTyLit -> Ordering
IfaceTyLit -> IfaceTyLit -> IfaceTyLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceTyLit -> IfaceTyLit -> Ordering
compare :: IfaceTyLit -> IfaceTyLit -> Ordering
$c< :: IfaceTyLit -> IfaceTyLit -> Bool
< :: IfaceTyLit -> IfaceTyLit -> Bool
$c<= :: IfaceTyLit -> IfaceTyLit -> Bool
<= :: IfaceTyLit -> IfaceTyLit -> Bool
$c> :: IfaceTyLit -> IfaceTyLit -> Bool
> :: IfaceTyLit -> IfaceTyLit -> Bool
$c>= :: IfaceTyLit -> IfaceTyLit -> Bool
>= :: IfaceTyLit -> IfaceTyLit -> Bool
$cmax :: IfaceTyLit -> IfaceTyLit -> IfaceTyLit
max :: IfaceTyLit -> IfaceTyLit -> IfaceTyLit
$cmin :: IfaceTyLit -> IfaceTyLit -> IfaceTyLit
min :: IfaceTyLit -> IfaceTyLit -> IfaceTyLit
Ord)

type IfaceTyConBinder    = VarBndr IfaceBndr TyConBndrVis
type IfaceForAllBndr     = VarBndr IfaceBndr ForAllTyFlag
type IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity

-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.
mkIfaceForAllTvBndr :: ForAllTyFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr :: ForAllTyFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr ForAllTyFlag
vis IfaceTvBndr
var = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
var) ForAllTyFlag
vis

-- | Build the 'tyConKind' from the binders and the result kind.
-- Keep in sync with 'mkTyConKind' in "GHC.Core.TyCon".
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceType -> IfaceType
mkIfaceTyConKind [IfaceTyConBinder]
bndrs IfaceType
res_kind = (IfaceTyConBinder -> IfaceType -> IfaceType)
-> IfaceType -> [IfaceTyConBinder] -> IfaceType
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceTyConBinder -> IfaceType -> IfaceType
mk IfaceType
res_kind [IfaceTyConBinder]
bndrs
  where
    mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
    mk :: IfaceTyConBinder -> IfaceType -> IfaceType
mk (Bndr IfaceBndr
tv TyConBndrVis
AnonTCB)        IfaceType
k = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
FTF_T_T IfaceType
many_ty (IfaceBndr -> IfaceType
ifaceBndrType IfaceBndr
tv) IfaceType
k
    mk (Bndr IfaceBndr
tv (NamedTCB ForAllTyFlag
vis)) IfaceType
k = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ForAllTyFlag
vis) IfaceType
k

ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs = (IfaceForAllSpecBndr -> IfaceForAllBndr)
-> [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr

ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr (Bndr IfaceBndr
tv Specificity
spec) = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv (Specificity -> ForAllTyFlag
Invisible Specificity
spec)

-- | Stores the arguments in a type application as a list.
-- See @Note [Suppressing invisible arguments]@.
data IfaceAppArgs
  = IA_Nil
  | IA_Arg IfaceType    -- The type argument

           ForAllTyFlag      -- The argument's visibility. We store this here so
                        -- that we can:
                        --
                        -- 1. Avoid pretty-printing invisible (i.e., specified
                        --    or inferred) arguments when
                        --    -fprint-explicit-kinds isn't enabled, or
                        -- 2. When -fprint-explicit-kinds *is*, enabled, print
                        --    specified arguments in @(...) and inferred
                        --    arguments in @{...}.

           IfaceAppArgs -- The rest of the arguments
  deriving (IfaceAppArgs -> IfaceAppArgs -> Bool
(IfaceAppArgs -> IfaceAppArgs -> Bool)
-> (IfaceAppArgs -> IfaceAppArgs -> Bool) -> Eq IfaceAppArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceAppArgs -> IfaceAppArgs -> Bool
== :: IfaceAppArgs -> IfaceAppArgs -> Bool
$c/= :: IfaceAppArgs -> IfaceAppArgs -> Bool
/= :: IfaceAppArgs -> IfaceAppArgs -> Bool
Eq, Eq IfaceAppArgs
Eq IfaceAppArgs =>
(IfaceAppArgs -> IfaceAppArgs -> Ordering)
-> (IfaceAppArgs -> IfaceAppArgs -> Bool)
-> (IfaceAppArgs -> IfaceAppArgs -> Bool)
-> (IfaceAppArgs -> IfaceAppArgs -> Bool)
-> (IfaceAppArgs -> IfaceAppArgs -> Bool)
-> (IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs)
-> (IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs)
-> Ord IfaceAppArgs
IfaceAppArgs -> IfaceAppArgs -> Bool
IfaceAppArgs -> IfaceAppArgs -> Ordering
IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceAppArgs -> IfaceAppArgs -> Ordering
compare :: IfaceAppArgs -> IfaceAppArgs -> Ordering
$c< :: IfaceAppArgs -> IfaceAppArgs -> Bool
< :: IfaceAppArgs -> IfaceAppArgs -> Bool
$c<= :: IfaceAppArgs -> IfaceAppArgs -> Bool
<= :: IfaceAppArgs -> IfaceAppArgs -> Bool
$c> :: IfaceAppArgs -> IfaceAppArgs -> Bool
> :: IfaceAppArgs -> IfaceAppArgs -> Bool
$c>= :: IfaceAppArgs -> IfaceAppArgs -> Bool
>= :: IfaceAppArgs -> IfaceAppArgs -> Bool
$cmax :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
max :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
$cmin :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
min :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
Ord)

instance Semi.Semigroup IfaceAppArgs where
  IfaceAppArgs
IA_Nil <> :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
<> IfaceAppArgs
xs              = IfaceAppArgs
xs
  IA_Arg IfaceType
ty ForAllTyFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
ty ForAllTyFlag
argf (IfaceAppArgs
rest IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Semigroup a => a -> a -> a
Semi.<> IfaceAppArgs
xs)

instance Monoid IfaceAppArgs where
  mempty :: IfaceAppArgs
mempty = IfaceAppArgs
IA_Nil
  mappend :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
mappend = IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Semigroup a => a -> a -> a
(Semi.<>)

-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
-- properly.
data IfaceTyCon = IfaceTyCon { IfaceTyCon -> IfExtName
ifaceTyConName :: IfExtName
                             , IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo :: !IfaceTyConInfo
                             -- ^ We add a bang to this field as heap analysis
                             -- showed that this constructor retains a thunk to
                             -- a value that is usually shared.
                             --
                             -- See !12200 for how this bang saved ~10% residency
                             -- when loading 'mi_extra_decls' on the agda
                             -- code base.
                             --
                             -- See Note [Sharing IfaceTyConInfo] for why
                             -- sharing is so important for 'IfaceTyConInfo'.
                             }
    deriving (IfaceTyCon -> IfaceTyCon -> Bool
(IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool) -> Eq IfaceTyCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyCon -> IfaceTyCon -> Bool
== :: IfaceTyCon -> IfaceTyCon -> Bool
$c/= :: IfaceTyCon -> IfaceTyCon -> Bool
/= :: IfaceTyCon -> IfaceTyCon -> Bool
Eq, Eq IfaceTyCon
Eq IfaceTyCon =>
(IfaceTyCon -> IfaceTyCon -> Ordering)
-> (IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> IfaceTyCon)
-> (IfaceTyCon -> IfaceTyCon -> IfaceTyCon)
-> Ord IfaceTyCon
IfaceTyCon -> IfaceTyCon -> Bool
IfaceTyCon -> IfaceTyCon -> Ordering
IfaceTyCon -> IfaceTyCon -> IfaceTyCon
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceTyCon -> IfaceTyCon -> Ordering
compare :: IfaceTyCon -> IfaceTyCon -> Ordering
$c< :: IfaceTyCon -> IfaceTyCon -> Bool
< :: IfaceTyCon -> IfaceTyCon -> Bool
$c<= :: IfaceTyCon -> IfaceTyCon -> Bool
<= :: IfaceTyCon -> IfaceTyCon -> Bool
$c> :: IfaceTyCon -> IfaceTyCon -> Bool
> :: IfaceTyCon -> IfaceTyCon -> Bool
$c>= :: IfaceTyCon -> IfaceTyCon -> Bool
>= :: IfaceTyCon -> IfaceTyCon -> Bool
$cmax :: IfaceTyCon -> IfaceTyCon -> IfaceTyCon
max :: IfaceTyCon -> IfaceTyCon -> IfaceTyCon
$cmin :: IfaceTyCon -> IfaceTyCon -> IfaceTyCon
min :: IfaceTyCon -> IfaceTyCon -> IfaceTyCon
Ord)

-- | The various types of TyCons which have special, built-in syntax.
data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon

                    | IfaceTupleTyCon !Arity !TupleSort
                      -- ^ a tuple, e.g. @(a, b, c)@ or @(#a, b, c#)@.
                      -- The arity is the tuple width, not the tycon arity
                      -- (which is twice the width in the case of unboxed
                      -- tuples).

                    | IfaceSumTyCon !Arity
                      -- ^ an unboxed sum, e.g. @(# a | b | c #)@

                    | IfaceEqualityTyCon
                      -- ^ A heterogeneous equality TyCon
                      --   (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
                      -- that is actually being applied to two types
                      -- of the same kind.  This affects pretty-printing
                      -- only: see Note [Equality predicates in IfaceType]
                    deriving (IfaceTyConSort -> IfaceTyConSort -> Bool
(IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool) -> Eq IfaceTyConSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyConSort -> IfaceTyConSort -> Bool
== :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
Eq, Eq IfaceTyConSort
Eq IfaceTyConSort =>
(IfaceTyConSort -> IfaceTyConSort -> Ordering)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort)
-> (IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort)
-> Ord IfaceTyConSort
IfaceTyConSort -> IfaceTyConSort -> Bool
IfaceTyConSort -> IfaceTyConSort -> Ordering
IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceTyConSort -> IfaceTyConSort -> Ordering
compare :: IfaceTyConSort -> IfaceTyConSort -> Ordering
$c< :: IfaceTyConSort -> IfaceTyConSort -> Bool
< :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c<= :: IfaceTyConSort -> IfaceTyConSort -> Bool
<= :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c> :: IfaceTyConSort -> IfaceTyConSort -> Bool
> :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c>= :: IfaceTyConSort -> IfaceTyConSort -> Bool
>= :: IfaceTyConSort -> IfaceTyConSort -> Bool
$cmax :: IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort
max :: IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort
$cmin :: IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort
min :: IfaceTyConSort -> IfaceTyConSort -> IfaceTyConSort
Ord)

instance Outputable IfaceTyConSort where
  ppr :: IfaceTyConSort -> SDoc
ppr IfaceTyConSort
IfaceNormalTyCon         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"normal"
  ppr (IfaceTupleTyCon Int
n TupleSort
sort) = TupleSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr TupleSort
sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
  ppr (IfaceSumTyCon Int
n)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sum:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
  ppr IfaceTyConSort
IfaceEqualityTyCon       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"equality"

{- Note [Free TyVars and CoVars in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
an IfaceType and pretty printing that.  This eliminates a lot of
pretty-print duplication, and it matches what we do with pretty-
printing TyThings. See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr.

It works fine for closed types, but when printing debug traces (e.g.
when using -ddump-tc-trace) we print a lot of /open/ types.  These
types are full of TcTyVars, and it's absolutely crucial to print them
in their full glory, with their unique, TcTyVarDetails etc.

So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
Note that:

* We never expect to serialise an IfaceFreeTyVar into an interface file, nor
  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
  and then pretty-print" pipeline.

We do the same for covars, naturally.

Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
in GHC.Builtin.Types.Prim for details).  In an effort to avoid confusing users, we suppress
the differences during pretty printing unless certain flags are enabled.
Here is how each equality predicate* is printed in homogeneous and
heterogeneous contexts, depending on which combination of the
-fprint-explicit-kinds and -fprint-equality-relations flags is used:

--------------------------------------------------------------------------------------------
|         Predicate             |        Neither flag        |    -fprint-explicit-kinds   |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~# b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
|-------------------------------|----------------------------|-----------------------------|
|         Predicate             | -fprint-equality-relations |          Both flags         |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~  b              | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~~ b              | (a :: Type) ~~ (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~# b              | (a :: Type) ~# (b :: Type)  |
| a ~# b,       heterogeneously |        a ~# c              | (a :: Type) ~# (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        a ~R# b             | (a :: Type) ~R# (b :: Type) |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
--------------------------------------------------------------------------------------------

(* There is no heterogeneous, representational, lifted equality counterpart
to (~~). There could be, but there seems to be no use for it.)

This table adheres to the following rules:

A. With -fprint-equality-relations, print the true equality relation.
B. Without -fprint-equality-relations:
     i. If the equality is representational and homogeneous, use Coercible.
    ii. Otherwise, if the equality is representational, use ~R#.
   iii. If the equality is nominal and homogeneous, use ~.
    iv. Otherwise, if the equality is nominal, use ~~.
C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,
   as above; or print the kind with Coercible.
D. Without -fprint-explicit-kinds, don't print kinds.

A hetero-kinded equality is used homogeneously when it is applied to two
identical kinds. Unfortunately, determining this from an IfaceType isn't
possible since we can't see through type synonyms. Consequently, we need to
record whether this particular application is homogeneous in IfaceTyConSort
for the purposes of pretty-printing.

See Note [The equality types story] in GHC.Builtin.Types.Prim.
-}

data IfaceTyConInfo   -- Used only to guide pretty-printing
  = IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
                      -- A PromotionFlag value of IsPromoted indicates
                      -- that the type constructor came from a data
                      -- constructor promoted by -XDataKinds, and thus
                      -- should be printed as 'D to distinguish it from
                      -- an existing type constructor D.
                   , IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort       :: IfaceTyConSort }
    deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
(IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool) -> Eq IfaceTyConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq, Eq IfaceTyConInfo
Eq IfaceTyConInfo =>
(IfaceTyConInfo -> IfaceTyConInfo -> Ordering)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo)
-> (IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo)
-> Ord IfaceTyConInfo
IfaceTyConInfo -> IfaceTyConInfo -> Bool
IfaceTyConInfo -> IfaceTyConInfo -> Ordering
IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceTyConInfo -> IfaceTyConInfo -> Ordering
compare :: IfaceTyConInfo -> IfaceTyConInfo -> Ordering
$c< :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
< :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c<= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
<= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c> :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
> :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c>= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
>= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$cmax :: IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo
max :: IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo
$cmin :: IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo
min :: IfaceTyConInfo -> IfaceTyConInfo -> IfaceTyConInfo
Ord)

-- | This smart constructor allows sharing of the two most common
-- cases. See Note [Sharing IfaceTyConInfo]
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted  IfaceTyConSort
IfaceNormalTyCon = IfaceTyConInfo
promotedNormalTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon = IfaceTyConInfo
notPromotedNormalTyConInfo
mkIfaceTyConInfo PromotionFlag
prom        IfaceTyConSort
sort             = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
prom IfaceTyConSort
sort

{-# NOINLINE promotedNormalTyConInfo #-}
-- | See Note [Sharing IfaceTyConInfo]
promotedNormalTyConInfo :: IfaceTyConInfo
promotedNormalTyConInfo :: IfaceTyConInfo
promotedNormalTyConInfo = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon

{-# NOINLINE notPromotedNormalTyConInfo #-}
-- | See Note [Sharing IfaceTyConInfo]
notPromotedNormalTyConInfo :: IfaceTyConInfo
notPromotedNormalTyConInfo :: IfaceTyConInfo
notPromotedNormalTyConInfo = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon

{-
Note [Sharing IfaceTyConInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'IfaceTyConInfo' occurs an awful lot in 'ModIface', see #19194 for an example.
But almost all of them are

   IfaceTyConInfo IsPromoted IfaceNormalTyCon
   IfaceTyConInfo NotPromoted IfaceNormalTyCon.

The smart constructor `mkIfaceTyConInfo` arranges to share these instances,
thus:

  promotedNormalTyConInfo    = IfaceTyConInfo IsPromoted  IfaceNormalTyCon
  notPromotedNormalTyConInfo = IfaceTyConInfo NotPromoted IfaceNormalTyCon

  mkIfaceTyConInfo IsPromoted  IfaceNormalTyCon = promotedNormalTyConInfo
  mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = notPromotedNormalTyConInfo
  mkIfaceTyConInfo prom        sort             = IfaceTyConInfo prom sort

But ALAS, the (nested) CPR transform can lose this sharing, completely
negating the effect of `mkIfaceTyConInfo`: see #24530 and #19326.

Sticking-plaster solution: add a NOINLINE pragma to those top-level constants.
When we fix the CPR bug we can remove the NOINLINE pragmas.

This one change leads to an 15% reduction in residency for GHC when embedding
'mi_extra_decls': see !12222.
-}

data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion deriving (IfaceMCoercion -> IfaceMCoercion -> Bool
(IfaceMCoercion -> IfaceMCoercion -> Bool)
-> (IfaceMCoercion -> IfaceMCoercion -> Bool) -> Eq IfaceMCoercion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceMCoercion -> IfaceMCoercion -> Bool
== :: IfaceMCoercion -> IfaceMCoercion -> Bool
$c/= :: IfaceMCoercion -> IfaceMCoercion -> Bool
/= :: IfaceMCoercion -> IfaceMCoercion -> Bool
Eq, Eq IfaceMCoercion
Eq IfaceMCoercion =>
(IfaceMCoercion -> IfaceMCoercion -> Ordering)
-> (IfaceMCoercion -> IfaceMCoercion -> Bool)
-> (IfaceMCoercion -> IfaceMCoercion -> Bool)
-> (IfaceMCoercion -> IfaceMCoercion -> Bool)
-> (IfaceMCoercion -> IfaceMCoercion -> Bool)
-> (IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion)
-> (IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion)
-> Ord IfaceMCoercion
IfaceMCoercion -> IfaceMCoercion -> Bool
IfaceMCoercion -> IfaceMCoercion -> Ordering
IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceMCoercion -> IfaceMCoercion -> Ordering
compare :: IfaceMCoercion -> IfaceMCoercion -> Ordering
$c< :: IfaceMCoercion -> IfaceMCoercion -> Bool
< :: IfaceMCoercion -> IfaceMCoercion -> Bool
$c<= :: IfaceMCoercion -> IfaceMCoercion -> Bool
<= :: IfaceMCoercion -> IfaceMCoercion -> Bool
$c> :: IfaceMCoercion -> IfaceMCoercion -> Bool
> :: IfaceMCoercion -> IfaceMCoercion -> Bool
$c>= :: IfaceMCoercion -> IfaceMCoercion -> Bool
>= :: IfaceMCoercion -> IfaceMCoercion -> Bool
$cmax :: IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion
max :: IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion
$cmin :: IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion
min :: IfaceMCoercion -> IfaceMCoercion -> IfaceMCoercion
Ord)

data IfaceCoercion
  = IfaceReflCo       IfaceType
  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
  | IfaceForAllCo     IfaceBndr !ForAllTyFlag !ForAllTyFlag IfaceCoercion IfaceCoercion
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomCo      IfaceAxiomRule [IfaceCoercion]
       -- ^ There are only a fixed number of CoAxiomRules, so it suffices
       -- to use an IfaceLclName to distinguish them.
       -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
  | IfaceUnivCo       UnivCoProvenance Role IfaceType IfaceType [IfaceCoercion]
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | IfaceSelCo        CoSel IfaceCoercion
  | IfaceLRCo         LeftOrRight IfaceCoercion
  | IfaceInstCo       IfaceCoercion IfaceCoercion
  | IfaceKindCo       IfaceCoercion
  | IfaceSubCo        IfaceCoercion
  | IfaceFreeCoVar    CoVar    -- ^ See Note [Free TyVars and CoVars in IfaceType]
  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]
  deriving (IfaceCoercion -> IfaceCoercion -> Bool
(IfaceCoercion -> IfaceCoercion -> Bool)
-> (IfaceCoercion -> IfaceCoercion -> Bool) -> Eq IfaceCoercion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceCoercion -> IfaceCoercion -> Bool
== :: IfaceCoercion -> IfaceCoercion -> Bool
$c/= :: IfaceCoercion -> IfaceCoercion -> Bool
/= :: IfaceCoercion -> IfaceCoercion -> Bool
Eq, Eq IfaceCoercion
Eq IfaceCoercion =>
(IfaceCoercion -> IfaceCoercion -> Ordering)
-> (IfaceCoercion -> IfaceCoercion -> Bool)
-> (IfaceCoercion -> IfaceCoercion -> Bool)
-> (IfaceCoercion -> IfaceCoercion -> Bool)
-> (IfaceCoercion -> IfaceCoercion -> Bool)
-> (IfaceCoercion -> IfaceCoercion -> IfaceCoercion)
-> (IfaceCoercion -> IfaceCoercion -> IfaceCoercion)
-> Ord IfaceCoercion
IfaceCoercion -> IfaceCoercion -> Bool
IfaceCoercion -> IfaceCoercion -> Ordering
IfaceCoercion -> IfaceCoercion -> IfaceCoercion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceCoercion -> IfaceCoercion -> Ordering
compare :: IfaceCoercion -> IfaceCoercion -> Ordering
$c< :: IfaceCoercion -> IfaceCoercion -> Bool
< :: IfaceCoercion -> IfaceCoercion -> Bool
$c<= :: IfaceCoercion -> IfaceCoercion -> Bool
<= :: IfaceCoercion -> IfaceCoercion -> Bool
$c> :: IfaceCoercion -> IfaceCoercion -> Bool
> :: IfaceCoercion -> IfaceCoercion -> Bool
$c>= :: IfaceCoercion -> IfaceCoercion -> Bool
>= :: IfaceCoercion -> IfaceCoercion -> Bool
$cmax :: IfaceCoercion -> IfaceCoercion -> IfaceCoercion
max :: IfaceCoercion -> IfaceCoercion -> IfaceCoercion
$cmin :: IfaceCoercion -> IfaceCoercion -> IfaceCoercion
min :: IfaceCoercion -> IfaceCoercion -> IfaceCoercion
Ord)
  -- Why Ord?  See Note [Ord instance of IfaceType]

data IfaceAxiomRule
  = IfaceAR_X IfLclName               -- Built-in
  | IfaceAR_B IfExtName BranchIndex   -- Branched
  | IfaceAR_U IfExtName               -- Unbranched
  deriving (IfaceAxiomRule -> IfaceAxiomRule -> Bool
(IfaceAxiomRule -> IfaceAxiomRule -> Bool)
-> (IfaceAxiomRule -> IfaceAxiomRule -> Bool) -> Eq IfaceAxiomRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
== :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
$c/= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
/= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
Eq, Eq IfaceAxiomRule
Eq IfaceAxiomRule =>
(IfaceAxiomRule -> IfaceAxiomRule -> Ordering)
-> (IfaceAxiomRule -> IfaceAxiomRule -> Bool)
-> (IfaceAxiomRule -> IfaceAxiomRule -> Bool)
-> (IfaceAxiomRule -> IfaceAxiomRule -> Bool)
-> (IfaceAxiomRule -> IfaceAxiomRule -> Bool)
-> (IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule)
-> (IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule)
-> Ord IfaceAxiomRule
IfaceAxiomRule -> IfaceAxiomRule -> Bool
IfaceAxiomRule -> IfaceAxiomRule -> Ordering
IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IfaceAxiomRule -> IfaceAxiomRule -> Ordering
compare :: IfaceAxiomRule -> IfaceAxiomRule -> Ordering
$c< :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
< :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
$c<= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
<= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
$c> :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
> :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
$c>= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
>= :: IfaceAxiomRule -> IfaceAxiomRule -> Bool
$cmax :: IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule
max :: IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule
$cmin :: IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule
min :: IfaceAxiomRule -> IfaceAxiomRule -> IfaceAxiomRule
Ord)

{- Note [Holes in IfaceCoercion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking fails the typechecker will produce a HoleCo to stand
in place of the unproven assertion. While we generally don't want to
let these unproven assertions leak into interface files, we still need
to be able to pretty-print them as we use IfaceType's pretty-printer
to render Types. For this reason IfaceCoercion has a IfaceHoleCo
constructor; however, we fails when asked to serialize to a
IfaceHoleCo to ensure that they don't end up in an interface file.


%************************************************************************
%*                                                                      *
                Functions over IfaceTypes
*                                                                      *
************************************************************************
-}

ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey IfaceTyCon
tc Unique
key = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
key

-- | Returns true for Type or (TYPE LiftedRep)
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind :: IfaceType -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- Type

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
  , IA_Arg IfaceType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfaceType -> Bool
isIfaceLiftedRep IfaceType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceLiftedTypeKind IfaceType
_ = Bool
False

-- | Returns true for Constraint or (CONSTRAINT LiftedRep)
isIfaceConstraintKind :: IfaceKind -> Bool
isIfaceConstraintKind :: IfaceType -> Bool
isIfaceConstraintKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
constraintKindTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- Type

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
cONSTRAINTTyConKey
  , IA_Arg IfaceType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfaceType -> Bool
isIfaceLiftedRep IfaceType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceConstraintKind IfaceType
_ = Bool
False

isIfaceLiftedRep :: IfaceKind -> Bool
-- Returns true for LiftedRep, or BoxedRep Lifted
isIfaceLiftedRep :: IfaceType -> Bool
isIfaceLiftedRep (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- LiftedRep

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
boxedRepDataConKey
  , IA_Arg IfaceType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfaceType -> Bool
isIfaceLifted IfaceType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceLiftedRep IfaceType
_ = Bool
False

isIfaceLifted :: IfaceKind -> Bool
-- Returns true for Lifted
isIfaceLifted :: IfaceType -> Bool
isIfaceLifted (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedDataConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True
isIfaceLifted IfaceType
_ = Bool
False

splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
-- Mainly for printing purposes
--
-- Here we split nested IfaceSigmaTy properly.
--
-- @
-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)
-- @
--
-- If you called @splitIfaceSigmaTy@ on this type:
--
-- @
-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))
-- @
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
ty
  = case ([IfaceForAllBndr]
bndrs, [IfaceType]
theta) of
      ([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceType]
theta, IfaceType
tau)
      ([IfaceForAllBndr], [IfaceType])
_        -> let ([IfaceForAllBndr]
bndrs', [IfaceType]
theta', IfaceType
tau') = IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
tau
                   in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceType]
theta [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType]
theta', IfaceType
tau')
  where
    ([IfaceForAllBndr]
bndrs, IfaceType
rho)   = IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty
    ([IfaceType]
theta, IfaceType
tau)   = IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
rho

    split_foralls :: IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
        | ForAllTyFlag -> Bool
isInvisibleForAllTyFlag (IfaceForAllBndr -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
        = case IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceType
rho) }
    split_foralls IfaceType
rho = ([], IfaceType
rho)

    split_rho :: IfaceType -> ([IfaceType], IfaceType)
split_rho (IfaceFunTy FunTyFlag
af IfaceType
_ IfaceType
ty1 IfaceType
ty2)
        | FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af
        = case IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
ty2 of { ([IfaceType]
ps, IfaceType
tau) -> (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
ps, IfaceType
tau) }
    split_rho IfaceType
tau = ([], IfaceType
tau)

splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
  | ForAllTyFlag -> Bool
isVisibleForAllTyFlag (IfaceForAllBndr -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
  = case IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceType
rho) }
splitIfaceReqForallTy IfaceType
rho = ([], IfaceType
rho)

suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: forall a. PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles (PrintExplicitKinds Bool
True) [IfaceTyConBinder]
_tys [a]
xs = [a]
xs
suppressIfaceInvisibles (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tys [a]
xs = [IfaceTyConBinder] -> [a] -> [a]
forall {tv} {a}. [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [IfaceTyConBinder]
tys [a]
xs
    where
      suppress :: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
_       []      = []
      suppress []      [a]
a       = [a]
a
      suppress (VarBndr tv TyConBndrVis
k:[VarBndr tv TyConBndrVis]
ks) (a
x:[a]
xs)
        | VarBndr tv TyConBndrVis -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
k =     [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
        | Bool
otherwise                = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs

stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars (PrintExplicitKinds Bool
True)  [IfaceTyConBinder]
tyvars = [IfaceTyConBinder]
tyvars
stripIfaceInvisVars (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tyvars
  = (IfaceTyConBinder -> Bool)
-> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. (a -> Bool) -> [a] -> [a]
filterOut IfaceTyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars

-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = IfaceForAllBndr -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar

-- | Extract the variable name from an 'IfaceForAllBndr'.
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> IfLclName
ifaceBndrName (IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar IfaceForAllBndr
fab)

-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = IfaceTyConBinder -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar

-- | Extract the variable name from an 'IfaceTyConBinder'.
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> IfLclName
ifaceBndrName (IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar IfaceTyConBinder
tcb)

ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree :: IfaceType -> Bool
ifTypeIsVarFree IfaceType
ty = IfaceType -> Bool
go IfaceType
ty
  where
    go :: IfaceType -> Bool
go (IfaceTyVar {})         = Bool
False
    go (IfaceFreeTyVar {})     = Bool
False
    go (IfaceAppTy IfaceType
fun IfaceAppArgs
args)   = IfaceType -> Bool
go IfaceType
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceFunTy FunTyFlag
_ IfaceType
w IfaceType
arg IfaceType
res) = IfaceType -> Bool
go IfaceType
w Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
res
    go (IfaceForAllTy {})      = Bool
False
    go (IfaceTyConApp IfaceTyCon
_ IfaceAppArgs
args)  = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceTupleTy TupleSort
_ PromotionFlag
_ IfaceAppArgs
args) = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceLitTy IfaceTyLit
_)          = Bool
True
    go (IfaceCastTy {})        = Bool
False -- Safe
    go (IfaceCoercionTy {})    = Bool
False -- Safe

    go_args :: IfaceAppArgs -> Bool
go_args IfaceAppArgs
IA_Nil = Bool
True
    go_args (IA_Arg IfaceType
arg ForAllTyFlag
_ IfaceAppArgs
args) = IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args

{- Note [Substitution on IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Substitutions on IfaceType are done only during pretty-printing to
construct the result type of a GADT, and does not deal with binders
(eg IfaceForAll), so it doesn't need fancy capture stuff.  -}

type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]

mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
-- See Note [Substitution on IfaceType]
mkIfaceTySubst :: [IfaceTvBndr] -> IfaceTySubst
mkIfaceTySubst [IfaceTvBndr]
eq_spec = [(FastString, IfaceType)] -> IfaceTySubst
forall a. [(FastString, a)] -> FastStringEnv a
mkFsEnv ((IfaceTvBndr -> (FastString, IfaceType))
-> [IfaceTvBndr] -> [(FastString, IfaceType)]
forall a b. (a -> b) -> [a] -> [b]
map ((IfLclName -> FastString) -> IfaceTvBndr -> (FastString, IfaceType)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first IfLclName -> FastString
ifLclNameFS) [IfaceTvBndr]
eq_spec)

inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
-- See Note [Substitution on IfaceType]
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst IfaceTySubst
subst (IfLclName
fs, IfaceType
_) = Maybe IfaceType -> Bool
forall a. Maybe a -> Bool
isJust (IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subst (IfLclName -> FastString
ifLclNameFS IfLclName
fs))

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
-- See Note [Substitution on IfaceType]
substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType IfaceTySubst
env IfaceType
ty
  = IfaceType -> IfaceType
go IfaceType
ty
  where
    go :: IfaceType -> IfaceType
go (IfaceFreeTyVar TyVar
tv)    = TyVar -> IfaceType
IfaceFreeTyVar TyVar
tv
    go (IfaceTyVar IfLclName
tv)        = IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar IfaceTySubst
env IfLclName
tv
    go (IfaceAppTy  IfaceType
t IfaceAppArgs
ts)     = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy  (IfaceType -> IfaceType
go IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
    go (IfaceFunTy FunTyFlag
af IfaceType
w IfaceType
t1 IfaceType
t2)  = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
af (IfaceType -> IfaceType
go IfaceType
w) (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
    go ty :: IfaceType
ty@(IfaceLitTy {})     = IfaceType
ty
    go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
s PromotionFlag
i (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceForAllTy {})     = String -> SDoc -> IfaceType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
    go (IfaceCastTy IfaceType
ty IfaceCoercion
co)    = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceType -> IfaceType
go IfaceType
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go (IfaceCoercionTy IfaceCoercion
co)   = IfaceCoercion -> IfaceType
IfaceCoercionTy (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)

    go_mco :: IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
IfaceMRefl    = IfaceMCoercion
IfaceMRefl
    go_mco (IfaceMCo IfaceCoercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co

    go_co :: IfaceCoercion -> IfaceCoercion
go_co (IfaceReflCo IfaceType
ty)           = IfaceType -> IfaceCoercion
IfaceReflCo (IfaceType -> IfaceType
go IfaceType
ty)
    go_co (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
mco)    = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfaceType -> IfaceType
go IfaceType
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
    go_co (IfaceFunCo Role
r IfaceCoercion
w IfaceCoercion
c1 IfaceCoercion
c2)     = Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
w) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos) = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r IfaceTyCon
tc ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2)         = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceForAllCo {})         = String -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceCoercion" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
    go_co (IfaceFreeCoVar TyVar
cv)        = TyVar -> IfaceCoercion
IfaceFreeCoVar TyVar
cv
    go_co (IfaceCoVarCo IfLclName
cv)          = IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
cv
    go_co (IfaceHoleCo TyVar
cv)           = TyVar -> IfaceCoercion
IfaceHoleCo TyVar
cv
    go_co (IfaceUnivCo UnivCoProvenance
p Role
r IfaceType
t1 IfaceType
t2 [IfaceCoercion]
ds) = UnivCoProvenance
-> Role
-> IfaceType
-> IfaceType
-> [IfaceCoercion]
-> IfaceCoercion
IfaceUnivCo UnivCoProvenance
p Role
r (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2) ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
ds)
    go_co (IfaceSymCo IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSymCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)     = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co2)
    go_co (IfaceSelCo CoSel
n IfaceCoercion
co)          = CoSel -> IfaceCoercion -> IfaceCoercion
IfaceSelCo CoSel
n (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceLRCo LeftOrRight
lr IfaceCoercion
co)          = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceInstCo IfaceCoercion
c1 IfaceCoercion
c2)        = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceKindCo IfaceCoercion
co)           = IfaceCoercion -> IfaceCoercion
IfaceKindCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceSubCo IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSubCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceAxiomCo IfaceAxiomRule
n [IfaceCoercion]
cos)       = IfaceAxiomRule -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomCo IfaceAxiomRule
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)

    go_cos :: [IfaceCoercion] -> [IfaceCoercion]
go_cos = (IfaceCoercion -> IfaceCoercion)
-> [IfaceCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> IfaceCoercion
go_co

substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
args
  = IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
args
  where
    go :: IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
IA_Nil              = IfaceAppArgs
IA_Nil
    go (IA_Arg IfaceType
ty ForAllTyFlag
arg IfaceAppArgs
tys) = IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceType -> IfaceType
substIfaceType IfaceTySubst
env IfaceType
ty) ForAllTyFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)

substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar IfaceTySubst
env IfLclName
tv
  | Just IfaceType
ty <- IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
env (IfLclName -> FastString
ifLclNameFS IfLclName
tv) = IfaceType
ty
  | Bool
otherwise                     = IfLclName -> IfaceType
IfaceTyVar IfLclName
tv


{-
************************************************************************
*                                                                      *
                Functions over IfaceAppArgs
*                                                                      *
************************************************************************
-}

stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (PrintExplicitKinds Bool
True)  IfaceAppArgs
tys = IfaceAppArgs
tys
stripInvisArgs (PrintExplicitKinds Bool
False) IfaceAppArgs
tys = IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
tys
    where
      suppress_invis :: IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
c
        = case IfaceAppArgs
c of
            IfaceAppArgs
IA_Nil -> IfaceAppArgs
IA_Nil
            IA_Arg IfaceType
t ForAllTyFlag
argf IfaceAppArgs
ts
              |  ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
argf
              -> IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t ForAllTyFlag
argf (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$ IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts
              -- Keep recursing through the remainder of the arguments, as it's
              -- possible that there are remaining invisible ones.
              -- See the "In type declarations" section of Note [VarBndrs,
              -- ForAllTyBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep.
              |  Bool
otherwise
              -> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts

appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
IA_Nil = []
appArgsIfaceTypes (IA_Arg IfaceType
t ForAllTyFlag
_ IfaceAppArgs
ts) = IfaceType
t IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
ts

appArgsIfaceTypesForAllTyFlags :: IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags :: IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags IfaceAppArgs
IA_Nil = []
appArgsIfaceTypesForAllTyFlags (IA_Arg IfaceType
t ForAllTyFlag
a IfaceAppArgs
ts)
                                 = (IfaceType
t, ForAllTyFlag
a) (IfaceType, ForAllTyFlag)
-> [(IfaceType, ForAllTyFlag)] -> [(IfaceType, ForAllTyFlag)]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags IfaceAppArgs
ts

ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = Int -> IfaceAppArgs -> Int
forall {t}. Num t => t -> IfaceAppArgs -> t
go Int
0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
    go t
n  (IA_Arg IfaceType
_ ForAllTyFlag
argf IfaceAppArgs
rest)
      | ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
argf = t -> IfaceAppArgs -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) IfaceAppArgs
rest
      | Bool
otherwise             = t -> IfaceAppArgs -> t
go t
n IfaceAppArgs
rest

ifaceAppArgsLength :: IfaceAppArgs -> Int
ifaceAppArgsLength :: IfaceAppArgs -> Int
ifaceAppArgsLength = Int -> IfaceAppArgs -> Int
forall {t}. Num t => t -> IfaceAppArgs -> t
go Int
0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
    go !t
n (IA_Arg IfaceType
_ ForAllTyFlag
_ IfaceAppArgs
ts) = t -> IfaceAppArgs -> t
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) IfaceAppArgs
ts

{-
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We use the IfaceAppArgs data type to specify which of the arguments to a type
should be displayed when pretty-printing, under the control of
-fprint-explicit-kinds.
See also Type.filterOutInvisibleTypes.
For example, given

    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
    'Just :: forall k. k -> 'Maybe k   -- Promoted

we want

    T * Tree Int    prints as    T Tree Int
    'Just *         prints as    Just *

For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,
since the corresponding Core constructor:

    data Type
      = ...
      | TyConApp TyCon [Type]

Already puts all of its arguments into a list. So when converting a Type to an
IfaceType (see toIfaceAppArgsX in GHC.Core.ToIface), we simply use the kind of
the TyCon (which is cached) to guide the process of converting the argument
Types into an IfaceAppArgs list.

We also want this behavior for IfaceAppTy, since given:

    data Proxy (a :: k)
    f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)

We want to print the return type as `Proxy (t True)` without the use of
-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the
tycon case, because the corresponding Core constructor for IfaceAppTy:

    data Type
      = ...
      | AppTy Type Type

Only stores one argument at a time. Therefore, when converting an AppTy to an
IfaceAppTy (in toIfaceTypeX in GHC.CoreToIface), we:

1. Flatten the chain of AppTys down as much as possible
2. Use typeKind to determine the function Type's kind
3. Use this kind to guide the process of converting the argument Types into an
   IfaceAppArgs list.

By flattening the arguments like this, we obtain two benefits:

(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as
    we do IfaceTyApp arguments, which means that we only need to implement the
    logic to filter out invisible arguments once.
(b) Unlike for tycons, finding the kind of a type in general (through typeKind)
    is not a constant-time operation, so by flattening the arguments first, we
    decrease the number of times we have to call typeKind.

Note [Pretty-printing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note [Suppressing invisible arguments] is all about how to avoid printing
invisible arguments when the -fprint-explicit-kinds flag is disables. Well,
what about when it's enabled? Then we can and should print invisible kind
arguments, and this Note explains how we do it.

As two running examples, consider the following code:

  {-# LANGUAGE PolyKinds #-}
  data T1 a
  data T2 (a :: k)

When displaying these types (with -fprint-explicit-kinds on), we could just
do the following:

  T1 k a
  T2 k a

That certainly gets the job done. But it lacks a crucial piece of information:
is the `k` argument inferred or specified? To communicate this, we use visible
kind application syntax to distinguish the two cases:

  T1 @{k} a
  T2 @k   a

Here, @{k} indicates that `k` is an inferred argument, and @k indicates that
`k` is a specified argument. (See
Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep for
a lengthier explanation on what "inferred" and "specified" mean.)

************************************************************************
*                                                                      *
                Pretty-printing
*                                                                      *
************************************************************************
-}

if_print_coercions :: SDoc  -- ^ if printing coercions
                   -> SDoc  -- ^ otherwise
                   -> SDoc
if_print_coercions :: SDoc -> SDoc -> SDoc
if_print_coercions SDoc
yes SDoc
no
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_co ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
    (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
    if Bool
print_co Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug
    then SDoc
yes
    else SDoc
no

pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
pp_tc SDoc
pp_ty1 SDoc
pp_ty2
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
pp_ty1, SDoc
pp_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ty2]

pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec SDoc
pp_fun [SDoc]
pp_tys
  | [SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
pp_tys = SDoc
pp_fun
  | Bool
otherwise   = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
pp_fun Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc]
pp_tys)

isIfaceRhoType :: IfaceType -> Bool
isIfaceRhoType :: IfaceType -> Bool
isIfaceRhoType (IfaceForAllTy IfaceForAllBndr
_ IfaceType
_)   = Bool
False
isIfaceRhoType (IfaceFunTy FunTyFlag
af IfaceType
_ IfaceType
_ IfaceType
_) = FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af
isIfaceRhoType IfaceType
_ = Bool
True

-- ----------------------------- Printing binders ------------------------------------

instance Outputable IfaceBndr where
    ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
bndr (Bool -> SuppressBndrSig
SuppressBndrSig Bool
False)
                                                             (Bool -> UseBndrParens
UseBndrParens Bool
False)

pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs [IfaceBndr]
bs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((IfaceBndr -> SDoc) -> [IfaceBndr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceBndr]
bs)

pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceNoOneShot) = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceOneShot)   = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[OneShot]"

pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (IfaceType
w, IfLclName
name, IfaceType
ty) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (IfaceType -> SDoc
ppr_ty_nested IfaceType
w) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
ppr_ty_nested IfaceType
ty)

{- Note [Suppressing binder signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When printing the binders in a 'forall', we want to keep the kind annotations:

    forall (a :: k). blah
              ^^^^
              good

On the other hand, when we print the binders of a data declaration in :info,
the kind information would be redundant due to the standalone kind signature:

   type F :: Symbol -> Type
   type F (s :: Symbol) = blah
             ^^^^^^^^^
             redundant

Here we'd like to omit the kind annotation:

   type F :: Symbol -> Type
   type F s = blah

Note [Printing type abbreviations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Normally, we pretty-print
   `TYPE       'LiftedRep` as `Type` (or `*`)
   `CONSTRAINT 'LiftedRep` as `Constraint`
   `FUN 'Many`             as `(->)`
This way, error messages don't refer to representation polymorphism
or linearity if it is not necessary.  Normally we'd would represent
these types using their synonyms (see GHC.Core.Type
Note [Using synonyms to compress types]), but in the :kind! GHCi
command we specifically expand synonyms (see GHC.Tc.Module.tcRnExpr).
So here in the pretty-printing we effectively collapse back Type
and Constraint to their synonym forms.  A bit confusing!

However, when printing the definition of Type, Constraint or (->) with :info,
this would give confusing output: `type (->) = (->)` (#18594).
Solution: detect when we are in :info and disable displaying the synonym
with the SDoc option sdocPrintTypeAbbreviations.
If you are creating a similar synonym, make sure it is listed in pprIfaceDecl,
see reference to this Note.

If there will be a need, in the future we could expose it as a flag
-fprint-type-abbreviations or even three separate flags controlling
TYPE 'LiftedRep, CONSTRAINT 'LiftedRep and FUN 'Many.
-}

-- | Do we want to suppress kind annotations on binders?
-- See Note [Suppressing binder signatures]
newtype SuppressBndrSig = SuppressBndrSig Bool

newtype UseBndrParens      = UseBndrParens Bool
newtype PrintExplicitKinds = PrintExplicitKinds Bool

pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (IfLclName
tv, IfaceType
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
  | Bool
suppress_sig             = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv
  | IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
ki = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv
  | Bool
otherwise                = SDoc -> SDoc
maybe_parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
ppr_ty_nested IfaceType
ki)
  where
    maybe_parens :: SDoc -> SDoc
maybe_parens | Bool
use_parens = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens
                 | Bool
otherwise  = SDoc -> SDoc
forall a. a -> a
id

pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders SuppressBndrSig
suppress_sig = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ([SDoc] -> SDoc)
-> ([IfaceTyConBinder] -> [SDoc]) -> [IfaceTyConBinder] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceTyConBinder -> SDoc) -> [IfaceTyConBinder] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceTyConBinder -> SDoc
go
  where
    go :: IfaceTyConBinder -> SDoc
    go :: IfaceTyConBinder -> SDoc
go (Bndr (IfaceIdBndr IfaceIdBndr
bndr) TyConBndrVis
_) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    go (Bndr (IfaceTvBndr IfaceTvBndr
bndr) TyConBndrVis
vis) =
      -- See Note [Pretty-printing invisible arguments]
      case TyConBndrVis
vis of
        TyConBndrVis
AnonTCB            -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ForAllTyFlag
Required  -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ForAllTyFlag
Specified -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ForAllTyFlag
Inferred  -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
      where
        ppr_bndr :: UseBndrParens -> SDoc
ppr_bndr = IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
bndr SuppressBndrSig
suppress_sig

instance Binary IfaceBndr where
    put_ :: WriteBinHandle -> IfaceBndr -> IO ()
put_ WriteBinHandle
bh (IfaceIdBndr IfaceIdBndr
aa) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
            WriteBinHandle -> IfaceIdBndr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceIdBndr
aa
    put_ WriteBinHandle
bh (IfaceTvBndr IfaceTvBndr
ab) = do
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
            WriteBinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTvBndr
ab
    get :: ReadBinHandle -> IO IfaceBndr
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> do aa <- ReadBinHandle -> IO IfaceIdBndr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      return (IfaceIdBndr aa)
              Word8
_ -> do ab <- ReadBinHandle -> IO IfaceTvBndr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      return (IfaceTvBndr ab)

instance Binary IfaceOneShot where
    put_ :: WriteBinHandle -> IfaceOneShot -> IO ()
put_ WriteBinHandle
bh IfaceOneShot
IfaceNoOneShot =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh IfaceOneShot
IfaceOneShot =
            WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    get :: ReadBinHandle -> IO IfaceOneShot
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> IfaceOneShot -> IO IfaceOneShot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
              Word8
_ -> IfaceOneShot -> IO IfaceOneShot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceOneShot

-- ----------------------------- Printing IfaceType ------------------------------------

---------------------------------
instance Outputable IfaceType where
  ppr :: IfaceType -> SDoc
ppr IfaceType
ty = IfaceType -> SDoc
pprIfaceType IfaceType
ty

-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not
-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables]
-- wrinkle (W2).
pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc
pprIfaceType :: IfaceType -> SDoc
pprIfaceType       = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
topPrec
pprParendIfaceType :: IfaceType -> SDoc
pprParendIfaceType = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
appPrec
ppr_ty_nested :: IfaceType -> SDoc
ppr_ty_nested = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec

pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
-- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be
-- called from other places, besides `:type` and `:info`.
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
prec IfaceType
ty =
  (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec) IfaceType
ty

pprTypeArrow :: FunTyFlag -> IfaceMult -> SDoc
pprTypeArrow :: FunTyFlag -> IfaceType -> SDoc
pprTypeArrow FunTyFlag
af IfaceType
mult
  = (IfaceType -> Maybe IfaceTyCon, PprPrec -> IfaceType -> SDoc)
-> FunTyFlag -> IfaceType -> SDoc
forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (IfaceType -> Maybe IfaceTyCon
mb_conc, PprPrec -> IfaceType -> SDoc
pprPrecIfaceType) FunTyFlag
af IfaceType
mult
  where
    mb_conc :: IfaceType -> Maybe IfaceTyCon
mb_conc (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just IfaceTyCon
tc
    mb_conc IfaceType
_                    = Maybe IfaceTyCon
forall a. Maybe a
Nothing

pprArrow :: (a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
         -> FunTyFlag -> a -> SDoc
-- Prints a thin arrow (->) with its multiplicity
-- Used for both FunTy and FunCo, hence higher order arguments
pprArrow :: forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (a -> Maybe IfaceTyCon
mb_conc, PprPrec -> a -> SDoc
ppr_mult) FunTyFlag
af a
mult
  | FunTyFlag -> Bool
isFUNArg FunTyFlag
af
  = case a -> Maybe IfaceTyCon
mb_conc a
mult of
      Just IfaceTyCon
tc | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey -> SDoc
arrow
              | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
oneDataConKey  -> SDoc
lollipop
      Maybe IfaceTyCon
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> a -> SDoc
ppr_mult PprPrec
appPrec a
mult SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
  | Bool
otherwise
  = TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FunTyFlag -> TyCon
funTyFlagTyCon FunTyFlag
af)

ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceType
ty
  | Bool -> Bool
not (IfaceType -> Bool
isIfaceRhoType IfaceType
ty)             = ShowForAllFlag -> PprPrec -> IfaceType -> SDoc
ppr_sigma ShowForAllFlag
ShowForAllMust PprPrec
ctxt_prec IfaceType
ty
ppr_ty PprPrec
_         (IfaceForAllTy {})     = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"ppr_ty"  -- Covered by not.isIfaceRhoType
ppr_ty PprPrec
_         (IfaceFreeTyVar TyVar
tyvar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tyvar  -- This is the main reason for IfaceFreeTyVar!
ppr_ty PprPrec
_         (IfaceTyVar IfLclName
tyvar)     = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tyvar  -- See Note [Free TyVars and CoVars in IfaceType]
ppr_ty PprPrec
ctxt_prec (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys
ppr_ty PprPrec
ctxt_prec (IfaceTupleTy TupleSort
i PromotionFlag
p IfaceAppArgs
tys) = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple PprPrec
ctxt_prec TupleSort
i PromotionFlag
p IfaceAppArgs
tys -- always fully saturated
ppr_ty PprPrec
_         (IfaceLitTy IfaceTyLit
n)         = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n

        -- Function types
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceFunTy FunTyFlag
af IfaceType
w IfaceType
ty1 IfaceType
ty2)  -- Should be a visible argument
  = Bool -> SDoc -> SDoc -> SDoc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af) (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$  -- Ensured by isIfaceRhoType above
    -- We want to print a chain of arrows in a column
    --     type1
    --     -> type2
    --     -> type3
    PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1, [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
w IfaceType
ty2)]
  where
    ppr_fun_tail :: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wthis (IfaceFunTy FunTyFlag
af IfaceType
wnext IfaceType
ty1 IfaceType
ty2)
      | FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af
      = (FunTyFlag -> IfaceType -> SDoc
pprTypeArrow FunTyFlag
af IfaceType
wthis SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wnext IfaceType
ty2
    ppr_fun_tail IfaceType
wthis IfaceType
other_ty
      = [FunTyFlag -> IfaceType -> SDoc
pprTypeArrow FunTyFlag
af IfaceType
wthis SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
ppr_ty_nested IfaceType
other_ty]

ppr_ty PprPrec
ctxt_prec (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      SDoc
ppr_app_ty
      SDoc
ppr_app_ty_no_casts
  where
    ppr_app_ty :: SDoc
ppr_app_ty =
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
        let tys_wo_kinds :: [(IfaceType, ForAllTyFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfaceType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs
                              (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
ts
        in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec
                             (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
t)
                             (((IfaceType, ForAllTyFlag) -> SDoc)
-> [(IfaceType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) [(IfaceType, ForAllTyFlag)]
tys_wo_kinds)


    -- Strip any casts from the head of the application
    ppr_app_ty_no_casts :: SDoc
ppr_app_ty_no_casts =
        case IfaceType
t of
          IfaceCastTy IfaceType
head IfaceCoercion
_ -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec (IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys IfaceType
head IfaceAppArgs
ts)
          IfaceType
_                  -> SDoc
ppr_app_ty

    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys1) IfaceAppArgs
tys2 =
        IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceAppArgs
tys1 IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Monoid a => a -> a -> a
`mappend` IfaceAppArgs
tys2)
    mk_app_tys IfaceType
t1 IfaceAppArgs
tys2 = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
t1 IfaceAppArgs
tys2

ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfaceType
ty IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"|>" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
      (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceType
ty)

ppr_ty PprPrec
ctxt_prec (IfaceCoercionTy IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
ctxt_prec IfaceCoercion
co)
      (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<>")

{- Note [Defaulting RuntimeRep variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RuntimeRep variables are considered by many (most?) users to be little
more than syntactic noise. When the notion was introduced there was a
significant and understandable push-back from those with pedagogy in
mind, which argued that RuntimeRep variables would throw a wrench into
nearly any teach approach since they appear in even the lowly ($)
function's type,

    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b

which is significantly less readable than its non RuntimeRep-polymorphic type of

    ($) :: (a -> b) -> a -> b

Moreover, unboxed types don't appear all that often in run-of-the-mill
Haskell programs, so it makes little sense to make all users pay this
syntactic overhead.

For this reason it was decided that we would hide RuntimeRep variables
for now (see #11549). We do this right in the pretty-printer, by pre-processing
the type we are about to print, to default any type variables of kind RuntimeRep
that are bound by toplevel invisible quantification to LiftedRep.
Likewise, we default Multiplicity variables to Many and Levity variables to
Lifted.

This is done in a pass right before pretty-printing
(defaultIfaceTyVarsOfKind, controlled by
-fprint-explicit-runtime-reps and -XLinearTypes)

This applies to /quantified/ variables like 'w' above.  What about
variables that are /free/ in the type being printed, which certainly
happens in error messages.  Suppose (#16074, #19361) we are reporting a
mismatch between skolems
          (a :: RuntimeRep) ~ (b :: RuntimeRep)
        or
          (m :: Multiplicity) ~ Many
We certainly don't want to say "Can't match LiftedRep with LiftedRep" or
"Can't match Many with Many"!

But if we are printing the type
    (forall (a :: TYPE r). blah)
we do want to turn that (free) r into LiftedRep, so it prints as
    (forall a. blah)

We use isMetaTyVar to distinguish between those two situations:
metavariables are converted, skolem variables are not.

There's one exception though: TyVarTv metavariables should not be defaulted,
as they appear during kind-checking of "newtype T :: TYPE r where..."
(test T18357a). Therefore, we additionally test for isTyConableTyVar.

Wrinkles:

(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1',
     around that indicates whether we haven't yet descended into the arguments
     of a function type.
     This is used to decide whether newly bound variables are eligible for
     defaulting – we do not want contravariant foralls to be defaulted because
     that would result in an incorrect, rather than specialized, type.
     For example:
       ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1
     We want to default 'r1', but not 'r2'.
     When examining the first forall, 'rank1' is True.
     The toplevel function type is matched as IfaceFunTy, where we recurse into
     'go' by passing False for 'rank1'.
     The forall in the first argument then skips adding a substitution for 'r2'.

(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a
     type.
     A few components of the printing machinery used to invoke 'ppr' on types
     nested in secondary structures like IfaceBndr, which would repeat the
     defaulting process, but treating the type as if it were top-level, causing
     unwanted defaulting.
     In order to prevent future developers from using 'ppr' again or being
     confused that @ppr_ty topPrec@ is used, we introduced a marker function,
     'ppr_ty_nested'.
-}

-- | Default 'RuntimeRep' variables to 'LiftedRep',
--   'Levity' variables to 'Lifted', and 'Multiplicity'
--   variables to 'Many'. For example:
--
-- @
-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
--        (a -> b) -> a -> b
-- Just :: forall (k :: Multiplicity) a. a % k -> Maybe a
-- @
--
-- turns in to,
--
-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
-- @ Just :: forall a . a -> Maybe a @
--
-- We do this to prevent RuntimeRep, Levity and Multiplicity variables from
-- incurring a significant syntactic overhead in otherwise simple
-- type signatures (e.g. ($)). See Note [Defaulting RuntimeRep variables]
-- and #11549 for further discussion.
defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables?
                         -> Bool -- ^ default 'Multiplicity' variables?
                         -> IfaceType -> IfaceType
defaultIfaceTyVarsOfKind :: Bool -> Bool -> IfaceType -> IfaceType
defaultIfaceTyVarsOfKind Bool
def_rep Bool
def_mult IfaceType
ty = IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
forall a. FastStringEnv a
emptyFsEnv Bool
True IfaceType
ty
  where
    go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables
       -> Bool -- Are we in a toplevel forall, where defaulting is allowed?
       -> IfaceType
       -> IfaceType
    go :: IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
True (IfaceForAllTy (Bndr (IfaceTvBndr (IfLclName
var, IfaceType
var_kind)) ForAllTyFlag
argf) IfaceType
ty)
     | ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf  -- Don't default *visible* quantification
                                     -- or we get the mess in #13963
     , Just IfaceType
substituted_ty <- IfaceType -> Maybe IfaceType
check_substitution IfaceType
var_kind
      = let subs' :: IfaceTySubst
subs' = IfaceTySubst -> FastString -> IfaceType -> IfaceTySubst
forall a. FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv IfaceTySubst
subs (IfLclName -> FastString
ifLclNameFS IfLclName
var) IfaceType
substituted_ty
            -- Record that we should replace it with LiftedRep/Lifted/Many,
            -- and recurse, discarding the forall
        in IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs' Bool
True IfaceType
ty

    go IfaceTySubst
subs Bool
rank1 (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
      = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs IfaceForAllBndr
bndr) (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
rank1 IfaceType
ty)

    go IfaceTySubst
subs Bool
_ ty :: IfaceType
ty@(IfaceTyVar IfLclName
tv) = case IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subs (IfLclName -> FastString
ifLclNameFS IfLclName
tv) of
      Just IfaceType
s -> IfaceType
s
      Maybe IfaceType
Nothing -> IfaceType
ty

    go IfaceTySubst
_ Bool
_ ty :: IfaceType
ty@(IfaceFreeTyVar TyVar
tv)
      -- See Note [Defaulting RuntimeRep variables], about free vars
      | Bool
def_rep
      , Type -> Bool
GHC.Core.Type.isRuntimeRepTy (TyVar -> Type
tyVarKind TyVar
tv)
      , TyVar -> Bool
isMetaTyVar TyVar
tv
      , TyVar -> Bool
isTyConableTyVar TyVar
tv
      = IfaceType
liftedRep_ty
      | Bool
def_rep
      , Type -> Bool
GHC.Core.Type.isLevityTy (TyVar -> Type
tyVarKind TyVar
tv)
      , TyVar -> Bool
isMetaTyVar TyVar
tv
      , TyVar -> Bool
isTyConableTyVar TyVar
tv
      = IfaceType
lifted_ty
      | Bool
def_mult
      , Type -> Bool
GHC.Core.Type.isMultiplicityTy (TyVar -> Type
tyVarKind TyVar
tv)
      , TyVar -> Bool
isMetaTyVar TyVar
tv
      , TyVar -> Bool
isTyConableTyVar TyVar
tv
      = IfaceType
many_ty
      | Bool
otherwise
      = IfaceType
ty

    go IfaceTySubst
subs Bool
_ (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
      = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)

    go IfaceTySubst
subs Bool
_ (IfaceTupleTy TupleSort
sort PromotionFlag
is_prom IfaceAppArgs
tc_args)
      = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
sort PromotionFlag
is_prom (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)

    go IfaceTySubst
subs Bool
rank1 (IfaceFunTy FunTyFlag
af IfaceType
w IfaceType
arg IfaceType
res)
      = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
af (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
w) (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
arg) (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
rank1 IfaceType
res)

    go IfaceTySubst
subs Bool
_ (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
      = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
ts)

    go IfaceTySubst
subs Bool
rank1 (IfaceCastTy IfaceType
x IfaceCoercion
co)
      = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
rank1 IfaceType
x) IfaceCoercion
co

    go IfaceTySubst
_ Bool
_ ty :: IfaceType
ty@(IfaceLitTy {}) = IfaceType
ty
    go IfaceTySubst
_ Bool
_ ty :: IfaceType
ty@(IfaceCoercionTy {}) = IfaceType
ty

    go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr
    go_ifacebndr :: IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs (Bndr (IfaceIdBndr (IfaceType
w, IfLclName
n, IfaceType
t)) ForAllTyFlag
argf)
      = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceIdBndr -> IfaceBndr
IfaceIdBndr (IfaceType
w, IfLclName
n, IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
t)) ForAllTyFlag
argf
    go_ifacebndr IfaceTySubst
subs (Bndr (IfaceTvBndr (IfLclName
n, IfaceType
t)) ForAllTyFlag
argf)
      = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (IfLclName
n, IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
t)) ForAllTyFlag
argf

    go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs
    go_args :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
_ IfaceAppArgs
IA_Nil = IfaceAppArgs
IA_Nil
    go_args IfaceTySubst
subs (IA_Arg IfaceType
ty ForAllTyFlag
argf IfaceAppArgs
args)
      = IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> Bool -> IfaceType -> IfaceType
go IfaceTySubst
subs Bool
False IfaceType
ty) ForAllTyFlag
argf (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
args)

    check_substitution :: IfaceType -> Maybe IfaceType
    check_substitution :: IfaceType -> Maybe IfaceType
check_substitution (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_)
        | Bool
def_rep
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
runtimeRepTyConKey
        = IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
liftedRep_ty
        | Bool
def_rep
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
levityTyConKey
        = IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
lifted_ty
        | Bool
def_mult
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
multiplicityTyConKey
        = IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
many_ty
    check_substitution IfaceType
_ = Maybe IfaceType
forall a. Maybe a
Nothing

-- | The type ('BoxedRep 'Lifted), also known as LiftedRep.
liftedRep_ty :: IfaceType
liftedRep_ty :: IfaceType
liftedRep_ty =
  IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
  where
    liftedRep :: IfaceTyCon
    liftedRep :: IfaceTyCon
liftedRep = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
tc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon)
      where tc_name :: IfExtName
tc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepTyCon

-- | The type 'Lifted :: Levity'.
lifted_ty :: IfaceType
lifted_ty :: IfaceType
lifted_ty =
    IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                  IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedDataConTyCon

-- | The type 'Many :: Multiplicity'.
many_ty :: IfaceType
many_ty :: IfaceType
many_ty = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                        IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
manyDataConTyCon

hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes IfaceType -> SDoc
f IfaceType
ty
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitRuntimeReps ->
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
linearTypes ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty    ->
    let def_rep :: Bool
def_rep  = Bool -> Bool
not Bool
printExplicitRuntimeReps
        def_mult :: Bool
def_mult = Bool -> Bool
not Bool
linearTypes
    in if PprStyle -> Bool
userStyle PprStyle
sty
       then IfaceType -> SDoc
f (Bool -> Bool -> IfaceType -> IfaceType
defaultIfaceTyVarsOfKind Bool
def_rep Bool
def_mult IfaceType
ty)
       else IfaceType -> SDoc
f IfaceType
ty

instance Outputable IfaceAppArgs where
  ppr :: IfaceAppArgs -> SDoc
ppr IfaceAppArgs
tca = IfaceAppArgs -> SDoc
pprIfaceAppArgs IfaceAppArgs
tca

pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs  = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
topPrec
pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprParendIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
appPrec

ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
ctx_prec = IfaceAppArgs -> SDoc
go
  where
    go :: IfaceAppArgs -> SDoc
    go :: IfaceAppArgs -> SDoc
go IfaceAppArgs
IA_Nil             = SDoc
forall doc. IsOutput doc => doc
empty
    go (IA_Arg IfaceType
t ForAllTyFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
t, ForAllTyFlag
argf) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceAppArgs -> SDoc
go IfaceAppArgs
ts

-- See Note [Pretty-printing invisible arguments]
ppr_app_arg :: PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg :: PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
t, ForAllTyFlag
argf) =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
  case ForAllTyFlag
argf of
       ForAllTyFlag
Required  -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctx_prec IfaceType
t
       ForAllTyFlag
Specified |  Bool
print_kinds
                 -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec IfaceType
t
       ForAllTyFlag
Inferred  |  Bool
print_kinds
                 -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (IfaceType -> SDoc
ppr_ty_nested IfaceType
t)
       ForAllTyFlag
_         -> SDoc
forall doc. IsOutput doc => doc
empty

-------------------
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
pprIfaceForAllPart [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
  = ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllWhen [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc

-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
pprIfaceForAllPartMust [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
  = ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllMust [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc

pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
                     -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
-> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs SDoc
sdoc
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCo [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs, SDoc
sdoc ]

ppr_iface_forall_part :: ShowForAllFlag
                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ case ShowForAllFlag
show_forall of
            ShowForAllFlag
ShowForAllMust -> [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
            ShowForAllFlag
ShowForAllWhen -> [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
        , [IfaceType] -> SDoc
pprIfaceContextArr [IfaceType]
ctxt
        , SDoc
sdoc]

-- | Render the "forall ... ." or "forall ... ->" bit of a type.
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceForAll bndrs :: [IfaceForAllBndr]
bndrs@(Bndr IfaceBndr
_ ForAllTyFlag
vis : [IfaceForAllBndr]
_)
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
add_separator (SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [SDoc]
docs)
        , [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
bndrs' ]
  where
    ([IfaceForAllBndr]
bndrs', [SDoc]
docs) = [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ForAllTyFlag
vis

    add_separator :: SDoc -> SDoc
add_separator SDoc
stuff = case ForAllTyFlag
vis of
                            ForAllTyFlag
Required -> SDoc
stuff SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
                            ForAllTyFlag
_inv     -> SDoc
stuff SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>  SDoc
forall doc. IsLine doc => doc
dot


-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
-- Returns both the list of not-yet-rendered binders and the doc.
-- No anonymous binders here!
ppr_itv_bndrs :: [IfaceForAllBndr]
             -> ForAllTyFlag  -- ^ visibility of the first binder in the list
             -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs :: [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs all_bndrs :: [IfaceForAllBndr]
all_bndrs@(bndr :: IfaceForAllBndr
bndr@(Bndr IfaceBndr
_ ForAllTyFlag
vis) : [IfaceForAllBndr]
bndrs) ForAllTyFlag
vis1
  | ForAllTyFlag
vis ForAllTyFlag -> ForAllTyFlag -> Bool
`eqForAllVis` ForAllTyFlag
vis1 = let ([IfaceForAllBndr]
bndrs', [SDoc]
doc) = [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ForAllTyFlag
vis1 in
                             ([IfaceForAllBndr]
bndrs', IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
doc)
  | Bool
otherwise              = ([IfaceForAllBndr]
all_bndrs, [])
ppr_itv_bndrs [] ForAllTyFlag
_ = ([], [])

pprIfaceForAllCo :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCo :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCo []  = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceForAllCo [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCoBndrs [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot

pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] -> SDoc
pprIfaceForAllCoBndrs [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
bndrs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag) -> SDoc)
-> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag) -> SDoc
pprIfaceForAllCoBndr [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
bndrs

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
  case IfaceForAllBndr
bndr of
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ForAllTyFlag
Inferred ->
      SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
False)
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ForAllTyFlag
_ ->
      IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
    Bndr (IfaceIdBndr IfaceIdBndr
idv) ForAllTyFlag
_ -> IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
idv
  where
    -- See Note [Suppressing binder signatures]
    suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False

pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag) -> SDoc
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag) -> SDoc
pprIfaceForAllCoBndr (IfLclName
tv, IfaceCoercion
kind_co, ForAllTyFlag
visL, ForAllTyFlag
visR)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_vis SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
kind_co)
  where
    pp_vis :: SDoc
pp_vis | ForAllTyFlag
visL ForAllTyFlag -> ForAllTyFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ForAllTyFlag
coreTyLamForAllTyFlag
           , ForAllTyFlag
visR ForAllTyFlag -> ForAllTyFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ForAllTyFlag
coreTyLamForAllTyFlag
           = SDoc
forall doc. IsOutput doc => doc
empty
           | Bool
otherwise
           = ForAllTyFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForAllTyFlag
visL SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'~' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ForAllTyFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForAllTyFlag
visR    -- "[spec]~[reqd]"

-- | Show forall flag
--
-- Unconditionally show the forall quantifier with ('ShowForAllMust')
-- or when ('ShowForAllWhen') the names used are free in the binder
-- or when compiling with -fprint-explicit-foralls.
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen

data ShowSub
  = ShowSub
      { ShowSub -> ShowHowMuch
ss_how_much :: ShowHowMuch
      , ShowSub -> ShowForAllFlag
ss_forall :: ShowForAllFlag }

-- See Note [Printing IfaceDecl binders]
-- The alternative pretty printer referred to in the note.
newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))

data ShowHowMuch
  = ShowHeader AltPpr -- ^ Header information only, not rhs
  | ShowSome (Maybe (OccName -> Bool)) AltPpr
  -- ^ Show the declaration and its RHS. The @Maybe@ predicate
  -- allows filtering of the sub-components which should be printing;
  -- any sub-components filtered out will be elided with @...@.
  | ShowIface
  -- ^ Everything including GHC-internal information (used in --show-iface)

instance Outputable ShowHowMuch where
  ppr :: ShowHowMuch -> SDoc
ppr (ShowHeader AltPpr
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ShowHeader"
  ppr ShowHowMuch
ShowIface      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ShowIface"
  ppr (ShowSome Maybe (OccName -> Bool)
_ AltPpr
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ShowSome"

pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
show_forall IfaceType
ty
  = (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes (ShowForAllFlag -> PprPrec -> IfaceType -> SDoc
ppr_sigma ShowForAllFlag
show_forall PprPrec
topPrec) IfaceType
ty

ppr_sigma :: ShowForAllFlag -> PprPrec -> IfaceType -> SDoc
ppr_sigma :: ShowForAllFlag -> PprPrec -> IfaceType -> SDoc
ppr_sigma ShowForAllFlag
show_forall PprPrec
ctxt_prec IfaceType
iface_ty
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    let ([IfaceForAllBndr]
invis_tvs, [IfaceType]
theta, IfaceType
tau) = IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
iface_ty
        ([IfaceForAllBndr]
req_tvs, IfaceType
tau') = IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy IfaceType
tau
          -- splitIfaceSigmaTy is recursive, so it will gather the binders after
          -- the theta, i.e.  forall a. theta => forall b. tau
          -- will give you    ([a,b], theta, tau).
          --
          -- This isn't right when it comes to visible forall (see
          --  testsuite/tests/polykinds/T18522-ppr),
          -- so we split off required binders separately,
          -- using splitIfaceReqForallTy.
          --
          -- An alternative solution would be to make splitIfaceSigmaTy
          -- non-recursive (see #18458).
          -- Then it could handle both invisible and required binders, and
          -- splitIfaceReqForallTy wouldn't be necessary here.
    in ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
invis_tvs [IfaceType]
theta (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
req_tvs, IfaceType -> SDoc
ppr_ty_nested IfaceType
tau']

pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
   = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitForalls ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_foralls ->
     -- See Note [When to print foralls] in this module.
     Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ((IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall {argf}. VarBndr IfaceBndr argf -> Bool
tv_has_kind_var [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| (IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall {tv}. VarBndr tv ForAllTyFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| Bool
print_foralls) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
     [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
   where
     tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (IfLclName
_,IfaceType
kind)) argf
_)
       = Bool -> Bool
not (IfaceType -> Bool
ifTypeIsVarFree IfaceType
kind)
     tv_has_kind_var VarBndr IfaceBndr argf
_ = Bool
False

     tv_is_required :: VarBndr tv ForAllTyFlag -> Bool
tv_is_required = ForAllTyFlag -> Bool
isVisibleForAllTyFlag (ForAllTyFlag -> Bool)
-> (VarBndr tv ForAllTyFlag -> ForAllTyFlag)
-> VarBndr tv ForAllTyFlag
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarBndr tv ForAllTyFlag -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag

{-
Note [When to print foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We opt to explicitly pretty-print `forall`s if any of the following
criteria are met:

1. -fprint-explicit-foralls is on.

2. A bound type variable has a polymorphic kind. E.g.,

     forall k (a::k). Proxy a -> Proxy a

   Since a's kind mentions a variable k, we print the foralls.

3. A bound type variable is a visible argument (#14238).
   Suppose we are printing the kind of:

     T :: forall k -> k -> Type

   The "forall k ->" notation means that this kind argument is required.
   That is, it must be supplied at uses of T. E.g.,

     f :: T (Type->Type)  Monad -> Int

   So we print an explicit "T :: forall k -> k -> Type",
   because omitting it and printing "T :: k -> Type" would be
   utterly misleading.

   See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility]
   in GHC.Core.TyCo.Rep.

N.B. Until now (Aug 2018) we didn't check anything for coercion variables.

Note [Printing foralls in type family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We use the same criteria as in Note [When to print foralls] to determine
whether a type family instance should be pretty-printed with an explicit
`forall`. Example:

  type family Foo (a :: k) :: k where
    Foo Maybe       = []
    Foo (a :: Type) = Int
    Foo a           = a

Without -fprint-explicit-foralls enabled, this will be pretty-printed as:

type family Foo (a :: k) :: k where
  Foo Maybe = []
  Foo a = Int
  forall k (a :: k). Foo a = a

Note that only the third equation has an explicit forall, since it has a type
variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then
the second equation would be preceded with `forall a.`.)

There is one tricky point in the implementation: what visibility
do we give the type variables in a type family instance? Type family instances
only store type *variables*, not type variable *binders*, and only the latter
has visibility information. We opt to default the visibility of each of these
type variables to Specified because users can't ever instantiate these
variables manually, so the choice of visibility is only relevant to
pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is
printed the way it is, even though it wasn't written explicitly in the
original source code.)

We adopt the same strategy for data family instances. Example:

  data family DF (a :: k)
  data instance DF '[a, b] = DFList

That data family instance is pretty-printed as:

  data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList

This is despite that the representation tycon for this data instance (call it
$DF:List) actually has different visibilities for its binders.
However, the visibilities of these binders are utterly irrelevant to the
programmer, who cares only about the specificity of variables in `DF`'s type,
not $DF:List's type. Therefore, we opt to pretty-print all variables in data
family instances as Specified.

Note [Printing promoted type constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this GHCi session (#14343)
    > _ :: Proxy '[ 'True ]
    error:
      Found hole: _ :: Proxy '['True]

This would be bad, because the '[' looks like a character literal.

A similar issue arises if the element is a character literal (#22488)
    ghci> type T = '[ 'x' ]
    ghci> :kind! T
    T :: [Char]
    = '['x']

Solution: in type-level lists and tuples, add a leading space
if the first element is printed with a single quote.
-}


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

-- See equivalent function in "GHC.Core.TyCo.Rep"
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
-- it in list notation [t1, ...].
-- Precondition: Opt_PrintExplicitKinds is off
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
ty2
  = case IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2 of
      ([IfaceType]
arg_tys, Maybe IfaceType
Nothing)
        ->
        (SDocContext -> SDoc) -> SDoc
sdocWithContext ((SDocContext -> SDoc) -> SDoc) -> (SDocContext -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
          let
            items :: [IfaceType]
items  = IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
arg_tys
            eos :: IsEmptyOrSingleton
eos    = [IfaceType] -> IsEmptyOrSingleton
forall a. [a] -> IsEmptyOrSingleton
isListEmptyOrSingleton [IfaceType]
items
            ticked :: Bool
ticked = PprStyle -> QueryPromotionTick
promTick (SDocContext -> PprStyle
sdocStyle SDocContext
ctx) (IsEmptyOrSingleton -> PromotedItem
PromotedItemListSyntax IsEmptyOrSingleton
eos)
            (SDoc
preBracket, SDoc -> SDoc
postBracket) =
              if Bool
ticked
              then (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\'', SDoc -> SDoc
spaceIfSingleQuote)
              else (SDoc
forall doc. IsOutput doc => doc
empty, SDoc -> SDoc
forall a. a -> a
id)
          in
            SDoc
preBracket SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc
postBracket ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep
                          (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) [IfaceType]
items))))
      ([IfaceType]
arg_tys, Just IfaceType
tl)
        -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1)
           Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty | IfaceType
ty <- [IfaceType]
arg_tys [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType
tl]])
  where
    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
      , IA_Arg IfaceType
_ ForAllTyFlag
argf (IA_Arg IfaceType
ty1 ForAllTyFlag
Required (IA_Arg IfaceType
ty2 ForAllTyFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
      , ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf
      , ([IfaceType]
args, Maybe IfaceType
tl) <- IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2
      = (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
args, Maybe IfaceType
tl)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
      = ([], Maybe IfaceType
forall a. Maybe a
Nothing)
    gather IfaceType
ty = ([], IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
ty)

pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args

pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys =
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypeAbbreviations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_type_abbreviations ->
    (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->

    if | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
       , IA_Arg (IfaceLitTy (IfaceStrTyLit LexicalFastString
n))
                ForAllTyFlag
Required (IA_Arg IfaceType
ty ForAllTyFlag
Required IfaceAppArgs
IA_Nil) <- IfaceAppArgs
tys
       -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec
         (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'?' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (LexicalFastString -> FastString
getLexicalFastString LexicalFastString
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty

       | IfaceTupleTyCon Int
arity TupleSort
sort <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
       , Bool -> Bool
not Bool
debug
       , Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
       -> PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple PprPrec
ctxt_prec TupleSort
sort (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
           -- NB: ppr_tuple requires a saturated tuple.

       | IfaceSumTyCon Int
arity <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
       , Bool -> Bool
not Bool
debug
       , Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
       -> PprPrec -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_sum PprPrec
ctxt_prec (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
           -- NB: ppr_sum requires a saturated unboxed sum.

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
       , Bool
False <- Bool
print_kinds
       , IA_Arg IfaceType
_ ForAllTyFlag
argf (IA_Arg IfaceType
ty1 ForAllTyFlag
Required (IA_Arg IfaceType
ty2 ForAllTyFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
       , ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf
       -> PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
ty2

       | IfaceType -> Bool
isIfaceLiftedTypeKind (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

       | IfaceType -> Bool
isIfaceConstraintKind (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> IfExtName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfExtName
constraintKindTyConName

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
fUNTyConKey
       , IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ForAllTyFlag
Required IfaceAppArgs
args <- IfaceAppArgs
tys
       , IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
arrow) (((IfaceType, ForAllTyFlag) -> SDoc)
-> [(IfaceType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) ([(IfaceType, ForAllTyFlag)] -> [SDoc])
-> [(IfaceType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
          IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfaceType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$
          PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
args)
          -- Use appArgsIfaceTypesForAllTyFlags to print invisible arguments
          -- correctly (#19310)

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
       , Bool -> Bool
not Bool
debug
         -- Suppress detail unless you _really_ want to see
       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(TypeError ...)"

       | Just SDoc
doc <- PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc (IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
tys)
       -> SDoc
doc

       | Bool
otherwise
       -> (PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceType, ForAllTyFlag)] -> SDoc
forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctxt_prec IfaceTyCon
tc ([(IfaceType, ForAllTyFlag)] -> SDoc)
-> [(IfaceType, ForAllTyFlag)] -> SDoc
forall a b. (a -> b) -> a -> b
$
          IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfaceType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
tys
  where
    info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc

ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocStarIsType ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
   Bool
False -> IfExtName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfExtName
liftedTypeKindTyConName
   Bool
True  -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
starPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'★') (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'*')

-- | Pretty-print a type-level equality.
-- Returns (Just doc) if the argument is a /saturated/ application
-- of   eqTyCon          (~)
--      eqPrimTyCon      (~#)
--      eqReprPrimTyCon  (~R#)
--      heqTyCon         (~~)
--
-- See Note [Equality predicates in IfaceType]
-- and Note [The equality types story] in GHC.Builtin.Types.Prim
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc [IfaceType]
args
  | Bool
hetero_eq_tc
  , [IfaceType
k1, IfaceType
k2, IfaceType
t1, IfaceType
t2] <- [IfaceType]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k1, IfaceType
k2, IfaceType
t1, IfaceType
t2)

  | Bool
hom_eq_tc
  , [IfaceType
k, IfaceType
t1, IfaceType
t2] <- [IfaceType]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k, IfaceType
k, IfaceType
t1, IfaceType
t2)

  | Bool
otherwise
  = Maybe SDoc
forall a. Maybe a
Nothing
  where
    homogeneous :: Bool
homogeneous = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey -- (~)
               Bool -> Bool -> Bool
|| Bool
hetero_tc_used_homogeneously
      where
        hetero_tc_used_homogeneously :: Bool
hetero_tc_used_homogeneously
          = case IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort (IfaceTyConInfo -> IfaceTyConSort)
-> IfaceTyConInfo -> IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc of
                          IfaceTyConSort
IfaceEqualityTyCon -> Bool
True
                          IfaceTyConSort
_other             -> Bool
False
             -- True <=> a heterogeneous equality whose arguments
             --          are (in this case) of the same kind

    tc_name :: IfExtName
tc_name = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc
    pp :: PprPrec -> IfaceType -> SDoc
pp = PprPrec -> IfaceType -> SDoc
ppr_ty
    hom_eq_tc :: Bool
hom_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey            -- (~)
    hetero_eq_tc :: Bool
hetero_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey     -- (~#)
                Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey -- (~R#)
                Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey        -- (~~)
    nominal_eq_tc :: Bool
nominal_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey       -- (~~)
                 Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey    -- (~#)
    print_equality :: (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType, IfaceType, IfaceType, IfaceType)
args =
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintEqualityRelations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_eqs ->
        (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style  ->
        (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug      ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug  ->
        (IfaceType, IfaceType, IfaceType, IfaceType)
-> Bool -> Bool -> SDoc
print_equality' (IfaceType, IfaceType, IfaceType, IfaceType)
args Bool
print_kinds
          (Bool
print_eqs Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug)

    print_equality' :: (IfaceType, IfaceType, IfaceType, IfaceType)
-> Bool -> Bool -> SDoc
print_equality' (IfaceType
ki1, IfaceType
ki2, IfaceType
ty1, IfaceType
ty2) Bool
print_kinds Bool
print_eqs
      | -- If -fprint-equality-relations is on, just print the original TyCon
        Bool
print_eqs
      = SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)

      | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)
        --                 or unlifted equality      (ty1 ~# ty2)
        Bool
nominal_eq_tc, Bool
homogeneous
      = SDoc -> SDoc
ppr_infix_eq (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~")

      | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)
        Bool -> Bool
not Bool
homogeneous
      = SDoc -> SDoc
ppr_infix_eq (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)

      | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)
        IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey, Bool
homogeneous
      = let ki :: [SDoc]
ki | Bool
print_kinds = [PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ki1]
               | Bool
otherwise   = []
        in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
coercibleTyCon)
                            ([SDoc]
ki [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ty1, PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ty2])

        -- The other cases work as you'd expect
      | Bool
otherwise
      = SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
      where
        ppr_infix_eq :: SDoc -> SDoc
        ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq SDoc
eq_op = PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
eq_op
                               (IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty1 IfaceType
ki1) (IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty2 IfaceType
ki2)
          where
            pp_ty_ki :: IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty IfaceType
ki
              | Bool
print_kinds
              = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceType -> SDoc
pp PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ki)
              | Bool
otherwise
              = PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ty


pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
ctxt_prec IfaceTyCon
tc [IfaceCoercion]
tys =
  (PprPrec -> (IfaceCoercion, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceCoercion, ForAllTyFlag)] -> SDoc
forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app (\PprPrec
prec (IfaceCoercion
co, ForAllTyFlag
_) -> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
prec IfaceCoercion
co) PprPrec
ctxt_prec IfaceTyCon
tc
    ((IfaceCoercion -> (IfaceCoercion, ForAllTyFlag))
-> [IfaceCoercion] -> [(IfaceCoercion, ForAllTyFlag)]
forall a b. (a -> b) -> [a] -> [b]
map (, ForAllTyFlag
Required) [IfaceCoercion]
tys)
    -- We are trying to re-use ppr_iface_tc_app here, which requires its
    -- arguments to be accompanied by visibilities. But visibility is
    -- irrelevant when printing coercions, so just default everything to
    -- Required.

-- | Pretty-prints an application of a type constructor to some arguments
-- (whose visibilities are known). This is polymorphic (over @a@) since we use
-- this function to pretty-print two different things:
--
-- 1. Types (from `pprTyTcApp'`)
--
-- 2. Coercions (from 'pprIfaceCoTcApp')
ppr_iface_tc_app :: (PprPrec -> (a, ForAllTyFlag) -> SDoc)
                 -> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc

ppr_iface_tc_app :: forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
ctxt_prec IfaceTyCon
tc [(a, ForAllTyFlag)]
tys =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocListTuplePuns ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
listTuplePuns ->
  if | Bool
listTuplePuns, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
listTyConKey, [(a, ForAllTyFlag)
ty] <- [(a, ForAllTyFlag)]
tys
     -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
topPrec (a, ForAllTyFlag)
ty)

     | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
     -> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

     | OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc))

     , [ ty1 :: (a, ForAllTyFlag)
ty1@(a
_, ForAllTyFlag
Required), ty2 :: (a, ForAllTyFlag)
ty2@(a
_, ForAllTyFlag
Required) ] <- [(a, ForAllTyFlag)]
tys
         -- Infix, two visible arguments (we know nothing of precedence though).
         -- Don't apply this special case if one of the arguments is invisible,
         -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
     -> PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
pprIfaceTyCon IfaceTyCon
tc) (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
opPrec (a, ForAllTyFlag)
ty1) (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
opPrec (a, ForAllTyFlag)
ty2)

     | Bool
otherwise
     -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
pprParendIfaceTyCon IfaceTyCon
tc) (((a, ForAllTyFlag) -> SDoc) -> [(a, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
appPrec) [(a, ForAllTyFlag)]
tys)

data TupleOrSum = IsSum | IsTuple TupleSort
  deriving (TupleOrSum -> TupleOrSum -> Bool
(TupleOrSum -> TupleOrSum -> Bool)
-> (TupleOrSum -> TupleOrSum -> Bool) -> Eq TupleOrSum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TupleOrSum -> TupleOrSum -> Bool
== :: TupleOrSum -> TupleOrSum -> Bool
$c/= :: TupleOrSum -> TupleOrSum -> Bool
/= :: TupleOrSum -> TupleOrSum -> Bool
Eq)

-- | Pretty-print a boxed tuple datacon in regular tuple syntax.
-- Used when -XListTuplePuns is disabled.
ppr_tuple_no_pun :: PprPrec -> [IfaceType] -> SDoc
ppr_tuple_no_pun :: PprPrec -> [IfaceType] -> SDoc
ppr_tuple_no_pun PprPrec
ctxt_prec = \case
  [IfaceType
t] -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MkSolo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
appPrec IfaceType
t)
  [IfaceType]
tys -> TupleSort -> SDoc -> SDoc
tupleParens TupleSort
BoxedTuple ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
tys)

-- | Pretty-print an unboxed tuple or sum type in its parenthesized, punned, form.
-- Used when -XListTuplePuns is enabled.
--
-- The tycon should be saturated:
-- as many visible arguments as the arity of the sum or tuple.
--
-- NB: this always strips off the invisible 'RuntimeRep' arguments,
-- even with `-fprint-explicit-runtime-reps` and `-fprint-explicit-kinds`.
ppr_tuple_sum_pun :: PprPrec -> TupleOrSum -> PromotionFlag -> IfaceType -> Arity -> [IfaceType] -> SDoc
ppr_tuple_sum_pun :: PprPrec
-> TupleOrSum
-> PromotionFlag
-> IfaceType
-> Int
-> [IfaceType]
-> SDoc
ppr_tuple_sum_pun PprPrec
ctxt_prec TupleOrSum
sort PromotionFlag
promoted IfaceType
tc Int
arity [IfaceType]
tys
  | TupleOrSum
IsSum <- TupleOrSum
sort
  = SDoc -> SDoc
sumParens ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) [IfaceType]
tys)

  |  IsTuple TupleSort
ConstraintTuple <- TupleOrSum
sort
  ,  PromotionFlag
NotPromoted <- PromotionFlag
promoted
  ,  Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
sigPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"() :: Constraint"

  -- Special-case unary boxed tuples so that they are pretty-printed as
  -- `Solo x`, not `(x)`
  | IsTuple TupleSort
BoxedTuple <- TupleOrSum
sort
  , Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec IfaceType
tc

  | IsTuple TupleSort
tupleSort <- TupleOrSum
sort
  = PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
promoted SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
    TupleSort -> SDoc -> SDoc
tupleParens TupleSort
tupleSort (SDoc -> SDoc
quote_space ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
tys))
  where
    quote_space :: SDoc -> SDoc
quote_space = case PromotionFlag
promoted of
      PromotionFlag
IsPromoted -> SDoc -> SDoc
spaceIfSingleQuote
      PromotionFlag
NotPromoted -> SDoc -> SDoc
forall a. a -> a
id

-- | Pretty-print an unboxed tuple or sum type either in the punned or unpunned form,
-- depending on whether -XListTuplePuns is enabled.
ppr_tuple_sum :: PprPrec -> TupleOrSum -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple_sum :: PprPrec -> TupleOrSum -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple_sum PprPrec
ctxt_prec TupleOrSum
sort PromotionFlag
is_promoted IfaceAppArgs
args =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocListTuplePuns ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
    Bool
True -> PprPrec
-> TupleOrSum
-> PromotionFlag
-> IfaceType
-> Int
-> [IfaceType]
-> SDoc
ppr_tuple_sum_pun PprPrec
ctxt_prec TupleOrSum
sort PromotionFlag
is_promoted IfaceType
prefix_tc Int
arity [IfaceType]
non_rep_tys
    Bool
False
      | PromotionFlag
IsPromoted <- PromotionFlag
is_promoted
      , IsTuple TupleSort
BoxedTuple <- TupleOrSum
sort
      -> PprPrec -> [IfaceType] -> SDoc
ppr_tuple_no_pun PprPrec
ctxt_prec [IfaceType]
non_rep_tys
      | Bool
otherwise
      -> PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec IfaceType
prefix_tc
  where
    -- This tycon is used to print in prefix notation for the punned Solo
    -- case and the unabbreviated case.
    prefix_tc :: IfaceType
prefix_tc = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (Int -> IfExtName
mk_name Int
arity) IfaceTyConInfo
info) IfaceAppArgs
args

    info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon

    mk_name :: Int -> IfExtName
mk_name = case (TupleOrSum
sort, PromotionFlag
is_promoted) of
      (IsTuple TupleSort
BoxedTuple, PromotionFlag
IsPromoted) -> Boxity -> Int -> IfExtName
tupleDataConName Boxity
Boxed
      (IsTuple TupleSort
s, PromotionFlag
_) -> TupleSort -> Int -> IfExtName
tupleTyConName TupleSort
s
      (TupleOrSum
IsSum, PromotionFlag
_) -> TyCon -> IfExtName
tyConName (TyCon -> IfExtName) -> (Int -> TyCon) -> Int -> IfExtName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TyCon
sumTyCon

    -- drop the RuntimeRep vars.
    -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    non_rep_tys :: [IfaceType]
non_rep_tys = if Bool
strip_reps then Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop Int
arity [IfaceType]
all_tys else [IfaceType]
all_tys

    arity :: Int
arity = if Bool
strip_reps then Int
count Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 else Int
count

    count :: Int
count = [IfaceType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
all_tys

    all_tys :: [IfaceType]
all_tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args

    strip_reps :: Bool
strip_reps = case PromotionFlag
is_promoted of
      PromotionFlag
IsPromoted -> Bool
True
      PromotionFlag
NotPromoted -> Bool
strip_reps_sort

    strip_reps_sort :: Bool
strip_reps_sort = case TupleOrSum
sort of
      IsTuple TupleSort
BoxedTuple -> Bool
False
      IsTuple TupleSort
UnboxedTuple -> Bool
True
      IsTuple TupleSort
ConstraintTuple -> Bool
False
      TupleOrSum
IsSum -> Bool
True

-- | Pretty-print an unboxed sum type.
-- The sum should be saturated: as many visible arguments as the arity of
-- the sum.
ppr_sum :: PprPrec -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_sum :: PprPrec -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_sum PprPrec
ctxt_prec = PprPrec -> TupleOrSum -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple_sum PprPrec
ctxt_prec TupleOrSum
IsSum

-- | Pretty-print a tuple type (boxed tuple, constraint tuple, unboxed tuple).
-- The tuple should be saturated: as many visible arguments as the arity of
-- the tuple.
ppr_tuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple PprPrec
ctxt_prec TupleSort
sort = PprPrec -> TupleOrSum -> PromotionFlag -> IfaceAppArgs -> SDoc
ppr_tuple_sum PprPrec
ctxt_prec (TupleSort -> TupleOrSum
IsTuple TupleSort
sort)

pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceNumTyLit Integer
n) = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
n
pprIfaceTyLit (IfaceStrTyLit LexicalFastString
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text (LexicalFastString -> String
forall a. Show a => a -> String
show LexicalFastString
n)
pprIfaceTyLit (IfaceCharTyLit Char
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)

pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec
pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprParendIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
appPrec

ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
_         (IfaceReflCo IfaceType
ty) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_         (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
IfaceMRefl)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfaceType
ty (IfaceMCo IfaceCoercion
co))
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
    (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GRefl" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
pprParendIfaceType IfaceType
ty) [IfaceCoercion
co]

ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r IfaceCoercion
co_mult IfaceCoercion
co1 IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult IfaceCoercion
co2)
  where
    ppr_fun_tail :: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult1 (IfaceFunCo Role
r IfaceCoercion
co_mult2 IfaceCoercion
co1 IfaceCoercion
co2)
      = (IfaceCoercion -> SDoc
ppr_arrow IfaceCoercion
co_mult1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1)
        SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult2 IfaceCoercion
co2
    ppr_fun_tail IfaceCoercion
co_mult1 IfaceCoercion
other_co
      = [IfaceCoercion -> SDoc
ppr_arrow IfaceCoercion
co_mult1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]

    ppr_arrow :: IfaceCoercion -> SDoc
ppr_arrow = (IfaceCoercion -> Maybe IfaceTyCon,
 PprPrec -> IfaceCoercion -> SDoc)
-> FunTyFlag -> IfaceCoercion -> SDoc
forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (IfaceCoercion -> Maybe IfaceTyCon
mb_conc, PprPrec -> IfaceCoercion -> SDoc
ppr_co) FunTyFlag
visArgTypeLike
    mb_conc :: IfaceCoercion -> Maybe IfaceTyCon
mb_conc (IfaceTyConAppCo Role
_ IfaceTyCon
tc [IfaceCoercion]
_) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just IfaceTyCon
tc
    mb_conc IfaceCoercion
_                        = Maybe IfaceTyCon
forall a. Maybe a
Nothing

ppr_co PprPrec
_         (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
topPrec IfaceTyCon
tc [IfaceCoercion]
cos) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceAppCo IfaceCoercion
co1 IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co2
ppr_co PprPrec
ctxt_prec co :: IfaceCoercion
co@(IfaceForAllCo {})
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    -- FIXME: collect and pretty-print visibility info?
    [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
-> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
  where
    ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion
-> ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)],
    IfaceCoercion)
split_co IfaceCoercion
co

    split_co :: IfaceCoercion
-> ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)],
    IfaceCoercion)
split_co (IfaceForAllCo (IfaceTvBndr (IfLclName
name, IfaceType
_)) ForAllTyFlag
visL ForAllTyFlag
visR IfaceCoercion
kind_co IfaceCoercion
co')
      = let ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs, IfaceCoercion
co'') = IfaceCoercion
-> ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)],
    IfaceCoercion)
split_co IfaceCoercion
co' in ((IfLclName
name,IfaceCoercion
kind_co,ForAllTyFlag
visL,ForAllTyFlag
visR)(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)
-> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
-> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
forall a. a -> [a] -> [a]
:[(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs,IfaceCoercion
co'')
    split_co (IfaceForAllCo (IfaceIdBndr (IfaceType
_, IfLclName
name, IfaceType
_)) ForAllTyFlag
visL ForAllTyFlag
visR IfaceCoercion
kind_co IfaceCoercion
co')
      = let ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs, IfaceCoercion
co'') = IfaceCoercion
-> ([(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)],
    IfaceCoercion)
split_co IfaceCoercion
co' in ((IfLclName
name,IfaceCoercion
kind_co,ForAllTyFlag
visL,ForAllTyFlag
visR)(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)
-> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
-> [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
forall a. a -> [a] -> [a]
:[(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)]
tvs,IfaceCoercion
co'')
    split_co IfaceCoercion
co' = ([], IfaceCoercion
co')

-- Why these three? See Note [Free TyVars and CoVars in IfaceType]
ppr_co PprPrec
_ (IfaceFreeCoVar TyVar
covar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo IfLclName
covar)   = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
covar
ppr_co PprPrec
_ (IfaceHoleCo TyVar
covar)    = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar)

ppr_co PprPrec
_ (IfaceUnivCo UnivCoProvenance
prov Role
role IfaceType
ty1 IfaceType
ty2 [IfaceCoercion]
ds)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Univ" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnivCoProvenance -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnivCoProvenance
prov SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [IfaceCoercion] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceCoercion]
ds
          , SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>  IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty2 ])

ppr_co PprPrec
ctxt_prec (IfaceInstCo IfaceCoercion
co IfaceCoercion
ty)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inst" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
                        , IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty ]

ppr_co PprPrec
ctxt_prec (IfaceAxiomCo IfaceAxiomRule
ax [IfaceCoercion]
cos)
  | [IfaceCoercion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IfaceCoercion]
cos  = IfaceAxiomRule -> SDoc
pprIfAxRule IfaceAxiomRule
ax  -- Don't add parens
  | Bool
otherwise = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (IfaceAxiomRule -> SDoc
pprIfAxRule IfaceAxiomRule
ax) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sym") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)
    -- chain nested TransCo
  = let ppr_trans :: IfaceCoercion -> [SDoc]
ppr_trans (IfaceTransCo IfaceCoercion
c1 IfaceCoercion
c2) = SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
c1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
c2
        ppr_trans IfaceCoercion
c                    = [SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
c]
    in PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
co2)
ppr_co PprPrec
ctxt_prec (IfaceSelCo CoSel
d IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SelCo:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CoSel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoSel
d) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceLRCo LeftOrRight
lr IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (LeftOrRight -> SDoc
forall a. Outputable a => a -> SDoc
ppr LeftOrRight
lr) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceSubCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sub") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceKindCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Kind") [IfaceCoercion
co]

ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec SDoc
doc [IfaceCoercion]
cos
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec
               ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
doc, Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((IfaceCoercion -> SDoc) -> [IfaceCoercion] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> SDoc
pprParendIfaceCoercion [IfaceCoercion]
cos))])

pprIfAxRule :: IfaceAxiomRule -> SDoc
pprIfAxRule :: IfaceAxiomRule -> SDoc
pprIfAxRule (IfaceAR_X IfLclName
n)   = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
n
pprIfAxRule (IfaceAR_U IfExtName
n)   = IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n
pprIfAxRule (IfaceAR_B IfExtName
n Int
i) = IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i)

ppr_role :: Role -> SDoc
ppr_role :: Role -> SDoc
ppr_role Role
r = SDoc
forall doc. IsLine doc => doc
underscore SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_role
  where pp_role :: SDoc
pp_role = case Role
r of
                    Role
Nominal          -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'N'
                    Role
Representational -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'R'
                    Role
Phantom          -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'P'

-------------------
instance Outputable IfLclName where
  ppr :: IfLclName -> SDoc
ppr = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FastString -> SDoc)
-> (IfLclName -> FastString) -> IfLclName -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfLclName -> FastString
ifLclNameFS

instance Outputable IfaceTyCon where
  ppr :: IfaceTyCon -> SDoc
ppr = IfaceTyCon -> SDoc
pprIfaceTyCon

-- | Print an `IfaceTyCon` with a promotion tick if needed, without parens,
-- suitable for use in infix contexts
pprIfaceTyCon :: IfaceTyCon -> SDoc
pprIfaceTyCon :: IfaceTyCon -> SDoc
pprIfaceTyCon IfaceTyCon
tc = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)

-- | Print an `IfaceTyCon` with a promotion tick if needed, possibly with parens,
-- suitable for use in prefix contexts
pprParendIfaceTyCon :: IfaceTyCon -> SDoc
pprParendIfaceTyCon :: IfaceTyCon -> SDoc
pprParendIfaceTyCon IfaceTyCon
tc = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc -> SDoc
pprPrefixVar (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName IfExtName
tc_name)) (IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
tc_name)
  where tc_name :: IfExtName
tc_name = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc

instance Outputable IfaceTyConInfo where
  ppr :: IfaceTyConInfo -> SDoc
ppr (IfaceTyConInfo { ifaceTyConIsPromoted :: IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted = PromotionFlag
prom
                      , ifaceTyConSort :: IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort       = IfaceTyConSort
sort })
    = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PromotionFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr PromotionFlag
prom SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceTyConSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyConSort
sort

pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc =
  (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
    let
      name :: OccName
name   = IfExtName -> OccName
forall a. NamedThing a => a -> OccName
getOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
      ticked :: Bool
ticked =
        case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc) of
          PromotionFlag
NotPromoted -> Bool
False
          PromotionFlag
IsPromoted  -> PprStyle -> QueryPromotionTick
promTick PprStyle
sty (OccName -> PromotedItem
PromotedItemDataCon OccName
name)
    in
      if Bool
ticked
      then Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''
      else SDoc
forall doc. IsOutput doc => doc
empty

pprPromotionQuoteI  :: PromotionFlag -> SDoc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
NotPromoted = SDoc
forall doc. IsOutput doc => doc
empty
pprPromotionQuoteI PromotionFlag
IsPromoted  = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''

instance Outputable IfaceCoercion where
  ppr :: IfaceCoercion -> SDoc
ppr = IfaceCoercion -> SDoc
pprIfaceCoercion

instance Binary IfaceTyCon where
  put_ :: WriteBinHandle -> IfaceTyCon -> IO ()
put_ WriteBinHandle
bh (IfaceTyCon IfExtName
n IfaceTyConInfo
i) = WriteBinHandle -> IfExtName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfExtName
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfaceTyConInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyConInfo
i

  get :: ReadBinHandle -> IO IfaceTyCon
get ReadBinHandle
bh = do
    n <- ReadBinHandle -> IO IfExtName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    i <- get bh
    return (IfaceTyCon n i)

instance Binary IfaceTyConSort where
   put_ :: WriteBinHandle -> IfaceTyConSort -> IO ()
put_ WriteBinHandle
bh IfaceTyConSort
IfaceNormalTyCon             = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
   put_ WriteBinHandle
bh (IfaceTupleTyCon Int
arity TupleSort
sort) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
arity IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> TupleSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TupleSort
sort
   put_ WriteBinHandle
bh (IfaceSumTyCon Int
arity)        = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
arity
   put_ WriteBinHandle
bh IfaceTyConSort
IfaceEqualityTyCon           = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3

   get :: ReadBinHandle -> IO IfaceTyConSort
get ReadBinHandle
bh = do
       n <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case n of
         Word8
0 -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
         Word8
1 -> Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (Int -> TupleSort -> IfaceTyConSort)
-> IO Int -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO TupleSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
         Word8
2 -> Int -> IfaceTyConSort
IfaceSumTyCon (Int -> IfaceTyConSort) -> IO Int -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
         Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceEqualityTyCon

instance Binary IfaceTyConInfo where
   put_ :: WriteBinHandle -> IfaceTyConInfo -> IO ()
put_ WriteBinHandle
bh (IfaceTyConInfo PromotionFlag
i IfaceTyConSort
s) = WriteBinHandle -> PromotionFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh PromotionFlag
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfaceTyConSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyConSort
s

   get :: ReadBinHandle -> IO IfaceTyConInfo
get ReadBinHandle
bh = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo)
-> IO PromotionFlag -> IO (IfaceTyConSort -> IfaceTyConInfo)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ReadBinHandle -> IO PromotionFlag
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (IfaceTyConSort -> IfaceTyConInfo)
-> IO IfaceTyConSort -> IO IfaceTyConInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO IfaceTyConSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    -- We want to make sure, when reading from disk, as the most common case
    -- is supposed to be shared. Any thunk adds an additional indirection
    -- making sharing less useful.
    --
    -- See !12200 for how this bang and the one in 'IfaceTyCon' reduces the
    -- residency by ~10% when loading 'mi_extra_decls' from disk.

instance Outputable IfaceTyLit where
  ppr :: IfaceTyLit -> SDoc
ppr = IfaceTyLit -> SDoc
pprIfaceTyLit

instance Binary IfaceTyLit where
  put_ :: WriteBinHandle -> IfaceTyLit -> IO ()
put_ WriteBinHandle
bh (IfaceNumTyLit Integer
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
n
  put_ WriteBinHandle
bh (IfaceStrTyLit LexicalFastString
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> LexicalFastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LexicalFastString
n
  put_ WriteBinHandle
bh (IfaceCharTyLit Char
n)  = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Char -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Char
n

  get :: ReadBinHandle -> IO IfaceTyLit
get ReadBinHandle
bh =
    do tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case tag of
         Word8
1 -> do { n <- ReadBinHandle -> IO Integer
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; return (IfaceNumTyLit n) }
         Word8
2 -> do { n <- ReadBinHandle -> IO LexicalFastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; return (IfaceStrTyLit n) }
         Word8
3 -> do { n <- ReadBinHandle -> IO Char
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 ; return (IfaceCharTyLit n) }
         Word8
_ -> String -> IO IfaceTyLit
forall a. HasCallStack => String -> a
panic (String
"get IfaceTyLit " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceAppArgs where
  put_ :: WriteBinHandle -> IfaceAppArgs -> IO ()
put_ WriteBinHandle
bh IfaceAppArgs
tk = do
    -- Int is variable length encoded so only
    -- one byte for small lists.
    WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (IfaceAppArgs -> Int
ifaceAppArgsLength IfaceAppArgs
tk)
    IfaceAppArgs -> IO ()
go IfaceAppArgs
tk
    where
      go :: IfaceAppArgs -> IO ()
go IfaceAppArgs
IA_Nil = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      go (IA_Arg IfaceType
a ForAllTyFlag
b IfaceAppArgs
t) = do
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
a
        WriteBinHandle -> ForAllTyFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ForAllTyFlag
b
        IfaceAppArgs -> IO ()
go IfaceAppArgs
t

  get :: ReadBinHandle -> IO IfaceAppArgs
get ReadBinHandle
bh = do
    n <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh :: IO Int
    go n
    where
      go :: Int -> IO IfaceAppArgs
go Int
0 = IfaceAppArgs -> IO IfaceAppArgs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
      go Int
c = do
        a <- ReadBinHandle -> IO IfaceType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        b <- get bh
        IA_Arg a b <$> go (c - 1)

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

-- Some notes about printing contexts
--
-- In the event that we are printing a singleton context (e.g. @Eq a@) we can
-- omit parentheses. However, we must take care to set the precedence correctly
-- to opPrec, since something like @a :~: b@ must be parenthesized (see
-- #9658).
--
-- When printing a larger context we use 'fsep' instead of 'sep' so that
-- the context doesn't get displayed as a giant column. Rather than,
--  instance (Eq a,
--            Eq b,
--            Eq c,
--            Eq d,
--            Eq e,
--            Eq f,
--            Eq g,
--            Eq h,
--            Eq i,
--            Eq j,
--            Eq k,
--            Eq l) =>
--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)
--
-- we want
--
--  instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
--            Eq j, Eq k, Eq l) =>
--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)



-- | Prints "(C a, D b) =>", including the arrow.
-- Used when we want to print a context in a type, so we
-- use 'funPrec' to decide whether to parenthesise a singleton
-- predicate; e.g.   Num a => a -> a
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceContextArr :: [IfaceType] -> SDoc
pprIfaceContextArr []     = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceContextArr [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
pred SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
pprIfaceContextArr [IfaceType]
preds  = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow

-- | Prints a context or @()@ if empty
-- You give it the context precedence
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext :: PprPrec -> [IfaceType] -> SDoc
pprIfaceContext PprPrec
_    []     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"()"
pprIfaceContext PprPrec
prec [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec IfaceType
pred
pprIfaceContext PprPrec
_    [IfaceType]
preds  = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds

ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds :: [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceType]
preds)))

instance Binary IfaceType where
   put_ :: WriteBinHandle -> IfaceType -> IO ()
put_ WriteBinHandle
bh IfaceType
ty =
    case Proxy IfaceType -> WriteBinHandle -> BinaryWriter IfaceType
forall a. Typeable a => Proxy a -> WriteBinHandle -> BinaryWriter a
findUserDataWriter Proxy IfaceType
forall {k} (t :: k). Proxy t
Proxy WriteBinHandle
bh of
      BinaryWriter IfaceType
tbl -> BinaryWriter IfaceType -> WriteBinHandle -> IfaceType -> IO ()
forall s. BinaryWriter s -> WriteBinHandle -> s -> IO ()
putEntry BinaryWriter IfaceType
tbl WriteBinHandle
bh IfaceType
ty

   get :: ReadBinHandle -> IO IfaceType
get ReadBinHandle
bh = ReadBinHandle -> IO IfaceType
getIfaceTypeShared ReadBinHandle
bh

-- | This is the byte tag we expect to read when the next
-- value is not an 'IfaceType' value, but an offset into a
-- lookup table.
-- See Note [Deduplication during iface binary serialisation].
--
-- Must not overlap with any byte tag in 'getIfaceType'.
ifaceTypeSharedByte :: Word8
ifaceTypeSharedByte :: Word8
ifaceTypeSharedByte = Word8
99

-- | Like 'getIfaceType' but checks for a specific byte tag
-- that indicates that we won't be able to read a 'IfaceType' value
-- but rather an offset into a lookup table. Consequentially,
-- we look up the value for the 'IfaceType' in the look up table.
--
-- See Note [Deduplication during iface binary serialisation]
-- for details.
getIfaceTypeShared :: ReadBinHandle -> IO IfaceType
getIfaceTypeShared :: ReadBinHandle -> IO IfaceType
getIfaceTypeShared ReadBinHandle
bh = do
  start <- ReadBinHandle -> IO (Bin (ZonkAny 1))
forall {k} (a :: k). ReadBinHandle -> IO (Bin a)
tellBinReader ReadBinHandle
bh
  tag <- getByte bh
  if ifaceTypeSharedByte == tag
    then case findUserDataReader Proxy bh of
            BinaryReader IfaceType
tbl -> BinaryReader IfaceType -> ReadBinHandle -> IO IfaceType
forall s. BinaryReader s -> ReadBinHandle -> IO s
getEntry BinaryReader IfaceType
tbl ReadBinHandle
bh
    else seekBinReader bh start >> getIfaceType bh

-- | Serialises an 'IfaceType' to the given 'WriteBinHandle'.
--
-- Serialising inner 'IfaceType''s uses the 'Binary.put' of 'IfaceType' which may be using
-- a deduplication table. See Note [Deduplication during iface binary serialisation].
putIfaceType :: WriteBinHandle -> IfaceType -> IO ()
putIfaceType :: WriteBinHandle -> IfaceType -> IO ()
putIfaceType WriteBinHandle
_ (IfaceFreeTyVar TyVar
tv)
  = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeTyVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv)
  -- See Note [Free TyVars and CoVars in IfaceType]

putIfaceType WriteBinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab) = do
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
        WriteBinHandle -> IfaceForAllBndr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceForAllBndr
aa
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
ab
putIfaceType WriteBinHandle
bh (IfaceTyVar IfLclName
ad) = do
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
        WriteBinHandle -> IfLclName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfLclName
ad
putIfaceType WriteBinHandle
bh (IfaceAppTy IfaceType
ae IfaceAppArgs
af) = do
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
ae
        WriteBinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceAppArgs
af
putIfaceType WriteBinHandle
bh (IfaceFunTy FunTyFlag
af IfaceType
aw IfaceType
ag IfaceType
ah) = do
        WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
        WriteBinHandle -> FunTyFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FunTyFlag
af
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
aw
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
ag
        WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
ah
putIfaceType WriteBinHandle
bh (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
  = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5; WriteBinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyCon
tc; WriteBinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceAppArgs
tys }
putIfaceType WriteBinHandle
bh (IfaceCastTy IfaceType
a IfaceCoercion
b)
  = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6; WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
a; WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b }
putIfaceType WriteBinHandle
bh (IfaceCoercionTy IfaceCoercion
a)
  = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
7; WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a }
putIfaceType WriteBinHandle
bh (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys)
  = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
8; WriteBinHandle -> TupleSort -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh TupleSort
s; WriteBinHandle -> PromotionFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh PromotionFlag
i; WriteBinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceAppArgs
tys }
putIfaceType WriteBinHandle
bh (IfaceLitTy IfaceTyLit
n)
  = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
9; WriteBinHandle -> IfaceTyLit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyLit
n }

-- | Deserialises an 'IfaceType' from the given 'ReadBinHandle'.
--
-- Reading inner 'IfaceType''s uses the 'Binary.get' of 'IfaceType' which may be using
-- a deduplication table. See Note [Deduplication during iface binary serialisation].
getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType
getIfaceType :: HasCallStack => ReadBinHandle -> IO IfaceType
getIfaceType ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> do aa <- ReadBinHandle -> IO IfaceForAllBndr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      ab <- get bh
                      return (IfaceForAllTy aa ab)
              Word8
1 -> do ad <- ReadBinHandle -> IO IfLclName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      return (IfaceTyVar ad)
              Word8
2 -> do ae <- ReadBinHandle -> IO IfaceType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      af <- get bh
                      return (IfaceAppTy ae af)
              Word8
3 -> do af <- ReadBinHandle -> IO FunTyFlag
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      aw <- get bh
                      ag <- get bh
                      ah <- get bh
                      return (IfaceFunTy af aw ag ah)
              Word8
5 -> do { tc <- ReadBinHandle -> IO IfaceTyCon
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; tys <- get bh
                      ; return (IfaceTyConApp tc tys) }
              Word8
6 -> do { a <- ReadBinHandle -> IO IfaceType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; b <- get bh
                      ; return (IfaceCastTy a b) }
              Word8
7 -> do { a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                      ; return (IfaceCoercionTy a) }

              Word8
8 -> do { s <- ReadBinHandle -> IO TupleSort
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; i <- get bh; tys <- get bh
                      ; return (IfaceTupleTy s i tys) }
              Word8
_  -> do n <- ReadBinHandle -> IO IfaceTyLit
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                       return (IfaceLitTy n)

instance Binary IfLclName where
  put_ :: WriteBinHandle -> IfLclName -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (FastString -> IO ())
-> (IfLclName -> FastString) -> IfLclName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfLclName -> FastString
ifLclNameFS

  get :: ReadBinHandle -> IO IfLclName
get ReadBinHandle
bh = do
    fs <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    pure $ IfLclName $ LexicalFastString fs

instance Binary IfaceMCoercion where
  put_ :: WriteBinHandle -> IfaceMCoercion -> IO ()
put_ WriteBinHandle
bh IfaceMCoercion
IfaceMRefl =
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
  put_ WriteBinHandle
bh (IfaceMCo IfaceCoercion
co) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
co

  get :: ReadBinHandle -> IO IfaceMCoercion
get ReadBinHandle
bh = do
    tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case tag of
         Word8
1 -> IfaceMCoercion -> IO IfaceMCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceMCoercion
IfaceMRefl
         Word8
2 -> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                 return $ IfaceMCo a
         Word8
_ -> String -> IO IfaceMCoercion
forall a. HasCallStack => String -> a
panic (String
"get IfaceMCoercion " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceCoercion where
  put_ :: WriteBinHandle -> IfaceCoercion -> IO ()
put_ WriteBinHandle
bh (IfaceReflCo IfaceType
a) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
          WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
a
  put_ WriteBinHandle
bh (IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
          WriteBinHandle -> Role -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Role
a
          WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
b
          WriteBinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceMCoercion
c
  put_ WriteBinHandle
bh (IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
          WriteBinHandle -> Role -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Role
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
w
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
c
  put_ WriteBinHandle
bh (IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
          WriteBinHandle -> Role -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Role
a
          WriteBinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceTyCon
b
          WriteBinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCoercion]
c
  put_ WriteBinHandle
bh (IfaceAppCo IfaceCoercion
a IfaceCoercion
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
  put_ WriteBinHandle
bh (IfaceForAllCo IfaceBndr
a ForAllTyFlag
visL ForAllTyFlag
visR IfaceCoercion
b IfaceCoercion
c) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6
          WriteBinHandle -> IfaceBndr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceBndr
a
          WriteBinHandle -> ForAllTyFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ForAllTyFlag
visL
          WriteBinHandle -> ForAllTyFlag -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ForAllTyFlag
visR
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
c
  put_ WriteBinHandle
bh (IfaceCoVarCo IfLclName
a) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
7
          WriteBinHandle -> IfLclName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfLclName
a
  put_ WriteBinHandle
bh (IfaceUnivCo UnivCoProvenance
a Role
b IfaceType
c IfaceType
d [IfaceCoercion]
deps) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
9
          WriteBinHandle -> UnivCoProvenance -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh UnivCoProvenance
a
          WriteBinHandle -> Role -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Role
b
          WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
c
          WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
d
          WriteBinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCoercion]
deps
  put_ WriteBinHandle
bh (IfaceSymCo IfaceCoercion
a) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
10
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
  put_ WriteBinHandle
bh (IfaceTransCo IfaceCoercion
a IfaceCoercion
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
11
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
  put_ WriteBinHandle
bh (IfaceSelCo CoSel
a IfaceCoercion
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
12
          WriteBinHandle -> CoSel -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CoSel
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
  put_ WriteBinHandle
bh (IfaceLRCo LeftOrRight
a IfaceCoercion
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
13
          WriteBinHandle -> LeftOrRight -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LeftOrRight
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
  put_ WriteBinHandle
bh (IfaceInstCo IfaceCoercion
a IfaceCoercion
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
14
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
b
  put_ WriteBinHandle
bh (IfaceKindCo IfaceCoercion
a) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
15
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
  put_ WriteBinHandle
bh (IfaceSubCo IfaceCoercion
a) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
16
          WriteBinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceCoercion
a
  put_ WriteBinHandle
bh (IfaceAxiomCo IfaceAxiomRule
a [IfaceCoercion]
b) = do
          WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
17
          WriteBinHandle -> IfaceAxiomRule -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceAxiomRule
a
          WriteBinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [IfaceCoercion]
b
  put_ WriteBinHandle
_ (IfaceFreeCoVar TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
           -- See Note [Free TyVars and CoVars in IfaceType]
  put_ WriteBinHandle
_  (IfaceHoleCo TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
           -- See Note [Holes in IfaceCoercion]

  get :: ReadBinHandle -> IO IfaceCoercion
get ReadBinHandle
bh = do
      tag <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
      case tag of
           Word8
1 -> do a <- ReadBinHandle -> IO IfaceType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   return $ IfaceReflCo a
           Word8
2 -> do a <- ReadBinHandle -> IO Role
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   c <- get bh
                   return $ IfaceGReflCo a b c
           Word8
3 -> do a  <- ReadBinHandle -> IO Role
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   w  <- get bh
                   b  <- get bh
                   c  <- get bh
                   return $ IfaceFunCo a w b c
           Word8
4 -> do a <- ReadBinHandle -> IO Role
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   c <- get bh
                   return $ IfaceTyConAppCo a b c
           Word8
5 -> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceAppCo a b
           Word8
6 -> do a <- ReadBinHandle -> IO IfaceBndr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   visL <- get bh
                   visR <- get bh
                   b <- get bh
                   c <- get bh
                   return $ IfaceForAllCo a visL visR b c
           Word8
7 -> do a <- ReadBinHandle -> IO IfLclName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   return $ IfaceCoVarCo a
           Word8
9 -> do a <- ReadBinHandle -> IO UnivCoProvenance
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   c <- get bh
                   d <- get bh
                   deps <- get bh
                   return $ IfaceUnivCo a b c d deps
           Word8
10-> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   return $ IfaceSymCo a
           Word8
11-> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceTransCo a b
           Word8
12-> do a <- ReadBinHandle -> IO CoSel
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceSelCo a b
           Word8
13-> do a <- ReadBinHandle -> IO LeftOrRight
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceLRCo a b
           Word8
14-> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceInstCo a b
           Word8
15-> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   return $ IfaceKindCo a
           Word8
16-> do a <- ReadBinHandle -> IO IfaceCoercion
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   return $ IfaceSubCo a
           Word8
17-> do a <- ReadBinHandle -> IO IfaceAxiomRule
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                   b <- get bh
                   return $ IfaceAxiomCo a b
           Word8
_ -> String -> IO IfaceCoercion
forall a. HasCallStack => String -> a
panic (String
"get IfaceCoercion " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceAxiomRule where
  put_ :: WriteBinHandle -> IfaceAxiomRule -> IO ()
put_ WriteBinHandle
bh (IfaceAR_X IfLclName
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfLclName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfLclName
n
  put_ WriteBinHandle
bh (IfaceAR_U IfExtName
n)   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfExtName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfExtName
n
  put_ WriteBinHandle
bh (IfaceAR_B IfExtName
n Int
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfExtName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfExtName
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
i

  get :: ReadBinHandle -> IO IfaceAxiomRule
get ReadBinHandle
bh = do h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
              case h of
                Word8
0 -> do { n <- ReadBinHandle -> IO IfLclName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (IfaceAR_X n) }
                Word8
1 -> do { n <- ReadBinHandle -> IO IfExtName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (IfaceAR_U n) }
                Word8
_ -> do { n <- ReadBinHandle -> IO IfExtName
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; i <- get bh; return (IfaceAR_B n i) }

instance Binary (DefMethSpec IfaceType) where
    put_ :: WriteBinHandle -> DefMethSpec IfaceType -> IO ()
put_ WriteBinHandle
bh DefMethSpec IfaceType
VanillaDM     = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh (GenericDM IfaceType
t) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> IfaceType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IfaceType
t
    get :: ReadBinHandle -> IO (DefMethSpec IfaceType)
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> DefMethSpec IfaceType -> IO (DefMethSpec IfaceType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DefMethSpec IfaceType
forall ty. DefMethSpec ty
VanillaDM
              Word8
_ -> do { t <- ReadBinHandle -> IO IfaceType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (GenericDM t) }

instance NFData IfaceType where
  rnf :: IfaceType -> ()
rnf = \case
    IfaceFreeTyVar TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceTyVar IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1
    IfaceLitTy IfaceTyLit
f1 -> IfaceTyLit -> ()
forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
    IfaceAppTy IfaceType
f1 IfaceAppArgs
f2 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceFunTy FunTyFlag
f1 IfaceType
f2 IfaceType
f3 IfaceType
f4 -> FunTyFlag
f1 FunTyFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f4
    IfaceForAllTy IfaceForAllBndr
f1 IfaceType
f2 -> IfaceForAllBndr
f1 IfaceForAllBndr -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2
    IfaceTyConApp IfaceTyCon
f1 IfaceAppArgs
f2 -> IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceCastTy IfaceType
f1 IfaceCoercion
f2 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceCoercionTy IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceTupleTy TupleSort
f1 PromotionFlag
f2 IfaceAppArgs
f3 -> TupleSort
f1 TupleSort -> () -> ()
forall a b. a -> b -> b
`seq` PromotionFlag
f2 PromotionFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3

instance NFData IfaceTyLit where
  rnf :: IfaceTyLit -> ()
rnf = \case
    IfaceNumTyLit Integer
f1 -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
f1
    IfaceStrTyLit LexicalFastString
f1 -> LexicalFastString -> ()
forall a. NFData a => a -> ()
rnf LexicalFastString
f1
    IfaceCharTyLit Char
f1 -> Char -> ()
forall a. NFData a => a -> ()
rnf Char
f1

instance NFData IfaceCoercion where
  rnf :: IfaceCoercion -> ()
rnf = \case
    IfaceReflCo IfaceType
f1 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1
    IfaceGReflCo Role
f1 IfaceType
f2 IfaceMCoercion
f3 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceMCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
    IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 IfaceCoercion
f4 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f4
    IfaceTyConAppCo Role
f1 IfaceTyCon
f2 [IfaceCoercion]
f3 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAppCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceForAllCo IfaceBndr
f1 ForAllTyFlag
f2 ForAllTyFlag
f3 IfaceCoercion
f4 IfaceCoercion
f5 -> IfaceBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceBndr
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` ForAllTyFlag -> ()
forall a. NFData a => a -> ()
rnf ForAllTyFlag
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` ForAllTyFlag -> ()
forall a. NFData a => a -> ()
rnf ForAllTyFlag
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f4 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f5
    IfaceCoVarCo IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1
    IfaceAxiomCo IfaceAxiomRule
f1 [IfaceCoercion]
f2 -> IfaceAxiomRule -> ()
forall a. NFData a => a -> ()
rnf IfaceAxiomRule
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
    IfaceUnivCo UnivCoProvenance
f1 Role
f2 IfaceType
f3 IfaceType
f4 [IfaceCoercion]
deps -> UnivCoProvenance -> ()
forall a. NFData a => a -> ()
rnf UnivCoProvenance
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` Role
f2 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f4 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
deps
    IfaceSymCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceTransCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceSelCo CoSel
f1 IfaceCoercion
f2 -> CoSel -> ()
forall a. NFData a => a -> ()
rnf CoSel
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceLRCo LeftOrRight
f1 IfaceCoercion
f2 -> LeftOrRight
f1 LeftOrRight -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceInstCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceKindCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceSubCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceFreeCoVar TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceHoleCo TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance NFData IfaceAxiomRule where
  rnf :: IfaceAxiomRule -> ()
rnf = \case
    IfaceAR_X IfLclName
n   -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
n
    IfaceAR_U IfExtName
n   -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
n
    IfaceAR_B IfExtName
n Int
i -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
n () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
i

instance NFData IfaceMCoercion where
  rnf :: IfaceMCoercion -> ()
rnf IfaceMCoercion
x = IfaceMCoercion -> () -> ()
forall a b. a -> b -> b
seq IfaceMCoercion
x ()

instance NFData IfaceOneShot where
  rnf :: IfaceOneShot -> ()
rnf IfaceOneShot
x = IfaceOneShot -> () -> ()
forall a b. a -> b -> b
seq IfaceOneShot
x ()

instance NFData IfaceTyConSort where
  rnf :: IfaceTyConSort -> ()
rnf = \case
    IfaceTyConSort
IfaceNormalTyCon -> ()
    IfaceTupleTyCon Int
arity TupleSort
sort -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity () -> () -> ()
forall a b. a -> b -> b
`seq` TupleSort
sort TupleSort -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceSumTyCon Int
arity -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity
    IfaceTyConSort
IfaceEqualityTyCon -> ()

instance NFData IfLclName where
  rnf :: IfLclName -> ()
rnf (IfLclName LexicalFastString
lfs) = LexicalFastString -> ()
forall a. NFData a => a -> ()
rnf LexicalFastString
lfs

instance NFData IfaceTyConInfo where
  rnf :: IfaceTyConInfo -> ()
rnf (IfaceTyConInfo PromotionFlag
f IfaceTyConSort
s) = PromotionFlag
f PromotionFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyConSort -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConSort
s

instance NFData IfaceTyCon where
  rnf :: IfaceTyCon -> ()
rnf (IfaceTyCon IfExtName
nm IfaceTyConInfo
info) = IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
nm () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyConInfo -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConInfo
info

instance NFData IfaceBndr where
  rnf :: IfaceBndr -> ()
rnf = \case
    IfaceIdBndr IfaceIdBndr
id_bndr -> IfaceIdBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceIdBndr
id_bndr
    IfaceTvBndr IfaceTvBndr
tv_bndr -> IfaceTvBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceTvBndr
tv_bndr

instance NFData IfaceAppArgs where
  rnf :: IfaceAppArgs -> ()
rnf = \case
    IfaceAppArgs
IA_Nil -> ()
    IA_Arg IfaceType
f1 ForAllTyFlag
f2 IfaceAppArgs
f3 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` ForAllTyFlag
f2 ForAllTyFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3