[commit: ghc] ghc-8.4: Fix seq# case of exprOkForSpeculation (ac1ade1)
git at git.haskell.org
git at git.haskell.org
Mon Mar 26 05:30:33 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.4
Link : http://ghc.haskell.org/trac/ghc/changeset/ac1ade1ad25f145ab27219c4fb8366e982658873/ghc
>---------------------------------------------------------------
commit ac1ade1ad25f145ab27219c4fb8366e982658873
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Mar 20 16:30:01 2018 +0000
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.
(cherry picked from commit abaf43d9d88d6fdf7345b936a571d17cfe1fa140)
>---------------------------------------------------------------
ac1ade1ad25f145ab27219c4fb8366e982658873
compiler/codeGen/StgCmmExpr.hs | 15 ++++++----
compiler/coreSyn/CoreUtils.hs | 24 ++++++++++++++-
compiler/prelude/PrelRules.hs | 51 +++++++++++++++++++++++++++++++-
compiler/prelude/primops.txt.pp | 8 +----
testsuite/tests/codeGen/should_run/all.T | 8 ++++-
5 files changed, 90 insertions(+), 16 deletions(-)
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 3fcc935..aaff6c1 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -61,7 +61,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 []
@@ -446,13 +447,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')
@@ -460,6 +462,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
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 821104a..7ade8f8 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -1400,8 +1400,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
@@ -1558,6 +1561,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
************************************************************************
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index 867c12f..dca6ff0 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -929,7 +929,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
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index b13123c..44e2f78 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2698,13 +2698,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 #)
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 9403c4b..55386e4 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -90,7 +90,13 @@ test('T3677', extra_run_opts('+RTS -K8k -RTS'), compile_and_run, [''])
test('T4441', normal, compile_and_run, [''])
test('T5149', omit_ways(['ghci']), multi_compile_and_run,
['T5149', [('T5149_cmm.cmm', '')], ''])
-test('T5129', normal, 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']),
+ compile_and_run, [''])
+
test('T5626', exit_code(1), compile_and_run, [''])
test('T5747', when(arch('i386'), extra_hc_opts('-msse2')), compile_and_run, ['-O2'])
test('T5785', normal, compile_and_run, [''])
More information about the ghc-commits
mailing list