[commit: ghc] wip/nested-cpr: Remove dmdAnalArg and replace by easier to understand code (07b097a)
git at git.haskell.org
git at git.haskell.org
Thu Dec 12 17:57:00 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nested-cpr
Link : http://ghc.haskell.org/trac/ghc/changeset/07b097a903f5a2cc30d54f17bb9d69010984cc73/ghc
>---------------------------------------------------------------
commit 07b097a903f5a2cc30d54f17bb9d69010984cc73
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
>---------------------------------------------------------------
07b097a903f5a2cc30d54f17bb9d69010984cc73
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 3b805d9..a377bf5 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -103,13 +103,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
@@ -177,7 +176,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
@@ -510,6 +509,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