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

[project @ 1997-09-04 20:01:34 by sof] 

doc update;
parent bd8ead09
No related merge requests found
Hide whitespace changes
Inline Side-by-side
ghc/compiler/simplCore/Simplify.lhs
+ 248
− 243
View file @ e00e72df
......@@ -24,7 +24,8 @@ import CoreSyn
import CoreUtils ( coreExprType, nonErrorRHSs, maybeErrorApp,
unTagBinders, squashableDictishCcExpr
)
import Id ( idType, idWantsToBeINLINEd, idMustNotBeINLINEd, addIdArity, getIdArity,
import Id ( idType, idMustBeINLINEd, idWantsToBeINLINEd, idMustNotBeINLINEd,
addIdArity, getIdArity,
getIdDemandInfo, addIdDemandInfo,
GenId{-instance NamedThing-}
)
......@@ -46,7 +47,7 @@ import SimplMonad
import SimplVar ( completeVar )
import Unique ( Unique )
import SimplUtils
import Type ( mkTyVarTy, mkTyVarTys, mkAppTy, applyTy, mkFunTys,
import Type ( mkTyVarTy, mkTyVarTys, mkAppTy, applyTy, mkFunTys, maybeAppDataTyCon,
splitFunTy, splitFunTyExpandingDicts, getFunTy_maybe, eqTy
)
import TysWiredIn ( realWorldStateTy )
......@@ -499,33 +500,67 @@ simplRhsExpr
-> InExpr
-> OutId -- The new binder (used only for its type)
-> SmplM (OutExpr, ArityInfo)
\end{code}
-- First a special case for variable right-hand sides
-- v = w
-- It's OK to simplify the RHS, but it's often a waste of time. Often
-- these v = w things persist because v is exported, and w is used
-- elsewhere. So if we're not careful we'll eta expand the rhs, only
-- to eta reduce it in competeNonRec.
--
-- If we leave the binding unchanged, we will certainly replace v by w at
-- every occurrence of v, which is good enough.
--
-- In fact, it's better to replace v by w than to inline w in v's rhs,
-- even if this is the only occurrence of w. Why? Because w might have
-- IdInfo (like strictness) that v doesn't.
First a special case for variable right-hand sides
v = w
It's OK to simplify the RHS, but it's often a waste of time. Often
these v = w things persist because v is exported, and w is used
elsewhere. So if we're not careful we'll eta expand the rhs, only
to eta reduce it in competeNonRec.
If we leave the binding unchanged, we will certainly replace v by w at
every occurrence of v, which is good enough.
In fact, it's *better* to replace v by w than to inline w in v's rhs,
even if this is the only occurrence of w. Why? Because w might have
IdInfo (like strictness) that v doesn't.
Furthermore, there might be other uses of w; if so, inlining w in
v's rhs will duplicate w's rhs, whereas replacing v by w doesn't.
HOWEVER, we have to be careful if w is something that *must* be
inlined. In particular, its binding may have been dropped. Here's
an example that actually happened:
let x = let y = e in y
in f x
The "let y" was floated out, and then (since y occurs once in a
definitely inlinable position) the binding was dropped, leaving
{y=e} let x = y in f x
But now using the reasoning of this little section,
y wasn't inlined, because it was a let x=y form.
\begin{code}
simplRhsExpr env binder@(id,occ_info) (Var v) new_id
= case (runEager $ lookupId env v) of
LitArg lit -> returnSmpl (Lit lit, ArityExactly 0)
VarArg v' -> returnSmpl (Var v', getIdArity v')
| maybeToBool maybe_stop_at_var
= returnSmpl (Var the_var, getIdArity the_var)
where
maybe_stop_at_var
= case (runEager $ lookupId env v) of
VarArg v' | not (must_unfold v') -> Just v'
other -> Nothing
Just the_var = maybe_stop_at_var
must_unfold v' = idMustBeINLINEd v'
|| case lookupOutIdEnv env v' of
Just (_, _, InUnfolding _ _) -> True
other -> False
\end{code}
\begin{code}
simplRhsExpr env binder@(id,occ_info) rhs new_id
| maybeToBool (maybeAppDataTyCon rhs_ty)
-- Deal with the data type case, in which case the elaborate
-- eta-expansion nonsense is really quite a waste of time.
= simplExpr rhs_env rhs [] rhs_ty `thenSmpl` \ rhs' ->
returnSmpl (rhs', ArityExactly 0)
| otherwise -- OK, use the big hammer
= -- Deal with the big lambda part
ASSERT( null uvars ) -- For now
mapSmpl cloneTyVarSmpl tyvars `thenSmpl` \ tyvars' ->
let
rhs_ty = idType new_id
new_tys = mkTyVarTys tyvars'
body_ty = foldl applyTy rhs_ty new_tys
lam_env = extendTyEnvList rhs_env (zipEqual "simplRhsExpr" tyvars new_tys)
......@@ -540,6 +575,7 @@ simplRhsExpr env binder@(id,occ_info) rhs new_id
returnSmpl (rhs', arity)
where
rhs_ty = idType new_id
rhs_env | idWantsToBeINLINEd id -- Don't ever inline in a INLINE thing's rhs
= switchOffInlining env1 -- See comments with switchOffInlining
| otherwise
......@@ -696,7 +732,7 @@ simplCoerce env coercion ty expr args result_ty
%************************************************************************
%* *
\subsection[Simplify-let]{Let-expressions}
\subsection[Simplify-bind]{Binding groups}
%* *
%************************************************************************
......@@ -706,8 +742,35 @@ simplBind :: SimplEnv
-> (SimplEnv -> SmplM OutExpr)
-> OutType
-> SmplM OutExpr
simplBind env (NonRec binder rhs) body_c body_ty = simplNonRec env binder rhs body_c body_ty
simplBind env (Rec pairs) body_c body_ty = simplRec env pairs body_c body_ty
\end{code}
%************************************************************************
%* *
\subsection[Simplify-let]{Let-expressions}
%* *
%************************************************************************
Float switches
~~~~~~~~~~~~~~
The booleans controlling floating have to be set with a little care.
Here's one performance bug I found:
let x = let y = let z = case a# +# 1 of {b# -> E1}
in E2
in E3
in E4
Now, if E2, E3 aren't HNFs we won't float the y-binding or the z-binding.
Before case_floating_ok included float_exposes_hnf, the case expression was floated
*one level per simplifier iteration* outwards. So it made th s
Floating case from let
~~~~~~~~~~~~~~~~~~~~~~
When floating cases out of lets, remember this:
let x* = case e of alts
......@@ -747,11 +810,89 @@ achieving the same effect.
ToDo: check this is OK with andy
Let to case: two points
~~~~~~~~~~~
Point 1. We defer let-to-case for all data types except single-constructor
ones. Suppose we change
let x* = e in b
to
case e of x -> b
It can be the case that we find that b ultimately contains ...(case x of ..)....
and this is the only occurrence of x. Then if we've done let-to-case
we can't inline x, which is a real pain. On the other hand, we lose no
transformations by not doing this transformation, because the relevant
case-of-X transformations are also implemented by simpl_bind.
If x is a single-constructor type, then we go ahead anyway, giving
case e of (y,z) -> let x = (y,z) in b
because now we can squash case-on-x wherever they occur in b.
We do let-to-case on multi-constructor types in the tidy-up phase
(tidyCoreExpr) mainly so that the code generator doesn't need to
spot the demand-flag.
Point 2. It's important to try let-to-case before doing the
strict-let-of-case transformation, which happens in the next equation
for simpl_bind.
let a*::Int = case v of {p1->e1; p2->e2}
in b
(The * means that a is sure to be demanded.)
If we do case-floating first we get this:
let k = \a* -> b
in case v of
p1-> let a*=e1 in k a
p2-> let a*=e2 in k a
Now watch what happens if we do let-to-case first:
case (case v of {p1->e1; p2->e2}) of
Int a# -> let a*=I# a# in b
===>
let k = \a# -> let a*=I# a# in b
in case v of
p1 -> case e1 of I# a# -> k a#
p1 -> case e2 of I# a# -> k a#
The latter is clearly better. (Remember the reboxing let-decl for a
is likely to go away, because after all b is strict in a.)
We do not do let to case for WHNFs, e.g.
let x = a:b in ...
=/=>
case a:b of x in ...
as this is less efficient. but we don't mind doing let-to-case for
"bottom", as that will allow us to remove more dead code, if anything:
let x = error in ...
===>
case error of x -> ...
===>
error
Notice that let to case occurs only if x is used strictly in its body
(obviously).
\begin{code}
-- Dead code is now discarded by the occurrence analyser,
simplBind env (NonRec 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
= -- The binder is used in definitely-inline way in the body
-- So add it to the environment, drop the binding, and continue
body_c (extendEnvGivenInlining env id occ_info rhs)
| idWantsToBeINLINEd id
= complete_bind env rhs -- Don't mess about with floating or let-to-case on
-- INLINE things
......@@ -798,7 +939,7 @@ simplBind env (NonRec binder@(id,occ_info) rhs) body_c body_ty
bindLargeRhs env [binder] body_ty body_c `thenSmpl` \ (extra_binding, new_body) ->
let
body_c' = \env -> simplExpr env new_body [] body_ty
case_c = \env rhs -> simplBind env (NonRec binder rhs) body_c' body_ty
case_c = \env rhs -> simplNonRec env binder rhs body_c' body_ty
in
simplCase env scrut alts case_c body_ty `thenSmpl` \ case_expr ->
returnSmpl (Let extra_binding case_expr)
......@@ -847,228 +988,8 @@ simplBind env (NonRec binder@(id,occ_info) rhs) body_c body_ty
-- See note below
\end{code}
Float switches
~~~~~~~~~~~~~~
The booleans controlling floating have to be set with a little care.
Here's one performance bug I found:
let x = let y = let z = case a# +# 1 of {b# -> E1}
in E2
in E3
in E4
Now, if E2, E3 aren't HNFs we won't float the y-binding or the z-binding.
Before case_floating_ok included float_exposes_hnf, the case expression was floated
*one level per simplifier iteration* outwards. So it made th s
Let to case: two points
~~~~~~~~~~~
Point 1. We defer let-to-case for all data types except single-constructor
ones. Suppose we change
let x* = e in b
to
case e of x -> b
It can be the case that we find that b ultimately contains ...(case x of ..)....
and this is the only occurrence of x. Then if we've done let-to-case
we can't inline x, which is a real pain. On the other hand, we lose no
transformations by not doing this transformation, because the relevant
case-of-X transformations are also implemented by simpl_bind.
If x is a single-constructor type, then we go ahead anyway, giving
case e of (y,z) -> let x = (y,z) in b
because now we can squash case-on-x wherever they occur in b.
We do let-to-case on multi-constructor types in the tidy-up phase
(tidyCoreExpr) mainly so that the code generator doesn't need to
spot the demand-flag.
Point 2. It's important to try let-to-case before doing the
strict-let-of-case transformation, which happens in the next equation
for simpl_bind.
let a*::Int = case v of {p1->e1; p2->e2}
in b
(The * means that a is sure to be demanded.)
If we do case-floating first we get this:
let k = \a* -> b
in case v of
p1-> let a*=e1 in k a
p2-> let a*=e2 in k a
Now watch what happens if we do let-to-case first:
case (case v of {p1->e1; p2->e2}) of
Int a# -> let a*=I# a# in b
===>
let k = \a# -> let a*=I# a# in b
in case v of
p1 -> case e1 of I# a# -> k a#
p1 -> case e2 of I# a# -> k a#
The latter is clearly better. (Remember the reboxing let-decl for a
is likely to go away, because after all b is strict in a.)
We do not do let to case for WHNFs, e.g.
let x = a:b in ...
=/=>
case a:b of x in ...
as this is less efficient. but we don't mind doing let-to-case for
"bottom", as that will allow us to remove more dead code, if anything:
let x = error in ...
===>
case error of x -> ...
===>
error
Notice that let to case occurs only if x is used strictly in its body
(obviously).
Letrec expressions
~~~~~~~~~~~~~~~~~~
Simplify each RHS, float any let(recs) from the RHSs (if let-floating is
on and it'll expose a HNF), and bang the whole resulting mess together
into a huge letrec.
1. Any "macros" should be expanded. The main application of this
macro-expansion is:
letrec
f = ....g...
g = ....f...
in
....f...
Here we would like the single call to g to be inlined.
We can spot this easily, because g will be tagged as having just one
occurrence. The "inlineUnconditionally" predicate is just what we want.
A worry: could this lead to non-termination? For example:
letrec
f = ...g...
g = ...f...
h = ...h...
in
..h..
Here, f and g call each other (just once) and neither is used elsewhere.
But it's OK:
* the occurrence analyser will drop any (sub)-group that isn't used at
all.
* If the group is used outside itself (ie in the "in" part), then there
can't be a cyle.
** IMPORTANT: check that NewOccAnal has the property that a group of
bindings like the above has f&g dropped.! ***
2. We'd also like to pull out any top-level let(rec)s from the
rhs of the defns:
letrec
f = let h = ... in \x -> ....h...f...h...
in
...f...
====>
letrec
h = ...
f = \x -> ....h...f...h...
in
...f...
But floating cases is less easy? (Don't for now; ToDo?)
3. We'd like to arrange that the RHSs "know" about members of the
group that are bound to constructors. For example:
let rec
d.Eq = (==,/=)
f a b c d = case d.Eq of (h,_) -> let x = (a,b); y = (c,d) in not (h x y)
/= a b = unpack tuple a, unpack tuple b, call f
in d.Eq
here, by knowing about d.Eq in f's rhs, one could get rid of
the case (and break out the recursion completely).
[This occurred with more aggressive inlining threshold (4),
nofib/spectral/knights]
How to do it?
1: we simplify constructor rhss first.
2: we record the "known constructors" in the environment
3: we simplify the other rhss, with the knowledge about the constructors
\begin{code}
simplBind env (Rec pairs) body_c body_ty
= -- Do floating, if necessary
floatBind env False (Rec pairs) `thenSmpl` \ [Rec pairs'] ->
let
binders = map fst pairs'
in
cloneIds env binders `thenSmpl` \ ids' ->
let
env_w_clones = extendIdEnvWithClones env binders ids'
in
simplRecursiveGroup env_w_clones ids' pairs' `thenSmpl` \ (pairs', new_env) ->
body_c new_env `thenSmpl` \ body' ->
returnSmpl (Let (Rec pairs') body')
\end{code}
\begin{code}
-- The env passed to simplRecursiveGroup already has
-- bindings that clone the variables of the group.
simplRecursiveGroup env new_ids []
= returnSmpl ([], env)
simplRecursiveGroup env (new_id : new_ids) ((binder@(_, occ_info), rhs) : pairs)
= simplRhsExpr env binder rhs new_id `thenSmpl` \ (new_rhs, arity) ->
let
new_id' = new_id `withArity` arity
-- ToDo: this next bit could usefully share code with completeNonRec
new_env
| idMustNotBeINLINEd new_id -- Occurrence analyser says "don't inline"
= env
| is_atomic eta'd_rhs -- If rhs (after eta reduction) is atomic
= extendIdEnvWithAtom env binder the_arg
| otherwise -- Non-atomic
= extendEnvGivenBinding env occ_info new_id new_rhs
-- Don't eta if it doesn't eliminate the binding
eta'd_rhs = etaCoreExpr new_rhs
the_arg = case eta'd_rhs of
Var v -> VarArg v
Lit l -> LitArg l
in
simplRecursiveGroup new_env new_ids pairs `thenSmpl` \ (new_pairs, final_env) ->
returnSmpl ((new_id', new_rhs) : new_pairs, final_env)
\end{code}
@completeLet@ looks at the simplified post-floating RHS of the
@completeNonRec@ looks at the simplified post-floating RHS of the
let-expression, and decides what to do. There's one interesting
aspect to this, namely constructor reuse. Consider
@
......@@ -1183,6 +1104,90 @@ completeNonRec env binder@(id,occ_info) new_id new_rhs
Lit l -> LitArg l
\end{code}
%************************************************************************
%* *
\subsection[Simplify-letrec]{Letrec-expressions}
%* *
%************************************************************************
Letrec expressions
~~~~~~~~~~~~~~~~~~
Here's the game plan
1. Float any let(rec)s out of the RHSs
2. Clone all the Ids and extend the envt with these clones
3. Simplify one binding at a time, adding each binding to the
environment once it's done.
This relies on the occurrence analyser to
a) break all cycles with an Id marked MustNotBeInlined
b) sort the decls into topological order
The former prevents infinite inlinings, and the latter means
that we get maximum benefit from working top to bottom.
\begin{code}
simplRec env pairs body_c body_ty
= -- Do floating, if necessary
floatBind env False (Rec pairs) `thenSmpl` \ [Rec pairs'] ->
let
binders = map fst pairs'
in
cloneIds env binders `thenSmpl` \ ids' ->
let
env_w_clones = extendIdEnvWithClones env binders ids'
in
simplRecursiveGroup env_w_clones ids' pairs' `thenSmpl` \ (pairs', new_env) ->
body_c new_env `thenSmpl` \ body' ->
returnSmpl (Let (Rec pairs') body')
\end{code}
\begin{code}
-- The env passed to simplRecursiveGroup already has
-- bindings that clone the variables of the group.
simplRecursiveGroup env new_ids []
= returnSmpl ([], env)
simplRecursiveGroup env (new_id : new_ids) ((binder@(_, occ_info), rhs) : pairs)
| inlineUnconditionally ok_to_dup occ_info
= -- Single occurrence, so drop binding and extend env with the inlining
let
new_env = extendEnvGivenInlining env new_id occ_info rhs
in
simplRecursiveGroup new_env new_ids pairs
| otherwise
= simplRhsExpr env binder rhs new_id `thenSmpl` \ (new_rhs, arity) ->
let
new_id' = new_id `withArity` arity
-- ToDo: this next bit could usefully share code with completeNonRec
new_env
| idMustNotBeINLINEd new_id -- Occurrence analyser says "don't inline"
= env
| is_atomic eta'd_rhs -- If rhs (after eta reduction) is atomic
= extendIdEnvWithAtom env binder the_arg
| otherwise -- Non-atomic
= extendEnvGivenBinding env occ_info new_id new_rhs
-- Don't eta if it doesn't eliminate the binding
eta'd_rhs = etaCoreExpr new_rhs
the_arg = case eta'd_rhs of
Var v -> VarArg v
Lit l -> LitArg l
in
simplRecursiveGroup new_env new_ids pairs `thenSmpl` \ (new_pairs, final_env) ->
returnSmpl ((new_id', new_rhs) : new_pairs, final_env)
where
ok_to_dup = switchIsSet env SimplOkToDupCode
\end{code}
\begin{code}
floatBind :: SimplEnv
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment