-- * Properties of expressions
exprType, coreAltType, coreAltsType,
- exprIsDupable, exprIsTrivial,
+ exprIsDupable, exprIsTrivial, exprIsBottom,
exprIsCheap, exprIsExpandable, exprIsCheap', CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprIsBig, exprIsConLike,
rhsIsStatic, isCheapApp, isExpandableApp,
import Unique
import Outputable
import TysPrim
-import PrelNames( absentErrorIdKey )
import FastString
import Maybes
import Util
exprIsTrivial _ = False
\end{code}
+exprIsBottom is a very cheap and cheerful function; it may return
+False for bottoming expressions, but it never costs much to ask.
+See also CoreArity.exprBotStrictness_maybe, but that's a bit more
+expensive.
+
+\begin{code}
+exprIsBottom :: CoreExpr -> Bool
+exprIsBottom e
+ = go 0 e
+ where
+ go n (Var v) = isBottomingId v && n >= idArity v
+ go n (App e a) | isTypeArg a = go n e
+ | otherwise = go (n+1) e
+ go n (Note _ e) = go n e
+ go n (Cast e _) = go n e
+ go n (Let _ e) = go n e
+ go _ _ = False
+\end{code}
+
%************************************************************************
%* *
\begin{code}
exprIsDupable :: CoreExpr -> Bool
-exprIsDupable (Type _) = True
-exprIsDupable (Var _) = True
-exprIsDupable (Lit lit) = litIsDupable lit
-exprIsDupable (Note _ e) = exprIsDupable e
-exprIsDupable (Cast e _) = exprIsDupable e
-exprIsDupable expr
- = go expr 0
+exprIsDupable e
+ = isJust (go dupAppSize e)
where
- go (Var _) _ = True
- go (App f a) n_args = n_args < dupAppSize
- && exprIsDupable a
- && go f (n_args+1)
- go _ _ = False
+ go :: Int -> CoreExpr -> Maybe Int
+ go n (Type {}) = Just n
+ go n (Var {}) = decrement n
+ go n (Note _ e) = go n e
+ go n (Cast e _) = go n e
+ go n (App f a) | Just n' <- go n a = go n' f
+ go n (Lit lit) | litIsDupable lit = decrement n
+ go _ _ = Nothing
+
+ decrement :: Int -> Maybe Int
+ decrement 0 = Nothing
+ decrement n = Just (n-1)
dupAppSize :: Int
-dupAppSize = 4 -- Size of application we are prepared to duplicate
+dupAppSize = 8 -- Size of term we are prepared to duplicate
+ -- This is *just* big enough to make test MethSharing
+ -- inline enough join points. Really it should be
+ -- smaller, and could be if we fixed Trac #4960.
\end{code}
%************************************************************************
= go other_expr []
where
-- Accumulate value arguments, then decide
+ go (Cast e _) val_args = go e val_args
go (App f a) val_args | isRuntimeArg a = go f (a:val_args)
| otherwise = go f val_args
--
-- * Safe /not/ to evaluate even if normal order would do so
--
+-- It is usually called on arguments of unlifted type, but not always
+-- In particular, Simplify.rebuildCase calls it on lifted types
+-- when a 'case' is a plain 'seq'. See the example in
+-- Note [exprOkForSpeculation: case expressions] below
+--
-- Precisely, it returns @True@ iff:
--
-- * The expression guarantees to terminate,
exprOkForSpeculation :: CoreExpr -> Bool
exprOkForSpeculation (Lit _) = True
exprOkForSpeculation (Type _) = True
- -- Tick boxes are *not* suitable for speculation
-exprOkForSpeculation (Var v) = isUnLiftedType (idType v)
- && not (isTickBoxOp v)
+
+exprOkForSpeculation (Var v)
+ | isTickBoxOp v = False -- Tick boxes are *not* suitable for speculation
+ | otherwise = isUnLiftedType (idType v) -- c.f. the Var case of exprIsHNF
+ || isDataConWorkId v -- Nullary constructors
+ || idArity v > 0 -- Functions
+ || isEvaldUnfolding (idUnfolding v) -- Let-bound values
+
exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
exprOkForSpeculation (Cast e _) = exprOkForSpeculation e
exprOkForSpeculation other_expr
= case collectArgs other_expr of
- (Var f, args) | f `hasKey` absentErrorIdKey -- Note [Absent error Id]
- -> all exprOkForSpeculation args -- in WwLib
- | otherwise
- -> spec_ok (idDetails f) args
+ (Var f, args) -> spec_ok (idDetails f) args
_ -> False
where
Note [exprOkForSpeculation: 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
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:
+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)