{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Iface.Type (
IfExtName, IfLclName,
IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
IfaceMCoercion(..),
IfaceUnivCoProv(..),
IfaceMult,
IfaceTyCon(..),
IfaceTyConInfo(..), mkIfaceTyConInfo,
IfaceTyConSort(..),
IfaceTyLit(..), IfaceAppArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllSpecBndr,
IfaceForAllBndr, ForAllTyFlag(..), FunTyFlag(..), ShowForAllFlag(..),
mkIfaceForAllTvBndr,
mkIfaceTyConKind,
ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr,
ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
ifTyConBinderVar, ifTyConBinderName,
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 )
import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, funTyFlagTyCon )
import GHC.Core.TyCo.Rep( CoSel )
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 qualified Data.Semigroup as Semi
import Control.DeepSeq
type IfLclName = FastString
type IfExtName = Name
data IfaceBndr
= IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
| IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
type IfaceIdBndr = (IfaceType, IfLclName, IfaceType)
type IfaceTvBndr = (IfLclName, IfaceKind)
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName :: IfaceTvBndr -> FastString
ifaceTvBndrName (FastString
n,IfaceType
_) = FastString
n
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceIdBndr -> FastString
ifaceIdBndrName (IfaceType
_,FastString
n,IfaceType
_) = FastString
n
ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName :: IfaceBndr -> FastString
ifaceBndrName (IfaceTvBndr IfaceTvBndr
bndr) = IfaceTvBndr -> FastString
ifaceTvBndrName IfaceTvBndr
bndr
ifaceBndrName (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> FastString
ifaceIdBndrName IfaceIdBndr
bndr
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType (IfaceIdBndr (IfaceType
_, FastString
_, IfaceType
t)) = IfaceType
t
ifaceBndrType (IfaceTvBndr (FastString
_, IfaceType
t)) = IfaceType
t
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
data IfaceOneShot
= IfaceNoOneShot
| IfaceOneShot
instance Outputable IfaceOneShot where
ppr :: IfaceOneShot -> SDoc
ppr IfaceOneShot
IfaceNoOneShot = forall doc. IsLine doc => String -> doc
text String
"NoOneShotInfo"
ppr IfaceOneShot
IfaceOneShot = 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
type IfaceMult = IfaceType
type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]
data IfaceTyLit
= IfaceNumTyLit Integer
| IfaceStrTyLit FastString
| IfaceCharTyLit Char
deriving (IfaceTyLit -> IfaceTyLit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyLit -> IfaceTyLit -> Bool
$c/= :: IfaceTyLit -> IfaceTyLit -> Bool
== :: IfaceTyLit -> IfaceTyLit -> Bool
$c== :: IfaceTyLit -> IfaceTyLit -> Bool
Eq)
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 = 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 = 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 (AnonTCB FunTyFlag
af)) IfaceType
k = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
af IfaceType
many_ty (IfaceBndr -> IfaceType
ifaceBndrType IfaceBndr
tv) IfaceType
k
mk (Bndr IfaceBndr
tv (NamedTCB ForAllTyFlag
vis)) IfaceType
k = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ForAllTyFlag
vis) IfaceType
k
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs = forall a b. (a -> b) -> [a] -> [b]
map IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr (Bndr IfaceBndr
tv Specificity
spec) = 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
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 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 = forall a. Semigroup a => a -> a -> a
(Semi.<>)
data IfaceTyCon = IfaceTyCon { IfaceTyCon -> IfExtName
ifaceTyConName :: IfExtName
, IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo :: IfaceTyConInfo }
deriving (IfaceTyCon -> IfaceTyCon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyCon -> IfaceTyCon -> Bool
$c/= :: IfaceTyCon -> IfaceTyCon -> Bool
== :: IfaceTyCon -> IfaceTyCon -> Bool
$c== :: IfaceTyCon -> IfaceTyCon -> Bool
Eq)
data IfaceTyConSort = IfaceNormalTyCon
| IfaceTupleTyCon !Arity !TupleSort
| IfaceSumTyCon !Arity
| IfaceEqualityTyCon
deriving (IfaceTyConSort -> IfaceTyConSort -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
== :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c== :: IfaceTyConSort -> IfaceTyConSort -> Bool
Eq)
instance Outputable IfaceTyConSort where
ppr :: IfaceTyConSort -> SDoc
ppr IfaceTyConSort
IfaceNormalTyCon = forall doc. IsLine doc => String -> doc
text String
"normal"
ppr (IfaceTupleTyCon Int
n TupleSort
sort) = forall a. Outputable a => a -> SDoc
ppr TupleSort
sort forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Int
n
ppr (IfaceSumTyCon Int
n) = forall doc. IsLine doc => String -> doc
text String
"sum:" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Int
n
ppr IfaceTyConSort
IfaceEqualityTyCon = forall doc. IsLine doc => String -> doc
text String
"equality"
data IfaceTyConInfo
= IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
, IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort :: IfaceTyConSort }
deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
prom IfaceTyConSort
sort = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
prom IfaceTyConSort
sort
data IfaceMCoercion
= IfaceMRefl
| IfaceMCo IfaceCoercion
data IfaceCoercion
= IfaceReflCo IfaceType
| IfaceGReflCo Role IfaceType (IfaceMCoercion)
| IfaceFunCo Role IfaceCoercion IfaceCoercion IfaceCoercion
| IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion]
| IfaceAppCo IfaceCoercion IfaceCoercion
| IfaceForAllCo IfaceBndr IfaceCoercion IfaceCoercion
| IfaceCoVarCo IfLclName
| IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
| IfaceAxiomRuleCo IfLclName [IfaceCoercion]
| IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
| IfaceSymCo IfaceCoercion
| IfaceTransCo IfaceCoercion IfaceCoercion
| IfaceSelCo CoSel IfaceCoercion
| IfaceLRCo LeftOrRight IfaceCoercion
| IfaceInstCo IfaceCoercion IfaceCoercion
| IfaceKindCo IfaceCoercion
| IfaceSubCo IfaceCoercion
| IfaceFreeCoVar CoVar
| IfaceHoleCo CoVar
data IfaceUnivCoProv
= IfacePhantomProv IfaceCoercion
| IfaceProofIrrelProv IfaceCoercion
| IfacePluginProv String
| IfaceCorePrepProv Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey IfaceTyCon
tc Unique
key = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc 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 forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceType]
theta 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 (forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
= case IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrforall 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
ty1forall 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 (forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
= case IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrforall 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 = 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)
| 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 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
= forall a. (a -> Bool) -> [a] -> [a]
filterOut forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = forall tv argf. VarBndr tv argf -> tv
binderVar
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> FastString
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> FastString
ifaceBndrName (IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar IfaceForAllBndr
fab)
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = forall tv argf. VarBndr tv argf -> tv
binderVar
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName :: IfaceTyConBinder -> FastString
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> FastString
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 = forall a. [(FastString, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst IfaceTySubst
subst (FastString
fs, IfaceType
_) = forall a. Maybe a -> Bool
isJust (forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subst FastString
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 CoVar
tv) = CoVar -> IfaceType
IfaceFreeTyVar CoVar
tv
go (IfaceTyVar FastString
tv) = IfaceTySubst -> FastString -> IfaceType
substIfaceTyVar IfaceTySubst
env FastString
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 {}) = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (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 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 {}) = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceCoercion" (forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
go_co (IfaceFreeCoVar CoVar
cv) = CoVar -> IfaceCoercion
IfaceFreeCoVar CoVar
cv
go_co (IfaceCoVarCo FastString
cv) = FastString -> IfaceCoercion
IfaceCoVarCo FastString
cv
go_co (IfaceHoleCo CoVar
cv) = CoVar -> IfaceCoercion
IfaceHoleCo CoVar
cv
go_co (IfaceAxiomInstCo IfExtName
a Int
i [IfaceCoercion]
cos) = IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_co (IfaceUnivCo IfaceUnivCoProv
prov Role
r IfaceType
t1 IfaceType
t2) = IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo (IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
prov) Role
r (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
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 (IfaceAxiomRuleCo FastString
n [IfaceCoercion]
cos) = FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_cos :: [IfaceCoercion] -> [IfaceCoercion]
go_cos = forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> IfaceCoercion
go_co
go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov (IfacePhantomProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_prov (IfaceProofIrrelProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_prov co :: IfaceUnivCoProv
co@(IfacePluginProv String
_) = IfaceUnivCoProv
co
go_prov co :: IfaceUnivCoProv
co@(IfaceCorePrepProv Bool
_) = IfaceUnivCoProv
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 -> FastString -> IfaceType
substIfaceTyVar IfaceTySubst
env FastString
tv
| Just IfaceType
ty <- forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
env FastString
tv = IfaceType
ty
| Bool
otherwise = FastString -> IfaceType
IfaceTyVar FastString
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 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 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) forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags IfaceAppArgs
ts
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = 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
nforall a. Num a => a -> a -> a
+t
1) IfaceAppArgs
rest
| Bool
otherwise = t -> IfaceAppArgs -> t
go t
n IfaceAppArgs
rest
if_print_coercions :: SDoc
-> SDoc
-> SDoc
if_print_coercions :: SDoc -> SDoc -> SDoc
if_print_coercions SDoc
yes SDoc
no
= forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions forall a b. (a -> b) -> a -> b
$ \Bool
print_co ->
(PprStyle -> SDoc) -> SDoc
getPprStyle forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug 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 forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
pp_ty1, SDoc
pp_tc 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
| 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 forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang SDoc
pp_fun Int
2 (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) = forall doc. IsLine doc => Char -> doc
char Char
'@' 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 = forall doc. IsLine doc => [doc] -> doc
sep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [IfaceBndr]
bs)
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceNoOneShot) = forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceOneShot) = forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"[OneShot]"
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (IfaceType
w, FastString
name, IfaceType
ty) = forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr FastString
name forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (forall a. Outputable a => a -> SDoc
ppr IfaceType
w) forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr 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 (FastString
tv, IfaceType
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
| Bool
suppress_sig = forall a. Outputable a => a -> SDoc
ppr FastString
tv
| IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
ki = forall a. Outputable a => a -> SDoc
ppr FastString
tv
| Bool
otherwise = SDoc -> SDoc
maybe_parens (forall a. Outputable a => a -> SDoc
ppr FastString
tv forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr IfaceType
ki)
where
maybe_parens :: SDoc -> SDoc
maybe_parens | Bool
use_parens = forall doc. IsLine doc => doc -> doc
parens
| Bool
otherwise = forall a. a -> a
id
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders SuppressBndrSig
suppress_sig = forall doc. IsLine doc => [doc] -> doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
AnonTCB FunTyFlag
af
| FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
| Bool
otherwise -> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
NamedTCB ForAllTyFlag
Required -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
NamedTCB ForAllTyFlag
Specified -> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
NamedTCB ForAllTyFlag
Inferred -> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> 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_ :: BinHandle -> IfaceBndr -> IO ()
put_ BinHandle
bh (IfaceIdBndr IfaceIdBndr
aa) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceIdBndr
aa
put_ BinHandle
bh (IfaceTvBndr IfaceTvBndr
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
ab
get :: BinHandle -> IO IfaceBndr
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do IfaceIdBndr
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceIdBndr -> IfaceBndr
IfaceIdBndr IfaceIdBndr
aa)
Word8
_ -> do IfaceTvBndr
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
ab)
instance Binary IfaceOneShot where
put_ :: BinHandle -> IfaceOneShot -> IO ()
put_ BinHandle
bh IfaceOneShot
IfaceNoOneShot =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh IfaceOneShot
IfaceOneShot =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
get :: BinHandle -> IO IfaceOneShot
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
Word8
_ -> 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 :: IfaceType -> SDoc
pprIfaceType :: IfaceType -> SDoc
pprIfaceType = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
topPrec
pprParendIfaceType :: IfaceType -> SDoc
pprParendIfaceType = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
appPrec
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
= 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
_) = forall a. a -> Maybe a
Just IfaceTyCon
tc
mb_conc IfaceType
_ = 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
_ -> forall doc. IsLine doc => String -> doc
text String
"%" forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> a -> SDoc
ppr_mult PprPrec
appPrec a
mult forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
| Bool
otherwise
= 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 {}) = forall a. HasCallStack => String -> a
panic String
"ppr_ty"
ppr_ty PprPrec
_ (IfaceFreeTyVar CoVar
tyvar) = forall a. Outputable a => a -> SDoc
ppr CoVar
tyvar
ppr_ty PprPrec
_ (IfaceTyVar FastString
tyvar) = forall a. Outputable a => a -> SDoc
ppr FastString
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
pprTuple 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)
= forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af) (forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) forall a b. (a -> b) -> a -> b
$
PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => [doc] -> doc
sep [PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1, 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 forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1) 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 forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceType -> SDoc
pprIfaceType 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 =
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
let tys_wo_kinds :: [(IfaceType, ForAllTyFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags 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)
(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 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
(forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"|>" forall doc. IsLine doc => doc -> doc -> doc
<+> 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)
(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 -> IfaceType -> IfaceType
go forall a. FastStringEnv a
emptyFsEnv IfaceType
ty
where
go :: FastStringEnv IfaceType
-> IfaceType
-> IfaceType
go :: IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs (IfaceForAllTy (Bndr (IfaceTvBndr (FastString
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' = forall a. FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv IfaceTySubst
subs FastString
var IfaceType
substituted_ty
in IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs' IfaceType
ty
go IfaceTySubst
subs (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
= IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs IfaceForAllBndr
bndr) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
ty)
go IfaceTySubst
subs ty :: IfaceType
ty@(IfaceTyVar FastString
tv) = case forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subs FastString
tv of
Just IfaceType
s -> IfaceType
s
Maybe IfaceType
Nothing -> IfaceType
ty
go IfaceTySubst
_ ty :: IfaceType
ty@(IfaceFreeTyVar CoVar
tv)
| Bool
def_rep
, Type -> Bool
GHC.Core.Type.isRuntimeRepTy (CoVar -> Type
tyVarKind CoVar
tv)
, CoVar -> Bool
isMetaTyVar CoVar
tv
, CoVar -> Bool
isTyConableTyVar CoVar
tv
= IfaceType
liftedRep_ty
| Bool
def_rep
, Type -> Bool
GHC.Core.Type.isLevityTy (CoVar -> Type
tyVarKind CoVar
tv)
, CoVar -> Bool
isMetaTyVar CoVar
tv
, CoVar -> Bool
isTyConableTyVar CoVar
tv
= IfaceType
lifted_ty
| Bool
def_mult
, Type -> Bool
GHC.Core.Type.isMultiplicityTy (CoVar -> Type
tyVarKind CoVar
tv)
, CoVar -> Bool
isMetaTyVar CoVar
tv
, CoVar -> Bool
isTyConableTyVar CoVar
tv
= IfaceType
many_ty
| Bool
otherwise
= IfaceType
ty
go IfaceTySubst
subs (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 (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 (IfaceFunTy FunTyFlag
af IfaceType
w IfaceType
arg IfaceType
res)
= FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
af (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
w) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
arg) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
res)
go IfaceTySubst
subs (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
= IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
ts)
go IfaceTySubst
subs (IfaceCastTy IfaceType
x IfaceCoercion
co)
= IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
x) IfaceCoercion
co
go IfaceTySubst
_ ty :: IfaceType
ty@(IfaceLitTy {}) = IfaceType
ty
go IfaceTySubst
_ 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, FastString
n, IfaceType
t)) ForAllTyFlag
argf)
= forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceIdBndr -> IfaceBndr
IfaceIdBndr (IfaceType
w, FastString
n, IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
t)) ForAllTyFlag
argf
go_ifacebndr IfaceTySubst
subs (Bndr (IfaceTvBndr (FastString
n, IfaceType
t)) ForAllTyFlag
argf)
= forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (FastString
n, IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs 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 -> IfaceType -> IfaceType
go IfaceTySubst
subs 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
= forall a. a -> Maybe a
Just IfaceType
liftedRep_ty
| Bool
def_rep
, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
levityTyConKey
= forall a. a -> Maybe a
Just IfaceType
lifted_ty
| Bool
def_mult
, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
multiplicityTyConKey
= forall a. a -> Maybe a
Just IfaceType
many_ty
check_substitution 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 = 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 = 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 = 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
= forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitRuntimeReps ->
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes forall a b. (a -> b) -> a -> b
$ \Bool
linearTypes ->
(PprStyle -> SDoc) -> SDoc
getPprStyle 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 = 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) 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) =
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds 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
-> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec IfaceType
t
ForAllTyFlag
Inferred | Bool
print_kinds
-> forall doc. IsLine doc => Char -> doc
char Char
'@' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
t)
ForAllTyFlag
_ -> 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)] -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs SDoc
sdoc
= forall doc. IsLine doc => [doc] -> doc
sep [ [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(FastString, IfaceCoercion)]
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
= 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 [] = forall doc. IsOutput doc => doc
empty
pprIfaceForAll bndrs :: [IfaceForAllBndr]
bndrs@(Bndr IfaceBndr
_ ForAllTyFlag
vis : [IfaceForAllBndr]
_)
= forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
add_separator (SDoc
forAllLit forall doc. IsLine doc => doc -> doc -> doc
<+> 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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
ForAllTyFlag
_inv -> SDoc
stuff forall doc. IsLine doc => doc -> doc -> doc
<> 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 forall a. a -> [a] -> [a]
: [SDoc]
doc)
| Bool
otherwise = ([IfaceForAllBndr]
all_bndrs, [])
ppr_itv_bndrs [] ForAllTyFlag
_ = ([], [])
pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [] = forall doc. IsOutput doc => doc
empty
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs = forall doc. IsLine doc => String -> doc
text String
"forall" forall doc. IsLine doc => doc -> doc -> doc
<+> [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
tvs forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot
pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
bndrs = forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr [(FastString, IfaceCoercion)]
bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
case IfaceForAllBndr
bndr of
Bndr (IfaceTvBndr IfaceTvBndr
tv) ForAllTyFlag
Inferred ->
forall doc. IsLine doc => doc -> doc
braces 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) -> SDoc
pprIfaceForAllCoBndr :: (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (FastString
tv, IfaceCoercion
kind_co)
= forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr FastString
tv forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
kind_co)
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
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 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 forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => [doc] -> doc
sep [[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
req_tvs, forall a. Outputable a => a -> SDoc
ppr IfaceType
tau']
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
= forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitForalls forall a b. (a -> b) -> a -> b
$ \Bool
print_foralls ->
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {argf}. VarBndr IfaceBndr argf -> Bool
tv_has_kind_var [IfaceForAllBndr]
tvs
Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {tv}. VarBndr tv ForAllTyFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
Bool -> Bool -> Bool
|| Bool
print_foralls) 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 (FastString
_,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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
let
items :: [IfaceType]
items = IfaceType
ty1forall a. a -> [a] -> [a]
:[IfaceType]
arg_tys
eos :: IsEmptyOrSingleton
eos = 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 (forall doc. IsLine doc => Char -> doc
char Char
'\'', SDoc -> SDoc
spaceIfSingleQuote)
else (forall doc. IsOutput doc => doc
empty, forall a. a -> a
id)
in
SDoc
preBracket forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc
postBracket (forall doc. IsLine doc => [doc] -> doc
fsep
(forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma (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 forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1)
Int
2 (forall doc. IsLine doc => [doc] -> doc
fsep [ forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty | IfaceType
ty <- [IfaceType]
arg_tys 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
ty1forall a. a -> [a] -> [a]
:[IfaceType]
args, Maybe IfaceType
tl)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
= ([], forall a. Maybe a
Nothing)
gather IfaceType
ty = ([], 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 =
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypeAbbreviations forall a b. (a -> b) -> a -> b
$ \Bool
print_type_abbreviations ->
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
if | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
, IA_Arg (IfaceLitTy (IfaceStrTyLit FastString
n))
ForAllTyFlag
Required (IA_Arg IfaceType
ty ForAllTyFlag
Required IfaceAppArgs
IA_Nil) <- IfaceAppArgs
tys
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec
forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Char -> doc
char Char
'?' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => FastString -> doc
ftext FastString
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"::" 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 forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
-> PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple 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 forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
-> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum (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
-> 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 (forall doc. IsLine doc => doc -> doc
parens SDoc
arrow) (forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) forall a b. (a -> b) -> a -> b
$
IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags 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
-> 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
-> 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 forall a b. (a -> b) -> a -> b
$
IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags 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 = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocStarIsType forall a b. (a -> b) -> a -> b
$ \case
Bool
False -> forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfExtName
liftedTypeKindTyConName
Bool
True -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
starPrec forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc -> SDoc
unicodeSyntax (forall doc. IsLine doc => Char -> doc
char Char
'★') (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
= forall a. a -> Maybe a
Just 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
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k, IfaceType
k, IfaceType
t1, IfaceType
t2)
| Bool
otherwise
= forall a. Maybe a
Nothing
where
homogeneous :: Bool
homogeneous = IfExtName
tc_name 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 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 forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
hetero_eq_tc :: Bool
hetero_eq_tc = IfExtName
tc_name forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
nominal_eq_tc :: Bool
nominal_eq_tc = IfExtName
tc_name forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
print_equality :: (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType, IfaceType, IfaceType, IfaceType)
args =
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintEqualityRelations forall a b. (a -> b) -> a -> b
$ \Bool
print_eqs ->
(PprStyle -> SDoc) -> SDoc
getPprStyle forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug 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 (forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
|
Bool
nominal_eq_tc, Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (forall doc. IsLine doc => String -> doc
text String
"~")
|
Bool -> Bool
not Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)
|
IfExtName
tc_name 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 (forall a. Outputable a => a -> SDoc
ppr TyCon
coercibleTyCon)
([SDoc]
ki 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 (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
= forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceType -> SDoc
pp PprPrec
topPrec IfaceType
ty forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon 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 =
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
(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 =
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocListTuplePuns 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
-> 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
| Bool -> Bool
not (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)))
-> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc) (forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
appPrec) [(a, ForAllTyFlag)]
tys)
| [ 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 (forall a. Outputable a => a -> SDoc
ppr 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 (forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)) (forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
appPrec) [(a, ForAllTyFlag)]
tys)
pprSum :: PromotionFlag -> IfaceAppArgs -> SDoc
pprSum :: PromotionFlag -> IfaceAppArgs -> SDoc
pprSum PromotionFlag
is_promoted IfaceAppArgs
args
=
let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
sumParens (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) [IfaceType]
args')
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort PromotionFlag
promoted IfaceAppArgs
args =
case PromotionFlag
promoted of
PromotionFlag
IsPromoted
-> let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
in [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
args' forall a b. (a -> b) -> a -> b
$
PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
IsPromoted forall doc. IsLine doc => doc -> doc -> doc
<>
TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort (SDoc -> SDoc
spaceIfSingleQuote (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
args'))
PromotionFlag
NotPromoted
| TupleSort
ConstraintTuple <- TupleSort
sort
, IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
sigPrec forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => String -> doc
text String
"() :: Constraint"
| Bool
otherwise
->
let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = case TupleSort
sort of
TupleSort
UnboxedTuple -> forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
TupleSort
_ -> [IfaceType]
tys
in
[IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
args' forall a b. (a -> b) -> a -> b
$
PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
promoted forall doc. IsLine doc => doc -> doc -> doc
<>
TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
args')
where
ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
args_wo_runtime_reps SDoc
ppr_args_w_parens
| [IfaceType
_] <- [IfaceType]
args_wo_runtime_reps
, TupleSort
BoxedTuple <- TupleSort
sort
= let solo_tc_info :: IfaceTyConInfo
solo_tc_info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
IfaceNormalTyCon
tupleName :: Int -> IfExtName
tupleName = case PromotionFlag
promoted of
PromotionFlag
IsPromoted -> Boxity -> Int -> IfExtName
tupleDataConName (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
PromotionFlag
NotPromoted -> TupleSort -> Int -> IfExtName
tupleTyConName TupleSort
sort
solo_tc :: IfaceTyCon
solo_tc = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (Int -> IfExtName
tupleName Int
1) IfaceTyConInfo
solo_tc_info in
PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
solo_tc IfaceAppArgs
args
| Bool
otherwise
= SDoc
ppr_args_w_parens
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceNumTyLit Integer
n) = forall doc. IsLine doc => Integer -> doc
integer Integer
n
pprIfaceTyLit (IfaceStrTyLit FastString
n) = forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show FastString
n)
pprIfaceTyLit (IfaceCharTyLit Char
c) = forall doc. IsLine doc => String -> doc
text (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) = forall doc. IsLine doc => doc -> doc
angleBrackets (forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_ (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
IfaceMRefl)
= forall doc. IsLine doc => doc -> doc
angleBrackets (forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) 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
(forall doc. IsLine doc => String -> doc
text String
"GRefl" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Role
r 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 forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => [doc] -> doc
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 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 forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1)
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 forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]
ppr_arrow :: IfaceCoercion -> SDoc
ppr_arrow = 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]
_) = forall a. a -> Maybe a
Just IfaceTyCon
tc
mb_conc IfaceCoercion
_ = forall a. Maybe a
Nothing
ppr_co PprPrec
_ (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos)
= forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
topPrec IfaceTyCon
tc [IfaceCoercion]
cos) 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 forall a b. (a -> b) -> a -> b
$
PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 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 forall a b. (a -> b) -> a -> b
$
[(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
where
([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co
split_co :: IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co (IfaceForAllCo (IfaceTvBndr (FastString
name, IfaceType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co (IfaceForAllCo (IfaceIdBndr (IfaceType
_, FastString
name, IfaceType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co IfaceCoercion
co' = ([], IfaceCoercion
co')
ppr_co PprPrec
_ (IfaceFreeCoVar CoVar
covar) = forall a. Outputable a => a -> SDoc
ppr CoVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo FastString
covar) = forall a. Outputable a => a -> SDoc
ppr FastString
covar
ppr_co PprPrec
_ (IfaceHoleCo CoVar
covar) = forall doc. IsLine doc => doc -> doc
braces (forall a. Outputable a => a -> SDoc
ppr CoVar
covar)
ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfaceType
ty1 IfaceType
ty2)
= forall doc. IsLine doc => String -> doc
text String
"Univ" forall doc. IsLine doc => doc -> doc -> doc
<> (forall doc. IsLine doc => doc -> doc
parens forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => [doc] -> doc
sep [ forall a. Outputable a => a -> SDoc
ppr Role
role forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
prov
, SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr IfaceType
ty1 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> 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 forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => String -> doc
text String
"Inst" forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty
ppr_co PprPrec
ctxt_prec (IfaceAxiomRuleCo FastString
tc [IfaceCoercion]
cos)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr FastString
tc forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => [a] -> SDoc
interpp'SP [IfaceCoercion]
cos)
ppr_co PprPrec
ctxt_prec (IfaceAxiomInstCo IfExtName
n Int
i [IfaceCoercion]
cos)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (forall a. Outputable a => a -> SDoc
ppr IfExtName
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
brackets (forall a. Outputable a => a -> SDoc
ppr Int
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (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) = forall doc. IsLine doc => doc
semi forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
c1 forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
c2
ppr_trans IfaceCoercion
c = [forall doc. IsLine doc => doc
semi 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 forall a b. (a -> b) -> a -> b
$
forall doc. IsDoc doc => [doc] -> doc
vcat (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
co1 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 (forall doc. IsLine doc => String -> doc
text String
"SelCo:" forall doc. IsLine doc => doc -> doc -> doc
<> 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 (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 (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 (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
(forall doc. IsLine doc => [doc] -> doc
sep [SDoc
doc, Int -> SDoc -> SDoc
nest Int
4 (forall doc. IsLine doc => [doc] -> doc
sep (forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> SDoc
pprParendIfaceCoercion [IfaceCoercion]
cos))])
ppr_role :: Role -> SDoc
ppr_role :: Role -> SDoc
ppr_role Role
r = forall doc. IsLine doc => doc
underscore forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_role
where pp_role :: SDoc
pp_role = case Role
r of
Role
Nominal -> forall doc. IsLine doc => Char -> doc
char Char
'N'
Role
Representational -> forall doc. IsLine doc => Char -> doc
char Char
'R'
Role
Phantom -> forall doc. IsLine doc => Char -> doc
char Char
'P'
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
co)
= forall doc. IsLine doc => String -> doc
text String
"phantom" forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
co)
= forall doc. IsLine doc => String -> doc
text String
"irrel" forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfacePluginProv String
s)
= forall doc. IsLine doc => String -> doc
text String
"plugin" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
doubleQuotes (forall doc. IsLine doc => String -> doc
text String
s)
pprIfaceUnivCoProv (IfaceCorePrepProv Bool
_)
= forall doc. IsLine doc => String -> doc
text String
"CorePrep"
instance Outputable IfaceTyCon where
ppr :: IfaceTyCon -> SDoc
ppr IfaceTyCon
tc = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr (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 })
= forall doc. IsLine doc => doc -> doc
angleBrackets forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr PromotionFlag
prom forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr IfaceTyConSort
sort
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc =
(PprStyle -> SDoc) -> SDoc
getPprStyle forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
let
name :: OccName
name = 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 forall doc. IsLine doc => Char -> doc
char Char
'\''
else forall doc. IsOutput doc => doc
empty
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
NotPromoted = forall doc. IsOutput doc => doc
empty
pprPromotionQuoteI PromotionFlag
IsPromoted = forall doc. IsLine doc => Char -> doc
char Char
'\''
instance Outputable IfaceCoercion where
ppr :: IfaceCoercion -> SDoc
ppr = IfaceCoercion -> SDoc
pprIfaceCoercion
instance Binary IfaceTyCon where
put_ :: BinHandle -> IfaceTyCon -> IO ()
put_ BinHandle
bh (IfaceTyCon IfExtName
n IfaceTyConInfo
i) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConInfo
i
get :: BinHandle -> IO IfaceTyCon
get BinHandle
bh = do IfExtName
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTyConInfo
i <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
n IfaceTyConInfo
i)
instance Binary IfaceTyConSort where
put_ :: BinHandle -> IfaceTyConSort -> IO ()
put_ BinHandle
bh IfaceTyConSort
IfaceNormalTyCon = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (IfaceTupleTyCon Int
arity TupleSort
sort) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
sort
put_ BinHandle
bh (IfaceSumTyCon Int
arity) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity
put_ BinHandle
bh IfaceTyConSort
IfaceEqualityTyCon = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
get :: BinHandle -> IO IfaceTyConSort
get BinHandle
bh = do
Word8
n <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
n of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
Word8
1 -> Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> Int -> IfaceTyConSort
IfaceSumTyCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceEqualityTyCon
instance Binary IfaceTyConInfo where
put_ :: BinHandle -> IfaceTyConInfo -> IO ()
put_ BinHandle
bh (IfaceTyConInfo PromotionFlag
i IfaceTyConSort
s) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConSort
s
get :: BinHandle -> IO IfaceTyConInfo
get BinHandle
bh = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Outputable IfaceTyLit where
ppr :: IfaceTyLit -> SDoc
ppr = IfaceTyLit -> SDoc
pprIfaceTyLit
instance Binary IfaceTyLit where
put_ :: BinHandle -> IfaceTyLit -> IO ()
put_ BinHandle
bh (IfaceNumTyLit Integer
n) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
n
put_ BinHandle
bh (IfaceStrTyLit FastString
n) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
n
put_ BinHandle
bh (IfaceCharTyLit Char
n) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
n
get :: BinHandle -> IO IfaceTyLit
get BinHandle
bh =
do Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do { Integer
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IfaceTyLit
IfaceNumTyLit Integer
n) }
Word8
2 -> do { FastString
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceTyLit
IfaceStrTyLit FastString
n) }
Word8
3 -> do { Char
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IfaceTyLit
IfaceCharTyLit Char
n) }
Word8
_ -> forall a. HasCallStack => String -> a
panic (String
"get IfaceTyLit " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag)
instance Binary IfaceAppArgs where
put_ :: BinHandle -> IfaceAppArgs -> IO ()
put_ BinHandle
bh IfaceAppArgs
tk =
case IfaceAppArgs
tk of
IA_Arg IfaceType
t ForAllTyFlag
a IfaceAppArgs
ts -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ForAllTyFlag
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
ts
IfaceAppArgs
IA_Nil -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
get :: BinHandle -> IO IfaceAppArgs
get BinHandle
bh =
do Word8
c <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
c of
Word8
0 -> do
IfaceType
t <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
ForAllTyFlag
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceAppArgs
ts <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t ForAllTyFlag
a IfaceAppArgs
ts
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
Word8
_ -> forall a. HasCallStack => String -> a
panic (String
"get IfaceAppArgs " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
c)
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceContextArr :: [IfaceType] -> SDoc
pprIfaceContextArr [] = forall doc. IsOutput doc => doc
empty
pprIfaceContextArr [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
pred forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
pprIfaceContextArr [IfaceType]
preds = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext :: PprPrec -> [IfaceType] -> SDoc
pprIfaceContext PprPrec
_ [] = 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 = forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => [doc] -> doc
fsep (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [IfaceType]
preds)))
instance Binary IfaceType where
put_ :: BinHandle -> IfaceType -> IO ()
put_ BinHandle
_ (IfaceFreeTyVar CoVar
tv)
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeTyVar" (forall a. Outputable a => a -> SDoc
ppr CoVar
tv)
put_ BinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceForAllBndr
aa
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ab
put_ BinHandle
bh (IfaceTyVar FastString
ad) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ad
put_ BinHandle
bh (IfaceAppTy IfaceType
ae IfaceAppArgs
af) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ae
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
put_ BinHandle
bh (IfaceFunTy FunTyFlag
af IfaceType
aw IfaceType
ag IfaceType
ah) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FunTyFlag
af
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
aw
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ag
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ah
put_ BinHandle
bh (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
tc; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
tys }
put_ BinHandle
bh (IfaceCastTy IfaceType
a IfaceCoercion
b)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b }
put_ BinHandle
bh (IfaceCoercionTy IfaceCoercion
a)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a }
put_ BinHandle
bh (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
s; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
tys }
put_ BinHandle
bh (IfaceLitTy IfaceTyLit
n)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyLit
n }
get :: BinHandle -> IO IfaceType
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do IfaceForAllBndr
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab)
Word8
1 -> do FastString
ad <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceType
IfaceTyVar FastString
ad)
Word8
2 -> do IfaceType
ae <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceAppArgs
af <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
ae IfaceAppArgs
af)
Word8
3 -> do FunTyFlag
af <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
aw <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
ag <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
ah <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
af IfaceType
aw IfaceType
ag IfaceType
ah)
Word8
5 -> do { IfaceTyCon
tc <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
Word8
6 -> do { IfaceType
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy IfaceType
a IfaceCoercion
b) }
Word8
7 -> do { IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceType
IfaceCoercionTy IfaceCoercion
a) }
Word8
8 -> do { TupleSort
s <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; PromotionFlag
i <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
Word8
_ -> do IfaceTyLit
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfaceType
IfaceLitTy IfaceTyLit
n)
instance Binary IfaceMCoercion where
put_ :: BinHandle -> IfaceMCoercion -> IO ()
put_ BinHandle
bh IfaceMCoercion
IfaceMRefl =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (IfaceMCo IfaceCoercion
co) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
co
get :: BinHandle -> IO IfaceMCoercion
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return IfaceMCoercion
IfaceMRefl
Word8
2 -> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceMCoercion
IfaceMCo IfaceCoercion
a
Word8
_ -> forall a. HasCallStack => String -> a
panic (String
"get IfaceMCoercion " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag)
instance Binary IfaceCoercion where
put_ :: BinHandle -> IfaceCoercion -> IO ()
put_ BinHandle
bh (IfaceReflCo IfaceType
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a
put_ BinHandle
bh (IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
put_ BinHandle
bh (IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
w
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
put_ BinHandle
bh (IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
put_ BinHandle
bh (IfaceAppCo IfaceCoercion
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBndr
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
put_ BinHandle
bh (IfaceCoVarCo FastString
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
d) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceUnivCoProv
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
b
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
c
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
d
put_ BinHandle
bh (IfaceSymCo IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfaceTransCo IfaceCoercion
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceSelCo CoSel
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CoSel
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceLRCo LeftOrRight
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LeftOrRight
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceInstCo IfaceCoercion
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceKindCo IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
15
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfaceSubCo IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
16
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
put_ BinHandle
_ (IfaceFreeCoVar CoVar
cv)
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
put_ BinHandle
_ (IfaceHoleCo CoVar
cv)
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
get :: BinHandle -> IO IfaceCoercion
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do IfaceType
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceType -> IfaceCoercion
IfaceReflCo IfaceType
a
Word8
2 -> do Role
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceMCoercion
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c
Word8
3 -> do Role
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
w <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c
Word8
4 -> do Role
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTyCon
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c
Word8
5 -> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo IfaceCoercion
a IfaceCoercion
b
Word8
6 -> do IfaceBndr
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceBndr -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c
Word8
7 -> do FastString
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FastString -> IfaceCoercion
IfaceCoVarCo FastString
a
Word8
8 -> do IfExtName
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c
Word8
9 -> do IfaceUnivCoProv
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Role
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
d <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
d
Word8
10-> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSymCo IfaceCoercion
a
Word8
11-> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo IfaceCoercion
a IfaceCoercion
b
Word8
12-> do CoSel
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CoSel -> IfaceCoercion -> IfaceCoercion
IfaceSelCo CoSel
a IfaceCoercion
b
Word8
13-> do LeftOrRight
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
a IfaceCoercion
b
Word8
14-> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo IfaceCoercion
a IfaceCoercion
b
Word8
15-> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceKindCo IfaceCoercion
a
Word8
16-> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSubCo IfaceCoercion
a
Word8
17-> do FastString
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b
Word8
_ -> forall a. HasCallStack => String -> a
panic (String
"get IfaceCoercion " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag)
instance Binary IfaceUnivCoProv where
put_ :: BinHandle -> IfaceUnivCoProv -> IO ()
put_ BinHandle
bh (IfacePhantomProv IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfaceProofIrrelProv IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfacePluginProv String
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
a
put_ BinHandle
bh (IfaceCorePrepProv Bool
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a
get :: BinHandle -> IO IfaceUnivCoProv
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv IfaceCoercion
a
Word8
2 -> do IfaceCoercion
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv IfaceCoercion
a
Word8
3 -> do String
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> IfaceUnivCoProv
IfacePluginProv String
a
Word8
4 -> do Bool
a <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IfaceUnivCoProv
IfaceCorePrepProv Bool
a)
Word8
_ -> forall a. HasCallStack => String -> a
panic (String
"get IfaceUnivCoProv " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag)
instance Binary (DefMethSpec IfaceType) where
put_ :: BinHandle -> DefMethSpec IfaceType -> IO ()
put_ BinHandle
bh DefMethSpec IfaceType
VanillaDM = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (GenericDM IfaceType
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
t
get :: BinHandle -> IO (DefMethSpec IfaceType)
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall ty. DefMethSpec ty
VanillaDM
Word8
_ -> do { IfaceType
t <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (forall ty. ty -> DefMethSpec ty
GenericDM IfaceType
t) }
instance NFData IfaceType where
rnf :: IfaceType -> ()
rnf = \case
IfaceFreeTyVar CoVar
f1 -> CoVar
f1 seq :: forall a b. a -> b -> b
`seq` ()
IfaceTyVar FastString
f1 -> forall a. NFData a => a -> ()
rnf FastString
f1
IfaceLitTy IfaceTyLit
f1 -> forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
IfaceAppTy IfaceType
f1 IfaceAppArgs
f2 -> forall a. NFData a => a -> ()
rnf IfaceType
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
IfaceFunTy FunTyFlag
f1 IfaceType
f2 IfaceType
f3 IfaceType
f4 -> FunTyFlag
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f3 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f4
IfaceForAllTy IfaceForAllBndr
f1 IfaceType
f2 -> IfaceForAllBndr
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f2
IfaceTyConApp IfaceTyCon
f1 IfaceAppArgs
f2 -> forall a. NFData a => a -> ()
rnf IfaceTyCon
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
IfaceCastTy IfaceType
f1 IfaceCoercion
f2 -> forall a. NFData a => a -> ()
rnf IfaceType
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceCoercionTy IfaceCoercion
f1 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceTupleTy TupleSort
f1 PromotionFlag
f2 IfaceAppArgs
f3 -> TupleSort
f1 seq :: forall a b. a -> b -> b
`seq` PromotionFlag
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3
instance NFData IfaceTyLit where
rnf :: IfaceTyLit -> ()
rnf = \case
IfaceNumTyLit Integer
f1 -> forall a. NFData a => a -> ()
rnf Integer
f1
IfaceStrTyLit FastString
f1 -> forall a. NFData a => a -> ()
rnf FastString
f1
IfaceCharTyLit Char
f1 -> forall a. NFData a => a -> ()
rnf Char
f1
instance NFData IfaceCoercion where
rnf :: IfaceCoercion -> ()
rnf = \case
IfaceReflCo IfaceType
f1 -> forall a. NFData a => a -> ()
rnf IfaceType
f1
IfaceGReflCo Role
f1 IfaceType
f2 IfaceMCoercion
f3 -> Role
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 IfaceCoercion
f4 -> Role
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f3 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f4
IfaceTyConAppCo Role
f1 IfaceTyCon
f2 [IfaceCoercion]
f3 -> Role
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceTyCon
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
IfaceAppCo IfaceCoercion
f1 IfaceCoercion
f2 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceForAllCo IfaceBndr
f1 IfaceCoercion
f2 IfaceCoercion
f3 -> forall a. NFData a => a -> ()
rnf IfaceBndr
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f3
IfaceCoVarCo FastString
f1 -> forall a. NFData a => a -> ()
rnf FastString
f1
IfaceAxiomInstCo IfExtName
f1 Int
f2 [IfaceCoercion]
f3 -> forall a. NFData a => a -> ()
rnf IfExtName
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Int
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
IfaceAxiomRuleCo FastString
f1 [IfaceCoercion]
f2 -> forall a. NFData a => a -> ()
rnf FastString
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
IfaceUnivCo IfaceUnivCoProv
f1 Role
f2 IfaceType
f3 IfaceType
f4 -> forall a. NFData a => a -> ()
rnf IfaceUnivCoProv
f1 seq :: forall a b. a -> b -> b
`seq` Role
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f3 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceType
f4
IfaceSymCo IfaceCoercion
f1 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceTransCo IfaceCoercion
f1 IfaceCoercion
f2 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceSelCo CoSel
f1 IfaceCoercion
f2 -> forall a. NFData a => a -> ()
rnf CoSel
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceLRCo LeftOrRight
f1 IfaceCoercion
f2 -> LeftOrRight
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceInstCo IfaceCoercion
f1 IfaceCoercion
f2 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceKindCo IfaceCoercion
f1 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceSubCo IfaceCoercion
f1 -> forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceFreeCoVar CoVar
f1 -> CoVar
f1 seq :: forall a b. a -> b -> b
`seq` ()
IfaceHoleCo CoVar
f1 -> CoVar
f1 seq :: forall a b. a -> b -> b
`seq` ()
instance NFData IfaceUnivCoProv where
rnf :: IfaceUnivCoProv -> ()
rnf IfaceUnivCoProv
x = seq :: forall a b. a -> b -> b
seq IfaceUnivCoProv
x ()
instance NFData IfaceMCoercion where
rnf :: IfaceMCoercion -> ()
rnf IfaceMCoercion
x = seq :: forall a b. a -> b -> b
seq IfaceMCoercion
x ()
instance NFData IfaceOneShot where
rnf :: IfaceOneShot -> ()
rnf IfaceOneShot
x = seq :: forall a b. a -> b -> b
seq IfaceOneShot
x ()
instance NFData IfaceTyConSort where
rnf :: IfaceTyConSort -> ()
rnf = \case
IfaceTyConSort
IfaceNormalTyCon -> ()
IfaceTupleTyCon Int
arity TupleSort
sort -> forall a. NFData a => a -> ()
rnf Int
arity seq :: forall a b. a -> b -> b
`seq` TupleSort
sort seq :: forall a b. a -> b -> b
`seq` ()
IfaceSumTyCon Int
arity -> forall a. NFData a => a -> ()
rnf Int
arity
IfaceTyConSort
IfaceEqualityTyCon -> ()
instance NFData IfaceTyConInfo where
rnf :: IfaceTyConInfo -> ()
rnf (IfaceTyConInfo PromotionFlag
f IfaceTyConSort
s) = PromotionFlag
f seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceTyConSort
s
instance NFData IfaceTyCon where
rnf :: IfaceTyCon -> ()
rnf (IfaceTyCon IfExtName
nm IfaceTyConInfo
info) = forall a. NFData a => a -> ()
rnf IfExtName
nm seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceTyConInfo
info
instance NFData IfaceBndr where
rnf :: IfaceBndr -> ()
rnf = \case
IfaceIdBndr IfaceIdBndr
id_bndr -> forall a. NFData a => a -> ()
rnf IfaceIdBndr
id_bndr
IfaceTvBndr IfaceTvBndr
tv_bndr -> 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 -> forall a. NFData a => a -> ()
rnf IfaceType
f1 seq :: forall a b. a -> b -> b
`seq` ForAllTyFlag
f2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3