Commit 4c3a0a4a authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix the implementation of lazyId

'lazy' was doing part of its job, but not all!  In particular,
an application
  f (lazy e)
where f is strict, was still being compiled using call-by-value in
CorePrep.  This defeated the purpose of defining catch as
   catch a b = catch# (lazy a) b
See Trac #11555, and Neil Mitchell's test case in comment:14

This patch makes 'lazy' behave properly. I updated Note [lazyId magic]
in MkId, but all the action is in CorePrep.

I can't say I really like this, but it does the job.
parent 1c76e168
......@@ -1324,23 +1324,46 @@ may fire.
Note [lazyId magic]
~~~~~~~~~~~~~~~~~~~
lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
Used to lazify pseq: pseq a b = a `seq` lazy b
Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
not from GHC.Base.hi. This is important, because the strictness
analyser will spot it as strict!
Also no unfolding in lazyId: it gets "inlined" by a HACK in CorePrep.
It's very important to do this inlining *after* unfoldings are exposed
in the interface file. Otherwise, the unfolding for (say) pseq in the
interface file will not mention 'lazy', so if we inline 'pseq' we'll totally
miss the very thing that 'lazy' was there for in the first place.
See Trac #3259 for a real world example.
lazyId is defined in GHC.Base, so we don't *have* to inline it. If it
appears un-applied, we'll end up just calling it.
lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
'lazy' is used to make sure that a sub-expression, and its free variables,
are truly used call-by-need, with no code motion. Key examples:
* pseq: pseq a b = a `seq` lazy b
We want to make sure that the free vars of 'b' are not evaluated
before 'a', even though the expression is plainly strict in 'b'.
* catch: catch a b = catch# (lazy a) b
Again, it's clear that 'a' will be evaluated strictly (and indeed
applied to a state token) but we want to make sure that any exceptions
arising from the evaluation of 'a' are caught by the catch (see
Trac #11555).
Implementing 'lazy' is a bit tricky:
* It must not have a strictness signature: by being a built-in Id,
all the info about lazyId comes from here, not from GHC.Base.hi.
This is important, because the strictness analyser will spot it as
strict!
* It must not have an unfolding: it gets "inlined" by a HACK in
CorePrep. It's very important to do this inlining *after* unfoldings
are exposed in the interface file. Otherwise, the unfolding for
(say) pseq in the interface file will not mention 'lazy', so if we
inline 'pseq' we'll totally miss the very thing that 'lazy' was
there for in the first place. See Trac #3259 for a real world
example.
* Suppose CorePrep sees (catch# (lazy e) b). At all costs we must
avoid using call by value here:
case e of r -> catch# r b
Avoiding that is the whole point of 'lazy'. So in CorePrep (which
generate the 'case' expression for a call-by-value call) we must
spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'
instead.
* lazyId is defined in GHC.Base, so we don't *have* to inline it. If it
appears un-applied, we'll end up just calling it.
Note [runRW magic]
~~~~~~~~~~~~~~~~~~
......
......@@ -657,14 +657,14 @@ rhsToBody expr = return (emptyFloats, expr)
cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
-- May return a CpeRhs because of saturating primops
cpeApp env expr
= do { (app, (head,depth), _, floats, ss) <- collect_args expr 0
= do { (app, head, _, floats, ss) <- collect_args expr 0
; MASSERT(null ss) -- make sure we used all the strictness info
-- Now deal with the function
; case head of
Var fn_id -> do { sat_app <- maybeSaturate fn_id app depth
; return (floats, sat_app) }
_other -> return (floats, app) }
Just (fn_id, depth) -> do { sat_app <- maybeSaturate fn_id app depth
; return (floats, sat_app) }
_other -> return (floats, app) }
where
-- Deconstruct and rebuild the application, floating any non-atomic
......@@ -675,13 +675,13 @@ cpeApp env expr
collect_args
:: CoreExpr
-> Int -- Current app depth
-> UniqSM (CpeApp, -- The rebuilt expression
(CoreExpr,Int), -- The head of the application,
-- and no. of args it was applied to
Type, -- Type of the whole expr
Floats, -- Any floats we pulled out
[Demand]) -- Remaining argument demands
-> Int -- Current app depth
-> UniqSM (CpeApp, -- The rebuilt expression
Maybe (Id, Int), -- The head of the application,
-- and no. of args it was applied to
Type, -- Type of the whole expr
Floats, -- Any floats we pulled out
[Demand]) -- Remaining argument demands
collect_args (App fun arg@(Type arg_ty)) depth
= do { (fun',hd,fun_ty,floats,ss) <- collect_args fun depth
......@@ -693,12 +693,13 @@ cpeApp env expr
collect_args (App fun arg) depth
= do { (fun',hd,fun_ty,floats,ss) <- collect_args fun (depth+1)
; let
(ss1, ss_rest) = case ss of
(ss1:ss_rest) -> (ss1, ss_rest)
[] -> (topDmd, [])
(arg_ty, res_ty) = expectJust "cpeBody:collect_args" $
splitFunTy_maybe fun_ty
; let (ss1, ss_rest) -- See Note [lazyId magic] in MkId
= case (ss, isLazyExpr arg) of
(_ : ss_rest, True) -> (topDmd, ss_rest)
(ss1 : ss_rest, False) -> (ss1, ss_rest)
([], _) -> (topDmd, [])
(arg_ty, res_ty) = expectJust "cpeBody:collect_args" $
splitFunTy_maybe fun_ty
; (fs, arg') <- cpeArg env ss1 arg arg_ty
; return (App fun' arg', hd, res_ty, fs `appendFloats` floats, ss_rest) }
......@@ -706,7 +707,7 @@ cpeApp env expr
collect_args (Var v) depth
= do { v1 <- fiddleCCall v
; let v2 = lookupCorePrepEnv env v1
; return (Var v2, (Var v2, depth), idType v2, emptyFloats, stricts) }
; return (Var v2, Just (v2, depth), idType v2, emptyFloats, stricts) }
where
stricts = case idStrictness v of
StrictSig (DmdType _ demands _)
......@@ -732,14 +733,21 @@ cpeApp env expr
; return (fun',hd,fun_ty,addFloat floats (FloatTick tickish),ss) }
-- N-variable fun, better let-bind it
collect_args fun depth
collect_args fun _
= do { (fun_floats, fun') <- cpeArg env evalDmd fun ty
-- The evalDmd says that it's sure to be evaluated,
-- so we'll end up case-binding it
; return (fun', (fun', depth), ty, fun_floats, []) }
; return (fun', Nothing, ty, fun_floats, []) }
where
ty = exprType fun
isLazyExpr :: CoreExpr -> Bool
-- See Note [lazyId magic] in MkId
isLazyExpr (Cast e _) = isLazyExpr e
isLazyExpr (Tick _ e) = isLazyExpr e
isLazyExpr (Var f `App` _ `App` _) = f `hasKey` lazyIdKey
isLazyExpr _ = False
-- ---------------------------------------------------------------------------
-- CpeArg: produces a result satisfying CpeArg
-- ---------------------------------------------------------------------------
......
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