-@extendUnfoldEnvGivenRhs@ records in the UnfoldEnv info about the RHS
-of a new binding. There is a horrid case we have to take care about,
-due to Andr\'e Santos:
-@
- type Array_type b = Array Int b;
- type Descr_type = (Int,Int);
-
- tabulate :: (Int -> x) -> Descr_type -> Array_type x;
- tabulate f (l,u) = listArray (l,u) [f i | i <- [l..u]];
-
- f_iaamain a_xs=
- let {
- f_aareorder::(Array_type Int) -> (Array_type t1) -> Array_type t1;
- f_aareorder a_index a_ar=
- let {
- f_aareorder' a_i= a_ar ! (a_index ! a_i)
- } in tabulate f_aareorder' (bounds a_ar);
- r_index=tabulate ((+) 1) (1,1);
- arr = listArray (1,1) a_xs;
- arg = f_aareorder r_index arr
- } in elems arg
-@
-Now, when the RHS of arg gets simplified, we inline f_aareorder to get
-@
- arg = let f_aareorder' a_i = arr ! (r_index ! a_i)
- in tabulate f_aareorder' (bounds arr)
-@
-Note that r_index is not inlined, because it was bound to a_index which
-occurs inside a lambda.
-
-Alas, if elems is inlined, so that (elems arg) becomes (case arg of ...),
-then arg is inlined. IF WE USE THE NEW VERSION OF arg, and re-occurrence
-analyse it, we won't spot the inside-lambda property of r_index, so r_index
-will get inlined inside the lambda. AARGH.
-
-Solution: when we occurrence-analyse the new RHS we have to go back
-and modify the info recorded in the UnfoldEnv for the free vars
-of the RHS. In the example we'd go back and record that r_index is now used
-inside a lambda.
-
-\begin{code}
-extendEnvGivenNewRhs :: SimplEnv -> OutId -> OutExpr -> SimplEnv
-extendEnvGivenNewRhs env out_id rhs
- = extendEnvGivenBinding env noBinderInfo out_id rhs
-
-extendEnvGivenBinding :: SimplEnv -> BinderInfo -> OutId -> OutExpr -> SimplEnv
-extendEnvGivenBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
- occ_info out_id rhs
- = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env new_con_apps
- where
- new_out_id_env | okToInline (whnfOrBottom form)
- (couldBeSmallEnoughToInline guidance)
- occ_info
- = out_id_env_with_unfolding
- | otherwise
- = out_id_env
- -- Don't bother to extend the OutIdEnv unless there is some possibility
- -- that the thing might be inlined. We check this by calling okToInline suitably.
-
- new_con_apps = _scc_ "eegnr.conapps"
- extendConApps con_apps out_id rhs
-
- -- Modify the occ info for rhs's interesting free variables.
- out_id_env_with_unfolding = _scc_ "eegnr.modify_occ"
- foldl modifyOccInfo env1 full_fv_occ_info
- -- NB: full_fv_occ_info *combines* the occurrence of the current binder
- -- with the occurrences of its RHS's free variables. That's to take
- -- account of:
- -- let a = \x -> BIG in
- -- let b = \f -> f a
- -- in ...b...b...b...
- -- Here "a" occurs exactly once. "b" simplifies to a small value.
- -- So "b" will be inlined at each call site, and there's a good chance
- -- that "a" will too. So we'd better modify "a"s occurrence info to
- -- record the fact that it can now occur many times by virtue that "b" can.
-
- full_fv_occ_info = _scc_ "eegnr.full_fv"
- [ (uniq, fv_occ `andBinderInfo` occ_info)
- | (uniq, fv_occ) <- ufmToList fv_occ_info
- ]
-
- -- Add an unfolding and rhs_info for the new Id.
- -- If the out_id is already in the OutIdEnv (which can happen if
- -- the call to extendEnvGivenBinding is from extendEnvGivenNewRhs)
- -- then just replace the unfolding, leaving occurrence info alone.
- env1 = _scc_ "eegnr.modify_out"
- addToUFM_C modifyOutEnvItem out_id_env out_id
- (out_id, occ_info, rhs_info)
-
- -- Occurrence-analyse the RHS
- -- The "interesting" free variables we want occurrence info for are those
- -- in the OutIdEnv that have only a single occurrence right now.
- (fv_occ_info, template) = _scc_ "eegnr.occ-anal"
- occurAnalyseExpr is_interesting rhs
-
- is_interesting v = _scc_ "eegnr.mkidset"
- case lookupIdEnv out_id_env v of
- Just (_, occ, _) -> isOneOcc occ
- other -> False
-
- -- Compute unfolding details
- rhs_info = OutUnfolding unf_cc (SimpleUnfolding form guidance template)
- form = _scc_ "eegnr.form_sum"
- mkFormSummary rhs
- guidance = _scc_ "eegnr.guidance"
- mkSimplUnfoldingGuidance chkr out_id rhs
-
- -- Compute cost centre for thing
- unf_cc | noCostCentreAttached expr_cc = encl_cc
- | otherwise = expr_cc
- where
- expr_cc = coreExprCc rhs
-\end{code}