Revert "Add -faggressive-primops plus refactoring in CoreUtils" (#5780)
authorSimon Marlow <marlowsd@gmail.com>
Mon, 16 Jan 2012 12:41:56 +0000 (12:41 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Mon, 16 Jan 2012 13:27:57 +0000 (13:27 +0000)
This reverts commit 601c983dd0bada6b49bdadd8f172fd4eacac4b0c.

compiler/coreSyn/CoreArity.lhs
compiler/coreSyn/CoreUtils.lhs
compiler/main/StaticFlagParser.hs
compiler/main/StaticFlags.hs
compiler/prelude/PrimOp.lhs
compiler/simplCore/FloatIn.lhs
compiler/simplCore/OccurAnal.lhs
compiler/simplCore/SimplUtils.lhs
compiler/simplCore/Simplify.lhs

index ce22f80..249861a 100644 (file)
@@ -473,7 +473,7 @@ vanillaArityType = ATop []  -- Totally uninformative
 
 -- ^ The Arity returned is the number of value args the
 -- expression can be applied to without doing much work
-exprEtaExpandArity :: DynFlags -> FunAppAnalyser -> CoreExpr -> Arity
+exprEtaExpandArity :: DynFlags -> CheapAppFun -> CoreExpr -> Arity
 -- exprEtaExpandArity is used when eta expanding
 --     e  ==>  \xy -> e x y
 exprEtaExpandArity dflags cheap_app e
@@ -497,7 +497,7 @@ getBotArity :: ArityType -> Maybe Arity
 getBotArity (ABot n) = Just n
 getBotArity _        = Nothing
 
-mk_cheap_fn :: DynFlags -> FunAppAnalyser -> CheapFun
+mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun
 mk_cheap_fn dflags cheap_app
   | not (dopt Opt_DictsCheap dflags)
   = \e _     -> exprIsCheap' cheap_app e
index b91125d..198ac7e 100644 (file)
@@ -20,10 +20,10 @@ module CoreUtils (
         -- * Properties of expressions
         exprType, coreAltType, coreAltsType,
         exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom,
-        exprIsCheap, exprIsExpandable, exprIsCheap', FunAppAnalyser,
+        exprIsCheap, exprIsExpandable, exprIsCheap', CheapAppFun,
         exprIsHNF, exprOkForSpeculation, exprOkForSideEffects,
-        exprIsBig, exprIsConLike, exprCertainlyTerminates,
-        rhsIsStatic, isHNFApp, isConLikeApp,
+        exprIsBig, exprIsConLike,
+        rhsIsStatic, isCheapApp, isExpandableApp,
 
         -- * Expression and bindings size
         coreBindsSize, exprSize,
@@ -553,63 +553,6 @@ dupAppSize = 8   -- Size of term we are prepared to duplicate
 
 %************************************************************************
 %*                                                                      *
-             FunAppAnalyser
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
--- | Given a function and the number of _value_ arguments,
--- return a boolean
-type FunAppAnalyser = Id -> Int -> Bool
-
-isHNFApp :: FunAppAnalyser
-isHNFApp fn n_val_args
-  =  isDataConWorkId fn
-  || n_val_args < idArity fn
-  || (n_val_args == 0 && (isEvaldUnfolding (idUnfolding fn) 
-                          || isUnLiftedType (idType fn)))
-
-isConLikeApp :: FunAppAnalyser
-isConLikeApp fn n_val_args
-  =  isConLikeId fn
-  || n_val_args < idArity fn
-  || (if n_val_args == 0 
-      then isConLikeUnfolding (idUnfolding fn)
-           || isUnLiftedType (idType fn)
-      else hack_me n_val_args (idType fn))
-  where
-  -- See if all the arguments are PredTys (implicit params or classes)
-  -- If so we'll regard it as expandable; see Note [Expandable overloadings]
-     hack_me 0 _ = True
-     hack_me n_val_args ty
-       | Just (_, ty) <- splitForAllTy_maybe ty   = hack_me n_val_args ty
-       | Just (arg, ty) <- splitFunTy_maybe ty
-       , isPredTy arg                             = hack_me (n_val_args-1) ty
-       | otherwise                                = False
-
-isTerminatingApp :: FunAppAnalyser
-isTerminatingApp fn n_val_args
-  | isPrimOpId fn = not (isBottomingId fn)
-  | otherwise     = isHNFApp fn n_val_args
-  -- Primops terminate, with the exception of, well, exceptions.
-  -- Their strictness signature tells us about them
-\end{code}
-
-Note [Expandable overloadings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose the user wrote this
-   {-# RULE  forall x. foo (negate x) = h x #-}
-   f x = ....(foo (negate x))....
-He'd expect the rule to fire. But since negate is overloaded, we might
-get this:
-    f = \d -> let n = negate d in \x -> ...foo (n x)...
-So we treat the application of a function (negate in this case) to a
-*dictionary* as expandable.  In effect, every function is CONLIKE when
-it's applied only to dictionaries.
-
-
-%************************************************************************
-%*                                                                      *
              exprIsCheap, exprIsExpandable
 %*                                                                      *
 %************************************************************************
@@ -653,14 +596,15 @@ False to exprIsCheap.
 
 \begin{code}
 exprIsCheap :: CoreExpr -> Bool
-exprIsCheap = exprIsCheap' isHNFApp
+exprIsCheap = exprIsCheap' isCheapApp
 
 exprIsExpandable :: CoreExpr -> Bool
-exprIsExpandable = exprIsCheap' isConLikeApp -- See Note [CONLIKE pragma] in BasicTypes
+exprIsExpandable = exprIsCheap' isExpandableApp -- See Note [CONLIKE pragma] in BasicTypes
 
-exprIsCheap' :: FunAppAnalyser -> CoreExpr -> Bool
+type CheapAppFun = Id -> Int -> Bool
+exprIsCheap' :: CheapAppFun -> CoreExpr -> Bool
 exprIsCheap' _        (Lit _)      = True
-exprIsCheap' _        (Type _)     = True
+exprIsCheap' _        (Type _)    = True
 exprIsCheap' _        (Coercion _) = True
 exprIsCheap' _        (Var _)      = True
 exprIsCheap' good_app (Cast e _)   = exprIsCheap' good_app e
@@ -736,8 +680,40 @@ exprIsCheap' good_app other_expr        -- Applications and variables
                                         -- lambda.  Particularly for dictionary field selection.
                 -- BUT: Take care with (sel d x)!  The (sel d) might be cheap, but
                 --      there's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)
+
+isCheapApp :: CheapAppFun
+isCheapApp fn n_val_args
+  = isDataConWorkId fn
+  || n_val_args < idArity fn
+
+isExpandableApp :: CheapAppFun
+isExpandableApp fn n_val_args
+  =  isConLikeId fn
+  || n_val_args < idArity fn
+  || go n_val_args (idType fn)
+  where
+  -- See if all the arguments are PredTys (implicit params or classes)
+  -- If so we'll regard it as expandable; see Note [Expandable overloadings]
+     go 0 _ = True
+     go n_val_args ty
+       | Just (_, ty) <- splitForAllTy_maybe ty   = go n_val_args ty
+       | Just (arg, ty) <- splitFunTy_maybe ty
+       , isPredTy arg                             = go (n_val_args-1) ty
+       | otherwise                                = False
 \end{code}
 
+Note [Expandable overloadings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose the user wrote this
+   {-# RULE  forall x. foo (negate x) = h x #-}
+   f x = ....(foo (negate x))....
+He'd expect the rule to fire. But since negate is overloaded, we might
+get this:
+    f = \d -> let n = negate d in \x -> ...foo (n x)...
+So we treat the application of a function (negate in this case) to a
+*dictionary* as expandable.  In effect, every function is CONLIKE when
+it's applied only to dictionaries.
+
 
 %************************************************************************
 %*                                                                      *
@@ -879,11 +855,31 @@ isDivOp _                = False
 
 Note [exprOkForSpeculation: case expressions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We keep going for case expressions.  This used to be vital,
-for the reason described in Note [exprCertainlyTerminates: case expressions],
-but exprOkForSpeculation isn't used for that any more.  So now it
-probably doesn't matter if said False for case expressions... but it's
-also fine to continue to accept case expressions.
+It's always sound for exprOkForSpeculation to return False, and we
+don't want it to take too long, so it bales out on complicated-looking
+terms.  Notably lets, which can be stacked very deeply; and in any
+case the argument of exprOkForSpeculation is usually in a strict context,
+so any lets will have been floated away.
+
+However, we keep going on case-expressions.  An example like this one
+showed up in DPH code (Trac #3717):
+    foo :: Int -> Int
+    foo 0 = 0
+    foo n = (if n < 5 then 1 else 2) `seq` foo (n-1)
+
+If exprOkForSpeculation doesn't look through case expressions, you get this:
+    T.$wfoo =
+      \ (ww :: GHC.Prim.Int#) ->
+        case ww of ds {
+          __DEFAULT -> case (case <# ds 5 of _ {
+                          GHC.Types.False -> lvl1;
+                          GHC.Types.True -> lvl})
+                       of _ { __DEFAULT ->
+                       T.$wfoo (GHC.Prim.-# ds_XkE 1) };
+          0 -> 0
+        }
+
+The inner case is redundant, and should be nuked.
 
 Note [Exhaustive alts]
 ~~~~~~~~~~~~~~~~~~~~~~
@@ -968,53 +964,57 @@ We say "yes", even though 'x' may not be evaluated.  Reasons
 -- happen: see "CoreSyn#let_app_invariant". This invariant states that arguments of
 -- unboxed type must be ok-for-speculation (or trivial).
 exprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP
-exprIsHNF = exprIsHNFlike isHNFApp
+exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding
+\end{code}
 
+\begin{code}
 -- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as
 -- data constructors. Conlike arguments are considered interesting by the
--- inliner.  Like a HNF version of exprIsExpandable.
+-- inliner.
 exprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP
-exprIsConLike = exprIsHNFlike isConLikeApp
-
--- | Tests if an expression guarantees to terminate, 
--- when evaluated to head normal form
-exprCertainlyTerminates :: CoreExpr -> Bool
-exprCertainlyTerminates = exprIsHNFlike isTerminatingApp
+exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding
 
 -- | Returns true for values or value-like expressions. These are lambdas,
 -- constructors / CONLIKE functions (as determined by the function argument)
 -- or PAPs.
 --
-exprIsHNFlike :: FunAppAnalyser -> CoreExpr -> Bool
-exprIsHNFlike app_is_hnf e = go e
+exprIsHNFlike :: (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
+exprIsHNFlike is_con is_con_unf = is_hnf_like
   where
-    go (Var v)              = app_is_hnf v 0
-    go (App e a) 
-          | isRuntimeArg a  = go_app e 1
-          | otherwise       = go e
-    go (Lit _)              = True
-    go (Type _)             = True       -- Types are honorary Values;
-                                         -- we don't mind copying them
-    go (Coercion _)         = True       -- Same for coercions
-    go (Lam b e)            = isRuntimeVar b || go e
-    go (Tick tickish e)     = not (tickishCounts tickish) && go e
+    is_hnf_like (Var v) -- NB: There are no value args at this point
+      =  is_con v       -- Catches nullary constructors,
+                        --      so that [] and () are values, for example
+      || idArity v > 0  -- Catches (e.g.) primops that don't have unfoldings
+      || is_con_unf (idUnfolding v)
+        -- Check the thing's unfolding; it might be bound to a value
+        -- We don't look through loop breakers here, which is a bit conservative
+        -- but otherwise I worry that if an Id's unfolding is just itself,
+        -- we could get an infinite loop
+
+    is_hnf_like (Lit _)          = True
+    is_hnf_like (Type _)         = True       -- Types are honorary Values;
+                                              -- we don't mind copying them
+    is_hnf_like (Coercion _)     = True       -- Same for coercions
+    is_hnf_like (Lam b e)        = isRuntimeVar b || is_hnf_like e
+    is_hnf_like (Tick tickish e) = not (tickishCounts tickish)
+                                      && is_hnf_like e
                                       -- See Note [exprIsHNF Tick]
-    go (Cast e _)           = go e
-    go (Let _ e)            = go e  -- Lazy let(rec)s don't affect us
-    go (Case e _ _ alts)    = go e && all (\(_,_,rhs) -> go rhs) alts
-                              -- Keep going for case expressions 
-                              -- See Note [exprCertainlyTerminates: case expressions]
-
-    -- Gather up value arguments
-    go_app :: CoreExpr -> Int -> Bool
-    go_app (Var f)    n = app_is_hnf f n
-    go_app (App f a)  n
-      | isRuntimeArg a  = go_app f (n+1)
-      | otherwise       = go_app f n
-    go_app (Tick _ f) n = go_app f n
-    go_app (Cast f _) n = go_app f n
-    go_app _          _ = False
-
+    is_hnf_like (Cast e _)           = is_hnf_like e
+    is_hnf_like (App e (Type _))     = is_hnf_like e
+    is_hnf_like (App e (Coercion _)) = is_hnf_like e
+    is_hnf_like (App e a)            = app_is_value e [a]
+    is_hnf_like (Let _ e)            = is_hnf_like e  -- Lazy let(rec)s don't affect us
+    is_hnf_like _                    = False
+
+    -- There is at least one value argument
+    app_is_value :: CoreExpr -> [CoreArg] -> Bool
+    app_is_value (Var fun) args
+      = idArity fun > valArgCount args    -- Under-applied function
+        || is_con fun                     --  or constructor-like
+    app_is_value (Tick _ f) as = app_is_value f as
+    app_is_value (Cast f _) as = app_is_value f as
+    app_is_value (App f a)  as = app_is_value f (a:as)
+    app_is_value _          _  = False
 
 {-
 Note [exprIsHNF Tick]
@@ -1032,33 +1032,6 @@ don't want to discard a seq on it.
 -}
 \end{code}
 
-Note [exprCertainlyTerminates: case expressions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-It's always sound for exprOkForSpeculation to return False, and we
-don't want it to take too long, so it bales out on complicated-looking
-terms.  Notably lets, which can be stacked very deeply; and in any
-case the argument of exprOkForSpeculation is usually in a strict context,
-so any lets will have been floated away.
-
-However, we keep going on case-expressions.  An example like this one
-showed up in DPH code (Trac #3717):
-    foo :: Int -> Int
-    foo 0 = 0
-    foo n = (if n < 5 then 1 else 2) `seq` foo (n-1)
-
-If exprOkForSpeculation doesn't look through case expressions, you get this:
-    T.$wfoo =
-      \ (ww :: GHC.Prim.Int#) ->
-        case ww of ds {
-          __DEFAULT -> case (case <# ds 5 of _ {
-                          GHC.Types.False -> lvl1;
-                          GHC.Types.True -> lvl})
-                       of _ { __DEFAULT ->
-                       T.$wfoo (GHC.Prim.-# ds_XkE 1) };
-          0 -> 0
-        }
-
-The inner case is redundant, and should be nuked.
 
 %************************************************************************
 %*                                                                      *
index e6b0d4c..07eb214 100644 (file)
@@ -192,7 +192,6 @@ isStaticFlag f =
     "static",
     "fhardwire-lib-paths",
     "funregisterised",
-    "faggressive-primops",
     "fcpr-off",
     "ferror-spans",
     "fPIC",
index 3c13e08..c2f8674 100644 (file)
@@ -62,7 +62,6 @@ module StaticFlags (
        opt_SimplExcessPrecision,
        opt_NoOptCoercion,
        opt_MaxWorkerArgs,
-        opt_AggressivePrimOps,
 
        -- Unfolding control
        opt_UF_CreationThreshold,
@@ -322,11 +321,6 @@ 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)
 
index 13d1498..39bee1f 100644 (file)
@@ -356,19 +356,6 @@ 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
@@ -386,14 +373,11 @@ 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?
 
@@ -411,17 +395,6 @@ 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, on by default, 
-controlled by -fconservative-primops.  When AggressivePrimOps is
-*off* we revert to 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 having a static flag lets us recover it when we want, in case
-there are mysterious errors.
-
 
 \begin{code}
 primOpHasSideEffects :: PrimOp -> Bool
@@ -431,32 +404,28 @@ primOpCanFail :: PrimOp -> Bool
 #include "primop-can-fail.hs-incl"
 
 primOpOkForSpeculation :: PrimOp -> Bool
-  -- 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 Note [primOpOkForSpeculation and primOpOkForFloatOut]
   -- See comments with CoreUtils.exprOkForSpeculation
 primOpOkForSpeculation op
-  = not (primOpHasSideEffects op || primOpCanFail op)
+  = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
 
 primOpOkForSideEffects :: PrimOp -> Bool
 primOpOkForSideEffects op
   = not (primOpHasSideEffects op)
+\end{code}
 
-primOpIsCheap :: PrimOp -> Bool
-primOpIsCheap op 
-  = not (primOpHasSideEffects op)
-     -- This is vital; see Note [PrimOp can_fail and has_side_effects]
- && primOpCodeSize op <= primOpCodeSizeDefault 
- && not (primOpOutOfLine op)
-     -- 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!
 
+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.
+
+\begin{code}
+primOpIsCheap :: PrimOp -> Bool
+primOpIsCheap op = primOpOkForSpeculation op
 -- In March 2001, we changed this to
 --      primOpIsCheap op = False
 -- thereby making *no* primops seem cheap.  But this killed eta
index a25ed40..0601d7b 100644 (file)
@@ -33,7 +33,6 @@ import Type           ( isUnLiftedType )
 import VarSet
 import Util            ( zipEqual, zipWithEqual, count )
 import UniqFM
-import StaticFlags      ( opt_AggressivePrimOps )
 import Outputable
 \end{code}
 
@@ -358,14 +357,7 @@ alternatives/default [default FVs always {\em first}!].
 \begin{code}
 fiExpr to_drop (_, AnnCase scrut case_bndr _ [(DEFAULT,[],rhs)])
   | isUnLiftedType (idType case_bndr)
-  , 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 AggressIvePrimOps flag lets us recover the earlier 
--- more conservative behaviour.  See Note [Aggressive PrimOps] in PrimOp
---
--- It would NOT be ok if a primop evaluated an unlifted
--- argument, but no primop does that.
+  , exprOkForSideEffects (deAnnotate scrut)
   = wrapFloats shared_binds $
     fiExpr (case_float : rhs_binds) rhs
   where
index ae02a1f..8056c0e 100644 (file)
@@ -28,7 +28,7 @@ module OccurAnal (
 
 import CoreSyn
 import CoreFVs
-import CoreUtils        ( exprIsTrivial, isDefaultAlt, isConLikeApp, mkCast )
+import CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp, mkCast )
 import Id
 import Name( localiseName )
 import BasicTypes
@@ -1240,7 +1240,7 @@ occAnalApp env (Var fun, args)
   where
     fun_uniq = idUnique fun
     fun_uds  = mkOneOcc env fun (valArgCount args > 0)
-    is_exp   = isConLikeApp fun (valArgCount args)
+    is_exp = isExpandableApp fun (valArgCount args)
           -- See Note [CONLIKE pragma] in BasicTypes
           -- The definition of is_exp should match that in
           -- Simplify.prepareRhs
index 46f49fd..86dc88d 100644 (file)
@@ -1161,10 +1161,10 @@ findArity dflags bndr rhs old_arity
        -- we stop right away (since arities should not decrease)
        -- Result: the common case is that there is just one iteration
   where
-    init_cheap_app :: FunAppAnalyser
+    init_cheap_app :: CheapAppFun
     init_cheap_app fn n_val_args
       | fn == bndr = True   -- On the first pass, this binder gets infinite arity
-      | otherwise  = isHNFApp fn n_val_args
+      | otherwise  = isCheapApp fn n_val_args
 
     go :: Arity -> Arity
     go cur_arity
@@ -1178,10 +1178,10 @@ findArity dflags bndr rhs old_arity
       where
         new_arity = exprEtaExpandArity dflags cheap_app rhs
 
-        cheap_app :: FunAppAnalyser
+        cheap_app :: CheapAppFun
         cheap_app fn n_val_args
           | fn == bndr = n_val_args < cur_arity
-          | otherwise  = isHNFApp fn n_val_args
+          | otherwise  = isCheapApp fn n_val_args
 \end{code}
 
 Note [Eta-expanding at let bindings]
@@ -1244,7 +1244,7 @@ argument
      type CheapFun = CoreExpr -> Maybe Type -> Bool
 used to decide if an expression is cheap enough to push inside a 
 lambda.  And exprIsCheap' in turn takes an argument
-     type FunAppAnalyser = Id -> Int -> Bool
+     type CheapAppFun = Id -> Int -> Bool
 which tells when an application is cheap. This makes it easy to
 write the analysis loop.
 
index 9ad7dc7..4d1717f 100644 (file)
@@ -45,7 +45,6 @@ import TysPrim          ( realWorldStatePrimTy )
 import BasicTypes       ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
 import MonadUtils      ( foldlM, mapAccumLM )
 import Maybes           ( orElse, isNothing )
-import StaticFlags      ( opt_AggressivePrimOps )
 import Data.List        ( mapAccumL )
 import Outputable
 import FastString
@@ -478,7 +477,7 @@ prepareRhs top_lvl env0 _ rhs0
     go n_val_args env (Var fun)
         = return (is_exp, env, Var fun)
         where
-          is_exp = isConLikeApp fun n_val_args   -- The fun a constructor or PAP
+          is_exp = isExpandableApp fun n_val_args   -- The fun a constructor or PAP
                        -- See Note [CONLIKE pragma] in BasicTypes
                        -- The definition of is_exp should match that in
                        -- OccurAnal.occAnalApp
@@ -1658,7 +1657,7 @@ check that
 or
         (b) the scrutinee is a variable and 'x' is used strictly
 or
-        (c) 'x' is not used at all and e certainly terminates
+        (c) 'x' is not used at all and e is ok-for-speculation
 
 For the (c), consider
    case (case a ># b of { True -> (p,q); False -> (q,p) }) of
@@ -1779,21 +1778,18 @@ 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 && expr_terminates)
+     || (is_plain_seq && ok_for_spec)
               -- Note: not the same as exprIsHNF
 
     elim_unlifted 
-      | 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
-      | otherwise = exprOkForSpeculation scrut
+      | is_plain_seq = exprOkForSideEffects scrut
+            -- The entire case is dead, so we can drop it,
+            -- _unless_ the scrutinee has side effects
+      | 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
 
-    expr_terminates  = exprCertainlyTerminates scrut
+    ok_for_spec      = exprOkForSpeculation scrut
     is_plain_seq     = isDeadBinder case_bndr  -- Evaluation *only* for effect
     strict_case_bndr = isStrictDmd (idDemandInfo case_bndr)