The laziness of `seq#` can create silly thunks
Consider this example program, added as a test case in !11464 (closed):
module T15226b where
import Control.Exception
data StrictPair a b = MkStrictPair !a !b
testFun :: a -> b -> IO (StrictPair a b)
testFun x y = do
x' <- evaluate x
evaluate (MkStrictPair x' y)
-- tag inference should not insert an eval for x' in making the strict pair
Since seq#
/evaluate
is lazy (see discussion in #22935), after Core Prep we will have something like this:
T15226b.testFun1
= \ (@a_aAo)
(@b_aAp)
(x_sFW [Occ=Once1] :: a_aAo)
(y_sFX [Occ=Once1, OS=OneShot] :: b_aAp)
(s_sFY [Occ=Once1, OS=OneShot]
:: GHC.Prim.State# GHC.Prim.RealWorld) ->
case GHC.Prim.seq# @a_aAo @GHC.Prim.RealWorld x_sFW s_sFY of
{ (# ipv_sG0 [Occ=Once1], ipv1_sG1 [Occ=Once1] #) ->
let {
sat_sG3 [Occ=Once1] :: T15226b.StrictPair a_aAo b_aAp
[LclId]
sat_sG3
= case y_sFX of conrep_sG2 [Occ=Once1] { __DEFAULT ->
T15226b.MkStrictPair @a_aAo @b_aAp ipv1_sG1 conrep_sG2
} } in
GHC.Prim.seq#
@(T15226b.StrictPair a_aAo b_aAp)
@GHC.Prim.RealWorld
sat_sG3
ipv_sG0
}
Here, sat_sG3
will become a thunk, which we allocate and then immediately evaluate. This is a bit silly!
In !11464 (comment 533039), @simonpj proposes:
But second, suppose we had this:
x <- evaluate (f y)
In Core we'll get
case seq# (f y) s of x { __DEFAULT -> ... x ... }
But we do not want to generate a thunk for
(f y)
in CorePrep. We want to turn this (in CorePrep) intocase f y of r { __DEFAULT -> case seq# r s of x { __DEFAULT -> ...
Right?
And I agree that CorePrep is probably the right time to fix this.
Also note that in the original example (above), we get Core like
seq# (case y of y' -> blah) s
Naively CorePrep might case-bind that argument giving
case (case y of y' -> blah) of r ->
seq# r s
but perhaps we'd prefer
case y of y' ->
case blah or r ->
seq# r s
I'm not sure if CorePrep floating does that.
Edited by Simon Peyton Jones