+ -- Mostly, the arity info of a function is in the fn's IdInfo
+ -- But new bindings introduced by CoreSat may not have no
+ -- arity info; it would do us no good anyway. For example:
+ -- let f = \ab -> e in f
+ -- No point in having correct arity info for f!
+ -- Hence the hasArity stuff below.
+ -- NB: f_arity is only consulted for LetBound things
+ f_arity = stgArity f how_bound
+ saturated = f_arity <= n_val_args
+
+ fun_occ
+ | not_letrec_bound = noBinderInfo -- Uninteresting variable
+ | f_arity > 0 && saturated = stgSatOcc -- Saturated or over-saturated function call
+ | otherwise = stgUnsatOcc -- Unsaturated function or thunk
+
+ fun_escs
+ | not_letrec_bound = emptyVarSet -- Only letrec-bound escapees are interesting
+ | f_arity == n_val_args = emptyVarSet -- A function *or thunk* with an exactly
+ -- saturated call doesn't escape
+ -- (let-no-escape applies to 'thunks' too)
+
+ | otherwise = unitVarSet f -- Inexact application; it does escape
+
+ -- At the moment of the call:
+
+ -- either the function is *not* let-no-escaped, in which case
+ -- nothing is live except live_in_cont
+ -- or the function *is* let-no-escaped in which case the
+ -- variables it uses are live, but still the function
+ -- itself is not. PS. In this case, the function's
+ -- live vars should already include those of the
+ -- continuation, but it does no harm to just union the
+ -- two regardless.
+
+ res_ty = exprType (mkApps (Var f) args)
+ app = case idDetails f of
+ DataConWorkId dc | saturated -> StgConApp dc args'
+
+ -- Some primitive operator that might be implemented as a library call.
+ PrimOpId op -> ASSERT( saturated )
+ StgOpApp (StgPrimOp op) args' res_ty
+
+ -- A call to some primitive Cmm function.
+ FCallId (CCall (CCallSpec (StaticTarget lbl (Just pkgId)) PrimCallConv _))
+ -> ASSERT( saturated )
+ StgOpApp (StgPrimCallOp (PrimCall lbl pkgId)) args' res_ty
+
+ -- A regular foreign call.
+ FCallId call -> ASSERT( saturated )
+ StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
+
+ TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args')
+ _other -> StgApp f args'
+ fvs = fun_fvs `unionFVInfo` args_fvs
+ vars = fun_escs `unionVarSet` (getFVSet args_fvs)
+ -- All the free vars of the args are disqualified
+ -- from being let-no-escaped.
+
+ -- Forcing these fixes a leak in the code generator, noticed while
+ -- profiling for trac #4367
+ app `seq` fvs `seq` seqVarSet vars `seq` return (
+ app,
+ fvs,
+ vars
+ )