{-# LANGUAGE CPP #-}
{-# 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
    , toIfaceForAllBndr
    , toIfaceTyCoVarBinders
    , 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
    , toIfaceAlt
    , toIfaceCon
    , toIfaceApp
    , toIfaceVar
      -- * Other stuff
    , toIfaceLFInfo
    ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Iface.Syntax
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.StgToCmm.Types
import GHC.Core
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
import GHC.Builtin.Types ( heqTyCon )
import GHC.Types.Id.Make ( noinlineIdName )
import GHC.Builtin.Names
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.PatSyn
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Tidy ( tidyCo )
import GHC.Types.Demand ( isTopSig )
import GHC.Types.Cpr ( topCprSig )

import Data.Maybe ( catMaybes )

{- 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 = ( OccName -> FastString
occNameFS (CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoVar
tyvar)
                          , VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr (CoVar -> Type
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 = ( Type -> IfaceType
toIfaceType (CoVar -> Type
idMult CoVar
covar)
                          , OccName -> FastString
occNameFS (CoVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName CoVar
covar)
                          , VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr (CoVar -> Type
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

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

toIfaceKind :: Type -> IfaceType
toIfaceKind :: Type -> IfaceType
toIfaceKind = Type -> IfaceType
toIfaceType

---------------------
toIfaceType :: Type -> IfaceType
toIfaceType :: Type -> IfaceType
toIfaceType = VarSet -> Type -> 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 -> Type -> IfaceType
toIfaceTypeX VarSet
fr (TyVarTy CoVar
tv)   -- See Note [TcTyVars in IfaceType] in GHC.Iface.Type
  | 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 :: Type
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 (Type
head, [Type]
args) = Type -> (Type, [Type])
splitAppTys Type
ty
  in IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
head) (VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX VarSet
fr Type
head [Type]
args)
toIfaceTypeX VarSet
_  (LitTy TyLit
n)      = IfaceTyLit -> IfaceType
IfaceLitTy (TyLit -> IfaceTyLit
toIfaceTyLit TyLit
n)
toIfaceTypeX VarSet
fr (ForAllTy TyCoVarBinder
b Type
t) = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (VarSet -> TyCoVarBinder -> IfaceForAllBndr
forall flag. VarSet -> VarBndr CoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndrX VarSet
fr TyCoVarBinder
b)
                                               (VarSet -> Type -> IfaceType
toIfaceTypeX (VarSet
fr VarSet -> CoVar -> VarSet
`delVarSet` TyCoVarBinder -> CoVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
b) Type
t)
toIfaceTypeX VarSet
fr (FunTy { ft_arg :: Type -> Type
ft_arg = Type
t1, ft_mult :: Type -> Type
ft_mult = Type
w, ft_res :: Type -> Type
ft_res = Type
t2, ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af })
  = AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
w) (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1) (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t2)
toIfaceTypeX VarSet
fr (CastTy Type
ty KindCoercion
co)  = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
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 [Type]
tys)
    -- tuples
  | Just TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
  , Int
n_tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity
  = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
sort PromotionFlag
NotPromoted (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)

  | Just DataCon
dc <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
  , DataCon -> Bool
isTupleDataCon DataCon
dc
  , Int
n_tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
arity
  = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
BoxedTuple PromotionFlag
IsPromoted (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc (Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop Int
arity [Type]
tys))

  | TyCon
tc TyCon -> [TyCon] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ TyCon
eqPrimTyCon, TyCon
eqReprPrimTyCon, TyCon
heqTyCon ]
  , (Type
k1:Type
k2:[Type]
_) <- [Type]
tys
  = let info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
sort
        sort :: IfaceTyConSort
sort | Type
k1 Type -> Type -> Bool
`eqType` Type
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 -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)

    -- other applications
  | Bool
otherwise
  = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)
  where
    arity :: Int
arity = TyCon -> Int
tyConArity TyCon
tc
    n_tys :: Int
n_tys = [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
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
IfaceTyConInfo 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 :: Int
arity = TyCon -> Int
tyConArity TyCon
tc' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                               in IfaceTyConSort -> Maybe IfaceTyConSort
forall a. a -> Maybe a
Just (IfaceTyConSort -> Maybe IfaceTyConSort)
-> IfaceTyConSort -> Maybe IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Int
arity TupleSort
UnboxedTuple
          Just TupleSort
sort         -> let arity :: Int
arity = TyCon -> Int
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
$ Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Int
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]
isDataSumTyCon_maybe TyCon
tc = Int -> IfaceTyConSort
IfaceSumTyCon ([DataCon] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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
IfaceTyConInfo 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) = FastString -> IfaceTyLit
IfaceStrTyLit FastString
x

----------------
toIfaceCoercion :: Coercion -> IfaceCoercion
toIfaceCoercion :: KindCoercion -> IfaceCoercion
toIfaceCoercion = VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
emptyVarSet

toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
-- (toIfaceCoercionX free ty)
--    translates the tyvars in 'free' as IfaceFreeTyVars
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 Type
ty)            = IfaceType -> IfaceCoercion
IfaceReflCo (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
ty)
    go (GRefl Role
r Type
ty MCoercion
mco)     = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
ty) (MCoercion -> IfaceMCoercion
go_mco MCoercion
mco)
    go (CoVarCo CoVar
cv)
      -- See [TcTyVars in IfaceType] in GHC.Iface.Type
      | 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 Int
d KindCoercion
co)      = Int -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Int
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 Int
i [KindCoercion]
cs) = Name -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo (CoAxiom Branched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
c) Int
i ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cs)
    go (UnivCo UnivCoProvenance
p Role
r Type
t1 Type
t2)   = IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo (UnivCoProvenance -> IfaceUnivCoProv
go_prov UnivCoProvenance
p) Role
r
                                          (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1)
                                          (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
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 -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toIfaceCoercion" SDoc
empty
      | Bool
otherwise                =
        Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) ((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 UnivCoProvenance
CorePrepProv        = String -> SDoc -> IfaceUnivCoProv
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toIfaceCoercionX" SDoc
empty
         -- CorePrepProv only happens after the iface file is generated

toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs = VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
emptyVarSet

toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
ty_args = VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (TyCon -> Type
tyConKind TyCon
tc) [Type]
ty_args

toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX VarSet
fr Type
ty [Type]
ty_args = VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty) [Type]
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 -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr Type
kind [Type]
ty_args
  = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (InScopeSet -> TCvSubst
mkEmptyTCvSubst InScopeSet
in_scope) Type
kind [Type]
ty_args
  where
    in_scope :: InScopeSet
in_scope = VarSet -> InScopeSet
mkInScopeSet ([Type] -> VarSet
tyCoVarsOfTypes [Type]
ty_args)

    go :: TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
_   Type
_                   []     = IfaceAppArgs
IA_Nil
    go TCvSubst
env Type
ty                  [Type]
ts
      | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty
      = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
ty' [Type]
ts
    go TCvSubst
env (ForAllTy (Bndr CoVar
tv ArgFlag
vis) Type
res) (Type
t:[Type]
ts)
      = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t' ArgFlag
vis IfaceAppArgs
ts'
      where
        t' :: IfaceType
t'  = VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t
        ts' :: IfaceAppArgs
ts' = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (TCvSubst -> CoVar -> Type -> TCvSubst
extendTCvSubst TCvSubst
env CoVar
tv Type
t) Type
res [Type]
ts

    go TCvSubst
env (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_res :: Type -> Type
ft_res = Type
res }) (Type
t:[Type]
ts)
      = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t) ArgFlag
argf (TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
res [Type]
ts)
      where
        argf :: ArgFlag
argf = case AnonArgFlag
af of
                 AnonArgFlag
VisArg   -> ArgFlag
Required
                 AnonArgFlag
InvisArg -> ArgFlag
Inferred
                   -- It's rare for a kind to have a constraint argument, but
                   -- it can happen. See Note [AnonTCB InvisArg] in GHC.Core.TyCon.

    go TCvSubst
env Type
ty ts :: [Type]
ts@(Type
t1:[Type]
ts1)
      | Bool -> Bool
not (TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
env)
      = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (TCvSubst -> TCvSubst
zapTCvSubst TCvSubst
env) (HasCallStack => TCvSubst -> Type -> Type
TCvSubst -> Type -> Type
substTy TCvSubst
env Type
ty) [Type]
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)
        WARN( True, ppr kind $$ ppr ty_args )
        IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1) ArgFlag
Required (TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
ty [Type]
ts1)

tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env Type
ty = Type -> IfaceType
toIfaceType (TidyEnv -> Type -> Type
tidyType TidyEnv
env Type
ty)

tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs TidyEnv
env TyCon
tc [Type]
tys = TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc (TidyEnv -> [Type] -> [Type]
tidyTypes TidyEnv
env [Type]
tys)

tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
tidyToIfaceContext :: TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env [Type]
theta = (Type -> IfaceType) -> [Type] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env) [Type]
theta

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

patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
ps
  = IfacePatSyn :: Name
-> Bool
-> (Name, Bool)
-> Maybe (Name, Bool)
-> [IfaceForAllSpecBndr]
-> [IfaceForAllSpecBndr]
-> IfaceContext
-> IfaceContext
-> IfaceContext
-> IfaceType
-> [FieldLabel]
-> IfaceDecl
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    = (CoVar, Bool) -> (Name, Bool)
forall {b}. (CoVar, b) -> (Name, b)
to_if_pr (PatSyn -> (CoVar, Bool)
patSynMatcher PatSyn
ps)
                , ifPatBuilder :: Maybe (Name, Bool)
ifPatBuilder    = ((CoVar, Bool) -> (Name, Bool))
-> Maybe (CoVar, Bool) -> Maybe (Name, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CoVar, Bool) -> (Name, Bool)
forall {b}. (CoVar, b) -> (Name, b)
to_if_pr (PatSyn -> Maybe (CoVar, 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 -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Type]
prov_theta
                , ifPatReqCtxt :: IfaceContext
ifPatReqCtxt    = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Type]
req_theta
                , ifPatArgs :: IfaceContext
ifPatArgs       = (Scaled Type -> IfaceType) -> [Scaled Type] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2 (Type -> IfaceType)
-> (Scaled Type -> Type) -> Scaled Type -> IfaceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scaled Type -> Type
forall a. Scaled a -> a
scaledThing) [Scaled Type]
args
                , ifPatTy :: IfaceType
ifPatTy         = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2 Type
rhs_ty
                , ifFieldLabels :: [FieldLabel]
ifFieldLabels   = (PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
ps)
                }
  where
    ([CoVar]
_univ_tvs, [Type]
req_theta, [CoVar]
_ex_tvs, [Type]
prov_theta, [Scaled Type]
args, Type
rhs_ty) = PatSyn -> ([CoVar], [Type], [CoVar], [Type], [Scaled Type], Type)
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 :: (CoVar, b) -> (Name, b)
to_if_pr (CoVar
id, b
needs_dummy) = (CoVar -> Name
idName CoVar
id, 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 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))
                               (Type -> IfaceType
toIfaceType (CoVar -> Type
idType CoVar
id))
                               (IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => CoVar -> IdInfo
CoVar -> IdInfo
idInfo CoVar
id))
                               (Maybe Int -> IfaceJoinInfo
toIfaceJoinInfo (CoVar -> Maybe Int
isJoinId_maybe 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

toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails IdDetails
VanillaId                      = IfaceIdDetails
IfVanillaId
toIfaceIdDetails (DFunId {})                    = IfaceIdDetails
IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
n
                           , sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
tc })  =
  let iface :: Either IfaceTyCon IfaceDecl
iface = case RecSelParent
tc of
                RecSelData TyCon
ty_con -> 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

  -- 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, Maybe IfaceInfoItem
levity_hsinfo]
               -- NB: strictness and arity must appear in the list before unfolding
               -- See GHC.IfaceToCore.tcUnfolding
  where
    ------------  Arity  --------------
    arity_info :: Int
arity_info = IdInfo -> Int
arityInfo IdInfo
id_info
    arity_hsinfo :: Maybe IfaceInfoItem
arity_hsinfo | Int
arity_info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
                 | Bool
otherwise       = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (Int -> IfaceInfoItem
HsArity Int
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 :: StrictSig
sig_info = IdInfo -> StrictSig
strictnessInfo IdInfo
id_info
    strict_hsinfo :: Maybe IfaceInfoItem
strict_hsinfo | Bool -> Bool
not (StrictSig -> Bool
isTopSig StrictSig
sig_info) = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (StrictSig -> IfaceInfoItem
HsStrictness StrictSig
sig_info)
                  | Bool
otherwise               = Maybe IfaceInfoItem
forall a. Maybe a
Nothing

    ------------  CPR --------------
    cpr_info :: CprSig
cpr_info = IdInfo -> CprSig
cprInfo 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
HsCpr 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
unfoldingInfo 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)

    ------------  Levity polymorphism  ----------
    levity_hsinfo :: Maybe IfaceInfoItem
levity_hsinfo | IdInfo -> Bool
isNeverLevPolyIdInfo 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 Int -> IfaceJoinInfo
toIfaceJoinInfo (Just Int
ar) = Int -> IfaceJoinInfo
IfaceJoinPoint Int
ar
toIfaceJoinInfo Maybe Int
Nothing   = IfaceJoinInfo
IfaceNotJoinPoint

--------------------------
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding Bool
lb (CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
rhs
                                , uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src
                                , uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
guidance })
  = 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 -> Int
ug_arity = Int
arity, ug_unsat_ok :: UnfoldingGuidance -> Bool
ug_unsat_ok = Bool
unsat_ok, ug_boring_ok :: UnfoldingGuidance -> Bool
ug_boring_ok =  Bool
boring_ok }
                      -> Int -> Bool -> Bool -> IfaceExpr -> IfaceUnfolding
IfInlineRule Int
arity Bool
unsat_ok Bool
boring_ok IfaceExpr
if_rhs
               UnfoldingGuidance
_other -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
True IfaceExpr
if_rhs
        UnfoldingSource
InlineCompulsory -> IfaceExpr -> IfaceUnfolding
IfCompulsory IfaceExpr
if_rhs
        UnfoldingSource
InlineRhs        -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
False IfaceExpr
if_rhs
        -- 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!
  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)))
      -- 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 zapUnfolding; 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

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

toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var CoVar
v)         = CoVar -> IfaceExpr
toIfaceVar CoVar
v
toIfaceExpr (Lit Literal
l)         = Literal -> IfaceExpr
IfaceLit Literal
l
toIfaceExpr (Type Type
ty)       = IfaceType -> IfaceExpr
IfaceType (Type -> IfaceType
toIfaceType Type
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 Type
ty [Alt CoVar]
as)
  | [Alt CoVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt CoVar]
as                 = IfaceExpr -> IfaceType -> IfaceExpr
IfaceECase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (Type -> IfaceType
toIfaceType Type
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 Tickish CoVar
t CoreExpr
e)
  | Just IfaceTickish
t' <- Tickish CoVar -> Maybe IfaceTickish
toIfaceTickish Tickish CoVar
t = IfaceTickish -> IfaceExpr -> IfaceExpr
IfaceTick IfaceTickish
t' (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
  | Bool
otherwise                   = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e

toIfaceOneShot :: Id -> IfaceOneShot
toIfaceOneShot :: CoVar -> IfaceOneShot
toIfaceOneShot CoVar
id | CoVar -> Bool
isId CoVar
id
                  , OneShotInfo
OneShotLam <- IdInfo -> OneShotInfo
oneShotInfo (HasDebugCallStack => CoVar -> IdInfo
CoVar -> IdInfo
idInfo CoVar
id)
                  = IfaceOneShot
IfaceOneShot
                  | Bool
otherwise
                  = IfaceOneShot
IfaceNoOneShot

---------------------
toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
toIfaceTickish :: Tickish CoVar -> 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 Int
ix)       = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (Module -> Int -> IfaceTickish
IfaceHpcTick Module
modl Int
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
   -- Ignore breakpoints, since they are relevant only to GHCi, and
   -- should not be serialised (#8333)

---------------------
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 :: (AltCon, [Var], CoreExpr)
           -> (IfaceConAlt, [FastString], IfaceExpr)
toIfaceAlt :: Alt CoVar -> IfaceAlt
toIfaceAlt (AltCon
c,[CoVar]
bs,CoreExpr
r) = (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)   = 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
        -- 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] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` CoVar -> Int
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 (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
noinlineIdName)
                         (IfaceType -> IfaceExpr
IfaceType (Type -> IfaceType
toIfaceType (CoVar -> Type
idType CoVar
v))))
               (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 (Type -> IfaceType
toIfaceType (CoVar -> Type
idType CoVar
v))
                                      -- Foreign calls have special syntax

    | 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 Int
arity Bool
no_fvs ArgDescr
_arg_descr ->
      -- Exported LFReEntrant closures are top level, and top-level closures
      -- don't have free variables
      ASSERT2(isTopLevel top_lvl, ppr nm)
      ASSERT2(no_fvs, ppr nm)
      Int -> IfaceLFInfo
IfLFReEntrant Int
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)
      ASSERT2(isTopLevel top_lvl, ppr nm)
      ASSERT2(no_fvs, ppr nm)
      ASSERT2(sfi == NonStandardThunk, ppr nm)
      Bool -> Bool -> IfaceLFInfo
IfLFThunk Bool
updatable Bool
mb_fun
    LFCon DataCon
dc ->
      Name -> IfaceLFInfo
IfLFCon (DataCon -> Name
dataConName DataCon
dc)
    LFUnknown Bool
mb_fun ->
      Bool -> IfaceLFInfo
IfLFUnknown Bool
mb_fun
    LambdaFormInfo
LFUnlifted ->
      IfaceLFInfo
IfLFUnlifted
    LambdaFormInfo
LFLetNoEscape ->
      String -> IfaceLFInfo
forall a. String -> a
panic String
"toIfaceLFInfo: LFLetNoEscape"

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

    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.

-}