{-# 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,
putIfaceType, getIfaceType, ifaceTypeSharedByte,
isIfaceLiftedTypeKind,
appArgsIfaceTypes, appArgsIfaceTypesForAllTyFlags,
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 ((<$!>))
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
data IfaceBndr
= 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
= IfaceNoOneShot
| 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"
type IfaceKind = IfaceType
data IfaceType
= IfaceFreeTyVar TyVar
| IfaceTyVar IfLclName
| IfaceLitTy IfaceTyLit
| IfaceAppTy IfaceType IfaceAppArgs
| IfaceFunTy FunTyFlag IfaceMult IfaceType IfaceType
| IfaceForAllTy IfaceForAllBndr IfaceType
| IfaceTyConApp IfaceTyCon IfaceAppArgs
| IfaceCastTy IfaceType IfaceCoercion
| IfaceCoercionTy IfaceCoercion
| IfaceTupleTy
TupleSort
PromotionFlag
IfaceAppArgs
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)
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
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
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)
data IfaceAppArgs
= IA_Nil
| IA_Arg IfaceType
ForAllTyFlag
IfaceAppArgs
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.<>)
data IfaceTyCon = IfaceTyCon { IfaceTyCon -> IfExtName
ifaceTyConName :: IfExtName
, IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo :: !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)
data IfaceTyConSort = IfaceNormalTyCon
| IfaceTupleTyCon !Arity !TupleSort
| IfaceSumTyCon !Arity
| IfaceEqualityTyCon
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"
data IfaceTyConInfo
= IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
, 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)
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 #-}
promotedNormalTyConInfo :: IfaceTyConInfo
promotedNormalTyConInfo :: IfaceTyConInfo
promotedNormalTyConInfo = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon
{-# NOINLINE notPromotedNormalTyConInfo #-}
notPromotedNormalTyConInfo :: IfaceTyConInfo
notPromotedNormalTyConInfo :: IfaceTyConInfo
notPromotedNormalTyConInfo = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
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]
| 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
| IfaceHoleCo CoVar
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)
data IfaceAxiomRule
= IfaceAR_X IfLclName
| IfaceAR_B IfExtName BranchIndex
| IfaceAR_U IfExtName
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)
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
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
| 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
isIfaceLiftedTypeKind IfaceType
_ = Bool
False
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
| 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
isIfaceConstraintKind IfaceType
_ = Bool
False
isIfaceLiftedRep :: IfaceKind -> Bool
isIfaceLiftedRep :: IfaceType -> Bool
isIfaceLiftedRep (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepTyConKey
, IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
= Bool
True
| 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
isIfaceLiftedRep IfaceType
_ = Bool
False
isIfaceLifted :: IfaceKind -> Bool
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)
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
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = IfaceForAllBndr -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> IfLclName
ifaceBndrName (IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar IfaceForAllBndr
fab)
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = IfaceTyConBinder -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> IfLclName
ifaceBndrName (IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar IfaceTyConBinder
tcb)
ifTypeIsVarFree :: IfaceType -> Bool
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
go (IfaceCoercionTy {}) = Bool
False
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
type IfaceTySubst = FastStringEnv IfaceType
mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
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
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
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
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
| 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
if_print_coercions :: SDoc
-> SDoc
-> 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
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)
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) =
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
instance Outputable IfaceType where
ppr :: IfaceType -> SDoc
ppr IfaceType
ty = IfaceType -> SDoc
pprIfaceType IfaceType
ty
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
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
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"
ppr_ty PprPrec
_ (IfaceFreeTyVar TyVar
tyvar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tyvar
ppr_ty PprPrec
_ (IfaceTyVar IfLclName
tyvar) = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tyvar
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
ppr_ty PprPrec
_ (IfaceLitTy IfaceTyLit
n) = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceFunTy FunTyFlag
af IfaceType
w IfaceType
ty1 IfaceType
ty2)
= 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
$
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)
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
"<>")
defaultIfaceTyVarsOfKind :: Bool
-> Bool
-> 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
-> Bool
-> 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
, 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
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)
| 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
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
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
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
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
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]
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
ppr_itv_bndrs :: [IfaceForAllBndr]
-> ForAllTyFlag
-> ([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
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
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
data ShowSub
= ShowSub
{ ShowSub -> ShowHowMuch
ss_how_much :: ShowHowMuch
, ShowSub -> ShowForAllFlag
ss_forall :: ShowForAllFlag }
newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))
data ShowHowMuch
= AltPpr
| ShowSome (Maybe (OccName -> Bool)) AltPpr
| ShowIface
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
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 ->
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
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
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 :: 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
| 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
| 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
-> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec
| IfaceType -> Bool
isIfaceConstraintKind (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
, Bool
print_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
-> 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)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
, Bool -> Bool
not Bool
debug
-> 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
'*')
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
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
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
|
Bool
print_eqs
= SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
|
Bool
nominal_eq_tc, Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~")
|
Bool -> Bool
not Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)
|
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])
| 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)
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
-> 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)
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)
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"
| 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
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
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
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
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
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
$
[(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')
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
| 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)
= 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
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)
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
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
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)
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
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
ifaceTypeSharedByte :: Word8
ifaceTypeSharedByte :: Word8
ifaceTypeSharedByte = Word8
99
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
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)
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 }
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)
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)
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