[commit: ghc] wip/nested-cpr: Put bothDmdResult back into bothDmdType (7a9b9be)

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

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

commit 7a9b9be12d3606128e47026e1aa1b7bce3b9d085
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Dec 4 16:11:28 2013 +0000

    Put bothDmdResult back into bothDmdType


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

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

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index dbae6bd..b4597b2 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -18,7 +18,7 @@ module Demand (
         isTopDmd, isBotDmd, isAbsDmd, isSeqDmd, 
         peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,
 
-        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdEnv, bothDmdType, bothDmdTypeCase,
+        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdEnv, bothDmdType,
         topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
         dmdTypeArgTop, addDemand,
 
@@ -1087,17 +1087,13 @@ bothDmdType (DmdType fv1 ds1 r1) (DmdType fv2 _ r2)
     -- using its second arg just for its free-var info.
     -- NB: Don't forget about r2!  It might be BotRes, which is
     -- a bottom demand on all the in-scope variables.
-  = DmdType both_fv2 ds1 r1
+  = DmdType both_fv2 ds1 (r1 `bothDmdResult` r2)
+
   where
     both_fv  = plusVarEnv_C bothDmd fv1 fv2
     both_fv1 = modifyEnv (isBotRes r1) (`bothDmd` botDmd) fv2 fv1 both_fv
     both_fv2 = modifyEnv (isBotRes r2) (`bothDmd` botDmd) fv1 fv2 both_fv1
 
-bothDmdTypeCase :: DmdType -> DmdType -> DmdType
-bothDmdTypeCase d1@(DmdType _ _ r1) d2@(DmdType _ _ r2)
-  = DmdType fv' ds' (r1 `bothDmdResult` r2)
-  where (DmdType fv' ds' _) = bothDmdType d1 d2
-
 bothDmdEnv :: DmdEnv -> DmdEnv -> DmdEnv
 bothDmdEnv = plusVarEnv_C bothDmd
 
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 2e33ca8..edb8fba 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -224,7 +224,7 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
         scrut_dmd  = scrut_dmd1 `bothCleanDmd` scrut_dmd2
 
 	(scrut_ty, scrut') = dmdAnal env scrut_dmd scrut
-        res_ty             = alt_ty1 `bothDmdTypeCase` scrut_ty
+        res_ty             = alt_ty1 `bothDmdType` scrut_ty
     in
 --    pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
 --                                   , text "dmd" <+> ppr dmd
@@ -240,7 +240,7 @@ dmdAnal env dmd (Case scrut case_bndr ty alts)
 	(alt_tys, alts')     = mapAndUnzip (dmdAnalAlt env dmd) alts
 	(scrut_ty, scrut')   = dmdAnal env cleanEvalDmd scrut
 	(alt_ty, case_bndr') = annotateBndr env (foldr lubDmdType botDmdType alt_tys) case_bndr
-        res_ty               = alt_ty `bothDmdTypeCase` scrut_ty
+        res_ty               = alt_ty `bothDmdType` scrut_ty
     in
 --    pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut
 --                                   , text "scrut_ty" <+> ppr scrut_ty