Skip to content
Snippets Groups Projects
Commit 9abe8b82 authored by sof's avatar sof
Browse files

[project @ 1997-09-09 17:50:33 by sof]

Doc update for simplRecursiveGroup
parent d43e6f77
No related merge requests found
...@@ -18,7 +18,10 @@ IMPORT_DELOOPER(SmplLoop) -- paranoia checking ...@@ -18,7 +18,10 @@ IMPORT_DELOOPER(SmplLoop) -- paranoia checking
import BinderInfo import BinderInfo
import CmdLineOpts ( SimplifierSwitch(..) ) import CmdLineOpts ( SimplifierSwitch(..) )
import ConFold ( completePrim ) import ConFold ( completePrim )
import CoreUnfold ( Unfolding, SimpleUnfolding, mkFormSummary, exprIsTrivial, whnfOrBottom, FormSummary(..) ) import CoreUnfold ( Unfolding, SimpleUnfolding, mkFormSummary,
exprIsTrivial, whnfOrBottom, inlineUnconditionally,
FormSummary(..)
)
import CostCentre ( isSccCountCostCentre, cmpCostCentre, costsAreSubsumed, useCurrentCostCentre ) import CostCentre ( isSccCountCostCentre, cmpCostCentre, costsAreSubsumed, useCurrentCostCentre )
import CoreSyn import CoreSyn
import CoreUtils ( coreExprType, nonErrorRHSs, maybeErrorApp, import CoreUtils ( coreExprType, nonErrorRHSs, maybeErrorApp,
...@@ -888,7 +891,7 @@ Notice that let to case occurs only if x is used strictly in its body ...@@ -888,7 +891,7 @@ Notice that let to case occurs only if x is used strictly in its body
-- Dead code is now discarded by the occurrence analyser, -- Dead code is now discarded by the occurrence analyser,
simplNonRec env binder@(id,occ_info) rhs body_c body_ty simplNonRec env binder@(id,occ_info) rhs body_c body_ty
| inlineUnconditionally ok_to_dup occ_info | inlineUnconditionally ok_to_dup id occ_info
= -- The binder is used in definitely-inline way in the body = -- The binder is used in definitely-inline way in the body
-- So add it to the environment, drop the binding, and continue -- So add it to the environment, drop the binding, and continue
body_c (extendEnvGivenInlining env id occ_info rhs) body_c (extendEnvGivenInlining env id occ_info rhs)
...@@ -1150,9 +1153,16 @@ simplRec env pairs body_c body_ty ...@@ -1150,9 +1153,16 @@ simplRec env pairs body_c body_ty
simplRecursiveGroup env new_ids [] simplRecursiveGroup env new_ids []
= returnSmpl ([], env) = returnSmpl ([], env)
simplRecursiveGroup env (new_id : new_ids) ((binder@(_, occ_info), rhs) : pairs) simplRecursiveGroup env (new_id : new_ids) ((binder@(id, occ_info), rhs) : pairs)
| inlineUnconditionally ok_to_dup occ_info | inlineUnconditionally ok_to_dup id occ_info
= -- Single occurrence, so drop binding and extend env with the inlining = -- Single occurrence, so drop binding and extend env with the inlining
-- This is a little delicate, because what if the unique occurrence
-- is *before* this binding? This'll never happen, because
-- either it'll be marked "never inline" or else its occurrence will
-- occur after its binding in the group.
--
-- If these claims aren't right Core Lint will spot an unbound
-- variable. A quick fix is to delete this clause for simplRecursiveGroup
let let
new_env = extendEnvGivenInlining env new_id occ_info rhs new_env = extendEnvGivenInlining env new_id occ_info rhs
in in
...@@ -1274,7 +1284,7 @@ floatBind env top_level bind ...@@ -1274,7 +1284,7 @@ floatBind env top_level bind
leakFree (id,_) rhs = case getIdArity id of leakFree (id,_) rhs = case getIdArity id of
ArityAtLeast n | n > 0 -> True ArityAtLeast n | n > 0 -> True
ArityExactly n | n > 0 -> True ArityExactly n | n > 0 -> True
other -> whnfOrBottom rhs other -> whnfOrBottom (mkFormSummary rhs)
\end{code} \end{code}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment