[commit: ghc] master: Refine exprOkForSpeculation (5a9a173)
git at git.haskell.org
git at git.haskell.org
Mon Jan 16 16:03:27 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a/ghc
>---------------------------------------------------------------
commit 5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jan 13 14:20:15 2017 +0000
Refine exprOkForSpeculation
This patch implements two related changes, both inspired by
the discussion on Trac #13027, comment:23:
* exprOkForSpeculation (op# a1 .. an), where op# is a primop,
now skips over arguments ai of lifted type. See the comments
at Note [Primops with lifted arguments] in CoreUtils.
There is no need to treat dataToTag# specially any more.
* dataToTag# is now treated as a can-fail primop. See
Note [dataToTag#] in primops.txt.pp
I don't expect this to have a visible effect on anything, but
it's much more solid than before.
>---------------------------------------------------------------
5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a
compiler/coreSyn/CoreUtils.hs | 75 +++++++++++++++++++++++++----------------
compiler/prelude/primops.txt.pp | 30 +++++++++++++++--
2 files changed, 73 insertions(+), 32 deletions(-)
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 60024c5..bad322d 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -68,6 +68,7 @@ import PrimOp
import Id
import IdInfo
import Type
+import TyCoRep( TyBinder(..) )
import Coercion
import TyCon
import Unique
@@ -1286,18 +1287,19 @@ app_ok primop_ok fun args
-- to take the arguments into account
PrimOpId op
- | isDivOp op -- Special case for dividing operations that fail
- , [arg1, Lit lit] <- args -- only if the divisor is zero
+ | isDivOp op
+ , [arg1, Lit lit] <- args
-> not (isZeroLit lit) && expr_ok primop_ok arg1
- -- Often there is a literal divisor, and this
- -- can get rid of a thunk in an inner looop
-
- | DataToTagOp <- op -- See Note [dataToTag speculation]
- -> True
+ -- Special case for dividing operations that fail
+ -- In general they are NOT ok-for-speculation
+ -- (which primop_ok will catch), but they ARE OK
+ -- if the divisor is definitely non-zero.
+ -- Often there is a literal divisor, and this
+ -- can get rid of a thunk in an inner looop
| otherwise
- -> primop_ok op -- A bit conservative: we don't really need
- && all (expr_ok primop_ok) args -- to care about lazy arguments, but this is easy
+ -> primop_ok op -- Check the primop itself
+ && and (zipWith arg_ok arg_tys args) -- Check the arguments
_other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF
|| idArity fun > n_val_args -- Partial apps
@@ -1305,6 +1307,14 @@ app_ok primop_ok fun args
isEvaldUnfolding (idUnfolding fun)) -- Let-bound values
where
n_val_args = valArgCount args
+ where
+ (arg_tys, _) = splitPiTys (idType fun)
+
+ arg_ok :: TyBinder -> Expr b -> Bool
+ arg_ok (Named _) _ = True -- A type argument
+ arg_ok (Anon ty) arg -- A term argument
+ | isUnliftedType ty = expr_ok primop_ok arg
+ | otherwise = True -- See Note [Primops with lifted arguments]
-----------------------------
altsAreExhaustive :: [Alt b] -> Bool
@@ -1386,26 +1396,33 @@ One could try to be clever, but the easy fix is simpy to regard
a non-exhaustive case as *not* okForSpeculation.
-Note [dataToTag speculation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Is this OK?
- f x = let v::Int# = dataToTag# x
- in ...
-We say "yes", even though 'x' may not be evaluated. Reasons
-
- * dataToTag#'s strictness means that its argument often will be
- evaluated, but FloatOut makes that temporarily untrue
- case x of y -> let v = dataToTag# y in ...
- -->
- case x of y -> let v = dataToTag# x in ...
- Note that we look at 'x' instead of 'y' (this is to improve
- floating in FloatOut). So Lint complains.
-
- Moreover, it really *might* improve floating to let the
- v-binding float out
-
- * CorePrep makes sure dataToTag#'s argument is evaluated, just
- before code gen. Until then, it's not guaranteed
+Note [Primops with lifted arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Is this ok-for-speculation (see Trac #13027)?
+ reallyUnsafePtrEq# a b
+Well, yes. The primop accepts lifted arguments and does not
+evaluate them. Indeed, in general primops are, well, primitive
+and do not perform evaluation.
+
+There is one primop, dataToTag#, which does /require/ a lifted
+argument to be evaluted. To ensure this, CorePrep adds an
+eval if it can't see the the argument is definitely evaluated
+(see [dataToTag magic] in CorePrep).
+
+We make no attempt to guarantee that dataToTag#'s argument is
+evaluated here. Main reason: it's very fragile to test for the
+evaluatedness of a lifted argument. Consider
+ case x of y -> let v = dataToTag# y in ...
+
+where x/y have type Int, say. 'y' looks evaluated (by the enclosing
+case) so all is well. Now the FloatOut pass does a binder-swap (for
+very good reasons), changing to
+ case x of y -> let v = dataToTag# x in ...
+
+See also Note [dataToTag#] in primops.txt.pp.
+
+Bottom line:
+ * in exprOkForSpeculation we simply ignore all lifted arguments.
************************************************************************
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 15fb785..a69ba97 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2592,13 +2592,37 @@ section "Tag to enum stuff"
primop DataToTagOp "dataToTag#" GenPrimOp
a -> Int#
with
- strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes }
-
- -- dataToTag# must have an evaluated argument
+ can_fail = True -- See Note [dataToTag#]
+ strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes }
+ -- dataToTag# must have an evaluated argument
primop TagToEnumOp "tagToEnum#" GenPrimOp
Int# -> a
+{- Note [dataToTag#]
+~~~~~~~~~~~~~~~~~~~~
+The dataToTag# primop should always be applied to an evaluated argument.
+The way to ensure this is to invoke it via the 'getTag' wrapper in GHC.Base:
+ getTag :: a -> Int#
+ getTag !x = dataToTag# x
+
+But now consider
+ \z. case x of y -> let v = dataToTag# y in ...
+
+To improve floating, the FloatOut pass (deliberately) does a
+binder-swap on the case, to give
+ \z. case x of y -> let v = dataToTag# x in ...
+
+Now FloatOut might float that v-binding outside the \z. But that is
+bad because that might mean x gest evaluated much too early! (CorePrep
+adds an eval to a dataToTag# call, to ensure that the agument really is
+evaluated; see CorePrep Note [dataToTag magic].)
+
+Solution: make DataToTag into a can_fail primop. That will stop it floating
+(see Note [PrimOp can_fail and has_side_effects] in PrimOp). It's a bit of
+a hack but never mind.
+-}
+
------------------------------------------------------------------------
section "Bytecode operations"
{Support for manipulating bytecode objects used by the interpreter and
More information about the ghc-commits
mailing list