{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module IfaceType (
IfExtName, IfLclName,
IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
IfaceMCoercion(..),
IfaceUnivCoProv(..),
IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),
IfaceTyLit(..), IfaceAppArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),
ForallVisFlag(..), ShowForAllFlag(..),
mkIfaceForAllTvBndr,
mkIfaceTyConKind,
ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
ifTyConBinderVar, ifTyConBinderName,
isIfaceLiftedTypeKind,
appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
SuppressBndrSig(..),
UseBndrParens(..),
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,
isIfaceTauType,
suppressIfaceInvisibles,
stripIfaceInvisVars,
stripInvisArgs,
mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst
) where
#include "HsVersions.h"
import GhcPrelude
import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
, liftedRepDataConTyCon, tupleTyConName )
import {-# SOURCE #-} Type ( isRuntimeRepTy )
import DynFlags
import TyCon hiding ( pprPromotionQuote )
import CoAxiom
import Var
import PrelNames
import Name
import BasicTypes
import Binary
import Outputable
import FastString
import FastStringEnv
import Util
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 = (IfLclName, IfaceType)
type IfaceTvBndr = (IfLclName, IfaceKind)
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName (IfLclName
n,IfaceKind
_) = IfLclName
n
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceTvBndr -> IfLclName
ifaceIdBndrName (IfLclName
n,IfaceKind
_) = IfLclName
n
ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName (IfaceTvBndr IfaceTvBndr
bndr) = IfaceTvBndr -> IfLclName
ifaceTvBndrName IfaceTvBndr
bndr
ifaceBndrName (IfaceIdBndr IfaceTvBndr
bndr) = IfaceTvBndr -> IfLclName
ifaceIdBndrName IfaceTvBndr
bndr
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfaceKind
ifaceBndrType (IfaceIdBndr (IfLclName
_, IfaceKind
t)) = IfaceKind
t
ifaceBndrType (IfaceTvBndr (IfLclName
_, IfaceKind
t)) = IfaceKind
t
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
data IfaceOneShot
= IfaceNoOneShot
| IfaceOneShot
type IfaceKind = IfaceType
data IfaceType
= IfaceFreeTyVar TyVar
| IfaceTyVar IfLclName
| IfaceLitTy IfaceTyLit
| IfaceAppTy IfaceType IfaceAppArgs
| IfaceFunTy AnonArgFlag IfaceType IfaceType
| IfaceForAllTy IfaceForAllBndr IfaceType
| IfaceTyConApp IfaceTyCon IfaceAppArgs
| IfaceCastTy IfaceType IfaceCoercion
| IfaceCoercionTy IfaceCoercion
| IfaceTupleTy
TupleSort
PromotionFlag
IfaceAppArgs
type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]
data IfaceTyLit
= IfaceNumTyLit Integer
| IfaceStrTyLit FastString
deriving (IfaceTyLit -> IfaceTyLit -> Bool
(IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool) -> Eq IfaceTyLit
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 ArgFlag
mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr ArgFlag
vis IfaceTvBndr
var = IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
var) ArgFlag
vis
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind [IfaceTyConBinder]
bndrs IfaceKind
res_kind = (IfaceTyConBinder -> IfaceKind -> IfaceKind)
-> IfaceKind -> [IfaceTyConBinder] -> IfaceKind
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceTyConBinder -> IfaceKind -> IfaceKind
mk IfaceKind
res_kind [IfaceTyConBinder]
bndrs
where
mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
mk (Bndr IfaceBndr
tv (AnonTCB AnonArgFlag
af)) IfaceKind
k = AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af (IfaceBndr -> IfaceKind
ifaceBndrType IfaceBndr
tv) IfaceKind
k
mk (Bndr IfaceBndr
tv (NamedTCB ArgFlag
vis)) IfaceKind
k = IfaceForAllBndr -> IfaceKind -> IfaceKind
IfaceForAllTy (IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ArgFlag
vis) IfaceKind
k
data IfaceAppArgs
= IA_Nil
| IA_Arg IfaceType
ArgFlag
IfaceAppArgs
instance Semi.Semigroup IfaceAppArgs where
IfaceAppArgs
IA_Nil <> :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
<> IfaceAppArgs
xs = IfaceAppArgs
xs
IA_Arg IfaceKind
ty ArgFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
ty ArgFlag
argf (IfaceAppArgs
rest IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Semigroup a => a -> a -> a
Semi.<> IfaceAppArgs
xs)
instance Monoid IfaceAppArgs where
mempty :: IfaceAppArgs
mempty = IfaceAppArgs
IA_Nil
mappend :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
mappend = IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Semigroup a => a -> a -> a
(Semi.<>)
data IfaceTyCon = IfaceTyCon { IfaceTyCon -> IfExtName
ifaceTyConName :: IfExtName
, IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo :: IfaceTyConInfo }
deriving (IfaceTyCon -> IfaceTyCon -> Bool
(IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool) -> Eq IfaceTyCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
(IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool) -> Eq IfaceTyConSort
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)
data IfaceTyConInfo
= IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
, IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort :: IfaceTyConSort }
deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
(IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool) -> Eq IfaceTyConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)
data IfaceMCoercion
= IfaceMRefl
| IfaceMCo IfaceCoercion
data IfaceCoercion
= IfaceReflCo IfaceType
| IfaceGReflCo Role IfaceType (IfaceMCoercion)
| IfaceFunCo Role 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
| IfaceNthCo Int IfaceCoercion
| IfaceLRCo LeftOrRight IfaceCoercion
| IfaceInstCo IfaceCoercion IfaceCoercion
| IfaceKindCo IfaceCoercion
| IfaceSubCo IfaceCoercion
| IfaceFreeCoVar CoVar
| IfaceHoleCo CoVar
data IfaceUnivCoProv
= IfaceUnsafeCoerceProv
| IfacePhantomProv IfaceCoercion
| IfaceProofIrrelProv IfaceCoercion
| IfacePluginProv String
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey IfaceTyCon
tc Unique
key = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
key
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
IA_Nil)
= IfExtName -> Bool
isLiftedTypeKindTyConName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc
(IA_Arg (IfaceTyConApp IfaceTyCon
ptr_rep_lifted IfaceAppArgs
IA_Nil)
ArgFlag
Required IfaceAppArgs
IA_Nil))
= IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
Bool -> Bool -> Bool
&& IfaceTyCon
ptr_rep_lifted IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
isIfaceLiftedTypeKind IfaceKind
_ = Bool
False
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
splitIfaceSigmaTy :: IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
ty
= case ([IfaceForAllBndr]
bndrs, [IfaceKind]
theta) of
([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceKind]
theta, IfaceKind
tau)
([IfaceForAllBndr], [IfaceKind])
_ -> let ([IfaceForAllBndr]
bndrs', [IfaceKind]
theta', IfaceKind
tau') = IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
tau
in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceKind]
theta [IfaceKind] -> [IfaceKind] -> [IfaceKind]
forall a. [a] -> [a] -> [a]
++ [IfaceKind]
theta', IfaceKind
tau')
where
([IfaceForAllBndr]
bndrs, IfaceKind
rho) = IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls IfaceKind
ty
([IfaceKind]
theta, IfaceKind
tau) = IfaceKind -> ([IfaceKind], IfaceKind)
split_rho IfaceKind
rho
split_foralls :: IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls (IfaceForAllTy IfaceForAllBndr
bndr IfaceKind
ty)
= case IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls IfaceKind
ty of { ([IfaceForAllBndr]
bndrs, IfaceKind
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceKind
rho) }
split_foralls IfaceKind
rho = ([], IfaceKind
rho)
split_rho :: IfaceKind -> ([IfaceKind], IfaceKind)
split_rho (IfaceFunTy AnonArgFlag
InvisArg IfaceKind
ty1 IfaceKind
ty2)
= case IfaceKind -> ([IfaceKind], IfaceKind)
split_rho IfaceKind
ty2 of { ([IfaceKind]
ps, IfaceKind
tau) -> (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
ps, IfaceKind
tau) }
split_rho IfaceKind
tau = ([], IfaceKind
tau)
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles DynFlags
dflags [IfaceTyConBinder]
tys [a]
xs
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [a]
xs
| Bool
otherwise = [IfaceTyConBinder] -> [a] -> [a]
forall tv a. [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [IfaceTyConBinder]
tys [a]
xs
where
suppress :: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
_ [] = []
suppress [] [a]
a = [a]
a
suppress (VarBndr tv TyConBndrVis
k:[VarBndr tv TyConBndrVis]
ks) (a
x:[a]
xs)
| VarBndr tv TyConBndrVis -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
k = [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars DynFlags
dflags [IfaceTyConBinder]
tyvars
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [IfaceTyConBinder]
tyvars
| Bool
otherwise = (IfaceTyConBinder -> Bool)
-> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. (a -> Bool) -> [a] -> [a]
filterOut IfaceTyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = IfaceForAllBndr -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> IfLclName
ifaceBndrName (IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar IfaceForAllBndr
fab)
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = IfaceTyConBinder -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> IfLclName
ifaceBndrName (IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar IfaceTyConBinder
tcb)
ifTypeIsVarFree :: IfaceType -> Bool
ifTypeIsVarFree :: IfaceKind -> Bool
ifTypeIsVarFree IfaceKind
ty = IfaceKind -> Bool
go IfaceKind
ty
where
go :: IfaceKind -> Bool
go (IfaceTyVar {}) = Bool
False
go (IfaceFreeTyVar {}) = Bool
False
go (IfaceAppTy IfaceKind
fun IfaceAppArgs
args) = IfaceKind -> Bool
go IfaceKind
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
go (IfaceFunTy AnonArgFlag
_ IfaceKind
arg IfaceKind
res) = IfaceKind -> Bool
go IfaceKind
arg Bool -> Bool -> Bool
&& IfaceKind -> Bool
go IfaceKind
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 IfaceKind
arg ArgFlag
_ IfaceAppArgs
args) = IfaceKind -> Bool
go IfaceKind
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 = [IfaceTvBndr] -> IfaceTySubst
forall a. [(IfLclName, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst IfaceTySubst
subst (IfLclName
fs, IfaceKind
_) = Maybe IfaceKind -> Bool
forall a. Maybe a -> Bool
isJust (IfaceTySubst -> IfLclName -> Maybe IfaceKind
forall a. FastStringEnv a -> IfLclName -> Maybe a
lookupFsEnv IfaceTySubst
subst IfLclName
fs)
substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType :: IfaceTySubst -> IfaceKind -> IfaceKind
substIfaceType IfaceTySubst
env IfaceKind
ty
= IfaceKind -> IfaceKind
go IfaceKind
ty
where
go :: IfaceKind -> IfaceKind
go (IfaceFreeTyVar TyVar
tv) = TyVar -> IfaceKind
IfaceFreeTyVar TyVar
tv
go (IfaceTyVar IfLclName
tv) = IfaceTySubst -> IfLclName -> IfaceKind
substIfaceTyVar IfaceTySubst
env IfLclName
tv
go (IfaceAppTy IfaceKind
t IfaceAppArgs
ts) = IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy (IfaceKind -> IfaceKind
go IfaceKind
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
go (IfaceFunTy AnonArgFlag
af IfaceKind
t1 IfaceKind
t2) = AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af (IfaceKind -> IfaceKind
go IfaceKind
t1) (IfaceKind -> IfaceKind
go IfaceKind
t2)
go ty :: IfaceKind
ty@(IfaceLitTy {}) = IfaceKind
ty
go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
s PromotionFlag
i (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
go (IfaceForAllTy {}) = String -> SDoc -> IfaceKind
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty)
go (IfaceCastTy IfaceKind
ty IfaceCoercion
co) = IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy (IfaceKind -> IfaceKind
go IfaceKind
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go (IfaceCoercionTy IfaceCoercion
co) = IfaceCoercion -> IfaceKind
IfaceCoercionTy (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_mco :: IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
IfaceMRefl = IfaceMCoercion
IfaceMRefl
go_mco (IfaceMCo IfaceCoercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co
go_co :: IfaceCoercion -> IfaceCoercion
go_co (IfaceReflCo IfaceKind
ty) = IfaceKind -> IfaceCoercion
IfaceReflCo (IfaceKind -> IfaceKind
go IfaceKind
ty)
go_co (IfaceGReflCo Role
r IfaceKind
ty IfaceMCoercion
mco) = Role -> IfaceKind -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfaceKind -> IfaceKind
go IfaceKind
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
go_co (IfaceFunCo Role
r IfaceCoercion
c1 IfaceCoercion
c2) = Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
go_co (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos) = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r IfaceTyCon
tc ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_co (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
go_co (IfaceForAllCo {}) = String -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceCoercion" (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty)
go_co (IfaceFreeCoVar TyVar
cv) = TyVar -> IfaceCoercion
IfaceFreeCoVar TyVar
cv
go_co (IfaceCoVarCo IfLclName
cv) = IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
cv
go_co (IfaceHoleCo TyVar
cv) = TyVar -> IfaceCoercion
IfaceHoleCo TyVar
cv
go_co (IfaceAxiomInstCo IfExtName
a BranchIndex
i [IfaceCoercion]
cos) = IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_co (IfaceUnivCo IfaceUnivCoProv
prov Role
r IfaceKind
t1 IfaceKind
t2) = IfaceUnivCoProv -> Role -> IfaceKind -> IfaceKind -> IfaceCoercion
IfaceUnivCo (IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
prov) Role
r (IfaceKind -> IfaceKind
go IfaceKind
t1) (IfaceKind -> IfaceKind
go IfaceKind
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 (IfaceNthCo BranchIndex
n IfaceCoercion
co) = BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
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 IfLclName
n [IfaceCoercion]
cos) = IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_cos :: [IfaceCoercion] -> [IfaceCoercion]
go_cos = (IfaceCoercion -> IfaceCoercion)
-> [IfaceCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> IfaceCoercion
go_co
go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
IfaceUnsafeCoerceProv = IfaceUnivCoProv
IfaceUnsafeCoerceProv
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 (IfacePluginProv String
str) = String -> IfaceUnivCoProv
IfacePluginProv String
str
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 IfaceKind
ty ArgFlag
arg IfaceAppArgs
tys) = IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceKind -> IfaceKind
substIfaceType IfaceTySubst
env IfaceKind
ty) ArgFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)
substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceKind
substIfaceTyVar IfaceTySubst
env IfLclName
tv
| Just IfaceKind
ty <- IfaceTySubst -> IfLclName -> Maybe IfaceKind
forall a. FastStringEnv a -> IfLclName -> Maybe a
lookupFsEnv IfaceTySubst
env IfLclName
tv = IfaceKind
ty
| Bool
otherwise = IfLclName -> IfaceKind
IfaceTyVar IfLclName
tv
stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
tys
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = IfaceAppArgs
tys
| Bool
otherwise = 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 IfaceKind
t ArgFlag
argf IfaceAppArgs
ts
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf
-> IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
t ArgFlag
argf (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$ IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts
| Bool
otherwise
-> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
IA_Nil = []
appArgsIfaceTypes (IA_Arg IfaceKind
t ArgFlag
_ IfaceAppArgs
ts) = IfaceKind
t IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
ts
appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
IA_Nil = []
appArgsIfaceTypesArgFlags (IA_Arg IfaceKind
t ArgFlag
a IfaceAppArgs
ts)
= (IfaceKind
t, ArgFlag
a) (IfaceKind, ArgFlag)
-> [(IfaceKind, ArgFlag)] -> [(IfaceKind, ArgFlag)]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
ts
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> BranchIndex
ifaceVisAppArgsLength = BranchIndex -> IfaceAppArgs -> BranchIndex
forall t. Num t => t -> IfaceAppArgs -> t
go BranchIndex
0
where
go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
go t
n (IA_Arg IfaceKind
_ ArgFlag
argf IfaceAppArgs
rest)
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf = t -> IfaceAppArgs -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) IfaceAppArgs
rest
| Bool
otherwise = t -> IfaceAppArgs -> t
go t
n IfaceAppArgs
rest
if_print_coercions :: SDoc
-> SDoc
-> SDoc
if_print_coercions :: SDoc -> SDoc -> SDoc
if_print_coercions SDoc
yes SDoc
no
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitCoercions DynFlags
dflags
Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| PprStyle -> Bool
debugStyle PprStyle
style
then SDoc
yes
else SDoc
no
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
pp_tc SDoc
pp_ty1 SDoc
pp_ty2
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [SDoc
pp_ty1, SDoc
pp_tc SDoc -> SDoc -> SDoc
<+> SDoc
pp_ty2]
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec SDoc
pp_fun [SDoc]
pp_tys
| [SDoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
pp_tys = SDoc
pp_fun
| Bool
otherwise = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> BranchIndex -> SDoc -> SDoc
hang SDoc
pp_fun BranchIndex
2 ([SDoc] -> SDoc
sep [SDoc]
pp_tys)
isIfaceTauType :: IfaceType -> Bool
isIfaceTauType :: IfaceKind -> Bool
isIfaceTauType (IfaceForAllTy IfaceForAllBndr
_ IfaceKind
_) = Bool
False
isIfaceTauType (IfaceFunTy AnonArgFlag
InvisArg IfaceKind
_ IfaceKind
_) = Bool
False
isIfaceTauType IfaceKind
_ = Bool
True
instance Outputable IfaceBndr where
ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceTvBndr
bndr) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<+> IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
bndr (Bool -> SuppressBndrSig
SuppressBndrSig Bool
False)
(Bool -> UseBndrParens
UseBndrParens Bool
False)
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs [IfaceBndr]
bs = [SDoc] -> SDoc
sep ((IfaceBndr -> SDoc) -> [IfaceBndr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceBndr]
bs)
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceNoOneShot) = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceOneShot) = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"[OneShot]"
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceTvBndr -> SDoc
pprIfaceIdBndr (IfLclName
name, IfaceKind
ty) = SDoc -> SDoc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty)
newtype SuppressBndrSig = SuppressBndrSig Bool
newtype UseBndrParens = UseBndrParens Bool
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (IfLclName
tv, IfaceKind
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
| Bool
suppress_sig = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv
| IfaceKind -> Bool
isIfaceLiftedTypeKind IfaceKind
ki = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv
| Bool
otherwise = SDoc -> SDoc
maybe_parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ki)
where
maybe_parens :: SDoc -> SDoc
maybe_parens | Bool
use_parens = SDoc -> SDoc
parens
| Bool
otherwise = SDoc -> SDoc
forall a. a -> a
id
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders SuppressBndrSig
suppress_sig = [SDoc] -> SDoc
sep ([SDoc] -> SDoc)
-> ([IfaceTyConBinder] -> [SDoc]) -> [IfaceTyConBinder] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceTyConBinder -> SDoc) -> [IfaceTyConBinder] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceTyConBinder -> SDoc
go
where
go :: IfaceTyConBinder -> SDoc
go :: IfaceTyConBinder -> SDoc
go (Bndr (IfaceIdBndr IfaceTvBndr
bndr) TyConBndrVis
_) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
go (Bndr (IfaceTvBndr IfaceTvBndr
bndr) TyConBndrVis
vis) =
case TyConBndrVis
vis of
AnonTCB AnonArgFlag
VisArg -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
AnonTCB AnonArgFlag
InvisArg -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
NamedTCB ArgFlag
Required -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
NamedTCB ArgFlag
Specified -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
NamedTCB ArgFlag
Inferred -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
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 IfaceTvBndr
aa) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
aa
put_ BinHandle
bh (IfaceTvBndr IfaceTvBndr
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> IfaceTvBndr -> IO ()
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 IfaceTvBndr
aa <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceBndr -> IO IfaceBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTvBndr -> IfaceBndr
IfaceIdBndr IfaceTvBndr
aa)
Word8
_ -> do IfaceTvBndr
ab <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceBndr -> IO IfaceBndr
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 = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh IfaceOneShot
IfaceOneShot = do
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 -> do IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
Word8
_ -> do IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceOneShot
instance Outputable IfaceType where
ppr :: IfaceKind -> SDoc
ppr IfaceKind
ty = IfaceKind -> SDoc
pprIfaceType IfaceKind
ty
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceType :: IfaceKind -> SDoc
pprIfaceType = PprPrec -> IfaceKind -> SDoc
pprPrecIfaceType PprPrec
topPrec
pprParendIfaceType :: IfaceKind -> SDoc
pprParendIfaceType = PprPrec -> IfaceKind -> SDoc
pprPrecIfaceType PprPrec
appPrec
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
pprPrecIfaceType :: PprPrec -> IfaceKind -> SDoc
pprPrecIfaceType PprPrec
prec IfaceKind
ty = (IfaceKind -> SDoc) -> IfaceKind -> SDoc
eliminateRuntimeRep (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
prec) IfaceKind
ty
ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma :: PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (ShowForAllFlag -> IfaceKind -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllMust IfaceKind
ty)
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctxt_prec ty :: IfaceKind
ty@(IfaceForAllTy {}) = PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty
ppr_ty PprPrec
ctxt_prec ty :: IfaceKind
ty@(IfaceFunTy AnonArgFlag
InvisArg IfaceKind
_ IfaceKind
_) = PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty
ppr_ty PprPrec
_ (IfaceFreeTyVar TyVar
tyvar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tyvar
ppr_ty PprPrec
_ (IfaceTyVar IfLclName
tyvar) = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tyvar
ppr_ty PprPrec
ctxt_prec (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys
ppr_ty PprPrec
ctxt_prec (IfaceTupleTy TupleSort
i PromotionFlag
p IfaceAppArgs
tys) = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
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 (IfaceFunTy AnonArgFlag
_ IfaceKind
ty1 IfaceKind
ty2)
=
PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1, [SDoc] -> SDoc
sep (IfaceKind -> [SDoc]
ppr_fun_tail IfaceKind
ty2)]
where
ppr_fun_tail :: IfaceKind -> [SDoc]
ppr_fun_tail (IfaceFunTy AnonArgFlag
VisArg IfaceKind
ty1 IfaceKind
ty2)
= (SDoc
arrow SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceKind -> [SDoc]
ppr_fun_tail IfaceKind
ty2
ppr_fun_tail IfaceKind
other_ty
= [SDoc
arrow SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprIfaceType IfaceKind
other_ty]
ppr_ty PprPrec
ctxt_prec (IfaceAppTy IfaceKind
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 =
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec
(PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
t)
(((IfaceKind, ArgFlag) -> SDoc) -> [(IfaceKind, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) (DynFlags -> [(IfaceKind, ArgFlag)]
tys_wo_kinds DynFlags
dflags))
tys_wo_kinds :: DynFlags -> [(IfaceKind, ArgFlag)]
tys_wo_kinds DynFlags
dflags = IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceKind, ArgFlag)])
-> IfaceAppArgs -> [(IfaceKind, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
ts
ppr_app_ty_no_casts :: SDoc
ppr_app_ty_no_casts =
case IfaceKind
t of
IfaceCastTy IfaceKind
head IfaceCoercion
_ -> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctxt_prec (IfaceKind -> IfaceAppArgs -> IfaceKind
mk_app_tys IfaceKind
head IfaceAppArgs
ts)
IfaceKind
_ -> SDoc
ppr_app_ty
mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys :: IfaceKind -> IfaceAppArgs -> IfaceKind
mk_app_tys (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys1) IfaceAppArgs
tys2 =
IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc (IfaceAppArgs
tys1 IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Monoid a => a -> a -> a
`mappend` IfaceAppArgs
tys2)
mk_app_tys IfaceKind
t1 IfaceAppArgs
tys2 = IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy IfaceKind
t1 IfaceAppArgs
tys2
ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfaceKind
ty IfaceCoercion
co)
= SDoc -> SDoc -> SDoc
if_print_coercions
(SDoc -> SDoc
parens (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
ty SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"|>" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
(PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceKind
ty)
ppr_ty PprPrec
ctxt_prec (IfaceCoercionTy IfaceCoercion
co)
= SDoc -> SDoc -> SDoc
if_print_coercions
(PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
ctxt_prec IfaceCoercion
co)
(String -> SDoc
text String
"<>")
defaultRuntimeRepVars :: IfaceType -> IfaceType
defaultRuntimeRepVars :: IfaceKind -> IfaceKind
defaultRuntimeRepVars IfaceKind
ty = Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
False FastStringEnv ()
forall a. FastStringEnv a
emptyFsEnv IfaceKind
ty
where
go :: Bool
-> FastStringEnv ()
-> IfaceType
-> IfaceType
go :: Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs (IfaceForAllTy (Bndr (IfaceTvBndr (IfLclName
var, IfaceKind
var_kind)) ArgFlag
argf) IfaceKind
ty)
| IfaceKind -> Bool
isRuntimeRep IfaceKind
var_kind
, ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
= let subs' :: FastStringEnv ()
subs' = FastStringEnv () -> IfLclName -> () -> FastStringEnv ()
forall a. FastStringEnv a -> IfLclName -> a -> FastStringEnv a
extendFsEnv FastStringEnv ()
subs IfLclName
var ()
in Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs' IfaceKind
ty
go Bool
ink FastStringEnv ()
subs (IfaceForAllTy IfaceForAllBndr
bndr IfaceKind
ty)
= IfaceForAllBndr -> IfaceKind -> IfaceKind
IfaceForAllTy (FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr FastStringEnv ()
subs IfaceForAllBndr
bndr) (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
ty)
go Bool
_ FastStringEnv ()
subs ty :: IfaceKind
ty@(IfaceTyVar IfLclName
tv)
| IfLclName
tv IfLclName -> FastStringEnv () -> Bool
forall a. IfLclName -> FastStringEnv a -> Bool
`elemFsEnv` FastStringEnv ()
subs
= IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
| Bool
otherwise
= IfaceKind
ty
go Bool
in_kind FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceFreeTyVar TyVar
tv)
| Bool
in_kind Bool -> Bool -> Bool
&& Type -> Bool
Type.isRuntimeRepTy (TyVar -> Type
tyVarKind TyVar
tv)
= IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
| Bool
otherwise
= IfaceKind
ty
go Bool
ink FastStringEnv ()
subs (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
= IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
tc_args)
go Bool
ink FastStringEnv ()
subs (IfaceTupleTy TupleSort
sort PromotionFlag
is_prom IfaceAppArgs
tc_args)
= TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
sort PromotionFlag
is_prom (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
tc_args)
go Bool
ink FastStringEnv ()
subs (IfaceFunTy AnonArgFlag
af IfaceKind
arg IfaceKind
res)
= AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
arg) (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
res)
go Bool
ink FastStringEnv ()
subs (IfaceAppTy IfaceKind
t IfaceAppArgs
ts)
= IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
t) (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
ts)
go Bool
ink FastStringEnv ()
subs (IfaceCastTy IfaceKind
x IfaceCoercion
co)
= IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
x) IfaceCoercion
co
go Bool
_ FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceLitTy {}) = IfaceKind
ty
go Bool
_ FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceCoercionTy {}) = IfaceKind
ty
go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr FastStringEnv ()
subs (Bndr (IfaceIdBndr (IfLclName
n, IfaceKind
t)) ArgFlag
argf)
= IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceIdBndr (IfLclName
n, Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
True FastStringEnv ()
subs IfaceKind
t)) ArgFlag
argf
go_ifacebndr FastStringEnv ()
subs (Bndr (IfaceTvBndr (IfLclName
n, IfaceKind
t)) ArgFlag
argf)
= IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (IfLclName
n, Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
True FastStringEnv ()
subs IfaceKind
t)) ArgFlag
argf
go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
_ FastStringEnv ()
_ IfaceAppArgs
IA_Nil = IfaceAppArgs
IA_Nil
go_args Bool
ink FastStringEnv ()
subs (IA_Arg IfaceKind
ty ArgFlag
argf IfaceAppArgs
args)
= IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
ty) ArgFlag
argf (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
args)
liftedRep :: IfaceTyCon
liftedRep :: IfaceTyCon
liftedRep = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon)
where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepDataConTyCon
isRuntimeRep :: IfaceType -> Bool
isRuntimeRep :: IfaceKind -> Bool
isRuntimeRep (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) =
IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
runtimeRepTyConKey
isRuntimeRep IfaceKind
_ = Bool
False
eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep :: (IfaceKind -> SDoc) -> IfaceKind -> SDoc
eliminateRuntimeRep IfaceKind -> SDoc
f IfaceKind
ty
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
if PprStyle -> Bool
userStyle PprStyle
sty Bool -> Bool -> Bool
&& Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitRuntimeReps DynFlags
dflags)
then IfaceKind -> SDoc
f (IfaceKind -> IfaceKind
defaultRuntimeRepVars IfaceKind
ty)
else IfaceKind -> SDoc
f IfaceKind
ty
instance Outputable IfaceAppArgs where
ppr :: IfaceAppArgs -> SDoc
ppr IfaceAppArgs
tca = IfaceAppArgs -> SDoc
pprIfaceAppArgs IfaceAppArgs
tca
pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
topPrec
pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprParendIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
appPrec
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
ctx_prec = IfaceAppArgs -> SDoc
go
where
go :: IfaceAppArgs -> SDoc
go :: IfaceAppArgs -> SDoc
go IfaceAppArgs
IA_Nil = SDoc
empty
go (IA_Arg IfaceKind
t ArgFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceKind
t, ArgFlag
argf) SDoc -> SDoc -> SDoc
<+> IfaceAppArgs -> SDoc
go IfaceAppArgs
ts
ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg :: PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceKind
t, ArgFlag
argf) =
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
let print_kinds :: Bool
print_kinds = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
in case ArgFlag
argf of
ArgFlag
Required -> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctx_prec IfaceKind
t
ArgFlag
Specified | Bool
print_kinds
-> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
appPrec IfaceKind
t
ArgFlag
Inferred | Bool
print_kinds
-> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
t)
ArgFlag
_ -> SDoc
empty
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
pprIfaceForAllPart [IfaceForAllBndr]
tvs [IfaceKind]
ctxt SDoc
sdoc
= ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllWhen [IfaceForAllBndr]
tvs [IfaceKind]
ctxt SDoc
sdoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
pprIfaceForAllPartMust [IfaceForAllBndr]
tvs [IfaceKind]
ctxt SDoc
sdoc
= ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllMust [IfaceForAllBndr]
tvs [IfaceKind]
ctxt SDoc
sdoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion)]
tvs SDoc
sdoc
= [SDoc] -> SDoc
sep [ [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(IfLclName, IfaceCoercion)]
tvs, SDoc
sdoc ]
ppr_iface_forall_part :: ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceKind]
ctxt SDoc
sdoc
= [SDoc] -> SDoc
sep [ case ShowForAllFlag
show_forall of
ShowForAllFlag
ShowForAllMust -> [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
ShowForAllFlag
ShowForAllWhen -> [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
, [IfaceKind] -> SDoc
pprIfaceContextArr [IfaceKind]
ctxt
, SDoc
sdoc]
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = SDoc
empty
pprIfaceForAll bndrs :: [IfaceForAllBndr]
bndrs@(Bndr IfaceBndr
_ ArgFlag
vis : [IfaceForAllBndr]
_)
= [SDoc] -> SDoc
sep [ SDoc -> SDoc
add_separator (SDoc
forAllLit SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep [SDoc]
docs)
, [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
bndrs' ]
where
([IfaceForAllBndr]
bndrs', [SDoc]
docs) = [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ArgFlag
vis
add_separator :: SDoc -> SDoc
add_separator SDoc
stuff = case ArgFlag
vis of
ArgFlag
Required -> SDoc
stuff SDoc -> SDoc -> SDoc
<+> SDoc
arrow
ArgFlag
_inv -> SDoc
stuff SDoc -> SDoc -> SDoc
<> SDoc
dot
ppr_itv_bndrs :: [IfaceForAllBndr]
-> ArgFlag
-> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs :: [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs all_bndrs :: [IfaceForAllBndr]
all_bndrs@(bndr :: IfaceForAllBndr
bndr@(Bndr IfaceBndr
_ ArgFlag
vis) : [IfaceForAllBndr]
bndrs) ArgFlag
vis1
| ArgFlag
vis ArgFlag -> ArgFlag -> Bool
`sameVis` ArgFlag
vis1 = let ([IfaceForAllBndr]
bndrs', [SDoc]
doc) = [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ArgFlag
vis1 in
([IfaceForAllBndr]
bndrs', IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
doc)
| Bool
otherwise = ([IfaceForAllBndr]
all_bndrs, [])
ppr_itv_bndrs [] ArgFlag
_ = ([], [])
pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [] = SDoc
empty
pprIfaceForAllCo [(IfLclName, IfaceCoercion)]
tvs = String -> SDoc
text String
"forall" SDoc -> SDoc -> SDoc
<+> [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(IfLclName, IfaceCoercion)]
tvs SDoc -> SDoc -> SDoc
<> SDoc
dot
pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(IfLclName, IfaceCoercion)]
bndrs = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((IfLclName, IfaceCoercion) -> SDoc)
-> [(IfLclName, IfaceCoercion)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr [(IfLclName, IfaceCoercion)]
bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
case IfaceForAllBndr
bndr of
Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
Inferred ->
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags
then SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
False)
else IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
_ ->
IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
Bndr (IfaceIdBndr IfaceTvBndr
idv) ArgFlag
_ -> IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
idv
where
suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (IfLclName
tv, IfaceCoercion
kind_co)
= SDoc -> SDoc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
kind_co)
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType :: ShowForAllFlag -> IfaceKind -> SDoc
pprIfaceSigmaType ShowForAllFlag
show_forall IfaceKind
ty
= (IfaceKind -> SDoc) -> IfaceKind -> SDoc
eliminateRuntimeRep IfaceKind -> SDoc
ppr_fn IfaceKind
ty
where
ppr_fn :: IfaceKind -> SDoc
ppr_fn IfaceKind
iface_ty =
let ([IfaceForAllBndr]
tvs, [IfaceKind]
theta, IfaceKind
tau) = IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
iface_ty
in ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceKind]
theta (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
tau)
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
Bool -> SDoc -> SDoc
ppWhen ((IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall argf. VarBndr IfaceBndr argf -> Bool
tv_has_kind_var [IfaceForAllBndr]
tvs
Bool -> Bool -> Bool
|| (IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall tv. VarBndr tv ArgFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
where
tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (IfLclName
_,IfaceKind
kind)) argf
_)
= Bool -> Bool
not (IfaceKind -> Bool
ifTypeIsVarFree IfaceKind
kind)
tv_has_kind_var VarBndr IfaceBndr argf
_ = Bool
False
tv_is_required :: VarBndr tv ArgFlag -> Bool
tv_is_required = ArgFlag -> Bool
isVisibleArgFlag (ArgFlag -> Bool)
-> (VarBndr tv ArgFlag -> ArgFlag) -> VarBndr tv ArgFlag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarBndr tv ArgFlag -> ArgFlag
forall tv argf. VarBndr tv argf -> argf
binderArgFlag
pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon :: IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon (IfaceTyConApp IfaceTyCon
tyCon IfaceAppArgs
_)
= case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tyCon) of
PromotionFlag
IsPromoted -> (SDoc
space SDoc -> SDoc -> SDoc
<>)
PromotionFlag
_ -> SDoc -> SDoc
forall a. a -> a
id
pprSpaceIfPromotedTyCon IfaceKind
_
= SDoc -> SDoc
forall a. a -> a
id
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList :: PprPrec -> IfaceKind -> IfaceKind -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceKind
ty1 IfaceKind
ty2
= case IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather IfaceKind
ty2 of
([IfaceKind]
arg_tys, Maybe IfaceKind
Nothing)
-> Char -> SDoc
char Char
'\'' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceKind
ty1 ([SDoc] -> SDoc
fsep
(SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceKind -> SDoc) -> [IfaceKind] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec) (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
arg_tys)))))
([IfaceKind]
arg_tys, Just IfaceKind
tl)
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> BranchIndex -> SDoc -> SDoc
hang (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1)
BranchIndex
2 ([SDoc] -> SDoc
fsep [ SDoc
colon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty | IfaceKind
ty <- [IfaceKind]
arg_tys [IfaceKind] -> [IfaceKind] -> [IfaceKind]
forall a. [a] -> [a] -> [a]
++ [IfaceKind
tl]])
where
gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
gather :: IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
, IA_Arg IfaceKind
_ ArgFlag
argf (IA_Arg IfaceKind
ty1 ArgFlag
Required (IA_Arg IfaceKind
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
, ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
, ([IfaceKind]
args, Maybe IfaceKind
tl) <- IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather IfaceKind
ty2
= (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
args, Maybe IfaceKind
tl)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
= ([], Maybe IfaceKind
forall a. Maybe a
Nothing)
gather IfaceKind
ty = ([], IfaceKind -> Maybe IfaceKind
forall a. a -> Maybe a
Just IfaceKind
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 =
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
PprPrec
-> IfaceTyCon -> IfaceAppArgs -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys DynFlags
dflags PprStyle
style
pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
-> DynFlags -> PprStyle -> SDoc
pprTyTcApp' :: PprPrec
-> IfaceTyCon -> IfaceAppArgs -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys DynFlags
dflags PprStyle
style
| IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
, IA_Arg (IfaceLitTy (IfaceStrTyLit IfLclName
n))
ArgFlag
Required (IA_Arg IfaceKind
ty ArgFlag
Required IfaceAppArgs
IA_Nil) <- IfaceAppArgs
tys
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char Char
'?' SDoc -> SDoc -> SDoc
<> IfLclName -> SDoc
ftext IfLclName
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"::" SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
ty
| IfaceTupleTyCon BranchIndex
arity TupleSort
sort <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
, Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
style)
, BranchIndex
arity BranchIndex -> BranchIndex -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> BranchIndex
ifaceVisAppArgsLength IfaceAppArgs
tys
= PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
| IfaceSumTyCon BranchIndex
arity <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
= BranchIndex -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum BranchIndex
arity (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
, Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags)
, IA_Arg IfaceKind
_ ArgFlag
argf (IA_Arg IfaceKind
ty1 ArgFlag
Required (IA_Arg IfaceKind
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
, ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
= PprPrec -> IfaceKind -> IfaceKind -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceKind
ty1 IfaceKind
ty2
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
, IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ArgFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
tys
, IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
= SDoc
kindType
| Bool
otherwise
= (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
dbg ->
if | Bool -> Bool
not Bool
dbg Bool -> Bool -> Bool
&& IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
-> String -> SDoc
text String
"(TypeError ...)"
| Just SDoc
doc <- PprPrec -> IfaceTyCon -> [IfaceKind] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc (IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
tys)
-> SDoc
doc
| Bool
otherwise
-> (PprPrec -> (IfaceKind, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceKind, ArgFlag)] -> SDoc
forall a.
(PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctxt_prec IfaceTyCon
tc [(IfaceKind, ArgFlag)]
tys_wo_kinds
where
info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc
tys_wo_kinds :: [(IfaceKind, ArgFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceKind, ArgFlag)])
-> IfaceAppArgs -> [(IfaceKind, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
tys
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceKind] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc [IfaceKind]
args
| Bool
hetero_eq_tc
, [IfaceKind
k1, IfaceKind
k2, IfaceKind
t1, IfaceKind
t2] <- [IfaceKind]
args
= SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind
k1, IfaceKind
k2, IfaceKind
t1, IfaceKind
t2)
| Bool
hom_eq_tc
, [IfaceKind
k, IfaceKind
t1, IfaceKind
t2] <- [IfaceKind]
args
= SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind
k, IfaceKind
k, IfaceKind
t1, IfaceKind
t2)
| Bool
otherwise
= Maybe SDoc
forall a. Maybe a
Nothing
where
homogeneous :: Bool
homogeneous = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
Bool -> Bool -> Bool
|| Bool
hetero_tc_used_homogeneously
where
hetero_tc_used_homogeneously :: Bool
hetero_tc_used_homogeneously
= case IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort (IfaceTyConInfo -> IfaceTyConSort)
-> IfaceTyConInfo -> IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc of
IfaceTyConSort
IfaceEqualityTyCon -> Bool
True
IfaceTyConSort
_other -> Bool
False
tc_name :: IfExtName
tc_name = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc
pp :: PprPrec -> IfaceKind -> SDoc
pp = PprPrec -> IfaceKind -> SDoc
ppr_ty
hom_eq_tc :: Bool
hom_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
hetero_eq_tc :: Bool
hetero_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
nominal_eq_tc :: Bool
nominal_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
print_equality :: (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
args =
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
(IfaceKind, IfaceKind, IfaceKind, IfaceKind)
-> PprStyle -> DynFlags -> SDoc
print_equality' (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
args PprStyle
style DynFlags
dflags
print_equality' :: (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
-> PprStyle -> DynFlags -> SDoc
print_equality' (IfaceKind
ki1, IfaceKind
ki2, IfaceKind
ty1, IfaceKind
ty2) PprStyle
style DynFlags
dflags
|
Bool
print_eqs
= SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
|
Bool
nominal_eq_tc, Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (String -> SDoc
text String
"~")
|
Bool -> Bool
not Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)
|
IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey, Bool
homogeneous
= let ki :: [SDoc]
ki | Bool
print_kinds = [PprPrec -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
ki1]
| Bool
otherwise = []
in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
coercibleTyCon)
([SDoc]
ki [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [PprPrec -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
ty1, PprPrec -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
ty2])
| Bool
otherwise
= SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
where
ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq SDoc
eq_op = PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
eq_op
(IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty1 IfaceKind
ki1) (IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty2 IfaceKind
ki2)
where
pp_ty_ki :: IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty IfaceKind
ki
| Bool
print_kinds
= SDoc -> SDoc
parens (PprPrec -> IfaceKind -> SDoc
pp PprPrec
topPrec IfaceKind
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
pp PprPrec
opPrec IfaceKind
ki)
| Bool
otherwise
= PprPrec -> IfaceKind -> SDoc
pp PprPrec
opPrec IfaceKind
ty
print_kinds :: Bool
print_kinds = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
print_eqs :: Bool
print_eqs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintEqualityRelations DynFlags
dflags Bool -> Bool -> Bool
||
PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| PprStyle -> Bool
debugStyle PprStyle
style
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
ctxt_prec IfaceTyCon
tc [IfaceCoercion]
tys =
(PprPrec -> (IfaceCoercion, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceCoercion, ArgFlag)] -> SDoc
forall a.
(PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app (\PprPrec
prec (IfaceCoercion
co, ArgFlag
_) -> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
prec IfaceCoercion
co) PprPrec
ctxt_prec IfaceTyCon
tc
((IfaceCoercion -> (IfaceCoercion, ArgFlag))
-> [IfaceCoercion] -> [(IfaceCoercion, ArgFlag)]
forall a b. (a -> b) -> [a] -> [b]
map (, ArgFlag
Required) [IfaceCoercion]
tys)
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
_ IfaceTyCon
tc [(a, ArgFlag)
ty]
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
listTyConKey = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
topPrec (a, ArgFlag)
ty)
ppr_iface_tc_app PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
ctxt_prec IfaceTyCon
tc [(a, ArgFlag)]
tys
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
= SDoc
kindType
| Bool -> Bool
not (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)))
= PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc) (((a, ArgFlag) -> SDoc) -> [(a, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
appPrec) [(a, ArgFlag)]
tys)
| [ ty1 :: (a, ArgFlag)
ty1@(a
_, ArgFlag
Required)
, ty2 :: (a, ArgFlag)
ty2@(a
_, ArgFlag
Required) ] <- [(a, ArgFlag)]
tys
= PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
(PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
opPrec (a, ArgFlag)
ty1) (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
opPrec (a, ArgFlag)
ty2)
| Bool
otherwise
= PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
parens (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)) (((a, ArgFlag) -> SDoc) -> [(a, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
appPrec) [(a, ArgFlag)]
tys)
pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum :: BranchIndex -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum BranchIndex
_arity PromotionFlag
is_promoted IfaceAppArgs
args
=
let tys :: [IfaceKind]
tys = IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceKind]
args' = BranchIndex -> [IfaceKind] -> [IfaceKind]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceKind] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceKind]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` BranchIndex
2) [IfaceKind]
tys
in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
sumParens ((IfaceKind -> SDoc) -> [IfaceKind] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec) [IfaceKind]
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 :: [IfaceKind]
tys = IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceKind]
args' = BranchIndex -> [IfaceKind] -> [IfaceKind]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceKind] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceKind]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` BranchIndex
2) [IfaceKind]
tys
spaceIfPromoted :: SDoc -> SDoc
spaceIfPromoted = case [IfaceKind]
args' of
IfaceKind
arg0:[IfaceKind]
_ -> IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceKind
arg0
[IfaceKind]
_ -> SDoc -> SDoc
forall a. a -> a
id
in [IfaceKind] -> SDoc -> SDoc
ppr_tuple_app [IfaceKind]
args' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
IsPromoted SDoc -> SDoc -> SDoc
<>
TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort (SDoc -> SDoc
spaceIfPromoted ((IfaceKind -> SDoc) -> [IfaceKind] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceKind -> SDoc
pprIfaceType [IfaceKind]
args'))
PromotionFlag
NotPromoted
| TupleSort
ConstraintTuple <- TupleSort
sort
, IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
sigPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"() :: Constraint"
| Bool
otherwise
->
let tys :: [IfaceKind]
tys = IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceKind]
args' = case TupleSort
sort of
TupleSort
UnboxedTuple -> BranchIndex -> [IfaceKind] -> [IfaceKind]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceKind] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceKind]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` BranchIndex
2) [IfaceKind]
tys
TupleSort
_ -> [IfaceKind]
tys
in
[IfaceKind] -> SDoc -> SDoc
ppr_tuple_app [IfaceKind]
args' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
promoted SDoc -> SDoc -> SDoc
<>
TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort ((IfaceKind -> SDoc) -> [IfaceKind] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceKind -> SDoc
pprIfaceType [IfaceKind]
args')
where
ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app :: [IfaceKind] -> SDoc -> SDoc
ppr_tuple_app [IfaceKind]
args_wo_runtime_reps SDoc
ppr_args_w_parens
| [IfaceKind
_] <- [IfaceKind]
args_wo_runtime_reps
, TupleSort
BoxedTuple <- TupleSort
sort
= let unit_tc_info :: IfaceTyConInfo
unit_tc_info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
IfaceNormalTyCon
unit_tc :: IfaceTyCon
unit_tc = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (TupleSort -> BranchIndex -> IfExtName
tupleTyConName TupleSort
sort BranchIndex
1) IfaceTyConInfo
unit_tc_info in
PprPrec -> IfaceKind -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec (IfaceKind -> SDoc) -> IfaceKind -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
unit_tc IfaceAppArgs
args
| Bool
otherwise
= SDoc
ppr_args_w_parens
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceNumTyLit Integer
n) = Integer -> SDoc
integer Integer
n
pprIfaceTyLit (IfaceStrTyLit IfLclName
n) = String -> SDoc
text (IfLclName -> String
forall a. Show a => a -> String
show IfLclName
n)
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 IfaceKind
ty) = SDoc -> SDoc
angleBrackets (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_ (IfaceGReflCo Role
r IfaceKind
ty IfaceMCoercion
IfaceMRefl)
= SDoc -> SDoc
angleBrackets (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfaceKind
ty (IfaceMCo IfaceCoercion
co))
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
(String -> SDoc
text String
"GRefl" SDoc -> SDoc -> SDoc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r IfaceCoercion
co1 IfaceCoercion
co2)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2)
where
ppr_fun_tail :: IfaceCoercion -> [SDoc]
ppr_fun_tail (IfaceFunCo Role
r IfaceCoercion
co1 IfaceCoercion
co2)
= (SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2
ppr_fun_tail IfaceCoercion
other_co
= [SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]
ppr_co PprPrec
_ (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos)
= SDoc -> SDoc
parens (PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
topPrec IfaceTyCon
tc [IfaceCoercion]
cos) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceAppCo IfaceCoercion
co1 IfaceCoercion
co2)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co2
ppr_co PprPrec
ctxt_prec co :: IfaceCoercion
co@(IfaceForAllCo {})
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
where
([(IfLclName, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co
split_co :: IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co (IfaceForAllCo (IfaceTvBndr (IfLclName
name, IfaceKind
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(IfLclName, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((IfLclName
name,IfaceCoercion
kind_co)(IfLclName, IfaceCoercion)
-> [(IfLclName, IfaceCoercion)] -> [(IfLclName, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(IfLclName, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co (IfaceForAllCo (IfaceIdBndr (IfLclName
name, IfaceKind
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(IfLclName, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((IfLclName
name,IfaceCoercion
kind_co)(IfLclName, IfaceCoercion)
-> [(IfLclName, IfaceCoercion)] -> [(IfLclName, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(IfLclName, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co IfaceCoercion
co' = ([], IfaceCoercion
co')
ppr_co PprPrec
_ (IfaceFreeCoVar TyVar
covar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo IfLclName
covar) = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
covar
ppr_co PprPrec
_ (IfaceHoleCo TyVar
covar) = SDoc -> SDoc
braces (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar)
ppr_co PprPrec
ctxt_prec (IfaceUnivCo IfaceUnivCoProv
IfaceUnsafeCoerceProv Role
r IfaceKind
ty1 IfaceKind
ty2)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"UnsafeCo" SDoc -> SDoc -> SDoc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
<+>
IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty1 SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty2
ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfaceKind
ty1 IfaceKind
ty2)
= String -> SDoc
text String
"Univ" SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [ Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role SDoc -> SDoc -> SDoc
<+> IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
prov
, SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty1 SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty2 ])
ppr_co PprPrec
ctxt_prec (IfaceInstCo IfaceCoercion
co IfaceCoercion
ty)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Inst" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty
ppr_co PprPrec
ctxt_prec (IfaceAxiomRuleCo IfLclName
tc [IfaceCoercion]
cos)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tc SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([IfaceCoercion] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [IfaceCoercion]
cos)
ppr_co PprPrec
ctxt_prec (IfaceAxiomInstCo IfExtName
n BranchIndex
i [IfaceCoercion]
cos)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BranchIndex
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Sym") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
co1 SDoc -> SDoc -> SDoc
<+> SDoc
semi SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
co2
ppr_co PprPrec
ctxt_prec (IfaceNthCo BranchIndex
d IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Nth:" SDoc -> SDoc -> SDoc
<> BranchIndex -> SDoc
int BranchIndex
d) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceLRCo LeftOrRight
lr IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (LeftOrRight -> SDoc
forall a. Outputable a => a -> SDoc
ppr LeftOrRight
lr) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceSubCo IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Sub") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceKindCo IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Kind") [IfaceCoercion
co]
ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec SDoc
doc [IfaceCoercion]
cos
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec
([SDoc] -> SDoc
sep [SDoc
doc, BranchIndex -> SDoc -> SDoc
nest BranchIndex
4 ([SDoc] -> SDoc
sep ((IfaceCoercion -> SDoc) -> [IfaceCoercion] -> [SDoc]
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 = SDoc
underscore SDoc -> SDoc -> SDoc
<> SDoc
pp_role
where pp_role :: SDoc
pp_role = case Role
r of
Role
Nominal -> Char -> SDoc
char Char
'N'
Role
Representational -> Char -> SDoc
char Char
'R'
Role
Phantom -> Char -> SDoc
char Char
'P'
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
IfaceUnsafeCoerceProv
= String -> SDoc
text String
"unsafe"
pprIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
co)
= String -> SDoc
text String
"phantom" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
co)
= String -> SDoc
text String
"irrel" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfacePluginProv String
s)
= String -> SDoc
text String
"plugin" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
doubleQuotes (String -> SDoc
text String
s)
instance Outputable IfaceTyCon where
ppr :: IfaceTyCon -> SDoc
ppr IfaceTyCon
tc = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
<> IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc =
PromotionFlag -> SDoc
pprPromotionQuoteI (PromotionFlag -> SDoc) -> PromotionFlag -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyConInfo -> PromotionFlag)
-> IfaceTyConInfo -> PromotionFlag
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
NotPromoted = SDoc
empty
pprPromotionQuoteI PromotionFlag
IsPromoted = Char -> SDoc
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) = BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
n IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTyConInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConInfo
i
get :: BinHandle -> IO IfaceTyCon
get BinHandle
bh = do IfExtName
n <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTyConInfo
i <- BinHandle -> IO IfaceTyConInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTyCon -> IO IfaceTyCon
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 BranchIndex
arity TupleSort
sort) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
arity IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
sort
put_ BinHandle
bh (IfaceSumTyCon BranchIndex
arity) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
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 -> IfaceTyConSort -> IO IfaceTyConSort
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
Word8
1 -> BranchIndex -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (BranchIndex -> TupleSort -> IfaceTyConSort)
-> IO BranchIndex -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> BranchIndex -> IfaceTyConSort
IfaceSumTyCon (BranchIndex -> IfaceTyConSort)
-> IO BranchIndex -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
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) = BinHandle -> PromotionFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTyConSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConSort
s
get :: BinHandle -> IO IfaceTyConInfo
get BinHandle
bh = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo)
-> IO PromotionFlag -> IO (IfaceTyConSort -> IfaceTyConInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO PromotionFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (IfaceTyConSort -> IfaceTyConInfo)
-> IO IfaceTyConSort -> IO IfaceTyConInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO IfaceTyConSort
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 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
n
put_ BinHandle
bh (IfaceStrTyLit IfLclName
n) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
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 <- BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IfaceTyLit
IfaceNumTyLit Integer
n) }
Word8
2 -> do { IfLclName
n <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceTyLit
IfaceStrTyLit IfLclName
n) }
Word8
_ -> String -> IO IfaceTyLit
forall a. String -> a
panic (String
"get IfaceTyLit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
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 IfaceKind
t ArgFlag
a IfaceAppArgs
ts -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
t IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ArgFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ArgFlag
a IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceAppArgs -> IO ()
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
IfaceKind
t <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
ArgFlag
a <- BinHandle -> IO ArgFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceAppArgs
ts <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceAppArgs -> IO IfaceAppArgs
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceAppArgs -> IO IfaceAppArgs)
-> IfaceAppArgs -> IO IfaceAppArgs
forall a b. (a -> b) -> a -> b
$! IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
t ArgFlag
a IfaceAppArgs
ts
Word8
1 -> IfaceAppArgs -> IO IfaceAppArgs
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
Word8
_ -> String -> IO IfaceAppArgs
forall a. String -> a
panic (String
"get IfaceAppArgs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c)
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceContextArr :: [IfaceKind] -> SDoc
pprIfaceContextArr [] = SDoc
empty
pprIfaceContextArr [IfaceKind
pred] = PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
pred SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContextArr [IfaceKind]
preds = [IfaceKind] -> SDoc
ppr_parend_preds [IfaceKind]
preds SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext :: PprPrec -> [IfaceKind] -> SDoc
pprIfaceContext PprPrec
_ [] = String -> SDoc
text String
"()"
pprIfaceContext PprPrec
prec [IfaceKind
pred] = PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
prec IfaceKind
pred
pprIfaceContext PprPrec
_ [IfaceKind]
preds = [IfaceKind] -> SDoc
ppr_parend_preds [IfaceKind]
preds
ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds :: [IfaceKind] -> SDoc
ppr_parend_preds [IfaceKind]
preds = SDoc -> SDoc
parens ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceKind -> SDoc) -> [IfaceKind] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceKind]
preds)))
instance Binary IfaceType where
put_ :: BinHandle -> IfaceKind -> IO ()
put_ BinHandle
_ (IfaceFreeTyVar TyVar
tv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeTyVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv)
put_ BinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfaceKind
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> IfaceForAllBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceForAllBndr
aa
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ab
put_ BinHandle
bh (IfaceTyVar IfLclName
ad) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
ad
put_ BinHandle
bh (IfaceAppTy IfaceKind
ae IfaceAppArgs
af) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ae
BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
put_ BinHandle
bh (IfaceFunTy AnonArgFlag
af IfaceKind
ag IfaceKind
ah) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> AnonArgFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh AnonArgFlag
af
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ag
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ah
put_ BinHandle
bh (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5; BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
tc; BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
tys }
put_ BinHandle
bh (IfaceCastTy IfaceKind
a IfaceCoercion
b)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
a; BinHandle -> IfaceCoercion -> IO ()
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; BinHandle -> IfaceCoercion -> IO ()
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; BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
s; BinHandle -> PromotionFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i; BinHandle -> IfaceAppArgs -> IO ()
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; BinHandle -> IfaceTyLit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyLit
n }
get :: BinHandle -> IO IfaceKind
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do IfaceForAllBndr
aa <- BinHandle -> IO IfaceForAllBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
ab <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfaceKind -> IfaceKind
IfaceForAllTy IfaceForAllBndr
aa IfaceKind
ab)
Word8
1 -> do IfLclName
ad <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceKind
IfaceTyVar IfLclName
ad)
Word8
2 -> do IfaceKind
ae <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceAppArgs
af <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy IfaceKind
ae IfaceAppArgs
af)
Word8
3 -> do AnonArgFlag
af <- BinHandle -> IO AnonArgFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
ag <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
ah <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af IfaceKind
ag IfaceKind
ah)
Word8
5 -> do { IfaceTyCon
tc <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
Word8
6 -> do { IfaceKind
a <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy IfaceKind
a IfaceCoercion
b) }
Word8
7 -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceKind
IfaceCoercionTy IfaceCoercion
a) }
Word8
8 -> do { TupleSort
s <- BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; PromotionFlag
i <- BinHandle -> IO PromotionFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
Word8
_ -> do IfaceTyLit
n <- BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfaceKind
IfaceLitTy IfaceTyLit
n)
instance Binary IfaceMCoercion where
put_ :: BinHandle -> IfaceMCoercion -> IO ()
put_ BinHandle
bh IfaceMCoercion
IfaceMRefl = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (IfaceMCo IfaceCoercion
co) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> IfaceCoercion -> IO ()
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 -> IfaceMCoercion -> IO IfaceMCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceMCoercion
IfaceMRefl
Word8
2 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceMCoercion -> IO IfaceMCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceMCoercion -> IO IfaceMCoercion)
-> IfaceMCoercion -> IO IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceMCoercion
IfaceMCo IfaceCoercion
a
Word8
_ -> String -> IO IfaceMCoercion
forall a. String -> a
panic (String
"get IfaceMCoercion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)
instance Binary IfaceCoercion where
put_ :: BinHandle -> IfaceCoercion -> IO ()
put_ BinHandle
bh (IfaceReflCo IfaceKind
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
a
put_ BinHandle
bh (IfaceGReflCo Role
a IfaceKind
b IfaceMCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
b
BinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
put_ BinHandle
bh (IfaceFunCo Role
a IfaceCoercion
b IfaceCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
b
BinHandle -> [IfaceCoercion] -> IO ()
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
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> IfaceBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBndr
a
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
put_ BinHandle
bh (IfaceCoVarCo IfLclName
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a BranchIndex
b [IfaceCoercion]
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
b
BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceKind
c IfaceKind
d) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
BinHandle -> IfaceUnivCoProv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceUnivCoProv
a
BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
b
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
c
BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
d
put_ BinHandle
bh (IfaceSymCo IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
put_ BinHandle
bh (IfaceNthCo BranchIndex
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
a
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> LeftOrRight -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LeftOrRight
a
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> IfaceCoercion -> IO ()
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
BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
put_ BinHandle
bh (IfaceAxiomRuleCo IfLclName
a [IfaceCoercion]
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
put_ BinHandle
_ (IfaceFreeCoVar TyVar
cv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
put_ BinHandle
_ (IfaceHoleCo TyVar
cv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
get :: BinHandle -> IO IfaceCoercion
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do IfaceKind
a <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceKind -> IfaceCoercion
IfaceReflCo IfaceKind
a
Word8
2 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
b <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceMCoercion
c <- BinHandle -> IO IfaceMCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceKind -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfaceKind
b IfaceMCoercion
c
Word8
3 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
c <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
b IfaceCoercion
c
Word8
4 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTyCon
b <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c
Word8
5 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo IfaceCoercion
a IfaceCoercion
b
Word8
6 -> do IfaceBndr
a <- BinHandle -> IO IfaceBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
c <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceBndr -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c
Word8
7 -> do IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
a
Word8
8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
BranchIndex
b <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
b [IfaceCoercion]
c
Word8
9 -> do IfaceUnivCoProv
a <- BinHandle -> IO IfaceUnivCoProv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Role
b <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
c <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceKind
d <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv -> Role -> IfaceKind -> IfaceKind -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceKind
c IfaceKind
d
Word8
10-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSymCo IfaceCoercion
a
Word8
11-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo IfaceCoercion
a IfaceCoercion
b
Word8
12-> do BranchIndex
a <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
a IfaceCoercion
b
Word8
13-> do LeftOrRight
a <- BinHandle -> IO LeftOrRight
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
a IfaceCoercion
b
Word8
14-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo IfaceCoercion
a IfaceCoercion
b
Word8
15-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceKindCo IfaceCoercion
a
Word8
16-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSubCo IfaceCoercion
a
Word8
17-> do IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCoercion]
b <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
a [IfaceCoercion]
b
Word8
_ -> String -> IO IfaceCoercion
forall a. String -> a
panic (String
"get IfaceCoercion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)
instance Binary IfaceUnivCoProv where
put_ :: BinHandle -> IfaceUnivCoProv -> IO ()
put_ BinHandle
bh IfaceUnivCoProv
IfaceUnsafeCoerceProv = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (IfacePhantomProv IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> IfaceCoercion -> IO ()
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
3
BinHandle -> IfaceCoercion -> IO ()
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
4
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
a
get :: BinHandle -> IO IfaceUnivCoProv
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv
IfaceUnsafeCoerceProv
Word8
2 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceUnivCoProv -> IO IfaceUnivCoProv
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv IfaceCoercion
a
Word8
3 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceUnivCoProv -> IO IfaceUnivCoProv
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv IfaceCoercion
a
Word8
4 -> do String
a <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceUnivCoProv -> IO IfaceUnivCoProv
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ String -> IfaceUnivCoProv
IfacePluginProv String
a
Word8
_ -> String -> IO IfaceUnivCoProv
forall a. String -> a
panic (String
"get IfaceUnivCoProv " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)
instance Binary (DefMethSpec IfaceType) where
put_ :: BinHandle -> DefMethSpec IfaceKind -> IO ()
put_ BinHandle
bh DefMethSpec IfaceKind
VanillaDM = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (GenericDM IfaceKind
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
t
get :: BinHandle -> IO (DefMethSpec IfaceKind)
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> DefMethSpec IfaceKind -> IO (DefMethSpec IfaceKind)
forall (m :: * -> *) a. Monad m => a -> m a
return DefMethSpec IfaceKind
forall ty. DefMethSpec ty
VanillaDM
Word8
_ -> do { IfaceKind
t <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; DefMethSpec IfaceKind -> IO (DefMethSpec IfaceKind)
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> DefMethSpec IfaceKind
forall ty. ty -> DefMethSpec ty
GenericDM IfaceKind
t) }
instance NFData IfaceType where
rnf :: IfaceKind -> ()
rnf = \case
IfaceFreeTyVar TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
`seq` ()
IfaceTyVar IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1
IfaceLitTy IfaceTyLit
f1 -> IfaceTyLit -> ()
forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
IfaceAppTy IfaceKind
f1 IfaceAppArgs
f2 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1 () -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
IfaceFunTy AnonArgFlag
f1 IfaceKind
f2 IfaceKind
f3 -> AnonArgFlag
f1 AnonArgFlag -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f2 () -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f3
IfaceForAllTy IfaceForAllBndr
f1 IfaceKind
f2 -> IfaceForAllBndr
f1 IfaceForAllBndr -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f2
IfaceTyConApp IfaceTyCon
f1 IfaceAppArgs
f2 -> IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f1 () -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
IfaceCastTy IfaceKind
f1 IfaceCoercion
f2 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceCoercionTy IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceTupleTy TupleSort
f1 PromotionFlag
f2 IfaceAppArgs