Commit 745ec959 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Add -faggressive-primops

I'm experimenting with making GHC a bit more aggressive about

  a) dropping case expressions if the result is unused
        Simplify.rebuildCase, CaseElim equation

  b) floating case expressions inwards
        FloatIn.fiExpr, AnnCase

In both cases the new behaviour is gotten with a static (debug)
flag -faggressive-primops.  The extra "aggression" is to allow
discarding and floating in for side-effecting operations.  See
the new, extensive Note [PrimOp can_fail and has_side_effects]
and Note [Aggressive PrimOps] in PrimoOp.

When discarding a case with unused binders, in the lifted-type
case it's definitely ok if the scrutinee terminates; previously
we were checking exprOkForSpeculation, which is significantly

There's a related change to CoreUtils/CoreArity, but I'll put that
in the next commit.
parent 5519566f
......@@ -192,6 +192,7 @@ isStaticFlag f =
......@@ -62,6 +62,7 @@ module StaticFlags (
-- Unfolding control
......@@ -312,6 +313,11 @@ opt_NoStateHack = lookUp (fsLit "-fno-state-hack")
opt_CprOff :: Bool
opt_CprOff = lookUp (fsLit "-fcpr-off")
-- Switch off CPR analysis in the new demand analyser
opt_AggressivePrimOps :: Bool
opt_AggressivePrimOps = lookUp (fsLit "-faggressive-primops")
-- See Note [Aggressive PrimOps] in PrimOp
opt_MaxWorkerArgs :: Int
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
......@@ -356,6 +356,19 @@ Consequences:
the writeMutVar will be performed in both branches, which is
utterly wrong.
Example of a worry about float-in:
case (writeMutVar v i s) of s' ->
if b then return s'
else error "foo"
Then, since s' is used only in the then-branch, we might float
in to get
if b then case (writeMutVar v i s) of s' -> returns s'
else error "foo"
So in the 'else' case the write won't happen. The same is
true if instead of writeMutVar you had some I/O performing thing.
Is this ok? Yes: if you care about this you should be using
throwIO, not throw.
* You cannot duplicate a has_side_effect primop. You might wonder
how this can occur given the state token threading, but just look
at Control.Monad.ST.Lazy.Imp.strictToLazy! We get something like
......@@ -373,11 +386,14 @@ Consequences:
However, it's fine to duplicate a can_fail primop. That is
the difference between can_fail and has_side_effects.
--------------- Summary table ------------------------
can_fail has_side_effects
Discard YES YES
Float in YES YES
Float out NO NO
Duplicate YES NO
How do we achieve these effects?
......@@ -395,6 +411,19 @@ Note [primOpOkForSpeculation]
* The no-duplicate thing is done via primOpIsCheap, by making
has_side_effects things (very very very) not-cheap!
Note [Aggressive PrimOps]
We have a static flag opt_AggressivePrimOps, off by default,
controlled by -faggressive-primops. When AggressivePrimOps is
*off* we keep the old behaviour in which
a) we do not float in has_side_effect ops
b) we never discard has_side_effect ops as dead code
I now think that this more conservative behaviour is unnecessary, but
I'm playing safe and making the conservative behaviour the default.
The static flag lets us try the more aggressive behaviour when we
want, in case there are mysterious errors.
primOpHasSideEffects :: PrimOp -> Bool
......@@ -404,28 +433,32 @@ primOpCanFail :: PrimOp -> Bool
#include "primop-can-fail.hs-incl"
primOpOkForSpeculation :: PrimOp -> Bool
-- See Note [primOpOkForSpeculation and primOpOkForFloatOut]
-- ok-for-speculation means the primop can be let-bound
-- and can float in and out freely
-- See Note [PrimOp can_fail and has_side_effects]
-- See comments with CoreUtils.exprOkForSpeculation
primOpOkForSpeculation op
= not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
= not (primOpHasSideEffects op || primOpCanFail op)
primOpOkForSideEffects :: PrimOp -> Bool
primOpOkForSideEffects op
= not (primOpHasSideEffects op)
Note [primOpIsCheap]
@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
WARNING), we just borrow some other predicates for a
what-should-be-good-enough test. "Cheap" means willing to call it more
than once, and/or push it inside a lambda. The latter could change the
behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
primOpIsCheap :: PrimOp -> Bool
primOpIsCheap op = primOpOkForSpeculation op
primOpIsCheap op
= not (primOpHasSideEffects op)
-- This is vital; see Note [PrimOp can_fail and has_side_effects]
&& not (primOpOutOfLine op)
-- && primOpCodeSize op <= primOpCodeSizeDefault
-- The latter two conditions are a HACK; we should
-- really have a proper property on primops that says
-- when they are cheap to execute. For now we are using
-- that the code size is small and not out-of-line.
-- NB that as things stand, array indexing operations
-- have default-size code size, and hence will be regarded
-- as cheap; we might want to make them more expensive!
-- In March 2001, we changed this to
-- primOpIsCheap op = False
-- thereby making *no* primops seem cheap. But this killed eta
......@@ -33,6 +33,7 @@ import Type ( isUnLiftedType )
import VarSet
import Util ( zipEqual, zipWithEqual, count )
import UniqFM
import StaticFlags ( opt_AggressivePrimOps )
import Outputable
......@@ -365,7 +366,14 @@ floating in cases with a single alternative that may bind values.
fiExpr to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])
| isUnLiftedType (idType case_bndr)
, exprOkForSideEffects (deAnnotate scrut)
, opt_AggressivePrimOps || exprOkForSideEffects (deAnnotate scrut)
-- It should be ok to float in ANY primop.
-- See Note [PrimOp can_fail and has_side_effects] in PrimOp
-- The opt_AggressIvePrimOps flag lets us choose between old and new behaviour
-- See Note [Aggressive PrimOps] in PrimOp
-- It would NOT be ok if a primop evaluated an unlifted
-- argument, but no primop does that.
= wrapFloats shared_binds $
fiExpr (case_float : rhs_binds) rhs
......@@ -1657,7 +1657,7 @@ check that
(b) the scrutinee is a variable and 'x' is used strictly
(c) 'x' is not used at all and e is ok-for-speculation
(c) 'x' is not used at all and e certainly terminates
For the (c), consider
case (case a ># b of { True -> (p,q); False -> (q,p) }) of
......@@ -1794,19 +1794,22 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
-- The case binder is going to be evaluated later,
-- and the scrutinee is a simple variable
|| (is_plain_seq && ok_for_spec)
|| (is_plain_seq && expr_terminates)
-- Note: not the same as exprIsHNF
| is_plain_seq = exprOkForSideEffects scrut
-- The entire case is dead, so we can drop it,
-- _unless_ the scrutinee has side effects
| otherwise = exprOkForSpeculation scrut
| is_plain_seq
= if opt_AggressivePrimOps then expr_terminates
else exprOkForSideEffects scrut
-- The entire case is dead, so we can drop it
-- But if AggressivePrimOps isn't on, only drop it
-- if it has no side effects. See See Note [Aggressive PrimOps] in PrimOp
| otherwise = exprOkForSpeculation scrut
-- The case-binder is alive, but we may be able
-- turn the case into a let, if the expression is ok-for-spec
-- See Note [Case elimination: unlifted case]
ok_for_spec = exprOkForSpeculation scrut
expr_terminates = exprCertainlyTerminates scrut
is_plain_seq = isDeadBinder case_bndr -- Evaluation *only* for effect
strict_case_bndr = isStrictDmd (idDemandInfo case_bndr)
Markdown is supported
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