Commit abaf43d9 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix seq# case of exprOkForSpeculation

This subtle patch fixes Trac #5129 (again; comment:20
and following).

I took the opportunity to document seq# properly; see
Note [seq# magic] in PrelRules, and Note [seq# and expr_ok]
in CoreUtils.
parent 0a778ebe
...@@ -60,7 +60,8 @@ cgExpr :: StgExpr -> FCode ReturnKind ...@@ -60,7 +60,8 @@ cgExpr :: StgExpr -> FCode ReturnKind
cgExpr (StgApp fun args) = cgIdApp fun args cgExpr (StgApp fun args) = cgIdApp fun args
{- seq# a s ==> a -} -- seq# a s ==> a
-- See Note [seq# magic] in PrelRules
cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) =
cgIdApp a [] cgIdApp a []
...@@ -447,13 +448,14 @@ cgCase scrut@(StgApp v []) _ (PrimAlt _) _ ...@@ -447,13 +448,14 @@ cgCase scrut@(StgApp v []) _ (PrimAlt _) _
{- Note [Handle seq#] {- Note [Handle seq#]
~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~
case seq# a s of v See Note [seq# magic] in PrelRules.
(# s', a' #) -> e The special case for seq# in cgCase does this:
case seq# a s of v
(# s', a' #) -> e
==> ==>
case a of v
case a of v (# s', a' #) -> e
(# s', a' #) -> e
(taking advantage of the fact that the return convention for (# State#, a #) (taking advantage of the fact that the return convention for (# State#, a #)
is the same as the return convention for just 'a') is the same as the return convention for just 'a')
...@@ -461,6 +463,7 @@ is the same as the return convention for just 'a') ...@@ -461,6 +463,7 @@ is the same as the return convention for just 'a')
cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts
= -- Note [Handle seq#] = -- Note [Handle seq#]
-- And see Note [seq# magic] in PrelRules
-- Use the same return convention as vanilla 'a'. -- Use the same return convention as vanilla 'a'.
cgCase (StgApp a []) bndr alt_type alts cgCase (StgApp a []) bndr alt_type alts
......
...@@ -1449,8 +1449,11 @@ app_ok primop_ok fun args ...@@ -1449,8 +1449,11 @@ app_ok primop_ok fun args
-- Often there is a literal divisor, and this -- Often there is a literal divisor, and this
-- can get rid of a thunk in an inner loop -- can get rid of a thunk in an inner loop
| SeqOp <- op -- See Note [seq# and expr_ok]
-> all (expr_ok primop_ok) args
| otherwise | otherwise
-> primop_ok op -- Check the primop itself -> primop_ok op -- Check the primop itself
&& and (zipWith arg_ok arg_tys args) -- Check the arguments && and (zipWith arg_ok arg_tys args) -- Check the arguments
_other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF _other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF
...@@ -1607,6 +1610,25 @@ See also Note [dataToTag#] in primops.txt.pp. ...@@ -1607,6 +1610,25 @@ See also Note [dataToTag#] in primops.txt.pp.
Bottom line: Bottom line:
* in exprOkForSpeculation we simply ignore all lifted arguments. * in exprOkForSpeculation we simply ignore all lifted arguments.
* except see Note [seq# and expr_ok] for an exception
Note [seq# and expr_ok]
~~~~~~~~~~~~~~~~~~~~~~~
Recall that
seq# :: forall a s . a -> State# s -> (# State# s, a #)
must always evaluate its first argument. So it's really a
counter-example to Note [Primops with lifted arguments]. In
the case of seq# we must check the argument to seq#. Remember
item (d) of the specification of exprOkForSpeculation:
-- Precisely, it returns @True@ iff:
-- a) The expression guarantees to terminate,
...
-- d) without throwing a Haskell exception
The lack of this special case caused Trac #5129 to go bad again.
See comment:24 and following
************************************************************************ ************************************************************************
......
...@@ -942,7 +942,56 @@ dataToTagRule = a `mplus` b ...@@ -942,7 +942,56 @@ dataToTagRule = a `mplus` b
************************************************************************ ************************************************************************
-} -}
-- seq# :: forall a s . a -> State# s -> (# State# s, a #) {- Note [seq# magic]
~~~~~~~~~~~~~~~~~~~~
The primop
seq# :: forall a s . a -> State# s -> (# State# s, a #)
is /not/ the same as the Prelude function seq :: a -> b -> b
as you can see from its type. In fact, seq# is the implementation
mechanism for 'evaluate'
evaluate :: a -> IO a
evaluate a = IO $ \s -> seq# a s
The semantics of seq# is
* evaluate its first argument
* and return it
Things to note
* Why do we need a primop at all? That is, instead of
case seq# x s of (# x, s #) -> blah
why not instead say this?
case x of { DEFAULT -> blah)
Reason (see Trac #5129): if we saw
catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler
then we'd drop the 'case x' because the body of the case is bottom
anyway. But we don't want to do that; the whole /point/ of
seq#/evaluate is to evaluate 'x' first in the IO monad.
In short, we /always/ evaluate the first argument and never
just discard it.
* Why return the value? So that we can control sharing of seq'd
values: in
let x = e in x `seq` ... x ...
We don't want to inline x, so better to represent it as
let x = e in case seq# x RW of (# _, x' #) -> ... x' ...
also it matches the type of rseq in the Eval monad.
Implementing seq#. The compiler has magic for SeqOp in
- PrelRules.seqRule: eliminate (seq# <whnf> s)
- StgCmmExpr.cgExpr, and cgCase: special case for seq#
- CoreUtils.exprOkForSpeculation;
see Note [seq# and expr_ok] in CoreUtils
-}
seqRule :: RuleM CoreExpr seqRule :: RuleM CoreExpr
seqRule = do seqRule = do
[Type ty_a, Type _ty_s, a, s] <- getArgs [Type ty_a, Type _ty_s, a, s] <- getArgs
......
...@@ -2697,13 +2697,7 @@ primop SparkOp "spark#" GenPrimOp ...@@ -2697,13 +2697,7 @@ primop SparkOp "spark#" GenPrimOp
primop SeqOp "seq#" GenPrimOp primop SeqOp "seq#" GenPrimOp
a -> State# s -> (# State# s, a #) a -> State# s -> (# State# s, a #)
-- See Note [seq# magic] in PrelRules
-- why return the value? So that we can control sharing of seq'd
-- values: in
-- let x = e in x `seq` ... x ...
-- we don't want to inline x, so better to represent it as
-- let x = e in case seq# x RW of (# _, x' #) -> ... x' ...
-- also it matches the type of rseq in the Eval monad.
primop GetSparkOp "getSpark#" GenPrimOp primop GetSparkOp "getSpark#" GenPrimOp
State# s -> (# State# s, Int#, a #) State# s -> (# State# s, Int#, a #)
......
...@@ -94,7 +94,7 @@ test('T5149', omit_ways(['ghci']), multi_compile_and_run, ...@@ -94,7 +94,7 @@ test('T5149', omit_ways(['ghci']), multi_compile_and_run,
test('T5129', test('T5129',
# The bug is in simplifier when run with -O1 and above, so only run it # The bug is in simplifier when run with -O1 and above, so only run it
# optimised, using any backend. # optimised, using any backend.
[ only_ways(['optasm']), expect_broken(5129) ], only_ways(['optasm']),
compile_and_run, ['']) compile_and_run, [''])
test('T5626', exit_code(1), compile_and_run, ['']) test('T5626', exit_code(1), compile_and_run, [''])
......
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