never executed always true always false
    1 
    2 {-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*]
    3 
    4 -- | Functions for converting Core things to interface file things.
    5 module GHC.CoreToIface
    6     ( -- * Binders
    7       toIfaceTvBndr
    8     , toIfaceTvBndrs
    9     , toIfaceIdBndr
   10     , toIfaceBndr
   11     , toIfaceForAllBndr
   12     , toIfaceTyCoVarBinders
   13     , toIfaceTyVar
   14       -- * Types
   15     , toIfaceType, toIfaceTypeX
   16     , toIfaceKind
   17     , toIfaceTcArgs
   18     , toIfaceTyCon
   19     , toIfaceTyCon_name
   20     , toIfaceTyLit
   21       -- * Tidying types
   22     , tidyToIfaceType
   23     , tidyToIfaceContext
   24     , tidyToIfaceTcArgs
   25       -- * Coercions
   26     , toIfaceCoercion, toIfaceCoercionX
   27       -- * Pattern synonyms
   28     , patSynToIfaceDecl
   29       -- * Expressions
   30     , toIfaceExpr
   31     , toIfaceBang
   32     , toIfaceSrcBang
   33     , toIfaceLetBndr
   34     , toIfaceIdDetails
   35     , toIfaceIdInfo
   36     , toIfUnfolding
   37     , toIfaceTickish
   38     , toIfaceBind
   39     , toIfaceAlt
   40     , toIfaceCon
   41     , toIfaceApp
   42     , toIfaceVar
   43       -- * Other stuff
   44     , toIfaceLFInfo
   45     ) where
   46 
   47 import GHC.Prelude
   48 
   49 import GHC.StgToCmm.Types
   50 
   51 import GHC.Core
   52 import GHC.Core.TyCon hiding ( pprPromotionQuote )
   53 import GHC.Core.Coercion.Axiom
   54 import GHC.Core.DataCon
   55 import GHC.Core.Type
   56 import GHC.Core.Multiplicity
   57 import GHC.Core.PatSyn
   58 import GHC.Core.TyCo.Rep
   59 import GHC.Core.TyCo.Tidy ( tidyCo )
   60 
   61 import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon )
   62 import GHC.Builtin.Types ( heqTyCon )
   63 import GHC.Builtin.Names
   64 
   65 import GHC.Iface.Syntax
   66 import GHC.Data.FastString
   67 
   68 import GHC.Types.Id
   69 import GHC.Types.Id.Info
   70 import GHC.Types.Id.Make ( noinlineIdName )
   71 import GHC.Types.Literal
   72 import GHC.Types.Name
   73 import GHC.Types.Basic
   74 import GHC.Types.Var
   75 import GHC.Types.Var.Env
   76 import GHC.Types.Var.Set
   77 import GHC.Types.Tickish
   78 import GHC.Types.Demand ( isTopSig )
   79 import GHC.Types.Cpr ( topCprSig )
   80 
   81 import GHC.Utils.Outputable
   82 import GHC.Utils.Panic
   83 import GHC.Utils.Misc
   84 import GHC.Utils.Trace
   85 
   86 import Data.Maybe ( catMaybes )
   87 
   88 {- Note [Avoiding space leaks in toIface*]
   89    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   90 
   91 Building a interface file depends on the output of the simplifier.
   92 If we build these lazily this would mean keeping the Core AST alive
   93 much longer than necessary causing a space "leak".
   94 
   95 This happens for example when we only write the interface file to disk
   96 after code gen has run, in which case we might carry megabytes of core
   97 AST in the heap which is no longer needed.
   98 
   99 We avoid this in two ways.
  100 * First we use -XStrict in GHC.CoreToIface which avoids many thunks
  101   to begin with.
  102 * Second we define NFData instance for Iface syntax and use them to
  103   force any remaining thunks.
  104 
  105 -XStrict is not sufficient as patterns of the form `f (g x)` would still
  106 result in a thunk being allocated for `g x`.
  107 
  108 NFData is sufficient for the space leak, but using -XStrict reduces allocation
  109 by ~0.1% when compiling with -O. (nofib/spectral/simple, T10370).
  110 It's essentially free performance hence we use -XStrict on top of NFData.
  111 
  112 MR !1633 on gitlab, has more discussion on the topic.
  113 -}
  114 
  115 ----------------
  116 toIfaceTvBndr :: TyVar -> IfaceTvBndr
  117 toIfaceTvBndr = toIfaceTvBndrX emptyVarSet
  118 
  119 toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr
  120 toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)
  121                           , toIfaceTypeX fr (tyVarKind tyvar)
  122                           )
  123 
  124 toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
  125 toIfaceTvBndrs = map toIfaceTvBndr
  126 
  127 toIfaceIdBndr :: Id -> IfaceIdBndr
  128 toIfaceIdBndr = toIfaceIdBndrX emptyVarSet
  129 
  130 toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
  131 toIfaceIdBndrX fr covar = ( toIfaceType (idMult covar)
  132                           , occNameFS (getOccName covar)
  133                           , toIfaceTypeX fr (varType covar)
  134                           )
  135 
  136 toIfaceBndr :: Var -> IfaceBndr
  137 toIfaceBndr var
  138   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
  139   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
  140 
  141 toIfaceBndrX :: VarSet -> Var -> IfaceBndr
  142 toIfaceBndrX fr var
  143   | isId var  = IfaceIdBndr (toIfaceIdBndrX fr var)
  144   | otherwise = IfaceTvBndr (toIfaceTvBndrX fr var)
  145 
  146 toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
  147 toIfaceTyCoVarBinder (Bndr tv vis) = Bndr (toIfaceBndr tv) vis
  148 
  149 toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]
  150 toIfaceTyCoVarBinders = map toIfaceTyCoVarBinder
  151 
  152 {-
  153 ************************************************************************
  154 *                                                                      *
  155         Conversion from Type to IfaceType
  156 *                                                                      *
  157 ************************************************************************
  158 -}
  159 
  160 toIfaceKind :: Type -> IfaceType
  161 toIfaceKind = toIfaceType
  162 
  163 ---------------------
  164 toIfaceType :: Type -> IfaceType
  165 toIfaceType = toIfaceTypeX emptyVarSet
  166 
  167 toIfaceTypeX :: VarSet -> Type -> IfaceType
  168 -- (toIfaceTypeX free ty)
  169 --    translates the tyvars in 'free' as IfaceFreeTyVars
  170 --
  171 -- Synonyms are retained in the interface type
  172 toIfaceTypeX fr (TyVarTy tv)   -- See Note [TcTyVars in IfaceType] in GHC.Iface.Type
  173   | tv `elemVarSet` fr         = IfaceFreeTyVar tv
  174   | otherwise                  = IfaceTyVar (toIfaceTyVar tv)
  175 toIfaceTypeX fr ty@(AppTy {})  =
  176   -- Flatten as many argument AppTys as possible, then turn them into an
  177   -- IfaceAppArgs list.
  178   -- See Note [Suppressing invisible arguments] in GHC.Iface.Type.
  179   let (head, args) = splitAppTys ty
  180   in IfaceAppTy (toIfaceTypeX fr head) (toIfaceAppTyArgsX fr head args)
  181 toIfaceTypeX _  (LitTy n)      = IfaceLitTy (toIfaceTyLit n)
  182 toIfaceTypeX fr (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndrX fr b)
  183                                                (toIfaceTypeX (fr `delVarSet` binderVar b) t)
  184 toIfaceTypeX fr (FunTy { ft_arg = t1, ft_mult = w, ft_res = t2, ft_af = af })
  185   = IfaceFunTy af (toIfaceTypeX fr w) (toIfaceTypeX fr t1) (toIfaceTypeX fr t2)
  186 toIfaceTypeX fr (CastTy ty co)  = IfaceCastTy (toIfaceTypeX fr ty) (toIfaceCoercionX fr co)
  187 toIfaceTypeX fr (CoercionTy co) = IfaceCoercionTy (toIfaceCoercionX fr co)
  188 
  189 toIfaceTypeX fr (TyConApp tc tys)
  190     -- tuples
  191   | Just sort <- tyConTuple_maybe tc
  192   , n_tys == arity
  193   = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys)
  194 
  195   | Just dc <- isPromotedDataCon_maybe tc
  196   , isBoxedTupleDataCon dc
  197   , n_tys == 2*arity
  198   = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))
  199 
  200   | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]
  201   , (k1:k2:_) <- tys
  202   = let info = mkIfaceTyConInfo NotPromoted sort
  203         sort | k1 `eqType` k2 = IfaceEqualityTyCon
  204              | otherwise      = IfaceNormalTyCon
  205     in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)
  206 
  207     -- other applications
  208   | otherwise
  209   = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgsX fr tc tys)
  210   where
  211     arity = tyConArity tc
  212     n_tys = length tys
  213 
  214 toIfaceTyVar :: TyVar -> FastString
  215 toIfaceTyVar = occNameFS . getOccName
  216 
  217 toIfaceCoVar :: CoVar -> FastString
  218 toIfaceCoVar = occNameFS . getOccName
  219 
  220 toIfaceForAllBndr :: (VarBndr TyCoVar flag) -> (VarBndr IfaceBndr flag)
  221 toIfaceForAllBndr = toIfaceForAllBndrX emptyVarSet
  222 
  223 toIfaceForAllBndrX :: VarSet -> (VarBndr TyCoVar flag) -> (VarBndr IfaceBndr flag)
  224 toIfaceForAllBndrX fr (Bndr v vis) = Bndr (toIfaceBndrX fr v) vis
  225 
  226 ----------------
  227 toIfaceTyCon :: TyCon -> IfaceTyCon
  228 toIfaceTyCon tc
  229   = IfaceTyCon tc_name info
  230   where
  231     tc_name = tyConName tc
  232     info    = mkIfaceTyConInfo promoted sort
  233     promoted | isPromotedDataCon tc = IsPromoted
  234              | otherwise            = NotPromoted
  235 
  236     tupleSort :: TyCon -> Maybe IfaceTyConSort
  237     tupleSort tc' =
  238         case tyConTuple_maybe tc' of
  239           Just UnboxedTuple -> let arity = tyConArity tc' `div` 2
  240                                in Just $ IfaceTupleTyCon arity UnboxedTuple
  241           Just sort         -> let arity = tyConArity tc'
  242                                in Just $ IfaceTupleTyCon arity sort
  243           Nothing           -> Nothing
  244 
  245     sort
  246       | Just tsort <- tupleSort tc           = tsort
  247 
  248       | Just dcon <- isPromotedDataCon_maybe tc
  249       , let tc' = dataConTyCon dcon
  250       , Just tsort <- tupleSort tc'          = tsort
  251 
  252       | isUnboxedSumTyCon tc
  253       , Just cons <- tyConDataCons_maybe tc  = IfaceSumTyCon (length cons)
  254 
  255       | otherwise                            = IfaceNormalTyCon
  256 
  257 
  258 toIfaceTyCon_name :: Name -> IfaceTyCon
  259 toIfaceTyCon_name n = IfaceTyCon n info
  260   where info = mkIfaceTyConInfo NotPromoted IfaceNormalTyCon
  261   -- Used for the "rough-match" tycon stuff,
  262   -- where pretty-printing is not an issue
  263 
  264 toIfaceTyLit :: TyLit -> IfaceTyLit
  265 toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
  266 toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x
  267 toIfaceTyLit (CharTyLit x) = IfaceCharTyLit x
  268 
  269 ----------------
  270 toIfaceCoercion :: Coercion -> IfaceCoercion
  271 toIfaceCoercion = toIfaceCoercionX emptyVarSet
  272 
  273 toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
  274 -- (toIfaceCoercionX free ty)
  275 --    translates the tyvars in 'free' as IfaceFreeTyVars
  276 toIfaceCoercionX fr co
  277   = go co
  278   where
  279     go_mco MRefl     = IfaceMRefl
  280     go_mco (MCo co)  = IfaceMCo $ go co
  281 
  282     go (Refl ty)            = IfaceReflCo (toIfaceTypeX fr ty)
  283     go (GRefl r ty mco)     = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)
  284     go (CoVarCo cv)
  285       -- See [TcTyVars in IfaceType] in GHC.Iface.Type
  286       | cv `elemVarSet` fr  = IfaceFreeCoVar cv
  287       | otherwise           = IfaceCoVarCo (toIfaceCoVar cv)
  288     go (HoleCo h)           = IfaceHoleCo  (coHoleCoVar h)
  289 
  290     go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)
  291     go (SymCo co)           = IfaceSymCo (go co)
  292     go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)
  293     go (NthCo _r d co)      = IfaceNthCo d (go co)
  294     go (LRCo lr co)         = IfaceLRCo lr (go co)
  295     go (InstCo co arg)      = IfaceInstCo (go co) (go arg)
  296     go (KindCo c)           = IfaceKindCo (go c)
  297     go (SubCo co)           = IfaceSubCo (go co)
  298     go (AxiomRuleCo co cs)  = IfaceAxiomRuleCo (coaxrName co) (map go cs)
  299     go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs)
  300     go (UnivCo p r t1 t2)   = IfaceUnivCo (go_prov p) r
  301                                           (toIfaceTypeX fr t1)
  302                                           (toIfaceTypeX fr t2)
  303     go (TyConAppCo r tc cos)
  304       | tc `hasKey` funTyConKey
  305       , [_,_,_,_, _] <- cos         = panic "toIfaceCoercion"
  306       | otherwise                =
  307         IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)
  308     go (FunCo r w co1 co2)   = IfaceFunCo r (go w) (go co1) (go co2)
  309 
  310     go (ForAllCo tv k co) = IfaceForAllCo (toIfaceBndr tv)
  311                                           (toIfaceCoercionX fr' k)
  312                                           (toIfaceCoercionX fr' co)
  313                           where
  314                             fr' = fr `delVarSet` tv
  315 
  316     go_prov :: UnivCoProvenance -> IfaceUnivCoProv
  317     go_prov (PhantomProv co)    = IfacePhantomProv (go co)
  318     go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)
  319     go_prov (PluginProv str)    = IfacePluginProv str
  320     go_prov (CorePrepProv b)    = IfaceCorePrepProv b
  321 
  322 toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
  323 toIfaceTcArgs = toIfaceTcArgsX emptyVarSet
  324 
  325 toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
  326 toIfaceTcArgsX fr tc ty_args = toIfaceAppArgsX fr (tyConKind tc) ty_args
  327 
  328 toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
  329 toIfaceAppTyArgsX fr ty ty_args = toIfaceAppArgsX fr (typeKind ty) ty_args
  330 
  331 toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs
  332 -- See Note [Suppressing invisible arguments] in GHC.Iface.Type
  333 -- We produce a result list of args describing visibility
  334 -- The awkward case is
  335 --    T :: forall k. * -> k
  336 -- And consider
  337 --    T (forall j. blah) * blib
  338 -- Is 'blib' visible?  It depends on the visibility flag on j,
  339 -- so we have to substitute for k.  Annoying!
  340 toIfaceAppArgsX fr kind ty_args
  341   = go (mkEmptyTCvSubst in_scope) kind ty_args
  342   where
  343     in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)
  344 
  345     go _   _                   []     = IA_Nil
  346     go env ty                  ts
  347       | Just ty' <- coreView ty
  348       = go env ty' ts
  349     go env (ForAllTy (Bndr tv vis) res) (t:ts)
  350       = IA_Arg t' vis ts'
  351       where
  352         t'  = toIfaceTypeX fr t
  353         ts' = go (extendTCvSubst env tv t) res ts
  354 
  355     go env (FunTy { ft_af = af, ft_res = res }) (t:ts)
  356       = IA_Arg (toIfaceTypeX fr t) argf (go env res ts)
  357       where
  358         argf = case af of
  359                  VisArg   -> Required
  360                  InvisArg -> Inferred
  361                    -- It's rare for a kind to have a constraint argument, but
  362                    -- it can happen. See Note [AnonTCB InvisArg] in GHC.Core.TyCon.
  363 
  364     go env ty ts@(t1:ts1)
  365       | not (isEmptyTCvSubst env)
  366       = go (zapTCvSubst env) (substTy env ty) ts
  367         -- See Note [Care with kind instantiation] in GHC.Core.Type
  368 
  369       | otherwise
  370       = -- There's a kind error in the type we are trying to print
  371         -- e.g. kind = k, ty_args = [Int]
  372         -- This is probably a compiler bug, so we print a trace and
  373         -- carry on as if it were FunTy.  Without the test for
  374         -- isEmptyTCvSubst we'd get an infinite loop (#15473)
  375         warnPprTrace True (ppr kind $$ ppr ty_args) $
  376         IA_Arg (toIfaceTypeX fr t1) Required (go env ty ts1)
  377 
  378 tidyToIfaceType :: TidyEnv -> Type -> IfaceType
  379 tidyToIfaceType env ty = toIfaceType (tidyType env ty)
  380 
  381 tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
  382 tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
  383 
  384 tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
  385 tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
  386 
  387 {-
  388 ************************************************************************
  389 *                                                                      *
  390         Conversion of pattern synonyms
  391 *                                                                      *
  392 ************************************************************************
  393 -}
  394 
  395 patSynToIfaceDecl :: PatSyn -> IfaceDecl
  396 patSynToIfaceDecl ps
  397   = IfacePatSyn { ifName          = getName $ ps
  398                 , ifPatMatcher    = to_if_pr (patSynMatcher ps)
  399                 , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)
  400                 , ifPatIsInfix    = patSynIsInfix ps
  401                 , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'
  402                 , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'
  403                 , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
  404                 , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
  405                 , ifPatArgs       = map (tidyToIfaceType env2 . scaledThing) args
  406                 , ifPatTy         = tidyToIfaceType env2 rhs_ty
  407                 , ifFieldLabels   = (patSynFieldLabels ps)
  408                 }
  409   where
  410     (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
  411     univ_bndrs = patSynUnivTyVarBinders ps
  412     ex_bndrs   = patSynExTyVarBinders ps
  413     (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs
  414     (env2, ex_bndrs')   = tidyTyCoVarBinders env1 ex_bndrs
  415     to_if_pr (name, _type, needs_dummy) = (name, needs_dummy)
  416 
  417 {-
  418 ************************************************************************
  419 *                                                                      *
  420         Conversion of other things
  421 *                                                                      *
  422 ************************************************************************
  423 -}
  424 
  425 toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
  426 toIfaceBang _    HsLazy              = IfNoBang
  427 toIfaceBang _   (HsUnpack Nothing)   = IfUnpack
  428 toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
  429 toIfaceBang _   HsStrict             = IfStrict
  430 
  431 toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
  432 toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang
  433 
  434 toIfaceLetBndr :: Id -> IfaceLetBndr
  435 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
  436                                (toIfaceType (idType id))
  437                                (toIfaceIdInfo (idInfo id))
  438                                (toIfaceJoinInfo (isJoinId_maybe id))
  439   -- Put into the interface file any IdInfo that GHC.Core.Tidy.tidyLetBndr
  440   -- has left on the Id.  See Note [IdInfo on nested let-bindings] in GHC.Iface.Syntax
  441 
  442 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
  443 toIfaceIdDetails VanillaId                      = IfVanillaId
  444 toIfaceIdDetails (DFunId {})                    = IfDFunId
  445 toIfaceIdDetails (RecSelId { sel_naughty = n
  446                            , sel_tycon = tc })  =
  447   let iface = case tc of
  448                 RecSelData ty_con -> Left (toIfaceTyCon ty_con)
  449                 RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)
  450   in IfRecSelId iface n
  451 
  452   -- The remaining cases are all "implicit Ids" which don't
  453   -- appear in interface files at all
  454 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
  455                          IfVanillaId   -- Unexpected; the other
  456 
  457 toIfaceIdInfo :: IdInfo -> IfaceIdInfo
  458 toIfaceIdInfo id_info
  459   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, cpr_hsinfo,
  460                inline_hsinfo,  unfold_hsinfo, levity_hsinfo]
  461                -- NB: strictness and arity must appear in the list before unfolding
  462                -- See GHC.IfaceToCore.tcUnfolding
  463   where
  464     ------------  Arity  --------------
  465     arity_info = arityInfo id_info
  466     arity_hsinfo | arity_info == 0 = Nothing
  467                  | otherwise       = Just (HsArity arity_info)
  468 
  469     ------------ Caf Info --------------
  470     caf_info   = cafInfo id_info
  471     caf_hsinfo = case caf_info of
  472                    NoCafRefs -> Just HsNoCafRefs
  473                    _other    -> Nothing
  474 
  475     ------------  Strictness  --------------
  476         -- No point in explicitly exporting TopSig
  477     sig_info = dmdSigInfo id_info
  478     strict_hsinfo | not (isTopSig sig_info) = Just (HsDmdSig sig_info)
  479                   | otherwise               = Nothing
  480 
  481     ------------  CPR --------------
  482     cpr_info = cprSigInfo id_info
  483     cpr_hsinfo | cpr_info /= topCprSig = Just (HsCprSig cpr_info)
  484                | otherwise             = Nothing
  485     ------------  Unfolding  --------------
  486     unfold_hsinfo = toIfUnfolding loop_breaker (realUnfoldingInfo id_info)
  487     loop_breaker  = isStrongLoopBreaker (occInfo id_info)
  488 
  489     ------------  Inline prag  --------------
  490     inline_prag = inlinePragInfo id_info
  491     inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
  492                   | otherwise = Just (HsInline inline_prag)
  493 
  494     ------------  Representation polymorphism  ----------
  495     levity_hsinfo | isNeverRepPolyIdInfo id_info = Just HsLevity
  496                   | otherwise                    = Nothing
  497 
  498 toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo
  499 toIfaceJoinInfo (Just ar) = IfaceJoinPoint ar
  500 toIfaceJoinInfo Nothing   = IfaceNotJoinPoint
  501 
  502 --------------------------
  503 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
  504 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
  505                                 , uf_src = src
  506                                 , uf_guidance = guidance })
  507   = Just $ HsUnfold lb $
  508     case src of
  509         InlineStable
  510           -> case guidance of
  511                UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }
  512                       -> IfInlineRule arity unsat_ok boring_ok if_rhs
  513                _other -> IfCoreUnfold True if_rhs
  514         InlineCompulsory -> IfCompulsory if_rhs
  515         InlineRhs        -> IfCoreUnfold False if_rhs
  516         -- Yes, even if guidance is UnfNever, expose the unfolding
  517         -- If we didn't want to expose the unfolding, GHC.Iface.Tidy would
  518         -- have stuck in NoUnfolding.  For supercompilation we want
  519         -- to see that unfolding!
  520   where
  521     if_rhs = toIfaceExpr rhs
  522 
  523 toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
  524   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
  525       -- No need to serialise the data constructor;
  526       -- we can recover it from the type of the dfun
  527 
  528 toIfUnfolding _ (OtherCon {}) = Nothing
  529   -- The binding site of an Id doesn't have OtherCon, except perhaps
  530   -- where we have called zapUnfolding; and that evald'ness info is
  531   -- not needed by importing modules
  532 
  533 toIfUnfolding _ BootUnfolding = Nothing
  534   -- Can't happen; we only have BootUnfolding for imported binders
  535 
  536 toIfUnfolding _ NoUnfolding = Nothing
  537 
  538 {-
  539 ************************************************************************
  540 *                                                                      *
  541         Conversion of expressions
  542 *                                                                      *
  543 ************************************************************************
  544 -}
  545 
  546 toIfaceExpr :: CoreExpr -> IfaceExpr
  547 toIfaceExpr (Var v)         = toIfaceVar v
  548 toIfaceExpr (Lit (LitRubbish r)) = IfaceLitRubbish (toIfaceType r)
  549 toIfaceExpr (Lit l)         = IfaceLit l
  550 toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)
  551 toIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)
  552 toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)
  553 toIfaceExpr (App f a)       = toIfaceApp f [a]
  554 toIfaceExpr (Case s x ty as)
  555   | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)
  556   | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)
  557 toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)
  558 toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
  559 toIfaceExpr (Tick t e)
  560   | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)
  561   | otherwise                   = toIfaceExpr e
  562 
  563 toIfaceOneShot :: Id -> IfaceOneShot
  564 toIfaceOneShot id | isId id
  565                   , OneShotLam <- oneShotInfo (idInfo id)
  566                   = IfaceOneShot
  567                   | otherwise
  568                   = IfaceNoOneShot
  569 
  570 ---------------------
  571 toIfaceTickish :: CoreTickish -> Maybe IfaceTickish
  572 toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
  573 toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)
  574 toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)
  575 toIfaceTickish (Breakpoint {})         = Nothing
  576    -- Ignore breakpoints, since they are relevant only to GHCi, and
  577    -- should not be serialised (#8333)
  578 
  579 ---------------------
  580 toIfaceBind :: Bind Id -> IfaceBinding
  581 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
  582 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
  583 
  584 ---------------------
  585 toIfaceAlt :: CoreAlt -> IfaceAlt
  586 toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr r)
  587 
  588 ---------------------
  589 toIfaceCon :: AltCon -> IfaceConAlt
  590 toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
  591 toIfaceCon (LitAlt l)   = assertPpr (not (isLitRubbish l)) (ppr l) $
  592                           -- assert: see Note [Rubbish literals] wrinkle (b)
  593                           IfaceLitAlt l
  594 toIfaceCon DEFAULT      = IfaceDefault
  595 
  596 ---------------------
  597 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
  598 toIfaceApp (App f a) as = toIfaceApp f (a:as)
  599 toIfaceApp (Var v) as
  600   = case isDataConWorkId_maybe v of
  601         -- We convert the *worker* for tuples into IfaceTuples
  602         Just dc |  saturated
  603                 ,  Just tup_sort <- tyConTuple_maybe tc
  604                 -> IfaceTuple tup_sort tup_args
  605           where
  606             val_args  = dropWhile isTypeArg as
  607             saturated = val_args `lengthIs` idArity v
  608             tup_args  = map toIfaceExpr val_args
  609             tc        = dataConTyCon dc
  610 
  611         _ -> mkIfaceApps (toIfaceVar v) as
  612 
  613 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
  614 
  615 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
  616 mkIfaceApps f as = foldl' (\f a -> IfaceApp f (toIfaceExpr a)) f as
  617 
  618 ---------------------
  619 toIfaceVar :: Id -> IfaceExpr
  620 toIfaceVar v
  621     | isBootUnfolding (idUnfolding v)
  622     = -- See Note [Inlining and hs-boot files]
  623       IfaceApp (IfaceApp (IfaceExt noinlineIdName)
  624                          (IfaceType (toIfaceType (idType v))))
  625                (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
  626 
  627     | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
  628                                       -- Foreign calls have special syntax
  629 
  630     | isExternalName name             = IfaceExt name
  631     | otherwise                       = IfaceLcl (getOccFS name)
  632   where name = idName v
  633 
  634 
  635 ---------------------
  636 toIfaceLFInfo :: Name -> LambdaFormInfo -> IfaceLFInfo
  637 toIfaceLFInfo nm lfi = case lfi of
  638     LFReEntrant top_lvl arity no_fvs _arg_descr ->
  639       -- Exported LFReEntrant closures are top level, and top-level closures
  640       -- don't have free variables
  641       assertPpr (isTopLevel top_lvl) (ppr nm) $
  642       assertPpr no_fvs (ppr nm) $
  643       IfLFReEntrant arity
  644     LFThunk top_lvl no_fvs updatable sfi mb_fun ->
  645       -- Exported LFThunk closures are top level (which don't have free
  646       -- variables) and non-standard (see cgTopRhsClosure)
  647       assertPpr (isTopLevel top_lvl) (ppr nm) $
  648       assertPpr no_fvs (ppr nm) $
  649       assertPpr (sfi == NonStandardThunk) (ppr nm) $
  650       IfLFThunk updatable mb_fun
  651     LFCon dc ->
  652       IfLFCon (dataConName dc)
  653     LFUnknown mb_fun ->
  654       IfLFUnknown mb_fun
  655     LFUnlifted ->
  656       IfLFUnlifted
  657     LFLetNoEscape ->
  658       panic "toIfaceLFInfo: LFLetNoEscape"
  659 
  660 {- Note [Inlining and hs-boot files]
  661 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  662 Consider this example (#10083, #12789):
  663 
  664     ---------- RSR.hs-boot ------------
  665     module RSR where
  666       data RSR
  667       eqRSR :: RSR -> RSR -> Bool
  668 
  669     ---------- SR.hs ------------
  670     module SR where
  671       import {-# SOURCE #-} RSR
  672       data SR = MkSR RSR
  673       eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2
  674 
  675     ---------- RSR.hs ------------
  676     module RSR where
  677       import SR
  678       data RSR = MkRSR SR -- deriving( Eq )
  679       eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
  680       foo x y = not (eqRSR x y)
  681 
  682 When compiling RSR we get this code
  683 
  684     RSR.eqRSR :: RSR -> RSR -> Bool
  685     RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
  686                 case ds1 of _ { RSR.MkRSR s1 ->
  687                 case ds2 of _ { RSR.MkRSR s2 ->
  688                 SR.eqSR s1 s2 }}
  689 
  690     RSR.foo :: RSR -> RSR -> Bool
  691     RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)
  692 
  693 Now, when optimising foo:
  694     Inline eqRSR (small, non-rec)
  695     Inline eqSR  (small, non-rec)
  696 but the result of inlining eqSR from SR is another call to eqRSR, so
  697 everything repeats.  Neither eqSR nor eqRSR are (apparently) loop
  698 breakers.
  699 
  700 Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR
  701 with `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means
  702 that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly
  703 as would have been the case if `foo` had been defined in SR.hs (and
  704 marked as a loop-breaker).
  705 
  706 But how do we arrange for this to happen?  There are two ingredients:
  707 
  708     1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),
  709     for every variable reference we see if we are referring to an
  710     'Id' that came from an hs-boot file.  If so, we add a `noinline`
  711     to the reference.
  712 
  713     2. But how do we know if a reference came from an hs-boot file
  714     or not?  We could record this directly in the 'IdInfo', but
  715     actually we deduce this by looking at the unfolding: 'Id's
  716     that come from boot files are given a special unfolding
  717     (upon typechecking) 'BootUnfolding' which say that there is
  718     no unfolding, and the reason is because the 'Id' came from
  719     a boot file.
  720 
  721 Here is a solution that doesn't work: when compiling RSR,
  722 add a NOINLINE pragma to every function exported by the boot-file
  723 for RSR (if it exists).  Doing so makes the bootstrapped GHC itself
  724 slower by 8% overall (on #9872a-d, and T1969: the reason
  725 is that these NOINLINE'd functions now can't be profitably inlined
  726 outside of the hs-boot loop.
  727 
  728 -}