[commit: ghc] wip/nested-cpr: Remove dmdAnalArg and replace by easier to understand code (b2e931a)
git at git.haskell.org
git at git.haskell.org
Thu Dec 5 18:59:55 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nested-cpr
Link : http://ghc.haskell.org/trac/ghc/changeset/b2e931ae896b2e12222b33962cb7962683f3c739/ghc
>---------------------------------------------------------------
commit b2e931ae896b2e12222b33962cb7962683f3c739
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Dec 4 17:38:25 2013 +0000
Remove dmdAnalArg and replace by easier to understand code
>---------------------------------------------------------------
b2e931ae896b2e12222b33962cb7962683f3c739
compiler/stranal/DmdAnal.lhs | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index ffe66ad..2553226 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -98,13 +98,12 @@ c) The application rule wouldn't be right either
evaluation of f in a C(L) demand!
\begin{code}
-dmdAnalArg :: AnalEnv
- -> Demand -- This one takes a *Demand*
- -> CoreExpr -> (DmdType, CoreExpr)
--- Used for function arguments
-dmdAnalArg env dmd e
- | exprIsTrivial e = dmdAnalStar env dmd e
- | otherwise = dmdAnalStar env (oneifyDmd dmd) e
+-- If e is complicated enough to become a thunk, its contents will be evaluated
+-- at most once, so oneify it.
+dmdTransformThunkDmd :: CoreExpr -> Demand -> Demand
+dmdTransformThunkDmd e
+ | exprIsTrivial e = id
+ | otherwise = oneifyDmd
-- Do not process absent demands
-- Otherwise act like in a normal demand analysis
@@ -172,7 +171,7 @@ dmdAnal env dmd (App fun arg) -- Non-type arguments
call_dmd = mkCallDmd dmd
(fun_ty, fun') = dmdAnal env call_dmd fun
(arg_dmd, res_ty) = splitDmdTy fun_ty
- (arg_ty, arg') = dmdAnalArg env arg_dmd arg
+ (arg_ty, arg') = dmdAnalStar env (dmdTransformThunkDmd arg arg_dmd) arg
in
-- pprTrace "dmdAnal:app" (vcat
-- [ text "dmd =" <+> ppr dmd
@@ -503,6 +502,7 @@ dmdTransform env var dmd
| otherwise -- Local non-letrec-bound thing
= unitVarDmd var (mkOnceUsedDmd dmd)
+
\end{code}
%************************************************************************
More information about the ghc-commits
mailing list