{-# LANGUAGE CPP #-}
{-# LANGUAGE Strict #-}
module GHC.CoreToIface
(
toIfaceTvBndr
, toIfaceTvBndrs
, toIfaceIdBndr
, toIfaceBndr
, toIfaceForAllBndr
, toIfaceTyCoVarBinders
, toIfaceTyVar
, toIfaceType, toIfaceTypeX
, toIfaceKind
, toIfaceTcArgs
, toIfaceTyCon
, toIfaceTyCon_name
, toIfaceTyLit
, tidyToIfaceType
, tidyToIfaceContext
, tidyToIfaceTcArgs
, toIfaceCoercion, toIfaceCoercionX
, patSynToIfaceDecl
, toIfaceExpr
, toIfaceBang
, toIfaceSrcBang
, toIfaceLetBndr
, toIfaceIdDetails
, toIfaceIdInfo
, toIfUnfolding
, toIfaceTickish
, toIfaceBind
, toIfaceAlt
, toIfaceCon
, toIfaceApp
, toIfaceVar
, toIfaceLFInfo
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Driver.Ppr
import GHC.Iface.Syntax
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.StgToCmm.Types
import GHC.Core
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
import GHC.Builtin.Types ( heqTyCon )
import GHC.Types.Id.Make ( noinlineIdName )
import GHC.Builtin.Names
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.PatSyn
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Tickish
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Tidy ( tidyCo )
import GHC.Types.Demand ( isTopSig )
import GHC.Types.Cpr ( topCprSig )
import Data.Maybe ( catMaybes )
toIfaceTvBndr :: TyVar -> IfaceTvBndr
toIfaceTvBndr :: CoVar -> IfaceTvBndr
toIfaceTvBndr = VarSet -> CoVar -> IfaceTvBndr
toIfaceTvBndrX VarSet
emptyVarSet
toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr
toIfaceTvBndrX :: VarSet -> CoVar -> IfaceTvBndr
toIfaceTvBndrX VarSet
fr CoVar
tyvar = ( OccName -> FastString
occNameFS (forall a. NamedThing a => a -> OccName
getOccName CoVar
tyvar)
, VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr (CoVar -> Kind
tyVarKind CoVar
tyvar)
)
toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
toIfaceTvBndrs :: [CoVar] -> [IfaceTvBndr]
toIfaceTvBndrs = forall a b. (a -> b) -> [a] -> [b]
map CoVar -> IfaceTvBndr
toIfaceTvBndr
toIfaceIdBndr :: Id -> IfaceIdBndr
toIfaceIdBndr :: CoVar -> IfaceIdBndr
toIfaceIdBndr = VarSet -> CoVar -> IfaceIdBndr
toIfaceIdBndrX VarSet
emptyVarSet
toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
toIfaceIdBndrX VarSet
fr CoVar
covar = ( Kind -> IfaceType
toIfaceType (CoVar -> Kind
idMult CoVar
covar)
, OccName -> FastString
occNameFS (forall a. NamedThing a => a -> OccName
getOccName CoVar
covar)
, VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr (CoVar -> Kind
varType CoVar
covar)
)
toIfaceBndr :: Var -> IfaceBndr
toIfaceBndr :: CoVar -> IfaceBndr
toIfaceBndr CoVar
var
| CoVar -> Bool
isId CoVar
var = IfaceIdBndr -> IfaceBndr
IfaceIdBndr (CoVar -> IfaceIdBndr
toIfaceIdBndr CoVar
var)
| Bool
otherwise = IfaceTvBndr -> IfaceBndr
IfaceTvBndr (CoVar -> IfaceTvBndr
toIfaceTvBndr CoVar
var)
toIfaceBndrX :: VarSet -> Var -> IfaceBndr
toIfaceBndrX :: VarSet -> CoVar -> IfaceBndr
toIfaceBndrX VarSet
fr CoVar
var
| CoVar -> Bool
isId CoVar
var = IfaceIdBndr -> IfaceBndr
IfaceIdBndr (VarSet -> CoVar -> IfaceIdBndr
toIfaceIdBndrX VarSet
fr CoVar
var)
| Bool
otherwise = IfaceTvBndr -> IfaceBndr
IfaceTvBndr (VarSet -> CoVar -> IfaceTvBndr
toIfaceTvBndrX VarSet
fr CoVar
var)
toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder :: forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder (Bndr CoVar
tv vis
vis) = forall var argf. var -> argf -> VarBndr var argf
Bndr (CoVar -> IfaceBndr
toIfaceBndr CoVar
tv) vis
vis
toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders :: forall vis. [VarBndr CoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders = forall a b. (a -> b) -> [a] -> [b]
map forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder
toIfaceKind :: Type -> IfaceType
toIfaceKind :: Kind -> IfaceType
toIfaceKind = Kind -> IfaceType
toIfaceType
toIfaceType :: Type -> IfaceType
toIfaceType :: Kind -> IfaceType
toIfaceType = VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
emptyVarSet
toIfaceTypeX :: VarSet -> Type -> IfaceType
toIfaceTypeX :: VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr (TyVarTy CoVar
tv)
| CoVar
tv CoVar -> VarSet -> Bool
`elemVarSet` VarSet
fr = CoVar -> IfaceType
IfaceFreeTyVar CoVar
tv
| Bool
otherwise = FastString -> IfaceType
IfaceTyVar (CoVar -> FastString
toIfaceTyVar CoVar
tv)
toIfaceTypeX VarSet
fr ty :: Kind
ty@(AppTy {}) =
let (Kind
head, [Kind]
args) = Kind -> (Kind, [Kind])
splitAppTys Kind
ty
in IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
head) (VarSet -> Kind -> [Kind] -> IfaceAppArgs
toIfaceAppTyArgsX VarSet
fr Kind
head [Kind]
args)
toIfaceTypeX VarSet
_ (LitTy TyLit
n) = IfaceTyLit -> IfaceType
IfaceLitTy (TyLit -> IfaceTyLit
toIfaceTyLit TyLit
n)
toIfaceTypeX VarSet
fr (ForAllTy TyCoVarBinder
b Kind
t) = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
fr TyCoVarBinder
b)
(VarSet -> Kind -> IfaceType
toIfaceTypeX (VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
b) Kind
t)
toIfaceTypeX VarSet
fr (FunTy { ft_arg :: Kind -> Kind
ft_arg = Kind
t1, ft_mult :: Kind -> Kind
ft_mult = Kind
w, ft_res :: Kind -> Kind
ft_res = Kind
t2, ft_af :: Kind -> AnonArgFlag
ft_af = AnonArgFlag
af })
= AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
w) (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t1) (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t2)
toIfaceTypeX VarSet
fr (CastTy Kind
ty KindCoercion
co) = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
ty) (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr KindCoercion
co)
toIfaceTypeX VarSet
fr (CoercionTy KindCoercion
co) = IfaceCoercion -> IfaceType
IfaceCoercionTy (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr KindCoercion
co)
toIfaceTypeX VarSet
fr (TyConApp TyCon
tc [Kind]
tys)
| Just TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
, Arity
n_tys forall a. Eq a => a -> a -> Bool
== Arity
arity
= TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
sort PromotionFlag
NotPromoted (VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Kind]
tys)
| Just DataCon
dc <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
, DataCon -> Bool
isBoxedTupleDataCon DataCon
dc
, Arity
n_tys forall a. Eq a => a -> a -> Bool
== Arity
2forall a. Num a => a -> a -> a
*Arity
arity
= TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
BoxedTuple PromotionFlag
IsPromoted (VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc (forall a. Arity -> [a] -> [a]
drop Arity
arity [Kind]
tys))
| TyCon
tc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ TyCon
eqPrimTyCon, TyCon
eqReprPrimTyCon, TyCon
heqTyCon ]
, (Kind
k1:Kind
k2:[Kind]
_) <- [Kind]
tys
= let info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
sort
sort :: IfaceTyConSort
sort | Kind
k1 Kind -> Kind -> Bool
`eqType` Kind
k2 = IfaceTyConSort
IfaceEqualityTyCon
| Bool
otherwise = IfaceTyConSort
IfaceNormalTyCon
in IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (Name -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (TyCon -> Name
tyConName TyCon
tc) IfaceTyConInfo
info) (VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Kind]
tys)
| Bool
otherwise
= IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) (VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Kind]
tys)
where
arity :: Arity
arity = TyCon -> Arity
tyConArity TyCon
tc
n_tys :: Arity
n_tys = forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Kind]
tys
toIfaceTyVar :: TyVar -> FastString
toIfaceTyVar :: CoVar -> FastString
toIfaceTyVar = OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> OccName
getOccName
toIfaceCoVar :: CoVar -> FastString
toIfaceCoVar :: CoVar -> FastString
toIfaceCoVar = OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> OccName
getOccName
toIfaceForAllBndr :: (VarBndr TyCoVar flag) -> (VarBndr IfaceBndr flag)
toIfaceForAllBndr :: forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceForAllBndr = forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
emptyVarSet
toIfaceForAllBndrX :: VarSet -> (VarBndr TyCoVar flag) -> (VarBndr IfaceBndr flag)
toIfaceForAllBndrX :: forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
fr (Bndr CoVar
v flag
vis) = forall var argf. var -> argf -> VarBndr var argf
Bndr (VarSet -> CoVar -> IfaceBndr
toIfaceBndrX VarSet
fr CoVar
v) flag
vis
toIfaceTyCon :: TyCon -> IfaceTyCon
toIfaceTyCon :: TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc
= Name -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon Name
tc_name IfaceTyConInfo
info
where
tc_name :: Name
tc_name = TyCon -> Name
tyConName TyCon
tc
info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
sort
promoted :: PromotionFlag
promoted | TyCon -> Bool
isPromotedDataCon TyCon
tc = PromotionFlag
IsPromoted
| Bool
otherwise = PromotionFlag
NotPromoted
tupleSort :: TyCon -> Maybe IfaceTyConSort
tupleSort :: TyCon -> Maybe IfaceTyConSort
tupleSort TyCon
tc' =
case TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc' of
Just TupleSort
UnboxedTuple -> let arity :: Arity
arity = TyCon -> Arity
tyConArity TyCon
tc' forall a. Integral a => a -> a -> a
`div` Arity
2
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Arity -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Arity
arity TupleSort
UnboxedTuple
Just TupleSort
sort -> let arity :: Arity
arity = TyCon -> Arity
tyConArity TyCon
tc'
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Arity -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Arity
arity TupleSort
sort
Maybe TupleSort
Nothing -> forall a. Maybe a
Nothing
sort :: IfaceTyConSort
sort
| Just IfaceTyConSort
tsort <- TyCon -> Maybe IfaceTyConSort
tupleSort TyCon
tc = IfaceTyConSort
tsort
| Just DataCon
dcon <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
, let tc' :: TyCon
tc' = DataCon -> TyCon
dataConTyCon DataCon
dcon
, Just IfaceTyConSort
tsort <- TyCon -> Maybe IfaceTyConSort
tupleSort TyCon
tc' = IfaceTyConSort
tsort
| TyCon -> Bool
isUnboxedSumTyCon TyCon
tc
, Just [DataCon]
cons <- TyCon -> Maybe [DataCon]
tyConDataCons_maybe TyCon
tc = Arity -> IfaceTyConSort
IfaceSumTyCon (forall (t :: * -> *) a. Foldable t => t a -> Arity
length [DataCon]
cons)
| Bool
otherwise = IfaceTyConSort
IfaceNormalTyCon
toIfaceTyCon_name :: Name -> IfaceTyCon
toIfaceTyCon_name :: Name -> IfaceTyCon
toIfaceTyCon_name Name
n = Name -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon Name
n IfaceTyConInfo
info
where info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
toIfaceTyLit :: TyLit -> IfaceTyLit
toIfaceTyLit :: TyLit -> IfaceTyLit
toIfaceTyLit (NumTyLit Integer
x) = Integer -> IfaceTyLit
IfaceNumTyLit Integer
x
toIfaceTyLit (StrTyLit FastString
x) = FastString -> IfaceTyLit
IfaceStrTyLit FastString
x
toIfaceTyLit (CharTyLit Char
x) = Char -> IfaceTyLit
IfaceCharTyLit Char
x
toIfaceCoercion :: Coercion -> IfaceCoercion
toIfaceCoercion :: KindCoercion -> IfaceCoercion
toIfaceCoercion = VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
emptyVarSet
toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX :: VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr KindCoercion
co
= KindCoercion -> IfaceCoercion
go KindCoercion
co
where
go_mco :: MCoercion -> IfaceMCoercion
go_mco MCoercion
MRefl = IfaceMCoercion
IfaceMRefl
go_mco (MCo KindCoercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo forall a b. (a -> b) -> a -> b
$ KindCoercion -> IfaceCoercion
go KindCoercion
co
go :: KindCoercion -> IfaceCoercion
go (Refl Kind
ty) = IfaceType -> IfaceCoercion
IfaceReflCo (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
ty)
go (GRefl Role
r Kind
ty MCoercion
mco) = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
ty) (MCoercion -> IfaceMCoercion
go_mco MCoercion
mco)
go (CoVarCo CoVar
cv)
| CoVar
cv CoVar -> VarSet -> Bool
`elemVarSet` VarSet
fr = CoVar -> IfaceCoercion
IfaceFreeCoVar CoVar
cv
| Bool
otherwise = FastString -> IfaceCoercion
IfaceCoVarCo (CoVar -> FastString
toIfaceCoVar CoVar
cv)
go (HoleCo CoercionHole
h) = CoVar -> IfaceCoercion
IfaceHoleCo (CoercionHole -> CoVar
coHoleCoVar CoercionHole
h)
go (AppCo KindCoercion
co1 KindCoercion
co2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)
go (SymCo KindCoercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSymCo (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go (TransCo KindCoercion
co1 KindCoercion
co2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)
go (NthCo Role
_r Arity
d KindCoercion
co) = Arity -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Arity
d (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go (LRCo LeftOrRight
lr KindCoercion
co) = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go (InstCo KindCoercion
co KindCoercion
arg) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (KindCoercion -> IfaceCoercion
go KindCoercion
co) (KindCoercion -> IfaceCoercion
go KindCoercion
arg)
go (KindCo KindCoercion
c) = IfaceCoercion -> IfaceCoercion
IfaceKindCo (KindCoercion -> IfaceCoercion
go KindCoercion
c)
go (SubCo KindCoercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSubCo (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go (AxiomRuleCo CoAxiomRule
co [KindCoercion]
cs) = FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo (CoAxiomRule -> FastString
coaxrName CoAxiomRule
co) (forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cs)
go (AxiomInstCo CoAxiom Branched
c Arity
i [KindCoercion]
cs) = Name -> Arity -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo (forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
c) Arity
i (forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cs)
go (UnivCo UnivCoProvenance
p Role
r Kind
t1 Kind
t2) = IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo (UnivCoProvenance -> IfaceUnivCoProv
go_prov UnivCoProvenance
p) Role
r
(VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t1)
(VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t2)
go (TyConAppCo Role
r TyCon
tc [KindCoercion]
cos)
| TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funTyConKey
, [KindCoercion
_,KindCoercion
_,KindCoercion
_,KindCoercion
_, KindCoercion
_] <- [KindCoercion]
cos = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toIfaceCoercion" SDoc
empty
| Bool
otherwise =
Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) (forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cos)
go (FunCo Role
r KindCoercion
w KindCoercion
co1 KindCoercion
co2) = Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (KindCoercion -> IfaceCoercion
go KindCoercion
w) (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)
go (ForAllCo CoVar
tv KindCoercion
k KindCoercion
co) = IfaceBndr -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceForAllCo (CoVar -> IfaceBndr
toIfaceBndr CoVar
tv)
(VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' KindCoercion
k)
(VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' KindCoercion
co)
where
fr' :: VarSet
fr' = VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` CoVar
tv
go_prov :: UnivCoProvenance -> IfaceUnivCoProv
go_prov :: UnivCoProvenance -> IfaceUnivCoProv
go_prov (PhantomProv KindCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go_prov (ProofIrrelProv KindCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (KindCoercion -> IfaceCoercion
go KindCoercion
co)
go_prov (PluginProv String
str) = String -> IfaceUnivCoProv
IfacePluginProv String
str
go_prov (CorePrepProv Bool
b) = Bool -> IfaceUnivCoProv
IfaceCorePrepProv Bool
b
toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs :: TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgs = VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
emptyVarSet
toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX :: VarSet -> TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Kind]
ty_args = VarSet -> Kind -> [Kind] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (TyCon -> Kind
tyConKind TyCon
tc) [Kind]
ty_args
toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX :: VarSet -> Kind -> [Kind] -> IfaceAppArgs
toIfaceAppTyArgsX VarSet
fr Kind
ty [Kind]
ty_args = VarSet -> Kind -> [Kind] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (HasDebugCallStack => Kind -> Kind
typeKind Kind
ty) [Kind]
ty_args
toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs
toIfaceAppArgsX :: VarSet -> Kind -> [Kind] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr Kind
kind [Kind]
ty_args
= TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go (InScopeSet -> TCvSubst
mkEmptyTCvSubst InScopeSet
in_scope) Kind
kind [Kind]
ty_args
where
in_scope :: InScopeSet
in_scope = VarSet -> InScopeSet
mkInScopeSet ([Kind] -> VarSet
tyCoVarsOfTypes [Kind]
ty_args)
go :: TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go TCvSubst
_ Kind
_ [] = IfaceAppArgs
IA_Nil
go TCvSubst
env Kind
ty [Kind]
ts
| Just Kind
ty' <- Kind -> Maybe Kind
coreView Kind
ty
= TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go TCvSubst
env Kind
ty' [Kind]
ts
go TCvSubst
env (ForAllTy (Bndr CoVar
tv ArgFlag
vis) Kind
res) (Kind
t:[Kind]
ts)
= IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t' ArgFlag
vis IfaceAppArgs
ts'
where
t' :: IfaceType
t' = VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t
ts' :: IfaceAppArgs
ts' = TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go (TCvSubst -> CoVar -> Kind -> TCvSubst
extendTCvSubst TCvSubst
env CoVar
tv Kind
t) Kind
res [Kind]
ts
go TCvSubst
env (FunTy { ft_af :: Kind -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_res :: Kind -> Kind
ft_res = Kind
res }) (Kind
t:[Kind]
ts)
= IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t) ArgFlag
argf (TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go TCvSubst
env Kind
res [Kind]
ts)
where
argf :: ArgFlag
argf = case AnonArgFlag
af of
AnonArgFlag
VisArg -> ArgFlag
Required
AnonArgFlag
InvisArg -> ArgFlag
Inferred
go TCvSubst
env Kind
ty ts :: [Kind]
ts@(Kind
t1:[Kind]
ts1)
| Bool -> Bool
not (TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
env)
= TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go (TCvSubst -> TCvSubst
zapTCvSubst TCvSubst
env) (HasCallStack => TCvSubst -> Kind -> Kind
substTy TCvSubst
env Kind
ty) [Kind]
ts
| Bool
otherwise
=
WARN( True, ppr kind $$ ppr ty_args )
IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t1) ArgFlag
Required (TCvSubst -> Kind -> [Kind] -> IfaceAppArgs
go TCvSubst
env Kind
ty [Kind]
ts1)
tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType :: TidyEnv -> Kind -> IfaceType
tidyToIfaceType TidyEnv
env Kind
ty = Kind -> IfaceType
toIfaceType (TidyEnv -> Kind -> Kind
tidyType TidyEnv
env Kind
ty)
tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Kind] -> IfaceAppArgs
tidyToIfaceTcArgs TidyEnv
env TyCon
tc [Kind]
tys = TyCon -> [Kind] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc (TidyEnv -> [Kind] -> [Kind]
tidyTypes TidyEnv
env [Kind]
tys)
tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
tidyToIfaceContext :: TidyEnv -> [Kind] -> IfaceContext
tidyToIfaceContext TidyEnv
env [Kind]
theta = forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Kind -> IfaceType
tidyToIfaceType TidyEnv
env) [Kind]
theta
patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
ps
= IfacePatSyn { ifName :: Name
ifName = forall a. NamedThing a => a -> Name
getName forall a b. (a -> b) -> a -> b
$ PatSyn
ps
, ifPatMatcher :: (Name, Bool)
ifPatMatcher = forall {a} {b} {b}. (a, b, b) -> (a, b)
to_if_pr (PatSyn -> PatSynMatcher
patSynMatcher PatSyn
ps)
, ifPatBuilder :: Maybe (Name, Bool)
ifPatBuilder = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {b} {b}. (a, b, b) -> (a, b)
to_if_pr (PatSyn -> PatSynBuilder
patSynBuilder PatSyn
ps)
, ifPatIsInfix :: Bool
ifPatIsInfix = PatSyn -> Bool
patSynIsInfix PatSyn
ps
, ifPatUnivBndrs :: [IfaceForAllSpecBndr]
ifPatUnivBndrs = forall a b. (a -> b) -> [a] -> [b]
map forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceForAllBndr [VarBndr CoVar Specificity]
univ_bndrs'
, ifPatExBndrs :: [IfaceForAllSpecBndr]
ifPatExBndrs = forall a b. (a -> b) -> [a] -> [b]
map forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceForAllBndr [VarBndr CoVar Specificity]
ex_bndrs'
, ifPatProvCtxt :: IfaceContext
ifPatProvCtxt = TidyEnv -> [Kind] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Kind]
prov_theta
, ifPatReqCtxt :: IfaceContext
ifPatReqCtxt = TidyEnv -> [Kind] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Kind]
req_theta
, ifPatArgs :: IfaceContext
ifPatArgs = forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Kind -> IfaceType
tidyToIfaceType TidyEnv
env2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scaled a -> a
scaledThing) [Scaled Kind]
args
, ifPatTy :: IfaceType
ifPatTy = TidyEnv -> Kind -> IfaceType
tidyToIfaceType TidyEnv
env2 Kind
rhs_ty
, ifFieldLabels :: [FieldLabel]
ifFieldLabels = (PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
ps)
}
where
([CoVar]
_univ_tvs, [Kind]
req_theta, [CoVar]
_ex_tvs, [Kind]
prov_theta, [Scaled Kind]
args, Kind
rhs_ty) = PatSyn -> ([CoVar], [Kind], [CoVar], [Kind], [Scaled Kind], Kind)
patSynSig PatSyn
ps
univ_bndrs :: [VarBndr CoVar Specificity]
univ_bndrs = PatSyn -> [VarBndr CoVar Specificity]
patSynUnivTyVarBinders PatSyn
ps
ex_bndrs :: [VarBndr CoVar Specificity]
ex_bndrs = PatSyn -> [VarBndr CoVar Specificity]
patSynExTyVarBinders PatSyn
ps
(TidyEnv
env1, [VarBndr CoVar Specificity]
univ_bndrs') = forall vis.
TidyEnv -> [VarBndr CoVar vis] -> (TidyEnv, [VarBndr CoVar vis])
tidyTyCoVarBinders TidyEnv
emptyTidyEnv [VarBndr CoVar Specificity]
univ_bndrs
(TidyEnv
env2, [VarBndr CoVar Specificity]
ex_bndrs') = forall vis.
TidyEnv -> [VarBndr CoVar vis] -> (TidyEnv, [VarBndr CoVar vis])
tidyTyCoVarBinders TidyEnv
env1 [VarBndr CoVar Specificity]
ex_bndrs
to_if_pr :: (a, b, b) -> (a, b)
to_if_pr (a
name, b
_type, b
needs_dummy) = (a
name, b
needs_dummy)
toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang TidyEnv
_ HsImplBang
HsLazy = IfaceBang
IfNoBang
toIfaceBang TidyEnv
_ (HsUnpack Maybe KindCoercion
Nothing) = IfaceBang
IfUnpack
toIfaceBang TidyEnv
env (HsUnpack (Just KindCoercion
co)) = IfaceCoercion -> IfaceBang
IfUnpackCo (KindCoercion -> IfaceCoercion
toIfaceCoercion (TidyEnv -> KindCoercion -> KindCoercion
tidyCo TidyEnv
env KindCoercion
co))
toIfaceBang TidyEnv
_ HsImplBang
HsStrict = IfaceBang
IfStrict
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang (HsSrcBang SourceText
_ SrcUnpackedness
unpk SrcStrictness
bang) = SrcUnpackedness -> SrcStrictness -> IfaceSrcBang
IfSrcBang SrcUnpackedness
unpk SrcStrictness
bang
toIfaceLetBndr :: Id -> IfaceLetBndr
toIfaceLetBndr :: CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
id = FastString
-> IfaceType -> IfaceIdInfo -> IfaceJoinInfo -> IfaceLetBndr
IfLetBndr (OccName -> FastString
occNameFS (forall a. NamedThing a => a -> OccName
getOccName CoVar
id))
(Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
id))
(IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => CoVar -> IdInfo
idInfo CoVar
id))
(Maybe Arity -> IfaceJoinInfo
toIfaceJoinInfo (CoVar -> Maybe Arity
isJoinId_maybe CoVar
id))
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails IdDetails
VanillaId = IfaceIdDetails
IfVanillaId
toIfaceIdDetails (DFunId {}) = IfaceIdDetails
IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
n
, sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
tc }) =
let iface :: Either IfaceTyCon IfaceDecl
iface = case RecSelParent
tc of
RecSelData TyCon
ty_con -> forall a b. a -> Either a b
Left (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
ty_con)
RecSelPatSyn PatSyn
pat_syn -> forall a b. b -> Either a b
Right (PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
pat_syn)
in Either IfaceTyCon IfaceDecl -> Bool -> IfaceIdDetails
IfRecSelId Either IfaceTyCon IfaceDecl
iface Bool
n
toIfaceIdDetails IdDetails
other = forall a. String -> SDoc -> a -> a
pprTrace String
"toIfaceIdDetails" (forall a. Outputable a => a -> SDoc
ppr IdDetails
other)
IfaceIdDetails
IfVanillaId
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo IdInfo
id_info
= forall a. [Maybe a] -> [a]
catMaybes [Maybe IfaceInfoItem
arity_hsinfo, Maybe IfaceInfoItem
caf_hsinfo, Maybe IfaceInfoItem
strict_hsinfo, Maybe IfaceInfoItem
cpr_hsinfo,
Maybe IfaceInfoItem
inline_hsinfo, Maybe IfaceInfoItem
unfold_hsinfo, Maybe IfaceInfoItem
levity_hsinfo]
where
arity_info :: Arity
arity_info = IdInfo -> Arity
arityInfo IdInfo
id_info
arity_hsinfo :: Maybe IfaceInfoItem
arity_hsinfo | Arity
arity_info forall a. Eq a => a -> a -> Bool
== Arity
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Arity -> IfaceInfoItem
HsArity Arity
arity_info)
caf_info :: CafInfo
caf_info = IdInfo -> CafInfo
cafInfo IdInfo
id_info
caf_hsinfo :: Maybe IfaceInfoItem
caf_hsinfo = case CafInfo
caf_info of
CafInfo
NoCafRefs -> forall a. a -> Maybe a
Just IfaceInfoItem
HsNoCafRefs
CafInfo
_other -> forall a. Maybe a
Nothing
sig_info :: StrictSig
sig_info = IdInfo -> StrictSig
strictnessInfo IdInfo
id_info
strict_hsinfo :: Maybe IfaceInfoItem
strict_hsinfo | Bool -> Bool
not (StrictSig -> Bool
isTopSig StrictSig
sig_info) = forall a. a -> Maybe a
Just (StrictSig -> IfaceInfoItem
HsStrictness StrictSig
sig_info)
| Bool
otherwise = forall a. Maybe a
Nothing
cpr_info :: CprSig
cpr_info = IdInfo -> CprSig
cprInfo IdInfo
id_info
cpr_hsinfo :: Maybe IfaceInfoItem
cpr_hsinfo | CprSig
cpr_info forall a. Eq a => a -> a -> Bool
/= CprSig
topCprSig = forall a. a -> Maybe a
Just (CprSig -> IfaceInfoItem
HsCpr CprSig
cpr_info)
| Bool
otherwise = forall a. Maybe a
Nothing
unfold_hsinfo :: Maybe IfaceInfoItem
unfold_hsinfo = Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding Bool
loop_breaker (IdInfo -> Unfolding
unfoldingInfo IdInfo
id_info)
loop_breaker :: Bool
loop_breaker = OccInfo -> Bool
isStrongLoopBreaker (IdInfo -> OccInfo
occInfo IdInfo
id_info)
inline_prag :: InlinePragma
inline_prag = IdInfo -> InlinePragma
inlinePragInfo IdInfo
id_info
inline_hsinfo :: Maybe IfaceInfoItem
inline_hsinfo | InlinePragma -> Bool
isDefaultInlinePragma InlinePragma
inline_prag = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (InlinePragma -> IfaceInfoItem
HsInline InlinePragma
inline_prag)
levity_hsinfo :: Maybe IfaceInfoItem
levity_hsinfo | IdInfo -> Bool
isNeverLevPolyIdInfo IdInfo
id_info = forall a. a -> Maybe a
Just IfaceInfoItem
HsLevity
| Bool
otherwise = forall a. Maybe a
Nothing
toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo
toIfaceJoinInfo :: Maybe Arity -> IfaceJoinInfo
toIfaceJoinInfo (Just Arity
ar) = Arity -> IfaceJoinInfo
IfaceJoinPoint Arity
ar
toIfaceJoinInfo Maybe Arity
Nothing = IfaceJoinInfo
IfaceNotJoinPoint
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding Bool
lb (CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
rhs
, uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src
, uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
guidance })
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb forall a b. (a -> b) -> a -> b
$
case UnfoldingSource
src of
UnfoldingSource
InlineStable
-> case UnfoldingGuidance
guidance of
UnfWhen {ug_arity :: UnfoldingGuidance -> Arity
ug_arity = Arity
arity, ug_unsat_ok :: UnfoldingGuidance -> Bool
ug_unsat_ok = Bool
unsat_ok, ug_boring_ok :: UnfoldingGuidance -> Bool
ug_boring_ok = Bool
boring_ok }
-> Arity -> Bool -> Bool -> IfaceExpr -> IfaceUnfolding
IfInlineRule Arity
arity Bool
unsat_ok Bool
boring_ok IfaceExpr
if_rhs
UnfoldingGuidance
_other -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
True IfaceExpr
if_rhs
UnfoldingSource
InlineCompulsory -> IfaceExpr -> IfaceUnfolding
IfCompulsory IfaceExpr
if_rhs
UnfoldingSource
InlineRhs -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
False IfaceExpr
if_rhs
where
if_rhs :: IfaceExpr
if_rhs = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs
toIfUnfolding Bool
lb (DFunUnfolding { df_bndrs :: Unfolding -> [CoVar]
df_bndrs = [CoVar]
bndrs, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args })
= forall a. a -> Maybe a
Just (Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb ([IfaceBndr] -> [IfaceExpr] -> IfaceUnfolding
IfDFunUnfold (forall a b. (a -> b) -> [a] -> [b]
map CoVar -> IfaceBndr
toIfaceBndr [CoVar]
bndrs) (forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
toIfaceExpr [CoreExpr]
args)))
toIfUnfolding Bool
_ (OtherCon {}) = forall a. Maybe a
Nothing
toIfUnfolding Bool
_ Unfolding
BootUnfolding = forall a. Maybe a
Nothing
toIfUnfolding Bool
_ Unfolding
NoUnfolding = forall a. Maybe a
Nothing
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var CoVar
v) = CoVar -> IfaceExpr
toIfaceVar CoVar
v
toIfaceExpr (Lit Literal
l) = Literal -> IfaceExpr
IfaceLit Literal
l
toIfaceExpr (Type Kind
ty) = IfaceType -> IfaceExpr
IfaceType (Kind -> IfaceType
toIfaceType Kind
ty)
toIfaceExpr (Coercion KindCoercion
co) = IfaceCoercion -> IfaceExpr
IfaceCo (KindCoercion -> IfaceCoercion
toIfaceCoercion KindCoercion
co)
toIfaceExpr (Lam CoVar
x CoreExpr
b) = IfaceLamBndr -> IfaceExpr -> IfaceExpr
IfaceLam (CoVar -> IfaceBndr
toIfaceBndr CoVar
x, CoVar -> IfaceOneShot
toIfaceOneShot CoVar
x) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
b)
toIfaceExpr (App CoreExpr
f CoreExpr
a) = CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp CoreExpr
f [CoreExpr
a]
toIfaceExpr (Case CoreExpr
s CoVar
x Kind
ty [Alt CoVar]
as)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt CoVar]
as = IfaceExpr -> IfaceType -> IfaceExpr
IfaceECase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (Kind -> IfaceType
toIfaceType Kind
ty)
| Bool
otherwise = IfaceExpr -> FastString -> [IfaceAlt] -> IfaceExpr
IfaceCase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (forall a. NamedThing a => a -> FastString
getOccFS CoVar
x) (forall a b. (a -> b) -> [a] -> [b]
map Alt CoVar -> IfaceAlt
toIfaceAlt [Alt CoVar]
as)
toIfaceExpr (Let Bind CoVar
b CoreExpr
e) = IfaceBinding -> IfaceExpr -> IfaceExpr
IfaceLet (Bind CoVar -> IfaceBinding
toIfaceBind Bind CoVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
toIfaceExpr (Cast CoreExpr
e KindCoercion
co) = IfaceExpr -> IfaceCoercion -> IfaceExpr
IfaceCast (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e) (KindCoercion -> IfaceCoercion
toIfaceCoercion KindCoercion
co)
toIfaceExpr (Tick CoreTickish
t CoreExpr
e)
| Just IfaceTickish
t' <- CoreTickish -> Maybe IfaceTickish
toIfaceTickish CoreTickish
t = IfaceTickish -> IfaceExpr -> IfaceExpr
IfaceTick IfaceTickish
t' (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
| Bool
otherwise = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e
toIfaceOneShot :: Id -> IfaceOneShot
toIfaceOneShot :: CoVar -> IfaceOneShot
toIfaceOneShot CoVar
id | CoVar -> Bool
isId CoVar
id
, OneShotInfo
OneShotLam <- IdInfo -> OneShotInfo
oneShotInfo (HasDebugCallStack => CoVar -> IdInfo
idInfo CoVar
id)
= IfaceOneShot
IfaceOneShot
| Bool
otherwise
= IfaceOneShot
IfaceNoOneShot
toIfaceTickish :: CoreTickish -> Maybe IfaceTickish
toIfaceTickish :: CoreTickish -> Maybe IfaceTickish
toIfaceTickish (ProfNote CostCentre
cc Bool
tick Bool
push) = forall a. a -> Maybe a
Just (CostCentre -> Bool -> Bool -> IfaceTickish
IfaceSCC CostCentre
cc Bool
tick Bool
push)
toIfaceTickish (HpcTick Module
modl Arity
ix) = forall a. a -> Maybe a
Just (Module -> Arity -> IfaceTickish
IfaceHpcTick Module
modl Arity
ix)
toIfaceTickish (SourceNote RealSrcSpan
src String
names) = forall a. a -> Maybe a
Just (RealSrcSpan -> String -> IfaceTickish
IfaceSource RealSrcSpan
src String
names)
toIfaceTickish (Breakpoint {}) = forall a. Maybe a
Nothing
toIfaceBind :: Bind Id -> IfaceBinding
toIfaceBind :: Bind CoVar -> IfaceBinding
toIfaceBind (NonRec CoVar
b CoreExpr
r) = IfaceLetBndr -> IfaceExpr -> IfaceBinding
IfaceNonRec (CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r)
toIfaceBind (Rec [(CoVar, CoreExpr)]
prs) = [(IfaceLetBndr, IfaceExpr)] -> IfaceBinding
IfaceRec [(CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
b, CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r) | (CoVar
b,CoreExpr
r) <- [(CoVar, CoreExpr)]
prs]
toIfaceAlt :: CoreAlt -> IfaceAlt
toIfaceAlt :: Alt CoVar -> IfaceAlt
toIfaceAlt (Alt AltCon
c [CoVar]
bs CoreExpr
r) = IfaceConAlt -> [FastString] -> IfaceExpr -> IfaceAlt
IfaceAlt (AltCon -> IfaceConAlt
toIfaceCon AltCon
c) (forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> FastString
getOccFS [CoVar]
bs) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r)
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon (DataAlt DataCon
dc) = Name -> IfaceConAlt
IfaceDataAlt (forall a. NamedThing a => a -> Name
getName DataCon
dc)
toIfaceCon (LitAlt Literal
l) = Literal -> IfaceConAlt
IfaceLitAlt Literal
l
toIfaceCon AltCon
DEFAULT = IfaceConAlt
IfaceDefault
toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
toIfaceApp :: CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp (App CoreExpr
f CoreExpr
a) [CoreExpr]
as = CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp CoreExpr
f (CoreExpr
aforall a. a -> [a] -> [a]
:[CoreExpr]
as)
toIfaceApp (Var CoVar
v) [CoreExpr]
as
= case CoVar -> Maybe DataCon
isDataConWorkId_maybe CoVar
v of
Just DataCon
dc | Bool
saturated
, Just TupleSort
tup_sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
-> TupleSort -> [IfaceExpr] -> IfaceExpr
IfaceTuple TupleSort
tup_sort [IfaceExpr]
tup_args
where
val_args :: [CoreExpr]
val_args = forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall b. Expr b -> Bool
isTypeArg [CoreExpr]
as
saturated :: Bool
saturated = [CoreExpr]
val_args forall a. [a] -> Arity -> Bool
`lengthIs` CoVar -> Arity
idArity CoVar
v
tup_args :: [IfaceExpr]
tup_args = forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
toIfaceExpr [CoreExpr]
val_args
tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
Maybe DataCon
_ -> IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps (CoVar -> IfaceExpr
toIfaceVar CoVar
v) [CoreExpr]
as
toIfaceApp CoreExpr
e [CoreExpr]
as = IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e) [CoreExpr]
as
mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps IfaceExpr
f [CoreExpr]
as = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IfaceExpr
f CoreExpr
a -> IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp IfaceExpr
f (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
a)) IfaceExpr
f [CoreExpr]
as
toIfaceVar :: Id -> IfaceExpr
toIfaceVar :: CoVar -> IfaceExpr
toIfaceVar CoVar
v
| Unfolding -> Bool
isBootUnfolding (CoVar -> Unfolding
idUnfolding CoVar
v)
=
IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp (IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp (Name -> IfaceExpr
IfaceExt Name
noinlineIdName)
(IfaceType -> IfaceExpr
IfaceType (Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
v))))
(Name -> IfaceExpr
IfaceExt Name
name)
| Just ForeignCall
fcall <- CoVar -> Maybe ForeignCall
isFCallId_maybe CoVar
v = ForeignCall -> IfaceType -> IfaceExpr
IfaceFCall ForeignCall
fcall (Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
v))
| Name -> Bool
isExternalName Name
name = Name -> IfaceExpr
IfaceExt Name
name
| Bool
otherwise = FastString -> IfaceExpr
IfaceLcl (forall a. NamedThing a => a -> FastString
getOccFS Name
name)
where name :: Name
name = CoVar -> Name
idName CoVar
v
toIfaceLFInfo :: Name -> LambdaFormInfo -> IfaceLFInfo
toIfaceLFInfo :: Name -> LambdaFormInfo -> IfaceLFInfo
toIfaceLFInfo Name
nm LambdaFormInfo
lfi = case LambdaFormInfo
lfi of
LFReEntrant TopLevelFlag
top_lvl Arity
arity Bool
no_fvs ArgDescr
_arg_descr ->
ASSERT2(isTopLevel top_lvl, ppr nm)
ASSERT2(no_fvs, ppr nm)
Arity -> IfaceLFInfo
IfLFReEntrant Arity
arity
LFThunk TopLevelFlag
top_lvl Bool
no_fvs Bool
updatable StandardFormInfo
sfi Bool
mb_fun ->
ASSERT2(isTopLevel top_lvl, ppr nm)
ASSERT2(no_fvs, ppr nm)
ASSERT2(sfi == NonStandardThunk, ppr nm)
Bool -> Bool -> IfaceLFInfo
IfLFThunk Bool
updatable Bool
mb_fun
LFCon DataCon
dc ->
Name -> IfaceLFInfo
IfLFCon (DataCon -> Name
dataConName DataCon
dc)
LFUnknown Bool
mb_fun ->
Bool -> IfaceLFInfo
IfLFUnknown Bool
mb_fun
LambdaFormInfo
LFUnlifted ->
IfaceLFInfo
IfLFUnlifted
LambdaFormInfo
LFLetNoEscape ->
forall a. String -> a
panic String
"toIfaceLFInfo: LFLetNoEscape"