{-# LANGUAGE Strict #-}
module GHC.CoreToIface
(
toIfaceTvBndr
, toIfaceTvBndrs
, toIfaceIdBndr
, toIfaceBndr
, toIfaceTopBndr
, toIfaceForAllBndr
, toIfaceForAllBndrs
, toIfaceTyVar
, toIfaceType, toIfaceTypeX
, toIfaceKind
, toIfaceTcArgs
, toIfaceTyCon
, toIfaceTyCon_name
, toIfaceTyLit
, tidyToIfaceType
, tidyToIfaceContext
, tidyToIfaceTcArgs
, toIfaceCoercion, toIfaceCoercionX
, patSynToIfaceDecl
, toIfaceExpr
, toIfaceBang
, toIfaceSrcBang
, toIfaceLetBndr
, toIfaceIdDetails
, toIfaceIdInfo
, toIfUnfolding
, toIfaceTickish
, toIfaceBind
, toIfaceTopBind
, toIfaceAlt
, toIfaceCon
, toIfaceApp
, toIfaceVar
, toIfaceLFInfo
, dehydrateCgBreakInfo
) where
import GHC.Prelude
import GHC.StgToCmm.Types
import GHC.ByteCode.Types
import GHC.Core
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Core.DataCon
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.PatSyn
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCo.Tidy ( tidyCo )
import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
import GHC.Builtin.Types ( heqTyCon )
import GHC.Iface.Syntax
import GHC.Data.FastString
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Id.Make ( noinlineIdName, noinlineConstraintIdName )
import GHC.Types.Literal
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Tickish
import GHC.Types.Demand ( isNopSig )
import GHC.Types.Cpr ( topCprSig )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import Data.Maybe ( isNothing, 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 = ( FastString -> IfLclName
mkIfLclName (OccName -> FastString
occNameFS (CoVar -> OccName
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 = (CoVar -> IfaceTvBndr) -> [CoVar] -> [IfaceTvBndr]
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 (HasDebugCallStack => CoVar -> Kind
CoVar -> Kind
idMult CoVar
covar)
, FastString -> IfLclName
mkIfLclName (OccName -> FastString
occNameFS (CoVar -> OccName
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)
toIfaceForAllBndrs :: [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceForAllBndrs :: forall vis. [VarBndr CoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceForAllBndrs = (VarBndr CoVar vis -> VarBndr IfaceBndr vis)
-> [VarBndr CoVar vis] -> [VarBndr IfaceBndr vis]
forall a b. (a -> b) -> [a] -> [b]
map VarBndr CoVar vis -> VarBndr IfaceBndr vis
forall flag. VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr
toIfaceForAllBndr :: VarBndr TyCoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr :: forall flag. VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr = VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
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) = IfaceBndr -> flag -> VarBndr IfaceBndr flag
forall var argf. var -> argf -> VarBndr var argf
Bndr (VarSet -> CoVar -> IfaceBndr
toIfaceBndrX VarSet
fr CoVar
v) flag
vis
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 = IfLclName -> IfaceType
IfaceTyVar (CoVar -> IfLclName
toIfaceTyVar CoVar
tv)
toIfaceTypeX VarSet
fr ty :: Kind
ty@(AppTy {}) =
let (Kind
head, [Kind]
args) = HasDebugCallStack => Kind -> (Kind, [Kind])
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 ForAllTyBinder
b Kind
t) = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (VarSet -> ForAllTyBinder -> IfaceForAllBndr
forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
fr ForAllTyBinder
b)
(VarSet -> Kind -> IfaceType
toIfaceTypeX (VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` ForAllTyBinder -> CoVar
forall tv argf. VarBndr tv argf -> tv
binderVar ForAllTyBinder
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 -> FunTyFlag
ft_af = FunTyFlag
af })
= FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
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 Coercion
co) = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
ty) (VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr Coercion
co)
toIfaceTypeX VarSet
fr (CoercionTy Coercion
co) = IfaceCoercion -> IfaceType
IfaceCoercionTy (VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr Coercion
co)
toIfaceTypeX VarSet
fr (TyConApp TyCon
tc [Kind]
tys)
| Just TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
, Arity
n_tys Arity -> Arity -> Bool
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 Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
2Arity -> Arity -> Arity
forall 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 (Arity -> [Kind] -> [Kind]
forall a. Arity -> [a] -> [a]
drop Arity
arity [Kind]
tys))
| TyCon
tc TyCon -> [TyCon] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 HasCallStack => Kind -> Kind -> Bool
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 = [Kind] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Kind]
tys
toIfaceTyVar :: TyVar -> IfLclName
toIfaceTyVar :: CoVar -> IfLclName
toIfaceTyVar = FastString -> IfLclName
mkIfLclName (FastString -> IfLclName)
-> (CoVar -> FastString) -> CoVar -> IfLclName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (CoVar -> OccName) -> CoVar -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName
toIfaceCoVar :: CoVar -> IfLclName
toIfaceCoVar :: CoVar -> IfLclName
toIfaceCoVar = FastString -> IfLclName
mkIfLclName (FastString -> IfLclName)
-> (CoVar -> FastString) -> CoVar -> IfLclName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (CoVar -> OccName) -> CoVar -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName
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
isDataKindsPromotedDataCon 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' Arity -> Arity -> Arity
forall a. Integral a => a -> a -> a
`div` Arity
2
in IfaceTyConSort -> Maybe IfaceTyConSort
forall a. a -> Maybe a
Just (IfaceTyConSort -> Maybe IfaceTyConSort)
-> IfaceTyConSort -> Maybe IfaceTyConSort
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 IfaceTyConSort -> Maybe IfaceTyConSort
forall a. a -> Maybe a
Just (IfaceTyConSort -> Maybe IfaceTyConSort)
-> IfaceTyConSort -> Maybe IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ Arity -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Arity
arity TupleSort
sort
Maybe TupleSort
Nothing -> Maybe IfaceTyConSort
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 ([DataCon] -> Arity
forall a. [a] -> Arity
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) = LexicalFastString -> IfaceTyLit
IfaceStrTyLit (FastString -> LexicalFastString
LexicalFastString FastString
x)
toIfaceTyLit (CharTyLit Char
x) = Char -> IfaceTyLit
IfaceCharTyLit Char
x
toIfaceCoercion :: Coercion -> IfaceCoercion
toIfaceCoercion :: Coercion -> IfaceCoercion
toIfaceCoercion = VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
emptyVarSet
toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr Coercion
co
= Coercion -> IfaceCoercion
go Coercion
co
where
go_mco :: MCoercion -> IfaceMCoercion
go_mco MCoercion
MRefl = IfaceMCoercion
IfaceMRefl
go_mco (MCo Coercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ Coercion -> IfaceCoercion
go Coercion
co
go :: Coercion -> 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 = IfLclName -> IfaceCoercion
IfaceCoVarCo (CoVar -> IfLclName
toIfaceCoVar CoVar
cv)
go (HoleCo CoercionHole
h) = CoVar -> IfaceCoercion
IfaceHoleCo (CoercionHole -> CoVar
coHoleCoVar CoercionHole
h)
go (AppCo Coercion
co1 Coercion
co2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (Coercion -> IfaceCoercion
go Coercion
co1) (Coercion -> IfaceCoercion
go Coercion
co2)
go (SymCo Coercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSymCo (Coercion -> IfaceCoercion
go Coercion
co)
go (TransCo Coercion
co1 Coercion
co2) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (Coercion -> IfaceCoercion
go Coercion
co1) (Coercion -> IfaceCoercion
go Coercion
co2)
go (SelCo CoSel
d Coercion
co) = CoSel -> IfaceCoercion -> IfaceCoercion
IfaceSelCo CoSel
d (Coercion -> IfaceCoercion
go Coercion
co)
go (LRCo LeftOrRight
lr Coercion
co) = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (Coercion -> IfaceCoercion
go Coercion
co)
go (InstCo Coercion
co Coercion
arg) = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (Coercion -> IfaceCoercion
go Coercion
co) (Coercion -> IfaceCoercion
go Coercion
arg)
go (KindCo Coercion
c) = IfaceCoercion -> IfaceCoercion
IfaceKindCo (Coercion -> IfaceCoercion
go Coercion
c)
go (SubCo Coercion
co) = IfaceCoercion -> IfaceCoercion
IfaceSubCo (Coercion -> IfaceCoercion
go Coercion
co)
go (AxiomCo CoAxiomRule
ax [Coercion]
cs) = IfaceAxiomRule -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomCo (CoAxiomRule -> IfaceAxiomRule
toIfaceAxiomRule CoAxiomRule
ax) ((Coercion -> IfaceCoercion) -> [Coercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map Coercion -> IfaceCoercion
go [Coercion]
cs)
go (UnivCo { uco_prov :: Coercion -> UnivCoProvenance
uco_prov = UnivCoProvenance
p, uco_role :: Coercion -> Role
uco_role = Role
r, uco_lty :: Coercion -> Kind
uco_lty = Kind
t1, uco_rty :: Coercion -> Kind
uco_rty = Kind
t2, uco_deps :: Coercion -> [Coercion]
uco_deps = [Coercion]
deps })
= UnivCoProvenance
-> Role
-> IfaceType
-> IfaceType
-> [IfaceCoercion]
-> IfaceCoercion
IfaceUnivCo UnivCoProvenance
p Role
r (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t1) (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t2) ((Coercion -> IfaceCoercion) -> [Coercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map Coercion -> IfaceCoercion
go [Coercion]
deps)
go co :: Coercion
co@(TyConAppCo Role
r TyCon
tc [Coercion]
cos)
= Bool -> SDoc -> IfaceCoercion -> IfaceCoercion
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Maybe Coercion -> Bool
forall a. Maybe a -> Bool
isNothing (HasDebugCallStack => Role -> TyCon -> [Coercion] -> Maybe Coercion
Role -> TyCon -> [Coercion] -> Maybe Coercion
tyConAppFunCo_maybe Role
r TyCon
tc [Coercion]
cos)) (Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co) (IfaceCoercion -> IfaceCoercion) -> IfaceCoercion -> IfaceCoercion
forall a b. (a -> b) -> a -> b
$
Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) ((Coercion -> IfaceCoercion) -> [Coercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map Coercion -> IfaceCoercion
go [Coercion]
cos)
go (FunCo { fco_role :: Coercion -> Role
fco_role = Role
r, fco_mult :: Coercion -> Coercion
fco_mult = Coercion
w, fco_arg :: Coercion -> Coercion
fco_arg = Coercion
co1, fco_res :: Coercion -> Coercion
fco_res = Coercion
co2 })
= Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (Coercion -> IfaceCoercion
go Coercion
w) (Coercion -> IfaceCoercion
go Coercion
co1) (Coercion -> IfaceCoercion
go Coercion
co2)
go (ForAllCo CoVar
tv ForAllTyFlag
visL ForAllTyFlag
visR Coercion
k Coercion
co)
= IfaceBndr
-> ForAllTyFlag
-> ForAllTyFlag
-> IfaceCoercion
-> IfaceCoercion
-> IfaceCoercion
IfaceForAllCo (CoVar -> IfaceBndr
toIfaceBndr CoVar
tv)
ForAllTyFlag
visL
ForAllTyFlag
visR
(VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' Coercion
k)
(VarSet -> Coercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' Coercion
co)
where
fr' :: VarSet
fr' = VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` CoVar
tv
toIfaceAxiomRule :: CoAxiomRule -> IfaceAxiomRule
toIfaceAxiomRule :: CoAxiomRule -> IfaceAxiomRule
toIfaceAxiomRule (BuiltInFamRew BuiltInFamRewrite
bif) = IfLclName -> IfaceAxiomRule
IfaceAR_X (FastString -> IfLclName
mkIfLclName (BuiltInFamRewrite -> FastString
bifrw_name BuiltInFamRewrite
bif))
toIfaceAxiomRule (BuiltInFamInj BuiltInFamInjectivity
bif) = IfLclName -> IfaceAxiomRule
IfaceAR_X (FastString -> IfLclName
mkIfLclName (BuiltInFamInjectivity -> FastString
bifinj_name BuiltInFamInjectivity
bif))
toIfaceAxiomRule (BranchedAxiom CoAxiom Branched
ax Arity
i) = Name -> Arity -> IfaceAxiomRule
IfaceAR_B (CoAxiom Branched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
ax) Arity
i
toIfaceAxiomRule (UnbranchedAxiom CoAxiom Unbranched
ax) = Name -> IfaceAxiomRule
IfaceAR_U (CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
ax)
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
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
| [Kind] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Kind]
ty_args
= IfaceAppArgs
IA_Nil
| Bool
otherwise
= Subst -> Kind -> [Kind] -> IfaceAppArgs
go (InScopeSet -> Subst
mkEmptySubst InScopeSet
in_scope) Kind
kind [Kind]
ty_args
where
in_scope :: InScopeSet
in_scope = VarSet -> InScopeSet
mkInScopeSet ([Kind] -> VarSet
tyCoVarsOfTypes [Kind]
ty_args)
go :: Subst -> Kind -> [Kind] -> IfaceAppArgs
go Subst
_ Kind
_ [] = IfaceAppArgs
IA_Nil
go Subst
env Kind
ty [Kind]
ts
| Just Kind
ty' <- Kind -> Maybe Kind
coreView Kind
ty
= Subst -> Kind -> [Kind] -> IfaceAppArgs
go Subst
env Kind
ty' [Kind]
ts
go Subst
env (ForAllTy (Bndr CoVar
tv ForAllTyFlag
vis) Kind
res) (Kind
t:[Kind]
ts)
= IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t' ForAllTyFlag
vis IfaceAppArgs
ts'
where
t' :: IfaceType
t' = VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t
ts' :: IfaceAppArgs
ts' = Subst -> Kind -> [Kind] -> IfaceAppArgs
go (Subst -> CoVar -> Kind -> Subst
extendTCvSubst Subst
env CoVar
tv Kind
t) Kind
res [Kind]
ts
go Subst
env (FunTy { ft_af :: Kind -> FunTyFlag
ft_af = FunTyFlag
af, ft_res :: Kind -> Kind
ft_res = Kind
res }) (Kind
t:[Kind]
ts)
= Bool
-> (IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs)
-> IfaceType
-> ForAllTyFlag
-> IfaceAppArgs
-> IfaceAppArgs
forall a. HasCallStack => Bool -> a -> a
assert (FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af)
IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t) ForAllTyFlag
Required (Subst -> Kind -> [Kind] -> IfaceAppArgs
go Subst
env Kind
res [Kind]
ts)
go Subst
env Kind
ty ts :: [Kind]
ts@(Kind
t1:[Kind]
ts1)
| Bool -> Bool
not (Subst -> Bool
isEmptyTCvSubst Subst
env)
= Subst -> Kind -> [Kind] -> IfaceAppArgs
go (Subst -> Subst
zapSubst Subst
env) (HasDebugCallStack => Subst -> Kind -> Kind
Subst -> Kind -> Kind
substTy Subst
env Kind
ty) [Kind]
ts
| Bool
otherwise
=
Bool -> String -> SDoc -> IfaceAppArgs -> IfaceAppArgs
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace Bool
True String
"toIfaceAppArgsX" (Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr Kind
kind SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Kind] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Kind]
ty_args) (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$
IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr Kind
t1) ForAllTyFlag
Required (Subst -> Kind -> [Kind] -> IfaceAppArgs
go Subst
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 = (Kind -> IfaceType) -> [Kind] -> IfaceContext
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 = PatSyn -> Name
forall a. NamedThing a => a -> Name
getName (PatSyn -> Name) -> PatSyn -> Name
forall a b. (a -> b) -> a -> b
$ PatSyn
ps
, ifPatMatcher :: (Name, Bool)
ifPatMatcher = (Name, Kind, Bool) -> (Name, Bool)
forall {a} {b} {b}. (a, b, b) -> (a, b)
to_if_pr (PatSyn -> (Name, Kind, Bool)
patSynMatcher PatSyn
ps)
, ifPatBuilder :: Maybe (Name, Bool)
ifPatBuilder = ((Name, Kind, Bool) -> (Name, Bool))
-> Maybe (Name, Kind, Bool) -> Maybe (Name, Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Kind, Bool) -> (Name, Bool)
forall {a} {b} {b}. (a, b, b) -> (a, b)
to_if_pr (PatSyn -> Maybe (Name, Kind, Bool)
patSynBuilder PatSyn
ps)
, ifPatIsInfix :: Bool
ifPatIsInfix = PatSyn -> Bool
patSynIsInfix PatSyn
ps
, ifPatUnivBndrs :: [IfaceForAllSpecBndr]
ifPatUnivBndrs = (VarBndr CoVar Specificity -> IfaceForAllSpecBndr)
-> [VarBndr CoVar Specificity] -> [IfaceForAllSpecBndr]
forall a b. (a -> b) -> [a] -> [b]
map VarBndr CoVar Specificity -> IfaceForAllSpecBndr
forall flag. VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr [VarBndr CoVar Specificity]
univ_bndrs'
, ifPatExBndrs :: [IfaceForAllSpecBndr]
ifPatExBndrs = (VarBndr CoVar Specificity -> IfaceForAllSpecBndr)
-> [VarBndr CoVar Specificity] -> [IfaceForAllSpecBndr]
forall a b. (a -> b) -> [a] -> [b]
map VarBndr CoVar Specificity -> IfaceForAllSpecBndr
forall flag. VarBndr CoVar flag -> VarBndr IfaceBndr flag
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 = (Scaled Kind -> IfaceType) -> [Scaled Kind] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Kind -> IfaceType
tidyToIfaceType TidyEnv
env2 (Kind -> IfaceType)
-> (Scaled Kind -> Kind) -> Scaled Kind -> IfaceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scaled Kind -> Kind
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') = TidyEnv
-> [VarBndr CoVar Specificity]
-> (TidyEnv, [VarBndr CoVar Specificity])
forall vis.
TidyEnv -> [VarBndr CoVar vis] -> (TidyEnv, [VarBndr CoVar vis])
tidyForAllTyBinders TidyEnv
emptyTidyEnv [VarBndr CoVar Specificity]
univ_bndrs
(TidyEnv
env2, [VarBndr CoVar Specificity]
ex_bndrs') = TidyEnv
-> [VarBndr CoVar Specificity]
-> (TidyEnv, [VarBndr CoVar Specificity])
forall vis.
TidyEnv -> [VarBndr CoVar vis] -> (TidyEnv, [VarBndr CoVar vis])
tidyForAllTyBinders 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 Coercion
Nothing) = IfaceBang
IfUnpack
toIfaceBang TidyEnv
env (HsUnpack (Just Coercion
co)) = IfaceCoercion -> IfaceBang
IfUnpackCo (Coercion -> IfaceCoercion
toIfaceCoercion (TidyEnv -> Coercion -> Coercion
tidyCo TidyEnv
env Coercion
co))
toIfaceBang TidyEnv
_ (HsStrict Bool
_) = IfaceBang
IfStrict
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang (HsSrcBang SourceText
_ (HsBang SrcUnpackedness
unpk SrcStrictness
bang)) = SrcUnpackedness -> SrcStrictness -> IfaceSrcBang
IfSrcBang SrcUnpackedness
unpk SrcStrictness
bang
toIfaceLetBndr :: Id -> IfaceLetBndr
toIfaceLetBndr :: CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
id = IfLclName
-> IfaceType -> IfaceIdInfo -> JoinPointHood -> IfaceLetBndr
IfLetBndr (FastString -> IfLclName
mkIfLclName (OccName -> FastString
occNameFS (CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoVar
id)))
(Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
id))
(IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => CoVar -> IdInfo
CoVar -> IdInfo
idInfo CoVar
id))
(CoVar -> JoinPointHood
idJoinPointHood CoVar
id)
toIfaceTopBndr :: Id -> IfaceTopBndrInfo
toIfaceTopBndr :: CoVar -> IfaceTopBndrInfo
toIfaceTopBndr CoVar
id
= if Name -> Bool
isExternalName Name
name
then Name -> IfaceTopBndrInfo
IfGblTopBndr Name
name
else IfLclName
-> IfaceType -> IfaceIdInfo -> IfaceIdDetails -> IfaceTopBndrInfo
IfLclTopBndr (FastString -> IfLclName
mkIfLclName (OccName -> FastString
occNameFS (CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoVar
id))) (Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
id))
(IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => CoVar -> IdInfo
CoVar -> IdInfo
idInfo CoVar
id)) (IdDetails -> IfaceIdDetails
toIfaceIdDetails (CoVar -> IdDetails
idDetails CoVar
id))
where
name :: Name
name = CoVar -> Name
forall a. NamedThing a => a -> Name
getName CoVar
id
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails IdDetails
VanillaId = IfaceIdDetails
IfVanillaId
toIfaceIdDetails (WorkerLikeId [CbvMark]
dmds) = [CbvMark] -> IfaceIdDetails
IfWorkerLikeId [CbvMark]
dmds
toIfaceIdDetails (DFunId {}) = IfaceIdDetails
IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
n
, sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
tc
, sel_fieldLabel :: IdDetails -> FieldLabel
sel_fieldLabel = FieldLabel
fl }) =
let (Either IfaceTyCon IfaceDecl
iface, Name
first_con) = case RecSelParent
tc of
RecSelData TyCon
ty_con -> ( IfaceTyCon -> Either IfaceTyCon IfaceDecl
forall a b. a -> Either a b
Left (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
ty_con), DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head ([DataCon] -> DataCon) -> [DataCon] -> DataCon
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
ty_con)
RecSelPatSyn PatSyn
pat_syn -> ( IfaceDecl -> Either IfaceTyCon IfaceDecl
forall a b. b -> Either a b
Right (PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
pat_syn), PatSyn -> Name
patSynName PatSyn
pat_syn)
in Either IfaceTyCon IfaceDecl
-> Name -> Bool -> FieldLabel -> IfaceIdDetails
IfRecSelId Either IfaceTyCon IfaceDecl
iface Name
first_con Bool
n FieldLabel
fl
toIfaceIdDetails IdDetails
other = String -> SDoc -> IfaceIdDetails -> IfaceIdDetails
forall a. String -> SDoc -> a -> a
pprTrace String
"toIfaceIdDetails" (IdDetails -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdDetails
other)
IfaceIdDetails
IfVanillaId
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo IdInfo
id_info
= [Maybe IfaceInfoItem] -> IfaceIdInfo
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]
where
arity_info :: Arity
arity_info = IdInfo -> Arity
arityInfo IdInfo
id_info
arity_hsinfo :: Maybe IfaceInfoItem
arity_hsinfo | Arity
arity_info Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
| Bool
otherwise = IfaceInfoItem -> Maybe IfaceInfoItem
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 -> IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just IfaceInfoItem
HsNoCafRefs
CafInfo
_other -> Maybe IfaceInfoItem
forall a. Maybe a
Nothing
sig_info :: DmdSig
sig_info = IdInfo -> DmdSig
dmdSigInfo IdInfo
id_info
strict_hsinfo :: Maybe IfaceInfoItem
strict_hsinfo | Bool -> Bool
not (DmdSig -> Bool
isNopSig DmdSig
sig_info) = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (DmdSig -> IfaceInfoItem
HsDmdSig DmdSig
sig_info)
| Bool
otherwise = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
cpr_info :: CprSig
cpr_info = IdInfo -> CprSig
cprSigInfo IdInfo
id_info
cpr_hsinfo :: Maybe IfaceInfoItem
cpr_hsinfo | CprSig
cpr_info CprSig -> CprSig -> Bool
forall a. Eq a => a -> a -> Bool
/= CprSig
topCprSig = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (CprSig -> IfaceInfoItem
HsCprSig CprSig
cpr_info)
| Bool
otherwise = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
unfold_hsinfo :: Maybe IfaceInfoItem
unfold_hsinfo = Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding Bool
loop_breaker (IdInfo -> Unfolding
realUnfoldingInfo 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 = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
| Bool
otherwise = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (InlinePragma -> IfaceInfoItem
HsInline InlinePragma
inline_prag)
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_cache :: Unfolding -> UnfoldingCache
uf_cache = UnfoldingCache
cache
, uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
guidance })
= IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (IfaceInfoItem -> Maybe IfaceInfoItem)
-> IfaceInfoItem -> Maybe IfaceInfoItem
forall a b. (a -> b) -> a -> b
$ Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb (IfaceUnfolding -> IfaceInfoItem)
-> IfaceUnfolding -> IfaceInfoItem
forall a b. (a -> b) -> a -> b
$
UnfoldingSource
-> UnfoldingCache -> IfGuidance -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold UnfoldingSource
src UnfoldingCache
cache (UnfoldingSource -> UnfoldingGuidance -> IfGuidance
toIfGuidance UnfoldingSource
src UnfoldingGuidance
guidance) (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 })
= IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb ([IfaceBndr] -> [IfaceExpr] -> IfaceUnfolding
IfDFunUnfold ((CoVar -> IfaceBndr) -> [CoVar] -> [IfaceBndr]
forall a b. (a -> b) -> [a] -> [b]
map CoVar -> IfaceBndr
toIfaceBndr [CoVar]
bndrs) ((CoreExpr -> IfaceExpr) -> [CoreExpr] -> [IfaceExpr]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
toIfaceExpr [CoreExpr]
args)))
toIfUnfolding Bool
_ (OtherCon {}) = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
toIfUnfolding Bool
_ Unfolding
BootUnfolding = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
toIfUnfolding Bool
_ Unfolding
NoUnfolding = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
toIfGuidance :: UnfoldingSource -> UnfoldingGuidance -> IfGuidance
toIfGuidance :: UnfoldingSource -> UnfoldingGuidance -> IfGuidance
toIfGuidance UnfoldingSource
src UnfoldingGuidance
guidance
| UnfWhen Arity
arity Bool
unsat_ok Bool
boring_ok <- UnfoldingGuidance
guidance
, UnfoldingSource -> Bool
isStableSource UnfoldingSource
src = Arity -> Bool -> Bool -> IfGuidance
IfWhen Arity
arity Bool
unsat_ok Bool
boring_ok
| Bool
otherwise = IfGuidance
IfNoGuidance
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var CoVar
v) = CoVar -> IfaceExpr
toIfaceVar CoVar
v
toIfaceExpr (Lit (LitRubbish TypeOrConstraint
tc Kind
r)) = TypeOrConstraint -> IfaceType -> IfaceExpr
IfaceLitRubbish TypeOrConstraint
tc (Kind -> IfaceType
toIfaceType Kind
r)
toIfaceExpr (Lit Literal
l) = Literal -> IfaceExpr
IfaceLit Literal
l
toIfaceExpr (Type Kind
ty) = IfaceType -> IfaceExpr
IfaceType (Kind -> IfaceType
toIfaceType Kind
ty)
toIfaceExpr (Coercion Coercion
co) = IfaceCoercion -> IfaceExpr
IfaceCo (Coercion -> IfaceCoercion
toIfaceCoercion Coercion
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)
| [Alt CoVar] -> Bool
forall a. [a] -> Bool
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 -> IfLclName -> [IfaceAlt] -> IfaceExpr
IfaceCase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (FastString -> IfLclName
mkIfLclName (CoVar -> FastString
forall a. NamedThing a => a -> FastString
getOccFS CoVar
x)) ((Alt CoVar -> IfaceAlt) -> [Alt CoVar] -> [IfaceAlt]
forall a b. (a -> b) -> [a] -> [b]
map Alt CoVar -> IfaceAlt
toIfaceAlt [Alt CoVar]
as)
toIfaceExpr (Let Bind CoVar
b CoreExpr
e) = IfaceBinding IfaceLetBndr -> IfaceExpr -> IfaceExpr
IfaceLet (Bind CoVar -> IfaceBinding IfaceLetBndr
toIfaceBind Bind CoVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
toIfaceExpr (Cast CoreExpr
e Coercion
co) = IfaceExpr -> IfaceCoercion -> IfaceExpr
IfaceCast (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e) (Coercion -> IfaceCoercion
toIfaceCoercion Coercion
co)
toIfaceExpr (Tick CoreTickish
t CoreExpr
e) = IfaceTickish -> IfaceExpr -> IfaceExpr
IfaceTick (CoreTickish -> IfaceTickish
toIfaceTickish CoreTickish
t) (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
CoVar -> IdInfo
idInfo CoVar
id)
= IfaceOneShot
IfaceOneShot
| Bool
otherwise
= IfaceOneShot
IfaceNoOneShot
toIfaceTickish :: CoreTickish -> IfaceTickish
toIfaceTickish :: CoreTickish -> IfaceTickish
toIfaceTickish (ProfNote CostCentre
cc Bool
tick Bool
push) = CostCentre -> Bool -> Bool -> IfaceTickish
IfaceSCC CostCentre
cc Bool
tick Bool
push
toIfaceTickish (HpcTick Module
modl Arity
ix) = Module -> Arity -> IfaceTickish
IfaceHpcTick Module
modl Arity
ix
toIfaceTickish (SourceNote RealSrcSpan
src (LexicalFastString FastString
names)) =
RealSrcSpan -> FastString -> IfaceTickish
IfaceSource RealSrcSpan
src FastString
names
toIfaceTickish (Breakpoint XBreakpoint 'TickishPassCore
_ Arity
ix [XTickishId 'TickishPassCore]
fv Module
m) =
Arity -> [IfaceExpr] -> Module -> IfaceTickish
IfaceBreakpoint Arity
ix (CoVar -> IfaceExpr
toIfaceVar (CoVar -> IfaceExpr) -> [CoVar] -> [IfaceExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoVar]
[XTickishId 'TickishPassCore]
fv) Module
m
toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr
toIfaceBind :: Bind CoVar -> IfaceBinding IfaceLetBndr
toIfaceBind (NonRec CoVar
b CoreExpr
r) = IfaceLetBndr -> IfaceExpr -> IfaceBinding IfaceLetBndr
forall r b. b -> r -> IfaceBindingX r b
IfaceNonRec (CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r)
toIfaceBind (Rec [(CoVar, CoreExpr)]
prs) = [(IfaceLetBndr, IfaceExpr)] -> IfaceBinding IfaceLetBndr
forall r b. [(b, r)] -> IfaceBindingX r b
IfaceRec [(CoVar -> IfaceLetBndr
toIfaceLetBndr CoVar
b, CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r) | (CoVar
b,CoreExpr
r) <- [(CoVar, CoreExpr)]
prs]
toIfaceTopBind :: Bind Id -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
toIfaceTopBind :: Bind CoVar -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
toIfaceTopBind Bind CoVar
b =
case Bind CoVar
b of
NonRec CoVar
b CoreExpr
r -> (IfaceTopBndrInfo
-> IfaceMaybeRhs -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo)
-> (IfaceTopBndrInfo, IfaceMaybeRhs)
-> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IfaceTopBndrInfo
-> IfaceMaybeRhs -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
forall r b. b -> r -> IfaceBindingX r b
IfaceNonRec ((CoVar, CoreExpr) -> (IfaceTopBndrInfo, IfaceMaybeRhs)
do_one (CoVar
b, CoreExpr
r))
Rec [(CoVar, CoreExpr)]
prs -> [(IfaceTopBndrInfo, IfaceMaybeRhs)]
-> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
forall r b. [(b, r)] -> IfaceBindingX r b
IfaceRec (((CoVar, CoreExpr) -> (IfaceTopBndrInfo, IfaceMaybeRhs))
-> [(CoVar, CoreExpr)] -> [(IfaceTopBndrInfo, IfaceMaybeRhs)]
forall a b. (a -> b) -> [a] -> [b]
map (CoVar, CoreExpr) -> (IfaceTopBndrInfo, IfaceMaybeRhs)
do_one [(CoVar, CoreExpr)]
prs)
where
do_one :: (CoVar, CoreExpr) -> (IfaceTopBndrInfo, IfaceMaybeRhs)
do_one (CoVar
b, CoreExpr
rhs) =
let top_bndr :: IfaceTopBndrInfo
top_bndr = CoVar -> IfaceTopBndrInfo
toIfaceTopBndr CoVar
b
rhs' :: IfaceMaybeRhs
rhs' = case IfaceTopBndrInfo
top_bndr of
IfGblTopBndr {} -> if CoVar -> Bool
already_has_unfolding CoVar
b then IfaceMaybeRhs
IfUseUnfoldingRhs else IfaceExpr -> IfaceMaybeRhs
IfRhs (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs)
IfLclTopBndr {} -> IfaceExpr -> IfaceMaybeRhs
IfRhs (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs)
in (IfaceTopBndrInfo
top_bndr, IfaceMaybeRhs
rhs')
disabledDueTo22807 :: Bool
disabledDueTo22807 = Bool
True
already_has_unfolding :: CoVar -> Bool
already_has_unfolding CoVar
b = Bool -> Bool
not Bool
disabledDueTo22807
Bool -> Bool -> Bool
&&
Unfolding -> Bool
hasCoreUnfolding (CoVar -> Unfolding
realIdUnfolding CoVar
b)
Bool -> Bool -> Bool
&& Bool -> Bool
not (Unfolding -> Bool
isStableUnfolding (CoVar -> Unfolding
realIdUnfolding CoVar
b))
toIfaceAlt :: CoreAlt -> IfaceAlt
toIfaceAlt :: Alt CoVar -> IfaceAlt
toIfaceAlt (Alt AltCon
c [CoVar]
bs CoreExpr
r) = IfaceConAlt -> [IfLclName] -> IfaceExpr -> IfaceAlt
IfaceAlt (AltCon -> IfaceConAlt
toIfaceCon AltCon
c) ((CoVar -> IfLclName) -> [CoVar] -> [IfLclName]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> IfLclName
mkIfLclName (FastString -> IfLclName)
-> (CoVar -> FastString) -> CoVar -> IfLclName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoVar -> FastString
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 (DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dc)
toIfaceCon (LitAlt Literal
l) = Bool -> SDoc -> IfaceConAlt -> IfaceConAlt
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Literal -> Bool
isLitRubbish Literal
l)) (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l) (IfaceConAlt -> IfaceConAlt) -> IfaceConAlt -> IfaceConAlt
forall a b. (a -> b) -> a -> b
$
Literal -> IfaceConAlt
IfaceLitAlt Literal
l
toIfaceCon AltCon
DEFAULT = IfaceConAlt
IfaceDefaultAlt
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
aCoreExpr -> [CoreExpr] -> [CoreExpr]
forall 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 = (CoreExpr -> Bool) -> [CoreExpr] -> [CoreExpr]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile CoreExpr -> Bool
forall b. Expr b -> Bool
isTypeArg [CoreExpr]
as
saturated :: Bool
saturated = [CoreExpr]
val_args [CoreExpr] -> Arity -> Bool
forall a. [a] -> Arity -> Bool
`lengthIs` CoVar -> Arity
idArity CoVar
v
tup_args :: [IfaceExpr]
tup_args = (CoreExpr -> IfaceExpr) -> [CoreExpr] -> [IfaceExpr]
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 = (IfaceExpr -> CoreExpr -> IfaceExpr)
-> IfaceExpr -> [CoreExpr] -> IfaceExpr
forall b a. (b -> a -> b) -> b -> [a] -> b
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
noinline_id)
(IfaceType -> IfaceExpr
IfaceType (Kind -> IfaceType
toIfaceType Kind
ty)))
(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 = IfLclName -> IfaceExpr
IfaceLcl (FastString -> IfLclName
mkIfLclName (OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name))
where
name :: Name
name = CoVar -> Name
idName CoVar
v
ty :: Kind
ty = CoVar -> Kind
idType CoVar
v
noinline_id :: Name
noinline_id | Kind -> Bool
isConstraintKind (HasDebugCallStack => Kind -> Kind
Kind -> Kind
typeKind Kind
ty) = Name
noinlineConstraintIdName
| Bool
otherwise = Name
noinlineIdName
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 ->
Bool -> SDoc -> IfaceLFInfo -> IfaceLFInfo
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TopLevelFlag -> Bool
isTopLevel TopLevelFlag
top_lvl) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IfaceLFInfo -> IfaceLFInfo) -> IfaceLFInfo -> IfaceLFInfo
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> IfaceLFInfo -> IfaceLFInfo
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
no_fvs (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IfaceLFInfo -> IfaceLFInfo) -> IfaceLFInfo -> IfaceLFInfo
forall a b. (a -> b) -> a -> b
$
Arity -> IfaceLFInfo
IfLFReEntrant Arity
arity
LFThunk TopLevelFlag
top_lvl Bool
no_fvs Bool
updatable StandardFormInfo
sfi Bool
mb_fun ->
Bool -> SDoc -> IfaceLFInfo -> IfaceLFInfo
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TopLevelFlag -> Bool
isTopLevel TopLevelFlag
top_lvl) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IfaceLFInfo -> IfaceLFInfo) -> IfaceLFInfo -> IfaceLFInfo
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> IfaceLFInfo -> IfaceLFInfo
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
no_fvs (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IfaceLFInfo -> IfaceLFInfo) -> IfaceLFInfo -> IfaceLFInfo
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> IfaceLFInfo -> IfaceLFInfo
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (StandardFormInfo
sfi StandardFormInfo -> StandardFormInfo -> Bool
forall a. Eq a => a -> a -> Bool
== StandardFormInfo
NonStandardThunk) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (IfaceLFInfo -> IfaceLFInfo) -> IfaceLFInfo -> IfaceLFInfo
forall a b. (a -> b) -> a -> b
$
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 ->
String -> IfaceLFInfo
forall a. HasCallStack => String -> a
panic String
"toIfaceLFInfo: LFLetNoEscape"
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
dehydrateCgBreakInfo :: [CoVar] -> [Maybe (CoVar, Word)] -> Kind -> CgBreakInfo
dehydrateCgBreakInfo [CoVar]
ty_vars [Maybe (CoVar, Word)]
idOffSets Kind
tick_ty =
CgBreakInfo
{ cgb_tyvars :: [IfaceTvBndr]
cgb_tyvars = (CoVar -> IfaceTvBndr) -> [CoVar] -> [IfaceTvBndr]
forall a b. (a -> b) -> [a] -> [b]
map CoVar -> IfaceTvBndr
toIfaceTvBndr [CoVar]
ty_vars
, cgb_vars :: [Maybe (IfaceIdBndr, Word)]
cgb_vars = (Maybe (CoVar, Word) -> Maybe (IfaceIdBndr, Word))
-> [Maybe (CoVar, Word)] -> [Maybe (IfaceIdBndr, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (((CoVar, Word) -> (IfaceIdBndr, Word))
-> Maybe (CoVar, Word) -> Maybe (IfaceIdBndr, Word)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CoVar
i, Word
offset) -> (CoVar -> IfaceIdBndr
toIfaceIdBndr CoVar
i, Word
offset))) [Maybe (CoVar, Word)]
idOffSets
, cgb_resty :: IfaceType
cgb_resty = Kind -> IfaceType
toIfaceType Kind
tick_ty
}