[commit: ghc] wip/nested-cpr: Comments and small refactor (73c42ac)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/73c42ac48cc1703d497f8f5704a59066978c9fe0/ghc

>---------------------------------------------------------------

commit 73c42ac48cc1703d497f8f5704a59066978c9fe0
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Dec 4 16:00:24 2013 +0000

    Comments and small refactor


>---------------------------------------------------------------

73c42ac48cc1703d497f8f5704a59066978c9fe0
 compiler/basicTypes/Demand.lhs |    2 +-
 compiler/stranal/DmdAnal.lhs   |    9 ++++++---
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index a65430b..2548c22 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -559,7 +559,7 @@ splitFVs is_thunk rhs_fvs
 %*                                                                      *
 %************************************************************************
 
-This domain differst from JointDemand in the sense that pure absence
+This domain differs from JointDemand in the sense that pure absence
 is taken away, i.e., we deal *only* with non-absent demands.
 
 Note [Strict demands]
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 897b5b4..f94d53d 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -530,9 +530,6 @@ dmdAnalVarApp env dmd fun args
     --                                , ppr arg_tys, ppr cpr_info, ppr res_ty]) $
     ( res_ty
     , foldl App (Var fun) args')
-
-  | otherwise
-  = completeApp env (dmdTransform env fun (mkCallDmdN n_val_args dmd), Var fun) args
   where
     n_val_args = valArgCount args
     cxt_ds = splitProdCleanDmd  n_val_args dmd
@@ -552,6 +549,12 @@ dmdAnalVarApp env dmd fun args
       , (arg_tys, arg_rets, args') <- anal_con_args ds args
       = (arg_ty:arg_tys, arg_ret:arg_rets, arg':args')
     anal_con_args ds args = pprPanic "anal_con_args" (ppr args $$ ppr ds)
+
+dmdAnalVarApp env dmd fun args
+  = --pprTrace "dmdAnalVarApp" (vcat [ ppr fun, ppr args
+    --                               , ppr $ completeApp env (dmdTransform env fun (mkCallDmdN n_val_args dmd), Var fun) args
+    --                               ])
+    completeApp env (dmdTransform env fun (mkCallDmdN (valArgCount args) dmd), Var fun) args
 \end{code}
 
 %************************************************************************