{-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*]

-- | Functions for converting Core things to interface file things.
module GHC.CoreToIface
    ( -- * Binders
      toIfaceTvBndr
    , toIfaceTvBndrs
    , toIfaceIdBndr
    , toIfaceBndr
    , toIfaceTopBndr
    , toIfaceForAllBndr
    , toIfaceForAllBndrs
    , toIfaceTyVar
      -- * Types
    , toIfaceType, toIfaceTypeX
    , toIfaceKind
    , toIfaceTcArgs
    , toIfaceTyCon
    , toIfaceTyCon_name
    , toIfaceTyLit
      -- * Tidying types
    , tidyToIfaceType
    , tidyToIfaceContext
    , tidyToIfaceTcArgs
      -- * Coercions
    , toIfaceCoercion, toIfaceCoercionX
      -- * Pattern synonyms
    , patSynToIfaceDecl
      -- * Expressions
    , toIfaceExpr
    , toIfaceBang
    , toIfaceSrcBang
    , toIfaceLetBndr
    , toIfaceIdDetails
    , toIfaceIdInfo
    , toIfUnfolding
    , toIfaceTickish
    , toIfaceBind
    , toIfaceTopBind
    , toIfaceAlt
    , toIfaceCon
    , toIfaceApp
    , toIfaceVar
      -- * Other stuff
    , toIfaceLFInfo
    , toIfaceBooleanFormula
      -- * CgBreakInfo
    , 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.Data.BooleanFormula qualified as BF(BooleanFormula(..))

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.Types.SrcLoc (unLoc)

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc

import GHC.Hs.Extension (GhcRn)

import Data.Maybe ( isNothing, catMaybes )

{- Note [Avoiding space leaks in toIface*]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Building a interface file depends on the output of the simplifier.
If we build these lazily this would mean keeping the Core AST alive
much longer than necessary causing a space "leak".

This happens for example when we only write the interface file to disk
after code gen has run, in which case we might carry megabytes of core
AST in the heap which is no longer needed.

We avoid this in two ways.
* First we use -XStrict in GHC.CoreToIface which avoids many thunks
  to begin with.
* Second we define NFData instance for Iface syntax and use them to
  force any remaining thunks.

-XStrict is not sufficient as patterns of the form `f (g x)` would still
result in a thunk being allocated for `g x`.

NFData is sufficient for the space leak, but using -XStrict reduces allocation
by ~0.1% when compiling with -O. (nofib/spectral/simple, T10370).
It's essentially free performance hence we use -XStrict on top of NFData.

MR !1633 on gitlab, has more discussion on the topic.
-}

----------------
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

{-
************************************************************************
*                                                                      *
        Conversion from Type to IfaceType
*                                                                      *
************************************************************************
-}

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 free ty)
--    translates the tyvars in 'free' as IfaceFreeTyVars
--
-- Synonyms are retained in the interface type
toIfaceTypeX :: VarSet -> Kind -> IfaceType
toIfaceTypeX VarSet
fr (TyVarTy CoVar
tv)   -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type
  | 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 {})  =
  -- Flatten as many argument AppTys as possible, then turn them into an
  -- IfaceAppArgs list.
  -- See Note [Suppressing invisible arguments] in GHC.Iface.Type.
  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)
    -- tuples
  | 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)

    -- other applications
  | 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
  -- Used for the "rough-match" tycon stuff,
  -- where pretty-printing is not an issue

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 free ty)
--    translates the tyvars in 'free' as IfaceFreeTyVars
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)
      -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type
      | 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
-- See Note [Suppressing invisible arguments] in GHC.Iface.Type
-- We produce a result list of args describing visibility
-- The awkward case is
--    T :: forall k. * -> k
-- And consider
--    T (forall j. blah) * blib
-- Is 'blib' visible?  It depends on the visibility flag on j,
-- so we have to substitute for k.  Annoying!
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
        -- See Note [Care with kind instantiation] in GHC.Core.Type

      | Bool
otherwise
      = -- There's a kind error in the type we are trying to print
        -- e.g. kind = k, ty_args = [Int]
        -- This is probably a compiler bug, so we print a trace and
        -- carry on as if it were FunTy.  Without the test for
        -- isEmptyTCvSubst we'd get an infinite loop (#15473)
        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

{-
************************************************************************
*                                                                      *
        Conversion of pattern synonyms
*                                                                      *
************************************************************************
-}

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)

{-
************************************************************************
*                                                                      *
        Conversion of other things
*                                                                      *
************************************************************************
-}

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)
  -- Put into the interface file any IdInfo that GHC.Core.Tidy.tidyLetBndr
  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in GHC.Iface.Syntax

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

  -- The remaining cases are all "implicit Ids" which don't
  -- appear in interface files at all
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   -- Unexpected; the other

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]
               -- NB: strictness and arity must appear in the list before unfolding
               -- See GHC.IfaceToCore.tcUnfolding
  where
    ------------  Arity  --------------
    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 --------------
    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

    ------------  Strictness  --------------
        -- No point in explicitly exporting TopSig
    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 --------------
    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
    ------------  Unfolding  --------------
    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  --------------
    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)
        -- Yes, even if guidance is UnfNever, expose the unfolding
        -- If we didn't want to expose the unfolding, GHC.Iface.Tidy would
        -- have stuck in NoUnfolding.  For supercompilation we want
        -- to see that unfolding!

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)))
      -- No need to serialise the data constructor;
      -- we can recover it from the type of the dfun

toIfUnfolding Bool
_ (OtherCon {}) = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
  -- The binding site of an Id doesn't have OtherCon, except perhaps
  -- where we have called trimUnfolding; and that evald'ness info is
  -- not needed by importing modules

toIfUnfolding Bool
_ Unfolding
BootUnfolding = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
  -- Can't happen; we only have BootUnfolding for imported binders

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

toIfaceBooleanFormula :: BF.BooleanFormula GhcRn -> IfaceBooleanFormula
toIfaceBooleanFormula :: BooleanFormula GhcRn -> IfaceBooleanFormula
toIfaceBooleanFormula = BooleanFormula GhcRn -> IfaceBooleanFormula
forall {p} {l} {l}.
(XRec p (IdP p) ~ GenLocated l (IdP p),
 XRec p (BooleanFormula p) ~ GenLocated l (BooleanFormula p),
 NamedThing (IdP p)) =>
BooleanFormula p -> IfaceBooleanFormula
go
  where
    go :: BooleanFormula p -> IfaceBooleanFormula
go (BF.Var XRec p (IdP p)
nm   ) = IfLclName -> IfaceBooleanFormula
IfVar    (IfLclName -> IfaceBooleanFormula)
-> IfLclName -> IfaceBooleanFormula
forall a b. (a -> b) -> a -> b
$ FastString -> IfLclName
mkIfLclName (FastString -> IfLclName)
-> (XRec p (IdP p) -> FastString) -> XRec p (IdP p) -> IfLclName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP p -> FastString
forall a. NamedThing a => a -> FastString
getOccFS (IdP p -> FastString)
-> (GenLocated l (IdP p) -> IdP p)
-> GenLocated l (IdP p)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (IdP p) -> IdP p
forall l e. GenLocated l e -> e
unLoc (XRec p (IdP p) -> IfLclName) -> XRec p (IdP p) -> IfLclName
forall a b. (a -> b) -> a -> b
$  XRec p (IdP p)
nm
    go (BF.And [XRec p (BooleanFormula p)]
bfs  ) = [IfaceBooleanFormula] -> IfaceBooleanFormula
IfAnd    ([IfaceBooleanFormula] -> IfaceBooleanFormula)
-> [IfaceBooleanFormula] -> IfaceBooleanFormula
forall a b. (a -> b) -> a -> b
$ (GenLocated l (BooleanFormula p) -> IfaceBooleanFormula)
-> [GenLocated l (BooleanFormula p)] -> [IfaceBooleanFormula]
forall a b. (a -> b) -> [a] -> [b]
map (BooleanFormula p -> IfaceBooleanFormula
go (BooleanFormula p -> IfaceBooleanFormula)
-> (GenLocated l (BooleanFormula p) -> BooleanFormula p)
-> GenLocated l (BooleanFormula p)
-> IfaceBooleanFormula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (BooleanFormula p) -> BooleanFormula p
forall l e. GenLocated l e -> e
unLoc) [XRec p (BooleanFormula p)]
[GenLocated l (BooleanFormula p)]
bfs
    go (BF.Or [XRec p (BooleanFormula p)]
bfs   ) = [IfaceBooleanFormula] -> IfaceBooleanFormula
IfOr     ([IfaceBooleanFormula] -> IfaceBooleanFormula)
-> [IfaceBooleanFormula] -> IfaceBooleanFormula
forall a b. (a -> b) -> a -> b
$ (GenLocated l (BooleanFormula p) -> IfaceBooleanFormula)
-> [GenLocated l (BooleanFormula p)] -> [IfaceBooleanFormula]
forall a b. (a -> b) -> [a] -> [b]
map (BooleanFormula p -> IfaceBooleanFormula
go (BooleanFormula p -> IfaceBooleanFormula)
-> (GenLocated l (BooleanFormula p) -> BooleanFormula p)
-> GenLocated l (BooleanFormula p)
-> IfaceBooleanFormula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (BooleanFormula p) -> BooleanFormula p
forall l e. GenLocated l e -> e
unLoc) [XRec p (BooleanFormula p)]
[GenLocated l (BooleanFormula p)]
bfs
    go (BF.Parens XRec p (BooleanFormula p)
bf) = IfaceBooleanFormula -> IfaceBooleanFormula
IfParens (IfaceBooleanFormula -> IfaceBooleanFormula)
-> IfaceBooleanFormula -> IfaceBooleanFormula
forall a b. (a -> b) -> a -> b
$     (BooleanFormula p -> IfaceBooleanFormula
go (BooleanFormula p -> IfaceBooleanFormula)
-> (GenLocated l (BooleanFormula p) -> BooleanFormula p)
-> GenLocated l (BooleanFormula p)
-> IfaceBooleanFormula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (BooleanFormula p) -> BooleanFormula p
forall l e. GenLocated l e -> e
unLoc) XRec p (BooleanFormula p)
GenLocated l (BooleanFormula p)
bf

{-
************************************************************************
*                                                                      *
        Conversion of expressions
*                                                                      *
************************************************************************
-}

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
                      -- Use the existing unfolding for a global binder if we store that anyway.
                      -- See Note [Interface File with Core: Sharing RHSs]
                      IfGblTopBndr {} -> if CoVar -> Bool
already_has_unfolding CoVar
b then IfaceMaybeRhs
IfUseUnfoldingRhs else IfaceExpr -> IfaceMaybeRhs
IfRhs (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs)
                      -- Local binders will have had unfoldings trimmed so have
                      -- to serialise the whole RHS.
                      IfLclTopBndr {} -> IfaceExpr -> IfaceMaybeRhs
IfRhs (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs)
          in (IfaceTopBndrInfo
top_bndr, IfaceMaybeRhs
rhs')

        -- The sharing behaviour is currently disabled due to #22807, and relies on
        -- finished #20056 to be re-enabled.
        disabledDueTo22807 :: Bool
disabledDueTo22807 = Bool
True

        already_has_unfolding :: CoVar -> Bool
already_has_unfolding CoVar
b = Bool -> Bool
not Bool
disabledDueTo22807
                                Bool -> Bool -> Bool
&& -- The identifier has an unfolding, which we are going to serialise anyway
                                Unfolding -> Bool
hasCoreUnfolding (CoVar -> Unfolding
realIdUnfolding CoVar
b)
                                -- But not a stable unfolding, we want the optimised unfoldings.
                                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
$
                          -- assert: see Note [Rubbish literals] wrinkle (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
        -- We convert the *worker* for tuples into IfaceTuples
        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)
    = -- See Note [Inlining and hs-boot files]
      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) -- don't use mkIfaceApps, or infinite loop

    | Just ForeignCall
fcall <- CoVar -> Maybe ForeignCall
isFCallId_maybe CoVar
v = ForeignCall -> IfaceType -> IfaceExpr
IfaceFCall ForeignCall
fcall (Kind -> IfaceType
toIfaceType (CoVar -> Kind
idType CoVar
v))
                                      -- Foreign calls have special syntax

    | 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 ->
      -- Exported LFReEntrant closures are top level, and top-level closures
      -- don't have free variables
      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 ->
      -- Exported LFThunk closures are top level (which don't have free
      -- variables) and non-standard (see cgTopRhsClosure)
      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"

-- Dehydrating CgBreakInfo

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
            }

{- Note [Inlining and hs-boot files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this example (#10083, #12789):

    ---------- RSR.hs-boot ------------
    module RSR where
      data RSR
      eqRSR :: RSR -> RSR -> Bool

    ---------- SR.hs ------------
    module SR where
      import {-# SOURCE #-} RSR
      data SR = MkSR RSR
      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2

    ---------- RSR.hs ------------
    module RSR where
      import SR
      data RSR = MkRSR SR -- deriving( Eq )
      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
      foo x y = not (eqRSR x y)

When compiling RSR we get this code

    RSR.eqRSR :: RSR -> RSR -> Bool
    RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
                case ds1 of _ { RSR.MkRSR s1 ->
                case ds2 of _ { RSR.MkRSR s2 ->
                SR.eqSR s1 s2 }}

    RSR.foo :: RSR -> RSR -> Bool
    RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)

Now, when optimising foo:
    Inline eqRSR (small, non-rec)
    Inline eqSR  (small, non-rec)
but the result of inlining eqSR from SR is another call to eqRSR, so
everything repeats.  Neither eqSR nor eqRSR are (apparently) loop
breakers.

Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR
with `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means
that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly
as would have been the case if `foo` had been defined in SR.hs (and
marked as a loop-breaker).

But how do we arrange for this to happen?  There are two ingredients:

    1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),
    for every variable reference we see if we are referring to an
    'Id' that came from an hs-boot file.  If so, we add a `noinline`
    to the reference.  See Note [noinlineId magic]
    in GHC.Types.Id.Make

    2. But how do we know if a reference came from an hs-boot file
    or not?  We could record this directly in the 'IdInfo', but
    actually we deduce this by looking at the unfolding: 'Id's
    that come from boot files are given a special unfolding
    (upon typechecking) 'BootUnfolding' which say that there is
    no unfolding, and the reason is because the 'Id' came from
    a boot file.

Here is a solution that doesn't work: when compiling RSR,
add a NOINLINE pragma to every function exported by the boot-file
for RSR (if it exists).  Doing so makes the bootstrapped GHC itself
slower by 8% overall (on #9872a-d, and T1969: the reason
is that these NOINLINE'd functions now can't be profitably inlined
outside of the hs-boot loop.

Note [Interface File with Core: Sharing RHSs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

IMPORTANT: This optimisation is currently disabled due to #22807, it can be
           re-enabled once #22056 is implemented.

In order to avoid duplicating definitions for bindings which already have unfoldings
we do some minor headstands to avoid serialising the RHS of a definition if it has
*any* unfolding.

* Only global things have unfoldings, because local things have had their unfoldings stripped.
* For any global thing which has an unstable unfolding, we just use that.

In order to implement this sharing:

* When creating the interface, check the criteria above and don't serialise the RHS
  if such a case.

* When reading an interface, look at the realIdUnfolding, and then the
  maybeUnfoldingTemplate.  See `tc_iface_binding` for where this happens.

There are two main reasons why the mi_extra_decls field exists rather than shoe-horning
all the core bindings

1. mi_extra_decls retains the recursive group structure of the original program which
   is very convenient as otherwise we would have to do the analysis again when loading
   the program.
2. There are additional local top-level bindings which don't make it into mi_decls. It's
   best to keep these separate from mi_decls as mi_decls is used to compute the ABI hash.

-}