Commit 8d34ae39 authored by Joachim Breitner's avatar Joachim Breitner

Some polishing of the demand analyser.

I did some refactoring of the demand analyser, because I was smelling
some minor code smell. Most of my changes I had to undo, though,
adding notes and testcases on why the existing code was correct after
all.

Especially the semantics of the DmdResult is confusing, as it differs in
a DmdType and a StrictSig.

I got to imrpove the readability of the code for lubDmdType, though.

Also, dmdAnalRhs was a bit fishy in how it removed the demand on
further arguments of the body, but used the DmdResult. This would be
wrong if a body would return a demand type of "<L>m" (which currently
does not happen).  This is now treated better in removeDmdTyArgs.
parent 26acb498
...@@ -20,7 +20,7 @@ module Demand ( ...@@ -20,7 +20,7 @@ module Demand (
DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType, DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
nopDmdType, botDmdType, mkDmdType, nopDmdType, botDmdType, mkDmdType,
addDemand, addDemand, removeDmdTyArgs,
BothDmdArg, mkBothDmdArg, toBothDmdArg, BothDmdArg, mkBothDmdArg, toBothDmdArg,
DmdEnv, emptyDmdEnv, DmdEnv, emptyDmdEnv,
...@@ -931,35 +931,48 @@ data DmdType = DmdType ...@@ -931,35 +931,48 @@ data DmdType = DmdType
DmdEnv -- Demand on explicitly-mentioned DmdEnv -- Demand on explicitly-mentioned
-- free variables -- free variables
[Demand] -- Demand on arguments [Demand] -- Demand on arguments
DmdResult -- Nature of result DmdResult -- See [Nature of result demand]
\end{code} \end{code}
Note [Nature of result demand] Note [Nature of result demand]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We assume the result in a demand type to be either a top or bottom A DmdResult contains information about termination (currently distinguishing
in order to represent the information about demand on the function definite divergence and no information; it is possible to include definite
result, imposed by its definition. There are not so many things we convergence here), and CPR information about the result.
can say, though.
The semantics of this depends on whether we are looking at a DmdType, i.e. the
For instance, one can consider a function demand put on by an expression _under a specific incoming demand_ on its
environment, or at a StrictSig describing a demand transformer.
h = \v -> error "urk"
For a
Taking the definition of strictness, we can easily see that * DmdType, the termination information is true given the demand it was
generated with, while for
h undefined = undefined * a StrictSig it is olds after applying enough arguments.
that is, h is strict in v. However, v is not used somehow in the body The CPR information, though, is valid after the number of arguments mentioned
of h How can we know that h is strict in v? In fact, we know it by in the type is given. Therefore, when forgetting the demand on arguments, as in
considering a result demand of error and bottom and unleashing it on dmdAnalRhs, this needs to be considere (via removeDmdTyArgs).
all the variables in scope at a call site (in this case, this is only
v). We can also consider a case Consider
b2 x y = x `seq` y `seq` error (show x)
h = \v -> f x this has a strictness signature of
<S><S>b
where we know that the result of f is not hyper-strict (i.e, it is meaning that "b2 `seq` ()" and "b2 1 `seq` ()" might well terminate, but
lazy, or top). So, we put the same demand on v, which allow us to for "b2 1 2 `seq` ()" we get definite divergence.
infer a lazy demand that h puts on v.
For comparision,
b1 x = x `seq` error (show x)
has a strictness signature of
<S>b
and "b1 1 `seq` ()" is known to terminate.
Now consider a function h with signature "<C(S)>", and the expression
e1 = h b1
now h puts a demand of <C(S)> onto its argument, and the demand transformer
turns it into
<S>b
Now the DmdResult "b" does apply to us, even though "b1 `seq` ()" does not
diverge, and we do not anything being passed to b.
Note [Asymmetry of 'both' for DmdType and DmdResult] Note [Asymmetry of 'both' for DmdType and DmdResult]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...@@ -988,17 +1001,28 @@ instance Eq DmdType where ...@@ -988,17 +1001,28 @@ instance Eq DmdType where
&& ds1 == ds2 && res1 == res2 && ds1 == ds2 && res1 == res2
lubDmdType :: DmdType -> DmdType -> DmdType lubDmdType :: DmdType -> DmdType -> DmdType
lubDmdType (DmdType fv1 ds1 r1) (DmdType fv2 ds2 r2) lubDmdType d1 d2
= DmdType lub_fv (lub_ds ds1 ds2) (r1 `lubDmdResult` r2) = DmdType lub_fv lub_ds lub_res
where where
n = max (dmdTypeDepth d1) (dmdTypeDepth d2)
(DmdType fv1 ds1 r1) = ensureArgs n d1
(DmdType fv2 ds2 r2) = ensureArgs n d2
lub_fv = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2) lub_fv = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2)
lub_ds = zipWithEqual "lubDmdType" lubDmd ds1 ds2
lub_res = lubDmdResult r1 r2
\end{code}
Note [The need for BothDmdArg]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Previously, the right argument to bothDmdType, as well as the return value of
dmdAnalStar via postProcessDmdTypeM, was a DmdType. But bothDmdType only needs
to know about the free variables and termination information, but nothing about
the demand put on arguments, nor cpr information. So we make that explicit by
only passing the relevant information.
-- Extend the shorter argument list to match the longer, using resTypeArgDmd
lub_ds (d1:ds1) (d2:ds2) = lubDmd d1 d2 : lub_ds ds1 ds2
lub_ds (d1:ds1) [] = (d1 `lubDmd` resTypeArgDmd r2) : lub_ds ds1 []
lub_ds [] (d2:ds2) = (resTypeArgDmd r1 `lubDmd` d2) : lub_ds [] ds2
lub_ds [] [] = []
\begin{code}
type BothDmdArg = (DmdEnv, Termination ()) type BothDmdArg = (DmdEnv, Termination ())
mkBothDmdArg :: DmdEnv -> BothDmdArg mkBothDmdArg :: DmdEnv -> BothDmdArg
...@@ -1054,6 +1078,25 @@ mkDmdType fv ds res = DmdType fv ds res ...@@ -1054,6 +1078,25 @@ mkDmdType fv ds res = DmdType fv ds res
dmdTypeDepth :: DmdType -> Arity dmdTypeDepth :: DmdType -> Arity
dmdTypeDepth (DmdType _ ds _) = length ds dmdTypeDepth (DmdType _ ds _) = length ds
-- Remove any demand on arguments. This is used in dmdAnalRhs on the body
removeDmdTyArgs :: DmdType -> DmdType
removeDmdTyArgs = ensureArgs 0
-- This makes sure we can use the demand type with n arguments,
-- It extends the argument list with the correct resTypeArgDmd
-- It also adjusts the DmdResult: Divergence survives additional arguments,
-- CPR information does not (and definite converge also would not).
ensureArgs :: Arity -> DmdType -> DmdType
ensureArgs n d | n == depth = d
| otherwise = DmdType fv ds' r'
where depth = dmdTypeDepth d
DmdType fv ds r = d
ds' = take n (ds ++ repeat (resTypeArgDmd r))
r' | Diverges <- r = r
| otherwise = topRes
-- See [Nature of result demand]
seqDmdType :: DmdType -> () seqDmdType :: DmdType -> ()
seqDmdType (DmdType _env ds res) = seqDmdType (DmdType _env ds res) =
{- ??? env `seq` -} seqDemandList ds `seq` seqDmdResult res `seq` () {- ??? env `seq` -} seqDemandList ds `seq` seqDmdResult res `seq` ()
...@@ -1112,6 +1155,7 @@ toCleanDmd (JD { strd = s, absd = u }) ...@@ -1112,6 +1155,7 @@ toCleanDmd (JD { strd = s, absd = u })
-- This is used in dmdAnalStar when post-processing -- This is used in dmdAnalStar when post-processing
-- a function's argument demand. So we only care about what -- a function's argument demand. So we only care about what
-- does to free variables, and whether it terminates. -- does to free variables, and whether it terminates.
-- see Note [The need for BothDmdArg]
postProcessDmdTypeM :: DeferAndUseM -> DmdType -> BothDmdArg postProcessDmdTypeM :: DeferAndUseM -> DmdType -> BothDmdArg
postProcessDmdTypeM Nothing _ = (emptyDmdEnv, Dunno ()) postProcessDmdTypeM Nothing _ = (emptyDmdEnv, Dunno ())
-- Incoming demand was Absent, so just discard all usage information -- Incoming demand was Absent, so just discard all usage information
...@@ -1200,16 +1244,20 @@ then d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for ...@@ -1200,16 +1244,20 @@ then d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for
the free variable environment) and furthermore the result information r is the the free variable environment) and furthermore the result information r is the
one we want to use. one we want to use.
An anonymous lambda is also an unsaturated function all (needs one argument,
none given), so this applies to that case as well.
But the demand fed into f might be less than <C(C(S)), C1(C1(S))>. There are a few cases: But the demand fed into f might be less than <C(C(S)), C1(C1(S))>. There are a few cases:
* Not enough demand on the strictness side: * Not enough demand on the strictness side:
- In that case, we need to zap all strictness in the demand on arguments and - In that case, we need to zap all strictness in the demand on arguments and
free variables. free variables.
- Furthermore, we need to remove CPR information (after all, "f x1" surely - Furthermore, we remove CPR information. It could be left, but given the incoming
does not return a constructor). demand is not enough to evaluate so far we just do not bother.
- And finally, if r said that f would (possible or definitely) diverge when - And finally termination information: If r says that f diverges for sure,
called with two arguments, then "f x1" may diverge. So we use topRes here. then this holds when the demand guarantees that two arguments are going to
(We could return "Converges NoCPR" if f would converge for sure, but that be passed. If the demand is lower, we may just as well converge.
information would currently not be useful in any way.) If we were tracking definite convegence, than that would still hold under
a weaker demand than expected by the demand transformer.
* Not enough demand from the usage side: The missing usage can be expanded * Not enough demand from the usage side: The missing usage can be expanded
using UCall Many, therefore this is subsumed by the third case: using UCall Many, therefore this is subsumed by the third case:
* At least one of the uses has a cardinality of Many. * At least one of the uses has a cardinality of Many.
...@@ -1230,7 +1278,7 @@ peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv) ...@@ -1230,7 +1278,7 @@ peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
(DmdType fv' ds res, dmd) (DmdType fv' ds res, dmd)
where where
fv' = fv `delVarEnv` id fv' = fv `delVarEnv` id
-- See note [Default demand on free variables] -- See Note [Default demand on free variables]
dmd = lookupVarEnv fv id `orElse` defaultDmd res dmd = lookupVarEnv fv id `orElse` defaultDmd res
addDemand :: Demand -> DmdType -> DmdType addDemand :: Demand -> DmdType -> DmdType
...@@ -1314,6 +1362,8 @@ transfomer, namely ...@@ -1314,6 +1362,8 @@ transfomer, namely
This DmdType gives the demands unleashed by the Id when it is applied This DmdType gives the demands unleashed by the Id when it is applied
to as many arguments as are given in by the arg demands in the DmdType. to as many arguments as are given in by the arg demands in the DmdType.
Also see Note [Nature of result demand] for the meaning of a DmdResult in a
strictness signature.
If an Id is applied to less arguments than its arity, it means that If an Id is applied to less arguments than its arity, it means that
the demand on the function at a call site is weaker than the vanilla the demand on the function at a call site is weaker than the vanilla
...@@ -1321,11 +1371,11 @@ call demand, used for signature inference. Therefore we place a top ...@@ -1321,11 +1371,11 @@ call demand, used for signature inference. Therefore we place a top
demand on all arguments. Otherwise, the demand is specified by Id's demand on all arguments. Otherwise, the demand is specified by Id's
signature. signature.
For example, the demand transformer described by the DmdType For example, the demand transformer described by the demand signature
DmdType {x -> <S(LL),U(UU)>} [V,A] Top StrictSig (DmdType {x -> <S,1*U>} <L,A><L,U(U,U)>m)
says that when the function is applied to two arguments, it says that when the function is applied to two arguments, it
unleashes demand <S(LL),U(UU)> on the free var x, V on the first arg, unleashes demand <S,1*U> on the free var x, <L,A> on the first arg,
and A on the second. and <L,U(U,U)> on the second, then returning a constructor.
If this same function is applied to one arg, all we can say is that it If this same function is applied to one arg, all we can say is that it
uses x with <L,U>, and its arg with demand <L,U>. uses x with <L,U>, and its arg with demand <L,U>.
......
...@@ -602,13 +602,14 @@ dmdAnalRhs top_lvl rec_flag env id rhs ...@@ -602,13 +602,14 @@ dmdAnalRhs top_lvl rec_flag env id rhs
| otherwise | otherwise
= (sig_ty, lazy_fv, id', mkLams bndrs' body') = (sig_ty, lazy_fv, id', mkLams bndrs' body')
where where
(bndrs, body) = collectBinders rhs (bndrs, body) = collectBinders rhs
env_body = foldl extendSigsWithLam env bndrs env_body = foldl extendSigsWithLam env bndrs
(DmdType body_fv _ body_res, body') = dmdAnal env_body body_dmd body (body_ty, body') = dmdAnal env_body body_dmd body
(DmdType rhs_fv rhs_dmds rhs_res, bndrs') = annotateLamBndrs env (isDFunId id) body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info
(DmdType body_fv [] body_res) bndrs (DmdType rhs_fv rhs_dmds rhs_res, bndrs')
sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res') = annotateLamBndrs env (isDFunId id) body_ty' bndrs
id' = set_idStrictness env id sig_ty sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res')
id' = set_idStrictness env id sig_ty
-- See Note [NOINLINE and strictness] -- See Note [NOINLINE and strictness]
-- See Note [Product demands for function body] -- See Note [Product demands for function body]
......
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