{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Iface.Type (
IfExtName, IfLclName,
IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
IfaceMCoercion(..),
IfaceUnivCoProv(..),
IfaceMult,
IfaceTyCon(..),
IfaceTyConInfo(..), mkIfaceTyConInfo,
IfaceTyConSort(..),
IfaceTyLit(..), IfaceAppArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllSpecBndr,
IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..), ShowForAllFlag(..),
mkIfaceForAllTvBndr,
mkIfaceTyConKind,
ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr,
ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
ifTyConBinderVar, ifTyConBinderName,
isIfaceLiftedTypeKind,
appArgsIfaceTypes, appArgsIfaceTypesArgFlags,
SuppressBndrSig(..),
UseBndrParens(..),
PrintExplicitKinds(..),
pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
pprIfaceContext, pprIfaceContextArr,
pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
pprIfaceSigmaType, pprIfaceTyLit,
pprIfaceCoercion, pprParendIfaceCoercion,
splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
ppr_fun_arrow,
isIfaceTauType,
suppressIfaceInvisibles,
stripIfaceInvisVars,
stripInvisArgs,
mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst,
many_ty
) where
#include "HsVersions.h"
import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
( coercibleTyCon, heqTyCon
, tupleTyConName
, manyDataConTyCon, oneDataConTyCon
, liftedRepTyCon )
import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy )
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Types.Var
import GHC.Builtin.Names
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar )
import Data.Maybe( isJust )
import qualified Data.Semigroup as Semi
import Control.DeepSeq
type IfLclName = FastString
type IfExtName = Name
data IfaceBndr
= IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
| IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
type IfaceIdBndr = (IfaceType, IfLclName, IfaceType)
type IfaceTvBndr = (IfLclName, IfaceKind)
ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName :: IfaceTvBndr -> FastString
ifaceTvBndrName (FastString
n,IfaceType
_) = FastString
n
ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceIdBndr -> FastString
ifaceIdBndrName (IfaceType
_,FastString
n,IfaceType
_) = FastString
n
ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName :: IfaceBndr -> FastString
ifaceBndrName (IfaceTvBndr IfaceTvBndr
bndr) = IfaceTvBndr -> FastString
ifaceTvBndrName IfaceTvBndr
bndr
ifaceBndrName (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> FastString
ifaceIdBndrName IfaceIdBndr
bndr
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType (IfaceIdBndr (IfaceType
_, FastString
_, IfaceType
t)) = IfaceType
t
ifaceBndrType (IfaceTvBndr (FastString
_, IfaceType
t)) = IfaceType
t
type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
data IfaceOneShot
= IfaceNoOneShot
| IfaceOneShot
instance Outputable IfaceOneShot where
ppr :: IfaceOneShot -> SDoc
ppr IfaceOneShot
IfaceNoOneShot = String -> SDoc
text String
"NoOneShotInfo"
ppr IfaceOneShot
IfaceOneShot = String -> SDoc
text String
"OneShot"
type IfaceKind = IfaceType
data IfaceType
= IfaceFreeTyVar TyVar
| IfaceTyVar IfLclName
| IfaceLitTy IfaceTyLit
| IfaceAppTy IfaceType IfaceAppArgs
| IfaceFunTy AnonArgFlag IfaceMult IfaceType IfaceType
| IfaceForAllTy IfaceForAllBndr IfaceType
| IfaceTyConApp IfaceTyCon IfaceAppArgs
| IfaceCastTy IfaceType IfaceCoercion
| IfaceCoercionTy IfaceCoercion
| IfaceTupleTy
TupleSort
PromotionFlag
IfaceAppArgs
type IfaceMult = IfaceType
type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]
data IfaceTyLit
= IfaceNumTyLit Integer
| IfaceStrTyLit FastString
| IfaceCharTyLit Char
deriving (IfaceTyLit -> IfaceTyLit -> Bool
(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
type IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity
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] -> IfaceType -> IfaceType
mkIfaceTyConKind [IfaceTyConBinder]
bndrs IfaceType
res_kind = (IfaceTyConBinder -> IfaceType -> IfaceType)
-> IfaceType -> [IfaceTyConBinder] -> IfaceType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceTyConBinder -> IfaceType -> IfaceType
mk IfaceType
res_kind [IfaceTyConBinder]
bndrs
where
mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
mk :: IfaceTyConBinder -> IfaceType -> IfaceType
mk (Bndr IfaceBndr
tv (AnonTCB AnonArgFlag
af)) IfaceType
k = AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af IfaceType
many_ty (IfaceBndr -> IfaceType
ifaceBndrType IfaceBndr
tv) IfaceType
k
mk (Bndr IfaceBndr
tv (NamedTCB ArgFlag
vis)) IfaceType
k = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ArgFlag
vis) IfaceType
k
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs = (IfaceForAllSpecBndr -> IfaceForAllBndr)
-> [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr (Bndr IfaceBndr
tv Specificity
spec) = IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv (Specificity -> ArgFlag
Invisible Specificity
spec)
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 IfaceType
ty ArgFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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)
instance Outputable IfaceTyConSort where
ppr :: IfaceTyConSort -> SDoc
ppr IfaceTyConSort
IfaceNormalTyCon = String -> SDoc
text String
"normal"
ppr (IfaceTupleTyCon Int
n TupleSort
sort) = TupleSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr TupleSort
sort SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
ppr (IfaceSumTyCon Int
n) = String -> SDoc
text String
"sum:" SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
ppr IfaceTyConSort
IfaceEqualityTyCon = String -> SDoc
text String
"equality"
data IfaceTyConInfo
= IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
, IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort :: IfaceTyConSort }
deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
(IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool) -> Eq IfaceTyConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
prom IfaceTyConSort
sort = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
prom IfaceTyConSort
sort
data IfaceMCoercion
= IfaceMRefl
| IfaceMCo IfaceCoercion
data IfaceCoercion
= IfaceReflCo IfaceType
| IfaceGReflCo Role IfaceType (IfaceMCoercion)
| IfaceFunCo Role IfaceCoercion IfaceCoercion IfaceCoercion
| IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion]
| IfaceAppCo IfaceCoercion IfaceCoercion
| IfaceForAllCo IfaceBndr IfaceCoercion IfaceCoercion
| IfaceCoVarCo IfLclName
| IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
| IfaceAxiomRuleCo IfLclName [IfaceCoercion]
| IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
| IfaceSymCo IfaceCoercion
| IfaceTransCo IfaceCoercion IfaceCoercion
| IfaceNthCo Int IfaceCoercion
| IfaceLRCo LeftOrRight IfaceCoercion
| IfaceInstCo IfaceCoercion IfaceCoercion
| IfaceKindCo IfaceCoercion
| IfaceSubCo IfaceCoercion
| IfaceFreeCoVar CoVar
| IfaceHoleCo CoVar
data IfaceUnivCoProv
= 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 :: IfaceType -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
IA_Nil)
= IfExtName -> Bool
isLiftedTypeKindTyConName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc1 IfaceAppArgs
args1)
= IfaceTyCon -> IfaceAppArgs -> Bool
isIfaceTyConAppLiftedTypeKind IfaceTyCon
tc1 IfaceAppArgs
args1
isIfaceLiftedTypeKind IfaceType
_ = Bool
False
isIfaceTyConAppLiftedTypeKind :: IfaceTyCon -> IfaceAppArgs -> Bool
isIfaceTyConAppLiftedTypeKind :: IfaceTyCon -> IfaceAppArgs -> Bool
isIfaceTyConAppLiftedTypeKind IfaceTyCon
tc1 IfaceAppArgs
args1
| IfaceTyCon
tc1 IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
, IA_Arg IfaceType
soleArg1 ArgFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args1
, IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
args2 <- IfaceType
soleArg1 =
if | IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
boxedRepDataConKey
, IA_Arg IfaceType
soleArg2 ArgFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args2
, IfaceTyConApp IfaceTyCon
lev IfaceAppArgs
IA_Nil <- IfaceType
soleArg2
, IfaceTyCon
lev IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedDataConKey -> Bool
True
| IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepTyConKey
, IfaceAppArgs
IA_Nil <- IfaceAppArgs
args2 -> Bool
True
| Bool
otherwise -> Bool
False
| Bool
otherwise = Bool
False
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
ty
= case ([IfaceForAllBndr]
bndrs, [IfaceType]
theta) of
([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceType]
theta, IfaceType
tau)
([IfaceForAllBndr], [IfaceType])
_ -> let ([IfaceForAllBndr]
bndrs', [IfaceType]
theta', IfaceType
tau') = IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
tau
in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceType]
theta [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType]
theta', IfaceType
tau')
where
([IfaceForAllBndr]
bndrs, IfaceType
rho) = IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty
([IfaceType]
theta, IfaceType
tau) = IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
rho
split_foralls :: IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
| ArgFlag -> Bool
isInvisibleArgFlag (IfaceForAllBndr -> ArgFlag
forall tv argf. VarBndr tv argf -> argf
binderArgFlag IfaceForAllBndr
bndr)
= case IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceType
rho) }
split_foralls IfaceType
rho = ([], IfaceType
rho)
split_rho :: IfaceType -> ([IfaceType], IfaceType)
split_rho (IfaceFunTy AnonArgFlag
InvisArg IfaceType
_ IfaceType
ty1 IfaceType
ty2)
= case IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
ty2 of { ([IfaceType]
ps, IfaceType
tau) -> (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
ps, IfaceType
tau) }
split_rho IfaceType
tau = ([], IfaceType
tau)
splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
| ArgFlag -> Bool
isVisibleArgFlag (IfaceForAllBndr -> ArgFlag
forall tv argf. VarBndr tv argf -> argf
binderArgFlag IfaceForAllBndr
bndr)
= case IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy IfaceType
ty of { ([IfaceForAllBndr]
bndrs, IfaceType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceType
rho) }
splitIfaceReqForallTy IfaceType
rho = ([], IfaceType
rho)
suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: forall a. PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles (PrintExplicitKinds Bool
True) [IfaceTyConBinder]
_tys [a]
xs = [a]
xs
suppressIfaceInvisibles (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tys [a]
xs = [IfaceTyConBinder] -> [a] -> [a]
forall {tv} {a}. [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [IfaceTyConBinder]
tys [a]
xs
where
suppress :: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
_ [] = []
suppress [] [a]
a = [a]
a
suppress (VarBndr tv TyConBndrVis
k:[VarBndr tv TyConBndrVis]
ks) (a
x:[a]
xs)
| VarBndr tv TyConBndrVis -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
k = [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars (PrintExplicitKinds Bool
True) [IfaceTyConBinder]
tyvars = [IfaceTyConBinder]
tyvars
stripIfaceInvisVars (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tyvars
= (IfaceTyConBinder -> Bool)
-> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. (a -> Bool) -> [a] -> [a]
filterOut IfaceTyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = IfaceForAllBndr -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> FastString
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> FastString
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 -> FastString
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> FastString
ifaceBndrName (IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar IfaceTyConBinder
tcb)
ifTypeIsVarFree :: IfaceType -> Bool
ifTypeIsVarFree :: IfaceType -> Bool
ifTypeIsVarFree IfaceType
ty = IfaceType -> Bool
go IfaceType
ty
where
go :: IfaceType -> Bool
go (IfaceTyVar {}) = Bool
False
go (IfaceFreeTyVar {}) = Bool
False
go (IfaceAppTy IfaceType
fun IfaceAppArgs
args) = IfaceType -> Bool
go IfaceType
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
go (IfaceFunTy AnonArgFlag
_ IfaceType
w IfaceType
arg IfaceType
res) = IfaceType -> Bool
go IfaceType
w Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
res
go (IfaceForAllTy {}) = Bool
False
go (IfaceTyConApp IfaceTyCon
_ IfaceAppArgs
args) = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
go (IfaceTupleTy TupleSort
_ PromotionFlag
_ IfaceAppArgs
args) = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
go (IfaceLitTy IfaceTyLit
_) = Bool
True
go (IfaceCastTy {}) = Bool
False
go (IfaceCoercionTy {}) = Bool
False
go_args :: IfaceAppArgs -> Bool
go_args IfaceAppArgs
IA_Nil = Bool
True
go_args (IA_Arg IfaceType
arg ArgFlag
_ IfaceAppArgs
args) = IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
type IfaceTySubst = FastStringEnv IfaceType
mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
mkIfaceTySubst :: [IfaceTvBndr] -> IfaceTySubst
mkIfaceTySubst [IfaceTvBndr]
eq_spec = [IfaceTvBndr] -> IfaceTySubst
forall a. [(FastString, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst IfaceTySubst
subst (FastString
fs, IfaceType
_) = Maybe IfaceType -> Bool
forall a. Maybe a -> Bool
isJust (IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subst FastString
fs)
substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType IfaceTySubst
env IfaceType
ty
= IfaceType -> IfaceType
go IfaceType
ty
where
go :: IfaceType -> IfaceType
go (IfaceFreeTyVar CoVar
tv) = CoVar -> IfaceType
IfaceFreeTyVar CoVar
tv
go (IfaceTyVar FastString
tv) = IfaceTySubst -> FastString -> IfaceType
substIfaceTyVar IfaceTySubst
env FastString
tv
go (IfaceAppTy IfaceType
t IfaceAppArgs
ts) = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (IfaceType -> IfaceType
go IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
go (IfaceFunTy AnonArgFlag
af IfaceType
w IfaceType
t1 IfaceType
t2) = AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af (IfaceType -> IfaceType
go IfaceType
w) (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
go ty :: IfaceType
ty@(IfaceLitTy {}) = IfaceType
ty
go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
s PromotionFlag
i (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
go (IfaceForAllTy {}) = String -> SDoc -> IfaceType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
go (IfaceCastTy IfaceType
ty IfaceCoercion
co) = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceType -> IfaceType
go IfaceType
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go (IfaceCoercionTy IfaceCoercion
co) = IfaceCoercion -> IfaceType
IfaceCoercionTy (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_mco :: IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
IfaceMRefl = IfaceMCoercion
IfaceMRefl
go_mco (IfaceMCo IfaceCoercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co
go_co :: IfaceCoercion -> IfaceCoercion
go_co (IfaceReflCo IfaceType
ty) = IfaceType -> IfaceCoercion
IfaceReflCo (IfaceType -> IfaceType
go IfaceType
ty)
go_co (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
mco) = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfaceType -> IfaceType
go IfaceType
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
go_co (IfaceFunCo Role
r IfaceCoercion
w IfaceCoercion
c1 IfaceCoercion
c2) = Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
w) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
go_co (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos) = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r IfaceTyCon
tc ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_co (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
go_co (IfaceForAllCo {}) = String -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceCoercion" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
go_co (IfaceFreeCoVar CoVar
cv) = CoVar -> IfaceCoercion
IfaceFreeCoVar CoVar
cv
go_co (IfaceCoVarCo FastString
cv) = FastString -> IfaceCoercion
IfaceCoVarCo FastString
cv
go_co (IfaceHoleCo CoVar
cv) = CoVar -> IfaceCoercion
IfaceHoleCo CoVar
cv
go_co (IfaceAxiomInstCo IfExtName
a Int
i [IfaceCoercion]
cos) = IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_co (IfaceUnivCo IfaceUnivCoProv
prov Role
r IfaceType
t1 IfaceType
t2) = IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo (IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
prov) Role
r (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
go_co (IfaceSymCo IfaceCoercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSymCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_co (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co2)
go_co (IfaceNthCo Int
n IfaceCoercion
co) = Int -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Int
n (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_co (IfaceLRCo LeftOrRight
lr IfaceCoercion
co) = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_co (IfaceInstCo IfaceCoercion
c1 IfaceCoercion
c2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
go_co (IfaceKindCo IfaceCoercion
co) = IfaceCoercion -> IfaceCoercion
IfaceKindCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_co (IfaceSubCo IfaceCoercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSubCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_co (IfaceAxiomRuleCo FastString
n [IfaceCoercion]
cos) = FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
go_cos :: [IfaceCoercion] -> [IfaceCoercion]
go_cos = (IfaceCoercion -> IfaceCoercion)
-> [IfaceCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> IfaceCoercion
go_co
go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov (IfacePhantomProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_prov (IfaceProofIrrelProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
go_prov (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 IfaceType
ty ArgFlag
arg IfaceAppArgs
tys) = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceType -> IfaceType
substIfaceType IfaceTySubst
env IfaceType
ty) ArgFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)
substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar :: IfaceTySubst -> FastString -> IfaceType
substIfaceTyVar IfaceTySubst
env FastString
tv
| Just IfaceType
ty <- IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
env FastString
tv = IfaceType
ty
| Bool
otherwise = FastString -> IfaceType
IfaceTyVar FastString
tv
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (PrintExplicitKinds Bool
True) IfaceAppArgs
tys = IfaceAppArgs
tys
stripInvisArgs (PrintExplicitKinds Bool
False) IfaceAppArgs
tys = IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
tys
where
suppress_invis :: IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
c
= case IfaceAppArgs
c of
IfaceAppArgs
IA_Nil -> IfaceAppArgs
IA_Nil
IA_Arg IfaceType
t ArgFlag
argf IfaceAppArgs
ts
| ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf
-> IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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 -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
IA_Nil = []
appArgsIfaceTypes (IA_Arg IfaceType
t ArgFlag
_ IfaceAppArgs
ts) = IfaceType
t IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
ts
appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
IA_Nil = []
appArgsIfaceTypesArgFlags (IA_Arg IfaceType
t ArgFlag
a IfaceAppArgs
ts)
= (IfaceType
t, ArgFlag
a) (IfaceType, ArgFlag)
-> [(IfaceType, ArgFlag)] -> [(IfaceType, ArgFlag)]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
ts
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = Int -> IfaceAppArgs -> Int
forall {t}. Num t => t -> IfaceAppArgs -> t
go Int
0
where
go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
go t
n (IA_Arg IfaceType
_ 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
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_co ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
(Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
if Bool
print_co Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug
then SDoc
yes
else SDoc
no
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
pp_tc SDoc
pp_ty1 SDoc
pp_ty2
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
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 -> Int -> SDoc -> SDoc
hang SDoc
pp_fun Int
2 ([SDoc] -> SDoc
sep [SDoc]
pp_tys)
isIfaceTauType :: IfaceType -> Bool
isIfaceTauType :: IfaceType -> Bool
isIfaceTauType (IfaceForAllTy IfaceForAllBndr
_ IfaceType
_) = Bool
False
isIfaceTauType (IfaceFunTy AnonArgFlag
InvisArg IfaceType
_ IfaceType
_ IfaceType
_) = Bool
False
isIfaceTauType IfaceType
_ = Bool
True
instance Outputable IfaceBndr where
ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
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 :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (IfaceType
w, FastString
name, IfaceType
ty) = SDoc -> SDoc
parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
name SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
w) SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
newtype SuppressBndrSig = SuppressBndrSig Bool
newtype UseBndrParens = UseBndrParens Bool
newtype PrintExplicitKinds = PrintExplicitKinds Bool
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (FastString
tv, IfaceType
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
| Bool
suppress_sig = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
| IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
ki = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
| Bool
otherwise = SDoc -> SDoc
maybe_parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
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 IfaceIdBndr
bndr) TyConBndrVis
_) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
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 (Invisible Specificity
spec) -> case Specificity
spec of
Specificity
SpecifiedSpec -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
Specificity
InferredSpec -> 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 IfaceIdBndr
aa) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> IfaceIdBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceIdBndr
aa
put_ BinHandle
bh (IfaceTvBndr IfaceTvBndr
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
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 IfaceIdBndr
aa <- BinHandle -> IO IfaceIdBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceBndr -> IO IfaceBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceIdBndr -> IfaceBndr
IfaceIdBndr IfaceIdBndr
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 =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh IfaceOneShot
IfaceOneShot =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
get :: BinHandle -> IO IfaceOneShot
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
Word8
_ -> IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceOneShot
instance Outputable IfaceType where
ppr :: IfaceType -> SDoc
ppr IfaceType
ty = IfaceType -> SDoc
pprIfaceType IfaceType
ty
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceType :: IfaceType -> SDoc
pprIfaceType = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
topPrec
pprParendIfaceType :: IfaceType -> SDoc
pprParendIfaceType = PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
appPrec
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
prec IfaceType
ty =
(IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec) IfaceType
ty
ppr_fun_arrow :: IfaceMult -> SDoc
ppr_fun_arrow :: IfaceType -> SDoc
ppr_fun_arrow IfaceType
w
| (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) <- IfaceType
w
, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` (TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
manyDataConTyCon) = SDoc
arrow
| (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) <- IfaceType
w
, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` (TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
oneDataConTyCon) = SDoc
lollipop
| Bool
otherwise = SDoc -> SDoc
mulArrow (IfaceType -> SDoc
pprIfaceType IfaceType
w)
ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceType
ty
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllMust IfaceType
ty)
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceForAllTy {}) = PprPrec -> IfaceType -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceType
ty
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceFunTy AnonArgFlag
InvisArg IfaceType
_ IfaceType
_ IfaceType
_) = PprPrec -> IfaceType -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceType
ty
ppr_ty PprPrec
_ (IfaceFreeTyVar CoVar
tyvar) = CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
tyvar
ppr_ty PprPrec
_ (IfaceTyVar FastString
tyvar) = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tyvar
ppr_ty PprPrec
ctxt_prec (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys
ppr_ty PprPrec
ctxt_prec (IfaceTupleTy TupleSort
i PromotionFlag
p IfaceAppArgs
tys) = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
i PromotionFlag
p IfaceAppArgs
tys
ppr_ty PprPrec
_ (IfaceLitTy IfaceTyLit
n) = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n
ppr_ty PprPrec
ctxt_prec (IfaceFunTy AnonArgFlag
_ IfaceType
w IfaceType
ty1 IfaceType
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 -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1, [SDoc] -> SDoc
sep (IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
w IfaceType
ty2)]
where
ppr_fun_tail :: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wthis (IfaceFunTy AnonArgFlag
VisArg IfaceType
wnext IfaceType
ty1 IfaceType
ty2)
= (IfaceType -> SDoc
ppr_fun_arrow IfaceType
wthis SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wnext IfaceType
ty2
ppr_fun_tail IfaceType
wthis IfaceType
other_ty
= [IfaceType -> SDoc
ppr_fun_arrow IfaceType
wthis SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprIfaceType IfaceType
other_ty]
ppr_ty PprPrec
ctxt_prec (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
= SDoc -> SDoc -> SDoc
if_print_coercions
SDoc
ppr_app_ty
SDoc
ppr_app_ty_no_casts
where
ppr_app_ty :: SDoc
ppr_app_ty =
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
let tys_wo_kinds :: [(IfaceType, ArgFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceType, ArgFlag)])
-> IfaceAppArgs -> [(IfaceType, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs
(Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
ts
in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec
(PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
t)
(((IfaceType, ArgFlag) -> SDoc) -> [(IfaceType, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) [(IfaceType, ArgFlag)]
tys_wo_kinds)
ppr_app_ty_no_casts :: SDoc
ppr_app_ty_no_casts =
case IfaceType
t of
IfaceCastTy IfaceType
head IfaceCoercion
_ -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec (IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys IfaceType
head IfaceAppArgs
ts)
IfaceType
_ -> SDoc
ppr_app_ty
mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys1) IfaceAppArgs
tys2 =
IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceAppArgs
tys1 IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Monoid a => a -> a -> a
`mappend` IfaceAppArgs
tys2)
mk_app_tys IfaceType
t1 IfaceAppArgs
tys2 = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
t1 IfaceAppArgs
tys2
ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfaceType
ty IfaceCoercion
co)
= SDoc -> SDoc -> SDoc
if_print_coercions
(SDoc -> SDoc
parens (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"|>" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
(PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceType
ty)
ppr_ty PprPrec
ctxt_prec (IfaceCoercionTy IfaceCoercion
co)
= SDoc -> SDoc -> SDoc
if_print_coercions
(PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
ctxt_prec IfaceCoercion
co)
(String -> SDoc
text String
"<>")
defaultNonStandardVars :: Bool -> Bool -> IfaceType -> IfaceType
defaultNonStandardVars :: Bool -> Bool -> IfaceType -> IfaceType
defaultNonStandardVars Bool
do_runtimereps Bool
do_multiplicities IfaceType
ty = IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
forall a. FastStringEnv a
emptyFsEnv IfaceType
ty
where
go :: FastStringEnv IfaceType
-> IfaceType
-> IfaceType
go :: IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs (IfaceForAllTy (Bndr (IfaceTvBndr (FastString
var, IfaceType
var_kind)) ArgFlag
argf) IfaceType
ty)
| ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
, Just IfaceType
substituted_ty <- IfaceType -> Maybe IfaceType
check_substitution IfaceType
var_kind
= let subs' :: IfaceTySubst
subs' = IfaceTySubst -> FastString -> IfaceType -> IfaceTySubst
forall a. FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv IfaceTySubst
subs FastString
var IfaceType
substituted_ty
in IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs' IfaceType
ty
go IfaceTySubst
subs (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
= IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs IfaceForAllBndr
bndr) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
ty)
go IfaceTySubst
subs ty :: IfaceType
ty@(IfaceTyVar FastString
tv) = case IfaceTySubst -> FastString -> Maybe IfaceType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subs FastString
tv of
Just IfaceType
s -> IfaceType
s
Maybe IfaceType
Nothing -> IfaceType
ty
go IfaceTySubst
_ ty :: IfaceType
ty@(IfaceFreeTyVar CoVar
tv)
| Bool
do_runtimereps Bool -> Bool -> Bool
&& Type -> Bool
GHC.Core.Type.isRuntimeRepTy (CoVar -> Type
tyVarKind CoVar
tv)
, CoVar -> Bool
isMetaTyVar CoVar
tv
, CoVar -> Bool
isTyConableTyVar CoVar
tv
= IfaceType
liftedRep_ty
| Bool
do_multiplicities Bool -> Bool -> Bool
&& Type -> Bool
GHC.Core.Type.isMultiplicityTy (CoVar -> Type
tyVarKind CoVar
tv)
, CoVar -> Bool
isMetaTyVar CoVar
tv
, CoVar -> Bool
isTyConableTyVar CoVar
tv
= IfaceType
many_ty
| Bool
otherwise
= IfaceType
ty
go IfaceTySubst
subs (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
= IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)
go IfaceTySubst
subs (IfaceTupleTy TupleSort
sort PromotionFlag
is_prom IfaceAppArgs
tc_args)
= TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
sort PromotionFlag
is_prom (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)
go IfaceTySubst
subs (IfaceFunTy AnonArgFlag
af IfaceType
w IfaceType
arg IfaceType
res)
= AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
w) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
arg) (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
res)
go IfaceTySubst
subs (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
= IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
ts)
go IfaceTySubst
subs (IfaceCastTy IfaceType
x IfaceCoercion
co)
= IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
x) IfaceCoercion
co
go IfaceTySubst
_ ty :: IfaceType
ty@(IfaceLitTy {}) = IfaceType
ty
go IfaceTySubst
_ ty :: IfaceType
ty@(IfaceCoercionTy {}) = IfaceType
ty
go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr :: IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs (Bndr (IfaceIdBndr (IfaceType
w, FastString
n, IfaceType
t)) ArgFlag
argf)
= IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceIdBndr -> IfaceBndr
IfaceIdBndr (IfaceType
w, FastString
n, IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
t)) ArgFlag
argf
go_ifacebndr IfaceTySubst
subs (Bndr (IfaceTvBndr (FastString
n, IfaceType
t)) ArgFlag
argf)
= IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (FastString
n, IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
t)) ArgFlag
argf
go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs
go_args :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
_ IfaceAppArgs
IA_Nil = IfaceAppArgs
IA_Nil
go_args IfaceTySubst
subs (IA_Arg IfaceType
ty ArgFlag
argf IfaceAppArgs
args)
= IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceType -> IfaceType
go IfaceTySubst
subs IfaceType
ty) ArgFlag
argf (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
args)
check_substitution :: IfaceType -> Maybe IfaceType
check_substitution :: IfaceType -> Maybe IfaceType
check_substitution (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_)
| Bool
do_runtimereps, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
runtimeRepTyConKey = IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
liftedRep_ty
| Bool
do_multiplicities, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
multiplicityTyConKey = IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
many_ty
check_substitution IfaceType
_ = Maybe IfaceType
forall a. Maybe a
Nothing
liftedRep_ty :: IfaceType
liftedRep_ty :: IfaceType
liftedRep_ty =
IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
where
liftedRep :: IfaceTyCon
liftedRep :: IfaceTyCon
liftedRep = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
tc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon)
where tc_name :: IfExtName
tc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepTyCon
many_ty :: IfaceType
many_ty :: IfaceType
many_ty =
IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
IfaceAppArgs
IA_Nil
where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
manyDataConTyCon
hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes IfaceType -> SDoc
f IfaceType
ty
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitRuntimeReps ->
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
linearTypes ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
let do_runtimerep :: Bool
do_runtimerep = Bool -> Bool
not Bool
printExplicitRuntimeReps
do_multiplicity :: Bool
do_multiplicity = Bool -> Bool
not Bool
linearTypes
in if PprStyle -> Bool
userStyle PprStyle
sty
then IfaceType -> SDoc
f (Bool -> Bool -> IfaceType -> IfaceType
defaultNonStandardVars Bool
do_runtimerep Bool
do_multiplicity IfaceType
ty)
else IfaceType -> SDoc
f IfaceType
ty
instance Outputable IfaceAppArgs where
ppr :: IfaceAppArgs -> SDoc
ppr IfaceAppArgs
tca = IfaceAppArgs -> SDoc
pprIfaceAppArgs IfaceAppArgs
tca
pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
topPrec
pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprParendIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
appPrec
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
ctx_prec = IfaceAppArgs -> SDoc
go
where
go :: IfaceAppArgs -> SDoc
go :: IfaceAppArgs -> SDoc
go IfaceAppArgs
IA_Nil = SDoc
empty
go (IA_Arg IfaceType
t ArgFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
t, ArgFlag
argf) SDoc -> SDoc -> SDoc
<+> IfaceAppArgs -> SDoc
go IfaceAppArgs
ts
ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
t, ArgFlag
argf) =
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
case ArgFlag
argf of
ArgFlag
Required -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctx_prec IfaceType
t
ArgFlag
Specified | Bool
print_kinds
-> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec IfaceType
t
ArgFlag
Inferred | Bool
print_kinds
-> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
t)
ArgFlag
_ -> SDoc
empty
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
pprIfaceForAllPart [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
= ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllWhen [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
pprIfaceForAllPartMust [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
= ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllMust [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs SDoc
sdoc
= [SDoc] -> SDoc
sep [ [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs, SDoc
sdoc ]
ppr_iface_forall_part :: ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceType]
ctxt SDoc
sdoc
= [SDoc] -> SDoc
sep [ case ShowForAllFlag
show_forall of
ShowForAllFlag
ShowForAllMust -> [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
ShowForAllFlag
ShowForAllWhen -> [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
, [IfaceType] -> SDoc
pprIfaceContextArr [IfaceType]
ctxt
, SDoc
sdoc]
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = SDoc
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 :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [] = SDoc
empty
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs = String -> SDoc
text String
"forall" SDoc -> SDoc -> SDoc
<+> [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
tvs SDoc -> SDoc -> SDoc
<> SDoc
dot
pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
bndrs = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((FastString, IfaceCoercion) -> SDoc)
-> [(FastString, IfaceCoercion)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr [(FastString, IfaceCoercion)]
bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
case IfaceForAllBndr
bndr of
Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
Inferred ->
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)
Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
_ ->
IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
Bndr (IfaceIdBndr IfaceIdBndr
idv) ArgFlag
_ -> IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
idv
where
suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr :: (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (FastString
tv, IfaceCoercion
kind_co)
= SDoc -> SDoc
parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
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 -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
show_forall IfaceType
ty
= (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes IfaceType -> SDoc
ppr_fn IfaceType
ty
where
ppr_fn :: IfaceType -> SDoc
ppr_fn IfaceType
iface_ty =
let ([IfaceForAllBndr]
invis_tvs, [IfaceType]
theta, IfaceType
tau) = IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
iface_ty
([IfaceForAllBndr]
req_tvs, IfaceType
tau') = IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy IfaceType
tau
in ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
invis_tvs [IfaceType]
theta (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
req_tvs, IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
tau']
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitForalls ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_foralls ->
Bool -> SDoc -> SDoc
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
|| Bool
print_foralls) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
where
tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (FastString
_,IfaceType
kind)) argf
_)
= Bool -> Bool
not (IfaceType -> Bool
ifTypeIsVarFree IfaceType
kind)
tv_has_kind_var VarBndr IfaceBndr argf
_ = Bool
False
tv_is_required :: VarBndr tv 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 :: IfaceType -> 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 IfaceType
_
= SDoc -> SDoc
forall a. a -> a
id
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
ty2
= case IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2 of
([IfaceType]
arg_tys, Maybe IfaceType
Nothing)
-> Char -> SDoc
char Char
'\'' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceType
ty1 ([SDoc] -> SDoc
fsep
(SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
arg_tys)))))
([IfaceType]
arg_tys, Just IfaceType
tl)
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1)
Int
2 ([SDoc] -> SDoc
fsep [ SDoc
colon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty | IfaceType
ty <- [IfaceType]
arg_tys [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType
tl]])
where
gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
, IA_Arg IfaceType
_ ArgFlag
argf (IA_Arg IfaceType
ty1 ArgFlag
Required (IA_Arg IfaceType
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
, ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
, ([IfaceType]
args, Maybe IfaceType
tl) <- IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2
= (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
args, Maybe IfaceType
tl)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
= ([], Maybe IfaceType
forall a. Maybe a
Nothing)
gather IfaceType
ty = ([], IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
ty)
pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args
pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys =
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypeAbbreviations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_type_abbreviations ->
(Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
if | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
, IA_Arg (IfaceLitTy (IfaceStrTyLit FastString
n))
ArgFlag
Required (IA_Arg IfaceType
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
<> FastString -> SDoc
ftext FastString
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"::" SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty
| IfaceTupleTyCon Int
arity TupleSort
sort <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
, Bool -> Bool
not Bool
debug
, Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
-> PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
| IfaceSumTyCon Int
arity <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
-> Int -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum Int
arity (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
, Bool
False <- Bool
print_kinds
, IA_Arg IfaceType
_ ArgFlag
argf (IA_Arg IfaceType
ty1 ArgFlag
Required (IA_Arg IfaceType
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
, ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
-> PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
ty2
| IfaceTyCon -> IfaceAppArgs -> Bool
isIfaceTyConAppLiftedTypeKind IfaceTyCon
tc IfaceAppArgs
tys
, Bool
print_type_abbreviations
-> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
funTyConKey
, IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ArgFlag
Required IfaceAppArgs
args <- IfaceAppArgs
tys
, IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey
, Bool
print_type_abbreviations
-> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
parens SDoc
arrow) (((IfaceType, ArgFlag) -> SDoc) -> [(IfaceType, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) ([(IfaceType, ArgFlag)] -> [SDoc])
-> [(IfaceType, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceType, ArgFlag)])
-> IfaceAppArgs -> [(IfaceType, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
args)
| IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
, Bool -> Bool
not Bool
debug
-> String -> SDoc
text String
"(TypeError ...)"
| Just SDoc
doc <- PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc (IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
tys)
-> SDoc
doc
| Bool
otherwise
-> (PprPrec -> (IfaceType, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceType, ArgFlag)] -> SDoc
forall a.
(PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctxt_prec IfaceTyCon
tc ([(IfaceType, ArgFlag)] -> SDoc) -> [(IfaceType, ArgFlag)] -> SDoc
forall a b. (a -> b) -> a -> b
$
IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceType, ArgFlag)])
-> IfaceAppArgs -> [(IfaceType, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
tys
where
info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocStarIsType ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
False -> String -> SDoc
text String
"Type"
Bool
True -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
starPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
char Char
'★') (Char -> SDoc
char Char
'*')
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc [IfaceType]
args
| Bool
hetero_eq_tc
, [IfaceType
k1, IfaceType
k2, IfaceType
t1, IfaceType
t2] <- [IfaceType]
args
= SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k1, IfaceType
k2, IfaceType
t1, IfaceType
t2)
| Bool
hom_eq_tc
, [IfaceType
k, IfaceType
t1, IfaceType
t2] <- [IfaceType]
args
= SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k, IfaceType
k, IfaceType
t1, IfaceType
t2)
| Bool
otherwise
= Maybe SDoc
forall a. Maybe a
Nothing
where
homogeneous :: Bool
homogeneous = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
Bool -> Bool -> Bool
|| Bool
hetero_tc_used_homogeneously
where
hetero_tc_used_homogeneously :: Bool
hetero_tc_used_homogeneously
= case IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort (IfaceTyConInfo -> IfaceTyConSort)
-> IfaceTyConInfo -> IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc of
IfaceTyConSort
IfaceEqualityTyCon -> Bool
True
IfaceTyConSort
_other -> Bool
False
tc_name :: IfExtName
tc_name = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc
pp :: PprPrec -> IfaceType -> SDoc
pp = PprPrec -> IfaceType -> SDoc
ppr_ty
hom_eq_tc :: Bool
hom_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey
hetero_eq_tc :: Bool
hetero_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
nominal_eq_tc :: Bool
nominal_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey
Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey
print_equality :: (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType, IfaceType, IfaceType, IfaceType)
args =
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
(SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintEqualityRelations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_eqs ->
(PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
(Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
(IfaceType, IfaceType, IfaceType, IfaceType)
-> Bool -> Bool -> SDoc
print_equality' (IfaceType, IfaceType, IfaceType, IfaceType)
args Bool
print_kinds
(Bool
print_eqs Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug)
print_equality' :: (IfaceType, IfaceType, IfaceType, IfaceType)
-> Bool -> Bool -> SDoc
print_equality' (IfaceType
ki1, IfaceType
ki2, IfaceType
ty1, IfaceType
ty2) Bool
print_kinds Bool
print_eqs
|
Bool
print_eqs
= SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
|
Bool
nominal_eq_tc, Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (String -> SDoc
text String
"~")
|
Bool -> Bool
not Bool
homogeneous
= SDoc -> SDoc
ppr_infix_eq (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)
|
IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey, Bool
homogeneous
= let ki :: [SDoc]
ki | Bool
print_kinds = [PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ki1]
| Bool
otherwise = []
in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
coercibleTyCon)
([SDoc]
ki [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ty1, PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ty2])
| Bool
otherwise
= SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
where
ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq SDoc
eq_op = PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
eq_op
(IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty1 IfaceType
ki1) (IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty2 IfaceType
ki2)
where
pp_ty_ki :: IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty IfaceType
ki
| Bool
print_kinds
= SDoc -> SDoc
parens (PprPrec -> IfaceType -> SDoc
pp PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ki)
| Bool
otherwise
= PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ty
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
ctxt_prec IfaceTyCon
tc [IfaceCoercion]
tys =
(PprPrec -> (IfaceCoercion, 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 :: forall a.
(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
= PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec
| Bool -> Bool
not (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)))
= PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (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 :: Int -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum Int
_arity PromotionFlag
is_promoted IfaceAppArgs
args
=
let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
sumParens ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) [IfaceType]
args')
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort PromotionFlag
promoted IfaceAppArgs
args =
case PromotionFlag
promoted of
PromotionFlag
IsPromoted
-> let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
spaceIfPromoted :: SDoc -> SDoc
spaceIfPromoted = case [IfaceType]
args' of
IfaceType
arg0:[IfaceType]
_ -> IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceType
arg0
[IfaceType]
_ -> SDoc -> SDoc
forall a. a -> a
id
in [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
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 ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
args'))
PromotionFlag
NotPromoted
| TupleSort
ConstraintTuple <- TupleSort
sort
, IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
-> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
sigPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"() :: Constraint"
| Bool
otherwise
->
let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
args' :: [IfaceType]
args' = case TupleSort
sort of
TupleSort
UnboxedTuple -> Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
TupleSort
_ -> [IfaceType]
tys
in
[IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
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 ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
args')
where
ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
args_wo_runtime_reps SDoc
ppr_args_w_parens
| [IfaceType
_] <- [IfaceType]
args_wo_runtime_reps
, TupleSort
BoxedTuple <- TupleSort
sort
= let unit_tc_info :: IfaceTyConInfo
unit_tc_info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
IfaceNormalTyCon
unit_tc :: IfaceTyCon
unit_tc = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (TupleSort -> Int -> IfExtName
tupleTyConName TupleSort
sort Int
1) IfaceTyConInfo
unit_tc_info in
PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec (IfaceType -> SDoc) -> IfaceType -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceAppArgs -> IfaceType
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 FastString
n) = String -> SDoc
text (FastString -> String
forall a. Show a => a -> String
show FastString
n)
pprIfaceTyLit (IfaceCharTyLit Char
c) = String -> SDoc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec
pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprParendIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
appPrec
ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
_ (IfaceReflCo IfaceType
ty) = SDoc -> SDoc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_ (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
IfaceMRefl)
= SDoc -> SDoc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfaceType
ty (IfaceMCo IfaceCoercion
co))
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
(String -> SDoc
text String
"GRefl" SDoc -> SDoc -> SDoc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprParendIfaceType IfaceType
ty) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r IfaceCoercion
cow 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 -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow IfaceCoercion
co2)
where
ppr_fun_tail :: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow' (IfaceFunCo Role
r IfaceCoercion
cow IfaceCoercion
co1 IfaceCoercion
co2)
= (IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
cow' 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 -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow IfaceCoercion
co2
ppr_fun_tail IfaceCoercion
cow' IfaceCoercion
other_co
= [IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
cow' SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]
coercionArrow :: IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
w = SDoc -> SDoc
mulArrow (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
w)
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
$
[(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
where
([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co
split_co :: IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co (IfaceForAllCo (IfaceTvBndr (FastString
name, IfaceType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)(FastString, IfaceCoercion)
-> [(FastString, IfaceCoercion)] -> [(FastString, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co (IfaceForAllCo (IfaceIdBndr (IfaceType
_, FastString
name, IfaceType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
= let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)(FastString, IfaceCoercion)
-> [(FastString, IfaceCoercion)] -> [(FastString, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
split_co IfaceCoercion
co' = ([], IfaceCoercion
co')
ppr_co PprPrec
_ (IfaceFreeCoVar CoVar
covar) = CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo FastString
covar) = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
covar
ppr_co PprPrec
_ (IfaceHoleCo CoVar
covar) = SDoc -> SDoc
braces (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
covar)
ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfaceType
ty1 IfaceType
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
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty1 SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty2 ])
ppr_co PprPrec
ctxt_prec (IfaceInstCo IfaceCoercion
co IfaceCoercion
ty)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
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 FastString
tc [IfaceCoercion]
cos)
= PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
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 Int
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 (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Sym") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)
= let ppr_trans :: IfaceCoercion -> [SDoc]
ppr_trans (IfaceTransCo IfaceCoercion
c1 IfaceCoercion
c2) = SDoc
semi SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
c1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
c2
ppr_trans IfaceCoercion
c = [SDoc
semi SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
c]
in PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
co2)
ppr_co PprPrec
ctxt_prec (IfaceNthCo Int
d IfaceCoercion
co)
= PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Nth:" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
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, Int -> SDoc -> SDoc
nest Int
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 (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)
instance Outputable IfaceTyConInfo where
ppr :: IfaceTyConInfo -> SDoc
ppr (IfaceTyConInfo { ifaceTyConIsPromoted :: IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted = PromotionFlag
prom
, ifaceTyConSort :: IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort = IfaceTyConSort
sort })
= SDoc -> SDoc
angleBrackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PromotionFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr PromotionFlag
prom SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> IfaceTyConSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyConSort
sort
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 Int
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 -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
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 Int
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 -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity
put_ BinHandle
bh IfaceTyConSort
IfaceEqualityTyCon = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
get :: BinHandle -> IO IfaceTyConSort
get BinHandle
bh = do
Word8
n <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
n of
Word8
0 -> IfaceTyConSort -> IO IfaceTyConSort
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
Word8
1 -> Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (Int -> TupleSort -> IfaceTyConSort)
-> IO Int -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
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 -> Int -> IfaceTyConSort
IfaceSumTyCon (Int -> IfaceTyConSort) -> IO Int -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
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
mkIfaceTyConInfo (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 FastString
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 -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
n
put_ BinHandle
bh (IfaceCharTyLit Char
n) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Char -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
n
get :: BinHandle -> IO IfaceTyLit
get BinHandle
bh =
do Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do { Integer
n <- 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 { FastString
n <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceTyLit
IfaceStrTyLit FastString
n) }
Word8
3 -> do { Char
n <- BinHandle -> IO Char
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IfaceTyLit
IfaceCharTyLit Char
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 IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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
IfaceType
t <- BinHandle -> IO IfaceType
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
$! IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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 :: [IfaceType] -> SDoc
pprIfaceContextArr [] = SDoc
empty
pprIfaceContextArr [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
pred SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContextArr [IfaceType]
preds = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext :: PprPrec -> [IfaceType] -> SDoc
pprIfaceContext PprPrec
_ [] = String -> SDoc
text String
"()"
pprIfaceContext PprPrec
prec [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec IfaceType
pred
pprIfaceContext PprPrec
_ [IfaceType]
preds = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds
ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds :: [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds = SDoc -> SDoc
parens ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceType]
preds)))
instance Binary IfaceType where
put_ :: BinHandle -> IfaceType -> IO ()
put_ BinHandle
_ (IfaceFreeTyVar CoVar
tv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeTyVar" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
tv)
put_ BinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> IfaceForAllBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceForAllBndr
aa
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ab
put_ BinHandle
bh (IfaceTyVar FastString
ad) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ad
put_ BinHandle
bh (IfaceAppTy IfaceType
ae IfaceAppArgs
af) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ae
BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
put_ BinHandle
bh (IfaceFunTy AnonArgFlag
af IfaceType
aw IfaceType
ag IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
aw
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ag
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ah
put_ BinHandle
bh (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5; 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 IfaceType
a IfaceCoercion
b)
= do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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 IfaceType
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
IfaceType
ab <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab)
Word8
1 -> do FastString
ad <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceType
IfaceTyVar FastString
ad)
Word8
2 -> do IfaceType
ae <- BinHandle -> IO IfaceType
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
IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
ae IfaceAppArgs
af)
Word8
3 -> do AnonArgFlag
af <- BinHandle -> IO AnonArgFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
aw <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
ag <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
ah <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af IfaceType
aw IfaceType
ag IfaceType
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
; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
Word8
6 -> do { IfaceType
a <- BinHandle -> IO IfaceType
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
; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy IfaceType
a IfaceCoercion
b) }
Word8
7 -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceType
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
; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
Word8
_ -> do IfaceTyLit
n <- BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfaceType
IfaceLitTy IfaceTyLit
n)
instance Binary IfaceMCoercion where
put_ :: BinHandle -> IfaceMCoercion -> IO ()
put_ BinHandle
bh IfaceMCoercion
IfaceMRefl =
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (IfaceMCo IfaceCoercion
co) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
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 IfaceType
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a
put_ BinHandle
bh (IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
b
BinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
put_ BinHandle
bh (IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
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
w
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 FastString
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
d) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
c
BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
d
put_ BinHandle
bh (IfaceSymCo IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
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 Int
a IfaceCoercion
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
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 FastString
a [IfaceCoercion]
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
put_ BinHandle
_ (IfaceFreeCoVar CoVar
cv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
put_ BinHandle
_ (IfaceHoleCo CoVar
cv)
= String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
get :: BinHandle -> IO IfaceCoercion
get BinHandle
bh = do
Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
tag of
Word8
1 -> do IfaceType
a <- BinHandle -> IO IfaceType
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
$ IfaceType -> IfaceCoercion
IfaceReflCo IfaceType
a
Word8
2 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
b <- BinHandle -> IO IfaceType
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 -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c
Word8
3 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceCoercion
w <- 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
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 -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
w 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 FastString
a <- BinHandle -> IO FastString
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
$ FastString -> IfaceCoercion
IfaceCoVarCo FastString
a
Word8
8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
b <- BinHandle -> IO Int
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 -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
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
IfaceType
c <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceType
d <- BinHandle -> IO IfaceType
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 -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
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 Int
a <- BinHandle -> IO Int
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
$ Int -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Int
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 FastString
a <- BinHandle -> IO FastString
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
$ FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
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 (IfacePhantomProv IfaceCoercion
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
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
2
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
3
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 -> 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
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
IfaceProofIrrelProv IfaceCoercion
a
Word8
3 -> 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 IfaceType -> IO ()
put_ BinHandle
bh DefMethSpec IfaceType
VanillaDM = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (GenericDM IfaceType
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
t
get :: BinHandle -> IO (DefMethSpec IfaceType)
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> DefMethSpec IfaceType -> IO (DefMethSpec IfaceType)
forall (m :: * -> *) a. Monad m => a -> m a
return DefMethSpec IfaceType
forall ty. DefMethSpec ty
VanillaDM
Word8
_ -> do { IfaceType
t <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; DefMethSpec IfaceType -> IO (DefMethSpec IfaceType)
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> DefMethSpec IfaceType
forall ty. ty -> DefMethSpec ty
GenericDM IfaceType
t) }
instance NFData IfaceType where
rnf :: IfaceType -> ()
rnf = \case
IfaceFreeTyVar CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
`seq` ()
IfaceTyVar FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
IfaceLitTy IfaceTyLit
f1 -> IfaceTyLit -> ()
forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
IfaceAppTy IfaceType
f1 IfaceAppArgs
f2 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1 () -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
IfaceFunTy AnonArgFlag
f1 IfaceType
f2 IfaceType
f3 IfaceType
f4 -> AnonArgFlag
f1 AnonArgFlag -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2 () -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f3 () -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f4
IfaceForAllTy IfaceForAllBndr
f1 IfaceType
f2 -> IfaceForAllBndr
f1 IfaceForAllBndr -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
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 IfaceType
f1 IfaceCoercion
f2 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
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
f3 -> TupleSort
f1 TupleSort -> () -> ()
`seq` PromotionFlag
f2 PromotionFlag -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3
instance NFData IfaceTyLit where
rnf :: IfaceTyLit -> ()
rnf = \case
IfaceNumTyLit Integer
f1 -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
f1
IfaceStrTyLit FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
IfaceCharTyLit Char
f1 -> Char -> ()
forall a. NFData a => a -> ()
rnf Char
f1
instance NFData IfaceCoercion where
rnf :: IfaceCoercion -> ()
rnf = \case
IfaceReflCo IfaceType
f1 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1
IfaceGReflCo Role
f1 IfaceType
f2 IfaceMCoercion
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2 () -> () -> ()
`seq` IfaceMCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 IfaceCoercion
f4 -> Role
f1 Role -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f4
IfaceTyConAppCo Role
f1 IfaceTyCon
f2 [IfaceCoercion]
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f2 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
IfaceAppCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceForAllCo IfaceBndr
f1 IfaceCoercion
f2 IfaceCoercion
f3 -> IfaceBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceBndr
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3
IfaceCoVarCo FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
IfaceAxiomInstCo IfExtName
f1 Int
f2 [IfaceCoercion]
f3 -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
f1 () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
f2 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
IfaceAxiomRuleCo FastString
f1 [IfaceCoercion]
f2 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
IfaceUnivCo IfaceUnivCoProv
f1 Role
f2 IfaceType
f3 IfaceType
f4 -> IfaceUnivCoProv -> ()
forall a. NFData a => a -> ()
rnf IfaceUnivCoProv
f1 () -> () -> ()
`seq` Role
f2 Role -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f3 () -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f4
IfaceSymCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceTransCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceNthCo Int
f1 IfaceCoercion
f2 -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceLRCo LeftOrRight
f1 IfaceCoercion
f2 -> LeftOrRight
f1 LeftOrRight -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceInstCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
IfaceKindCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceSubCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
IfaceFreeCoVar CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
`seq` ()
IfaceHoleCo CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
`seq` ()
instance NFData IfaceUnivCoProv where
rnf :: IfaceUnivCoProv -> ()
rnf IfaceUnivCoProv
x = IfaceUnivCoProv -> () -> ()
seq IfaceUnivCoProv
x ()
instance NFData IfaceMCoercion where
rnf :: IfaceMCoercion -> ()
rnf IfaceMCoercion
x = IfaceMCoercion -> () -> ()
seq IfaceMCoercion
x ()
instance NFData IfaceOneShot where
rnf :: IfaceOneShot -> ()
rnf IfaceOneShot
x = IfaceOneShot -> () -> ()
seq IfaceOneShot
x ()
instance NFData IfaceTyConSort where
rnf :: IfaceTyConSort -> ()
rnf = \case
IfaceTyConSort
IfaceNormalTyCon -> ()
IfaceTupleTyCon Int
arity TupleSort
sort -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity () -> () -> ()
`seq` TupleSort
sort TupleSort -> () -> ()
`seq` ()
IfaceSumTyCon Int
arity -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity
IfaceTyConSort
IfaceEqualityTyCon -> ()
instance NFData IfaceTyConInfo where
rnf :: IfaceTyConInfo -> ()
rnf (IfaceTyConInfo PromotionFlag
f IfaceTyConSort
s) = PromotionFlag
f PromotionFlag -> () -> ()
`seq` IfaceTyConSort -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConSort
s
instance NFData IfaceTyCon where
rnf :: IfaceTyCon -> ()
rnf (IfaceTyCon IfExtName
nm IfaceTyConInfo
info) = IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
nm () -> () -> ()
`seq` IfaceTyConInfo -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConInfo
info
instance NFData IfaceBndr where
rnf :: IfaceBndr -> ()
rnf = \case
IfaceIdBndr IfaceIdBndr
id_bndr -> IfaceIdBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceIdBndr
id_bndr
IfaceTvBndr IfaceTvBndr
tv_bndr -> IfaceTvBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceTvBndr
tv_bndr
instance NFData IfaceAppArgs where
rnf :: IfaceAppArgs -> ()
rnf = \case
IfaceAppArgs
IA_Nil -> ()
IA_Arg IfaceType
f1 ArgFlag
f2 IfaceAppArgs
f3 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1 () -> () -> ()
`seq` ArgFlag
f2 ArgFlag -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3