[commit: ghc] wip/nested-cpr: Revert "Only use bothDmdEnv, not bothDmdType, in dmdAnalVarApp for constructors" (d037873)

[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/d0378738c069261d8bffdc48a6ad7ef25386b671/ghc

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

commit d0378738c069261d8bffdc48a6ad7ef25386b671
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Dec 4 16:47:47 2013 +0000

    Revert "Only use bothDmdEnv, not bothDmdType, in dmdAnalVarApp for constructors"
    
    This reverts commit 2b1ebabdfbc07d0bdba60e04bbd6cdcf210f7953.


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

d0378738c069261d8bffdc48a6ad7ef25386b671
 compiler/basicTypes/Demand.lhs |    5 +----
 compiler/stranal/DmdAnal.lhs   |   17 ++++++++---------
 2 files changed, 9 insertions(+), 13 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 95f6a8b..27ed312 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -22,7 +22,7 @@ module Demand (
         topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
         dmdTypeArgTop, addDemand,
 
-        DmdEnv, emptyDmdEnv, getDmdEnv,
+        DmdEnv, emptyDmdEnv,
         peelFV,
 
         DmdResult(..), CPRResult(..),
@@ -1111,9 +1111,6 @@ instance Outputable DmdType where
 emptyDmdEnv :: VarEnv Demand
 emptyDmdEnv = emptyVarEnv
 
-getDmdEnv :: DmdType -> DmdEnv
-getDmdEnv (DmdType e _ _) = e       -- Only for data-typed arguments!
-
 topDmdType, botDmdType :: DmdType
 topDmdType = DmdType emptyDmdEnv [] topRes
 botDmdType = DmdType emptyDmdEnv [] botRes
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index b7ce27c..fb45b46 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -522,8 +522,7 @@ dmdAnalVarApp env dmd fun args
   , isVanillaDataCon con
   , n_val_args == dataConRepArity con      -- Saturated
   , let cpr_info = Converges (cprConRes (dataConTag con) arg_rets)
-        fv_env = foldl bothDmdEnv emptyDmdEnv arg_envs
-        res_ty = DmdType fv_env [] cpr_info
+        res_ty = foldl bothDmdType (DmdType emptyDmdEnv [] cpr_info) arg_tys
   = -- pprTrace "dmdAnalVarApp" (vcat [ ppr con, ppr args, ppr n_val_args, ppr cxt_ds
     --                                , ppr arg_tys, ppr cpr_info, ppr res_ty]) $
     ( res_ty 
@@ -540,21 +539,21 @@ dmdAnalVarApp env dmd fun args
   where
     n_val_args = valArgCount args
     cxt_ds = splitProdCleanDmd  n_val_args dmd
-    (arg_envs, arg_rets, args') = anal_args cxt_ds args
+    (arg_tys, arg_rets, args') = anal_args cxt_ds args
         -- The constructor itself is lazy
         -- See Note [Data-con worker strictness] in MkId
   
-    anal_args :: [Demand] -> [CoreExpr] -> ([DmdEnv], [DmdResult], [CoreExpr])
+    anal_args :: [Demand] -> [CoreExpr] -> ([DmdType], [DmdResult], [CoreExpr])
     anal_args _ [] = ([],[],[])
     anal_args ds (arg : args)
       | isTypeArg arg 
-      , (arg_envs, arg_rets, args') <- anal_args ds args
-      = (arg_envs, arg_rets, arg:args')
+      , (arg_tys, arg_rets, args') <- anal_args ds args
+      = (arg_tys, arg_rets, arg:args')
     anal_args (d:ds) (arg : args)
       | (arg_ty, arg_ret, arg')  <- dmdAnalArg env d arg
-      , (arg_envs, arg_rets, args') <- anal_args ds args
-      = --pprTrace "dmdAnalVarApp arg" (vcat [ ppr d, ppr arg, ppr arg_env, ppr arg' ])
-        (getDmdEnv arg_ty:arg_envs, arg_ret:arg_rets, arg':args')
+      , (arg_tys, arg_rets, args') <- anal_args ds args
+      = --pprTrace "dmdAnalVarApp arg" (vcat [ ppr d, ppr arg, ppr arg_ty, ppr arg' ])
+        (arg_ty:arg_tys, arg_ret:arg_rets, arg':args')
     anal_args ds args = pprPanic "anal_args" (ppr args $$ ppr ds)
 \end{code}