Commit 4e36a8b1 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Improve the treatment of 'seq' (Trac #2273)

Trac #2273 showed a case in which 'seq' didn't cure the space leak
it was supposed to.  This patch does two things to help

a) It removes a now-redundant special case in Simplify, which
   switched off the case-binder-swap in the early stages.  This
   isn't necessary any more because FloatOut has improved since
   the Simplify code was written.  And switching off the binder-swap
   is harmful for seq.

However fix (a) is a bit fragile, so I did (b) too:

b) Desugar 'seq' specially.  See Note [Desugaring seq (2)] in DsUtils
   This isn't very robust either, since it's defeated by abstraction, 
   but that's not something GHC can fix; the programmer should use
   a let! instead.
parent bca61eb5
......@@ -1154,6 +1154,7 @@ nonExhaustiveGuardsErrorName
\end{code}
\begin{code}
------------------------------------------------
-- unsafeCoerce# :: forall a b. a -> b
unsafeCoerceId
= pcMiscPrelId unsafeCoerceName ty info
......@@ -1167,17 +1168,23 @@ unsafeCoerceId
rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
------------------------------------------------
nullAddrId :: Id
-- nullAddr# :: Addr#
-- The reason is is here is because we don't provide
-- a way to write this literal in Haskell.
nullAddrId
= pcMiscPrelId nullAddrName addrPrimTy info
nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
where
info = noCafIdInfo `setUnfoldingInfo`
mkCompulsoryUnfolding (Lit nullAddrLit)
seqId
= pcMiscPrelId seqName ty info
------------------------------------------------
seqId :: Id
-- 'seq' is very special. See notes with
-- See DsUtils.lhs Note [Desugaring seq (1)] and
-- Note [Desugaring seq (2)] and
-- Fixity is set in LoadIface.ghcPrimIface
seqId = pcMiscPrelId seqName ty info
where
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
......@@ -1187,6 +1194,8 @@ seqId
[x,y] = mkTemplateLocals [alphaTy, openBetaTy]
rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
------------------------------------------------
lazyId :: Id
-- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
-- Used to lazify pseq: pseq a b = a `seq` lazy b
--
......@@ -1198,8 +1207,7 @@ seqId
-- (see WorkWrap.wwExpr)
-- We could use inline phases to do this, but that would be vulnerable to changes in
-- phase numbering....we must inline precisely after strictness analysis.
lazyId
= pcMiscPrelId lazyIdName ty info
lazyId = pcMiscPrelId lazyIdName ty info
where
info = noCafIdInfo
ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
......
......@@ -163,14 +163,18 @@ mkDsApps fun args
(arg_ty, res_ty) = splitFunTy fun_ty
-----------
mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr
mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
| f == seqId -- Note [Desugaring seq (1), (2)]
= Case arg1 case_bndr res_ty [(DEFAULT,[],arg2)]
where
case_bndr = case arg1 of
Var v1 -> v1 -- Note [Desugaring seq (2)]
_ -> mkWildId ty1
mk_val_app fun arg arg_ty _ -- See Note [CoreSyn let/app invariant]
| not (isUnLiftedType arg_ty) || exprOkForSpeculation arg
= App fun arg -- The vastly common case
mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
| f == seqId -- Note [Desugaring seq]
= Case arg1 (mkWildId ty1) res_ty [(DEFAULT,[],arg2)]
mk_val_app fun arg arg_ty res_ty
= Case arg (mkWildId arg_ty) res_ty [(DEFAULT,[],App fun (Var arg_id))]
where
......@@ -178,8 +182,8 @@ mk_val_app fun arg arg_ty res_ty
-- because 'fun ' should not have a free wild-id
\end{code}
Note [Desugaring seq] cf Trac #1031
~~~~~~~~~~~~~~~~~~~~~
Note [Desugaring seq (1)] cf Trac #1031
~~~~~~~~~~~~~~~~~~~~~~~~~
f x y = x `seq` (y `seq` (# x,y #))
The [CoreSyn let/app invariant] means that, other things being equal, because
......@@ -194,10 +198,41 @@ But that is bad for two reasons:
Seq is very, very special! So we recognise it right here, and desugar to
case x of _ -> case y of _ -> (# x,y #)
The special case would be valid for all calls to 'seq', but it's only *necessary*
for ones whose second argument has an unlifted type. So we only catch the latter
case here, to avoid unnecessary tests.
Note [Desugaring seq (2)] cf Trac #2231
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
let chp = case b of { True -> fst x; False -> 0 }
in chp `seq` ...chp...
Here the seq is designed to plug the space leak of retaining (snd x)
for too long.
If we rely on the ordinary inlining of seq, we'll get
let chp = case b of { True -> fst x; False -> 0 }
case chp of _ { I# -> ...chp... }
But since chp is cheap, and the case is an alluring contet, we'll
inline chp into the case scrutinee. Now there is only one use of chp,
so we'll inline a second copy. Alas, we've now ruined the purpose of
the seq, by re-introducing the space leak:
case (case b of {True -> fst x; False -> 0}) of
I# _ -> ...case b of {True -> fst x; False -> 0}...
We can try to avoid doing this by ensuring that the binder-swap in the
case happens, so we get his at an early stage:
case chp of chp2 { I# -> ...chp2... }
But this is fragile. The real culprit is the source program. Perhpas we
should have said explicitly
let !chp2 = chp in ...chp2...
But that's painful. So the code here does a little hack to make seq
more robust: a saturated application of 'seq' is turned *directly* into
the case expression. So we desugar to:
let chp = case b of { True -> fst x; False -> 0 }
case chp of chp { I# -> ...chp... }
Notice the shadowing of the case binder! And now all is well.
The reason it's a hack is because if you define mySeq=seq, the hack
won't work on mySeq.
%************************************************************************
%* *
......
......@@ -1265,15 +1265,18 @@ inlined.
Note [no-case-of-case]
~~~~~~~~~~~~~~~~~~~~~~
There is a time we *don't* want to do that, namely when
-fno-case-of-case is on. This happens in the first simplifier pass,
and enhances full laziness. Here's the bad case:
f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
If we eliminate the inner case, we trap it inside the I# v -> arm,
which might prevent some full laziness happening. I've seen this
in action in spectral/cichelli/Prog.hs:
[(m,n) | m <- [1..max], n <- [1..max]]
Hence the check for NoCaseOfCase.
We *used* to suppress the binder-swap in case expressoins when
-fno-case-of-case is on. Old remarks:
"This happens in the first simplifier pass,
and enhances full laziness. Here's the bad case:
f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
If we eliminate the inner case, we trap it inside the I# v -> arm,
which might prevent some full laziness happening. I've seen this
in action in spectral/cichelli/Prog.hs:
[(m,n) | m <- [1..max], n <- [1..max]]
Hence the check for NoCaseOfCase."
However, now the full-laziness pass itself reverses the binder-swap, so this
check is no longer necessary.
Note [Suppressing the case binder-swap]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1495,9 +1498,9 @@ simplCaseBinder env0 scrut0 case_bndr0 alts
improve_case_bndr env scrut case_bndr
| switchIsOn (getSwitchChecker env) NoCaseOfCase
-- See Note [no-case-of-case]
= (env, case_bndr)
-- See Note [no-case-of-case]
-- | switchIsOn (getSwitchChecker env) NoCaseOfCase
-- = (env, case_bndr)
| otherwise -- Failed try; see Note [Suppressing the case binder-swap]
-- not (isEvaldUnfolding (idUnfolding v))
......
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