Commit d77501cd authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improvements to demand analysis

This patch collects a few improvements triggered by Trac #15696,
and fixing Trac #16029

* Stop making toCleanDmd behave specially for unlifted types.
  This special case was the cause of stupid behaviour in Trac
  #16029.  And to my joy I discovered the let/app invariant
  rendered it unnecessary.  (Maybe the special case pre-dated
  the let/app invariant.)

  Result: less special-case handling in the compiler, and
  better perf for the compiled code.

* In WwLib.mkWWstr_one, treat seqDmd like U(AAA).  It was not
  being so treated before, which again led to stupid code.

* Update and improve Notes

There are .stderr test wibbles because we get slightly different
strictness signatures for an argumment of unlifted type:
    <L,U> rather than <S,U>        for Int#
    <S,U> rather than <S(S),U(U)>  for Int
parent ded4a1db
......@@ -74,7 +74,7 @@ import BasicTypes
import Binary
import Maybes ( orElse )
import Type ( Type, isUnliftedType )
import Type ( Type )
import TyCon ( isNewTyCon, isClassTyCon )
import DataCon ( splitDataProductType_maybe )
......@@ -393,10 +393,15 @@ data UseDmd
-- (in that case, use UHead)
| UHead -- ^ May be used but its sub-components are
-- definitely *not* used. Roughly U(AAA)
-- e.g. the usage of @x@ in @x `seq` e@
-- A polymorphic demand: used for values of all types,
-- including a type variable
-- definitely *not* used. For product types, UHead
-- is equivalent to U(AAA); see mkUProd.
--
-- UHead is needed only to express the demand
-- of 'seq' and 'case' which are polymorphic;
-- i.e. the scrutinised value is of type 'a'
-- rather than a product type. That's why we
-- can't use UProd [A,A,A]
--
-- Since (UCall _ Abs) is ill-typed, UHead doesn't
-- make sense for lambdas
......@@ -1100,81 +1105,6 @@ different:
unused, so we can use absDmd there.
* Further arguments *can* be used, of course. Hence topDmd is used.
Note [Worthy functions for Worker-Wrapper split]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For non-bottoming functions a worker-wrapper transformation takes into
account several possibilities to decide if the function is worthy for
splitting:
1. The result is of product type and the function is strict in some
(or even all) of its arguments. The check that the argument is used is
more of sanity nature, since strictness implies usage. Example:
f :: (Int, Int) -> Int
f p = (case p of (a,b) -> a) + 1
should be splitted to
f :: (Int, Int) -> Int
f p = case p of (a,b) -> $wf a
$wf :: Int -> Int
$wf a = a + 1
2. Sometimes it also makes sense to perform a WW split if the
strictness analysis cannot say for sure if the function is strict in
components of its argument. Then we reason according to the inferred
usage information: if the function uses its product argument's
components, the WW split can be beneficial. Example:
g :: Bool -> (Int, Int) -> Int
g c p = case p of (a,b) ->
if c then a else b
The function g is strict in is argument p and lazy in its
components. However, both components are used in the RHS. The idea is
since some of the components (both in this case) are used in the
right-hand side, the product must presumable be taken apart.
Therefore, the WW transform splits the function g to
g :: Bool -> (Int, Int) -> Int
g c p = case p of (a,b) -> $wg c a b
$wg :: Bool -> Int -> Int -> Int
$wg c a b = if c then a else b
3. If an argument is absent, it would be silly to pass it to a
function, hence the worker with reduced arity is generated.
Note [Worker-wrapper for bottoming functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used not to split if the result is bottom.
[Justification: there's no efficiency to be gained.]
But it's sometimes bad not to make a wrapper. Consider
fw = \x# -> let x = I# x# in case e of
p1 -> error_fn x
p2 -> error_fn x
p3 -> the real stuff
The re-boxing code won't go away unless error_fn gets a wrapper too.
[We don't do reboxing now, but in general it's better to pass an
unboxed thing to f, and have it reboxed in the error cases....]
However we *don't* want to do this when the argument is not actually
taken apart in the function at all. Otherwise we risk decomposing a
massive tuple which is barely used. Example:
f :: ((Int,Int) -> String) -> (Int,Int) -> a
f g pr = error (g pr)
main = print (f fst (1, error "no"))
Here, f does not take 'pr' apart, and it's stupid to do so.
Imagine that it had millions of fields. This actually happened
in GHC itself where the tuple was DynFlags
************************************************************************
* *
......@@ -1406,25 +1336,20 @@ type DmdShell -- Describes the "outer shell"
-- of a Demand
= JointDmd (Str ()) (Use ())
toCleanDmd :: Demand -> Type -> (DmdShell, CleanDemand)
toCleanDmd :: Demand -> (DmdShell, CleanDemand)
-- Splits a Demand into its "shell" and the inner "clean demand"
toCleanDmd (JD { sd = s, ud = u }) expr_ty
toCleanDmd (JD { sd = s, ud = u })
= (JD { sd = ss, ud = us }, JD { sd = s', ud = u' })
-- See Note [Analyzing with lazy demand and lambdas]
-- See Note [Analysing with absent demand]
where
(ss, s') = case s of
Str x s' -> (Str x (), s')
Lazy | is_unlifted -> (Str VanStr (), HeadStr)
| otherwise -> (Lazy, HeadStr)
Str x s' -> (Str x (), s')
Lazy -> (Lazy, HeadStr)
(us, u') = case u of
Use c u' -> (Use c (), u')
Abs | is_unlifted -> (Use One (), Used)
| otherwise -> (Abs, Used)
is_unlifted = isUnliftedType expr_ty
-- See Note [Analysing with absent demand]
Use c u' -> (Use c (), u')
Abs -> (Abs, Used)
-- This is used in dmdAnalStar when post-processing
-- a function's argument demand. So we only care about what
......@@ -1646,9 +1571,9 @@ There are several wrinkles:
But we can post-process the results to ignore all the usage
demands coming back. This is done by postProcessDmdType.
* But in the case of an *unlifted type* we must be extra careful,
because unlifted values are evaluated even if they are not used.
Example (see Trac #9254):
* In a previous incarnation of GHC we needed to be extra careful in the
case of an *unlifted type*, because unlifted values are evaluated
even if they are not used. Example (see Trac #9254):
f :: (() -> (# Int#, () #)) -> ()
-- Strictness signature is
-- <C(S(LS)), 1*C1(U(A,1*U()))>
......@@ -1668,10 +1593,11 @@ There are several wrinkles:
usage of 'y', else 'g' will say 'y' is absent, and will w/w so that
'y' is bound to an aBSENT_ERROR thunk.
An alternative would be to replace the 'case y of ...' with (say) 0#,
but I have not tried that. It's not a common situation, but it is
not theoretical: unsafePerformIO's implementation is very very like
'f' above.
However, the argument of toCleanDmd always satisfies the let/app
invariant; so if it is unlifted it is also okForSpeculation, and so
can be evaluated in a short finite time -- and that rules out nasty
cases like the one above. (I'm not quite sure why this was a
problem in an earlier version of GHC, but it isn't now.)
************************************************************************
......
......@@ -342,7 +342,7 @@ rhsDmdShell bndr
where
is_thunk = idArity bndr == 0
-- Let's pray idDemandInfo is still OK after unarise...
(ds, cd) = toCleanDmd (idDemandInfo bndr) (idType bndr)
(ds, cd) = toCleanDmd (idDemandInfo bndr)
tagSkeletonAlt :: CgStgAlt -> (Skeleton, IdSet, LlStgAlt)
tagSkeletonAlt (con, bndrs, rhs)
......
......@@ -26,7 +26,7 @@ import BasicTypes
import Data.List
import DataCon
import Id
import CoreUtils ( exprIsHNF, exprType, exprIsTrivial )
import CoreUtils ( exprIsHNF, exprType, exprIsTrivial, exprOkForSpeculation )
import TyCon
import Type
import Coercion ( Coercion, coVarsOfCo )
......@@ -140,11 +140,15 @@ dmdTransformThunkDmd e
-- See ↦* relation in the Cardinality Analysis paper
dmdAnalStar :: AnalEnv
-> Demand -- This one takes a *Demand*
-> CoreExpr -> (BothDmdArg, CoreExpr)
-> CoreExpr -- Should obey the let/app invariatn
-> (BothDmdArg, CoreExpr)
dmdAnalStar env dmd e
| (defer_and_use, cd) <- toCleanDmd dmd (exprType e)
, (dmd_ty, e') <- dmdAnal env cd e
= (postProcessDmdType defer_and_use dmd_ty, e')
| (dmd_shell, cd) <- toCleanDmd dmd
, (dmd_ty, e') <- dmdAnal env cd e
= ASSERT2( not (isUnliftedType (exprType e)) || exprOkForSpeculation e, ppr e )
-- The argument 'e' should satisfy the let/app invariant
-- See Note [Analysing with absent demand] in Demand.hs
(postProcessDmdType dmd_shell dmd_ty, e')
-- Main Demand Analsysis machinery
dmdAnal, dmdAnal' :: AnalEnv
......@@ -170,19 +174,6 @@ dmdAnal' env dmd (Cast e co)
where
(dmd_ty, e') = dmdAnal env dmd e
{- ----- I don't get this, so commenting out -------
to_co = pSnd (coercionKind co)
dmd'
| Just tc <- tyConAppTyCon_maybe to_co
, isRecursiveTyCon tc = cleanEvalDmd
| otherwise = dmd
-- This coerce usually arises from a recursive
-- newtype, and we don't want to look inside them
-- for exactly the same reason that we don't look
-- inside recursive products -- we might not reach
-- a fixpoint. So revert to a vanilla Eval demand
-}
dmdAnal' env dmd (Tick t e)
= (dmd_ty, Tick t e')
where
......@@ -259,6 +250,7 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)])
-- pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
-- , text "dmd" <+> ppr dmd
-- , text "case_bndr_dmd" <+> ppr (idDemandInfo case_bndr')
-- , text "id_dmds" <+> ppr id_dmds
-- , text "scrut_dmd" <+> ppr scrut_dmd
-- , text "scrut_ty" <+> ppr scrut_ty
-- , text "alt_ty" <+> ppr alt_ty2
......
This diff is collapsed.
......@@ -52,7 +52,7 @@ dr :: Double -> Double
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......@@ -69,7 +69,7 @@ dl [InlPrag=NOUSERINLINE[2]] :: Double -> Double
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......@@ -82,7 +82,7 @@ fr :: Float -> Float
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......@@ -101,7 +101,7 @@ fl [InlPrag=NOUSERINLINE[2]] :: Float -> Float
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......
......@@ -76,7 +76,7 @@ Rec {
-- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
T13143.$wg [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker]
:: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>, Unf=OtherCon []]
[GblId, Arity=3, Str=<S,1*U><S,1*U><L,U>, Unf=OtherCon []]
T13143.$wg
= \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) ->
case w of {
......@@ -97,7 +97,7 @@ end Rec }
g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int
[GblId,
Arity=3,
Str=<S,1*U><S,1*U><S(S),1*U(U)>m,
Str=<S,1*U><S,1*U><S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
......
==================== Strictness signatures ====================
Foo.$trModule: m
Foo.f: <S(S),1*U(1*U)><S(S),1*U(U)><S(S),1*U(U)>m
Foo.g: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m
Foo.f: <S(S),1*U(1*U)><S,1*U(U)><S,1*U(U)>m
Foo.g: <S(SS),1*U(1*U(U),1*U(U))>m
==================== Strictness signatures ====================
Foo.$trModule: m
Foo.f: <S(S),1*U(1*U)><S(S),1*U(U)><S(S),1*U(U)>m
Foo.g: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m
\ No newline at end of file
Foo.f: <S(S),1*U(1*U)><S,1*U(U)><S,1*U(U)>m
Foo.g: <S(SS),1*U(1*U(U),1*U(U))>m
......@@ -61,7 +61,7 @@ end Rec }
-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
T3772.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>, Unf=OtherCon []]
[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>, Unf=OtherCon []]
T3772.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.<# 0# ww of {
......@@ -74,7 +74,7 @@ foo [InlPrag=NOUSERINLINE[0]] :: Int -> ()
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>,
Str=<S,1*U(U)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......
......@@ -51,7 +51,7 @@ Rec {
-- RHS size: {terms: 17, types: 3, coercions: 0, joins: 0/0}
T4930.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>, Unf=OtherCon []]
[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>, Unf=OtherCon []]
T4930.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.<# ww 5# of {
......@@ -65,7 +65,7 @@ foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......
......@@ -62,7 +62,7 @@ Rec {
-- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0}
Roman.foo_$s$wgo [Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,U>, Unf=OtherCon []]
[GblId, Arity=2, Caf=NoCafRefs, Str=<L,A><L,U>, Unf=OtherCon []]
Roman.foo_$s$wgo
= \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
case GHC.Prim.<=# sc1 0# of {
......@@ -156,7 +156,7 @@ foo :: Int -> Int
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<S(S),1*U(U)>m,
Str=<S,1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
......
......@@ -5,3 +5,8 @@ include $(TOP)/mk/test.mk
T13031:
echo hello
'$(TEST_HC)' $(TEST_HC_OPTS) -c -fforce-recomp T13031.hs -ddump-simpl | grep 'Arity='
# Trying to make sure the workers for g1 and g2
# take only one Int# argument
T16029:
'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -fforce-recomp T16029.hs -dsuppress-uniques -ddump-simpl | grep '::.*Int'
module T16029 where
data S = MkS Int Int
g1 :: S -> Int -> Int
g1 (MkS x y) 0 = 0
g1 (MkS x y) n = g1 (MkS y x) (n-1)
data T = MkT !Int !Int
g2 :: T -> Int -> Int
g2 (MkT x y) 0 = 0
g2 (MkT x y) n = g2 (MkT y x) (n-1)
T16029.$WMkT [InlPrag=INLINE[2]] :: Int -> Int -> T
Tmpl= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
:: GHC.Prim.Int# -> GHC.Prim.Int#
= \ (ww :: GHC.Prim.Int#) ->
g2 [InlPrag=NOUSERINLINE[2]] :: T -> Int -> Int
Tmpl= \ (w [Occ=Once!] :: T) (w1 [Occ=Once!] :: Int) ->
= \ (w :: T) (w1 :: Int) ->
g1 [InlPrag=NOUSERINLINE[2]] :: S -> Int -> Int
Tmpl= \ (w [Occ=Once!] :: S) (w1 [Occ=Once!] :: Int) ->
= \ (w :: S) (w1 :: Int) ->
......@@ -47,3 +47,5 @@ test('T13077a', normal, compile, [''])
# The idea is to check that both $wmutVar and $warray
# don't mention MutVar# and Array# anymore.
test('T15627', [ grep_errmsg(r'(wmutVar|warray).*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl'])
test('T16029', normal, run_command, ['$MAKE -s --no-print-directory T16029'])
==================== Strictness signatures ====================
HyperStrUse.$trModule: m
HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m
HyperStrUse.f: <S(SL),1*U(1*U(U),A)><S,1*U>m
==================== Strictness signatures ====================
HyperStrUse.$trModule: m
HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m
HyperStrUse.f: <S(SL),1*U(1*U(U),A)><S,1*U>m
==================== Strictness signatures ====================
T12370.$trModule: m
T12370.bar: <S(S),1*U(U)><S(S),1*U(U)>m
T12370.foo: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m
T12370.bar: <S,1*U(U)><S,1*U(U)>m
T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>m
==================== Strictness signatures ====================
T12370.$trModule: m
T12370.bar: <S(S),1*U(U)><S(S),1*U(U)>m
T12370.foo: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m
T12370.bar: <S,1*U(U)><S,1*U(U)>m
T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>m
==================== Strictness signatures ====================
T8598.$trModule: m
T8598.fun: <S(S),1*U(U)>m
T8598.fun: <S,1*U(U)>m
==================== Strictness signatures ====================
T8598.$trModule: m
T8598.fun: <S(S),1*U(U)>m
T8598.fun: <S,1*U(U)>m
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