[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