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
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) =
cgIdApp a []
......@@ -447,13 +448,14 @@ cgCase scrut@(StgApp v []) _ (PrimAlt _) _
{- Note [Handle seq#]
~~~~~~~~~~~~~~~~~~~~~
case seq# a s of v
(# s', a' #) -> e
See Note [seq# magic] in PrelRules.
The special case for seq# in cgCase does this:
case seq# a s of v
(# s', a' #) -> e
==>
case a of v
(# s', a' #) -> e
case a of v
(# s', a' #) -> e
(taking advantage of the fact that the return convention for (# State#, 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')
cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts
= -- Note [Handle seq#]
-- And see Note [seq# magic] in PrelRules
-- Use the same return convention as vanilla 'a'.
cgCase (StgApp a []) bndr alt_type alts
......
......@@ -1449,8 +1449,11 @@ app_ok primop_ok fun args
-- Often there is a literal divisor, and this
-- 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
-> primop_ok op -- Check the primop itself
-> 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
......@@ -1607,6 +1610,25 @@ See also Note [dataToTag#] in primops.txt.pp.
Bottom line:
* 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
************************************************************************
-}
-- 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 = do
[Type ty_a, Type _ty_s, a, s] <- getArgs
......
......@@ -2697,13 +2697,7 @@ primop SparkOp "spark#" GenPrimOp
primop SeqOp "seq#" GenPrimOp
a -> State# s -> (# State# s, a #)
-- 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.
-- See Note [seq# magic] in PrelRules
primop GetSparkOp "getSpark#" GenPrimOp
State# s -> (# State# s, Int#, a #)
......
......@@ -94,7 +94,7 @@ test('T5149', omit_ways(['ghci']), multi_compile_and_run,
test('T5129',
# The bug is in simplifier when run with -O1 and above, so only run it
# optimised, using any backend.
[ only_ways(['optasm']), expect_broken(5129) ],
only_ways(['optasm']),
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