-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
- = let
- s_env = SimplEnv chkr encl_cc ty_env in_id_env out_id_env new_con_apps
- s_env_uf = SimplEnv chkr encl_cc ty_env in_id_env out_id_env_with_unfolding new_con_apps
- in
- case guidance of
- -- Cheap and nasty hack to force strict insertion.
- UnfoldNever ->
- if isEmptyFM new_con_apps then s_env else s_env
- other ->
- if isEmptyFM new_con_apps then s_env_uf else s_env_uf
- where
- new_con_apps = extendConApps con_apps out_id rhs
-{-
- new_out_id_env = case guidance of
- UnfoldNever -> out_id_env -- No new stuff to put in
- other -> out_id_env_with_unfolding
--}
- -- If there is an unfolding, we add rhs-info for out_id,
- -- *and* modify the occ info for rhs's interesting free variables.
- --
- -- If the out_id is already in the OutIdEnv, then just replace the
- -- unfolding, leaving occurrence info alone (this must then
- -- be a call via extendEnvGivenNewRhs).
- out_id_env_with_unfolding = foldl modifyOccInfo env1 full_fv_occ_info
- -- full_fv_occ_info combines the occurrence of the current binder
- -- with the occurrences of its RHS's free variables.
- full_fv_occ_info = [ (uniq, fv_occ `andBinderInfo` occ_info)
- | (uniq,fv_occ) <- ufmToList fv_occ_info
- ]
- env1 = 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) = occurAnalyseExpr interesting_fvs rhs
- interesting_fvs = mkIdSet [id | (id,OneOcc _ _ _ _ _,_) <- eltsUFM out_id_env]
-
- -- Compute unfolding details
- rhs_info = OutUnfolding unf_cc (SimpleUnfolding form_summary guidance template)
- form_summary = mkFormSummary rhs
-
- 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}
-
-
-
-Recursive bindings
-~~~~~~~~~~~~~~~~~~
-We need to be pretty careful when extending
-the environment with RHS info in recursive groups.
-
-Here's a nasty example:
-
- letrec r = f x
- t = r
- x = ...t...
- in
- ...t...
-
-Here, r occurs exactly once, so we may reasonably inline r in t's RHS.
-But the pre-simplified t's rhs is an atom, r, so we may also decide to
-inline t everywhere. But if we do *both* these reasonable things we get
-
- letrec r = f x
- t = f x
- x = ...r...
- in
- ...t...
-
-Bad news! (f x) is duplicated! (The t in the body doesn't get
-inlined because by the time the recursive group is done we see that
-t's RHS isn't an atom.)
-
-Our solution is this:
- (a) we inline un-simplified RHSs, and then simplify
- them in a clone-only environment.
- (b) we inline only variables and values
-This means that
-
-
- r = f x ==> r = f x
- t = r ==> t = r
- x = ...t... ==> x = ...r...
- in in
- t r
-
-Now t is dead, and we're home.
-
-Most silly x=y bindings in recursive group will go away. But not all:
-
- let y = 1:x
- x = y
-
-Here, we can't inline x because it's in an argument position. so we'll just replace
-with a clone of y. Instead we'll probably inline y (a small value) to give
-
- let y = 1:x
- x = 1:y
-
-which is OK if not clever.
-
-\begin{code}
-extendEnvForRecBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
- (out_id, ((_,occ_info), old_rhs))
- = case (form_summary, guidance) of
- (_, UnfoldNever) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps -- No new stuff to put in
- (ValueForm, _) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env_with_unfolding con_apps
- (VarForm, _) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env_with_unfolding con_apps
- other -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps -- Not a value or variable
-
--- SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env con_apps
- where
-{-
- new_out_id_env = case (form_summary, guidance) of
- (_, UnfoldNever) -> out_id_env -- No new stuff to put in
- (ValueForm, _) -> out_id_env_with_unfolding
- (VarForm, _) -> out_id_env_with_unfolding
- other -> out_id_env -- Not a value or variable
--}
- -- If there is an unfolding, we add rhs-info for out_id,
- -- No need to modify occ info because RHS is pre-simplification
- out_id_env_with_unfolding = addOneToIdEnv out_id_env out_id
- (out_id, occ_info, rhs_info)
-
- -- Compute unfolding details
- -- Note that we use the "old" environment, that just has clones of the rec-bound vars,
- -- in the InUnfolding. So if we ever use the InUnfolding we'll just inline once.
- -- Only if the thing is still small enough next time round will we inline again.
- rhs_info = InUnfolding env (SimpleUnfolding form_summary guidance old_rhs)
- form_summary = mkFormSummary old_rhs
- guidance = mkSimplUnfoldingGuidance chkr out_id (unTagBinders old_rhs)
-
-
-mkSimplUnfoldingGuidance chkr out_id rhs
- = case calcUnfoldingGuidance inline_prag opt_UnfoldingCreationThreshold rhs of
- UnfoldNever -> UnfoldNever
- v -> v
- where
- inline_prag = not (switchIsOn chkr IgnoreINLINEPragma) && idWantsToBeINLINEd out_id
-
-extendEnvGivenRhsInfo :: SimplEnv -> OutId -> BinderInfo -> RhsInfo -> SimplEnv
-extendEnvGivenRhsInfo env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)