diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-03-20 16:30:01 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-03-20 16:33:01 +0000 |
commit | abaf43d9d88d6fdf7345b936a571d17cfe1fa140 (patch) | |
tree | ca3971da6ca25d2d670305d68722f5fbb2d8c1d2 | |
parent | 0a778ebeccefe6c3c2540a06d5a1c585f18e01ab (diff) | |
download | haskell-abaf43d9d88d6fdf7345b936a571d17cfe1fa140.tar.gz |
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.
-rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 15 | ||||
-rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 24 | ||||
-rw-r--r-- | compiler/prelude/PrelRules.hs | 51 | ||||
-rw-r--r-- | compiler/prelude/primops.txt.pp | 8 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_run/all.T | 2 |
5 files changed, 84 insertions, 16 deletions
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index c2f2efed3d..22fcfaf412 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -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 diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 4db9d8fc29..5608afc334 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -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 ************************************************************************ diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 73484b7c35..14e3f0f36e 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -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 diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index e580f989c1..996e0bb3e8 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -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 #) diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index cf4904e79e..55386e402b 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -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, ['']) |