{-# 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
      
    , dehydrateCgBreakInfo
    ) where
import GHC.Prelude
import Data.Word
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.Tidy ( tidyCo )
import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
import GHC.Builtin.Types ( heqTyCon )
import GHC.Builtin.Names
import GHC.Iface.Syntax
import GHC.Data.FastString
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Id.Make ( noinlineIdName )
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 GHC.Utils.Trace
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 (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 (CoVar -> Kind
idMult CoVar
covar)
                          , 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)
toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder :: forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder (Bndr CoVar
tv vis
vis) = IfaceBndr -> vis -> VarBndr IfaceBndr 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 = (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 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 (VarSet -> TyCoVarBinder -> IfaceForAllBndr
forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
fr TyCoVarBinder
b)
                                               (VarSet -> Kind -> IfaceType
toIfaceTypeX (VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` TyCoVarBinder -> CoVar
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 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 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 -> FastString
toIfaceTyVar :: CoVar -> FastString
toIfaceTyVar = 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 -> FastString
toIfaceCoVar :: CoVar -> FastString
toIfaceCoVar = 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
toIfaceForAllBndr :: (VarBndr TyCoVar flag) -> (VarBndr IfaceBndr flag)
toIfaceForAllBndr :: forall vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
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
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' 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) = 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 (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
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) ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
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 (CoAxiom Branched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
c) Arity
i ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
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 TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funTyConKey
      , [KindCoercion
_,KindCoercion
_,KindCoercion
_,KindCoercion
_, KindCoercion
_] <- [KindCoercion]
cos         = String -> IfaceCoercion
forall a. String -> a
panic String
"toIfaceCoercion"
      | Bool
otherwise                =
        Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
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 ((() :: Constraint) => 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
  = 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) ((() :: Constraint) => TCvSubst -> Kind -> Kind
TCvSubst -> Kind -> Kind
substTy TCvSubst
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
$$ [Kind] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Kind]
ty_args) (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$
        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 = (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 vis. VarBndr CoVar vis -> VarBndr IfaceBndr vis
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 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       = (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])
tidyTyCoVarBinders 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])
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 (CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoVar
id))
                               (Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
id))
                               (IdInfo -> IfaceIdInfo
toIfaceIdInfo ((() :: Constraint) => CoVar -> IdInfo
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 (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 })  =
  let iface :: Either IfaceTyCon IfaceDecl
iface = 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)
                RecSelPatSyn PatSyn
pat_syn -> IfaceDecl -> Either IfaceTyCon IfaceDecl
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 = 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, 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 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)
    
    levity_hsinfo :: Maybe IfaceInfoItem
levity_hsinfo | IdInfo -> Bool
isNeverRepPolyIdInfo IdInfo
id_info = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just IfaceInfoItem
HsLevity
                  | Bool
otherwise                    = Maybe IfaceInfoItem
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_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
$
    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 -> UnfoldingCache -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
True UnfoldingCache
cache IfaceExpr
if_rhs
        UnfoldingSource
InlineCompulsory -> IfaceExpr -> IfaceUnfolding
IfCompulsory IfaceExpr
if_rhs
        UnfoldingSource
InlineRhs        -> Bool -> UnfoldingCache -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
False UnfoldingCache
cache 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 })
  = 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
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var CoVar
v)         = CoVar -> IfaceExpr
toIfaceVar CoVar
v
toIfaceExpr (Lit (LitRubbish Kind
r)) = IfaceType -> IfaceExpr
IfaceLitRubbish (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 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)
  | [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 -> FastString -> [IfaceAlt] -> IfaceExpr
IfaceCase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (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 -> 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 ((() :: Constraint) => CoVar -> IdInfo
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) = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (CostCentre -> Bool -> Bool -> IfaceTickish
IfaceSCC CostCentre
cc Bool
tick Bool
push)
toIfaceTickish (HpcTick Module
modl Arity
ix)       = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (Module -> Arity -> IfaceTickish
IfaceHpcTick Module
modl Arity
ix)
toIfaceTickish (SourceNote RealSrcSpan
src String
names)  = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (RealSrcSpan -> String -> IfaceTickish
IfaceSource RealSrcSpan
src String
names)
toIfaceTickish (Breakpoint {})         = Maybe IfaceTickish
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) ((CoVar -> FastString) -> [CoVar] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map 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
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
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
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 (Name -> FastString
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 ->
      
      
      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. String -> a
panic String
"toIfaceLFInfo: LFLetNoEscape"
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word16)] -> Type -> CgBreakInfo
dehydrateCgBreakInfo :: [CoVar] -> [Maybe (CoVar, Word16)] -> Kind -> CgBreakInfo
dehydrateCgBreakInfo [CoVar]
ty_vars [Maybe (CoVar, Word16)]
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, Word16)]
cgb_vars = (Maybe (CoVar, Word16) -> Maybe (IfaceIdBndr, Word16))
-> [Maybe (CoVar, Word16)] -> [Maybe (IfaceIdBndr, Word16)]
forall a b. (a -> b) -> [a] -> [b]
map (((CoVar, Word16) -> (IfaceIdBndr, Word16))
-> Maybe (CoVar, Word16) -> Maybe (IfaceIdBndr, Word16)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CoVar
i, Word16
offset) -> (CoVar -> IfaceIdBndr
toIfaceIdBndr CoVar
i, Word16
offset))) [Maybe (CoVar, Word16)]
idOffSets
            , cgb_resty :: IfaceType
cgb_resty = Kind -> IfaceType
toIfaceType Kind
tick_ty
            }