Refine exprOkForSpeculation
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 13 Jan 2017 14:20:15 +0000 (14:20 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 16 Jan 2017 11:57:14 +0000 (11:57 +0000)
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.

compiler/coreSyn/CoreUtils.hs
compiler/prelude/primops.txt.pp

index 60024c5..bad322d 100644 (file)
@@ -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.
 
 
 ************************************************************************
index 15fb785..a69ba97 100644 (file)
@@ -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