[commit: ghc] wip/nested-cpr: Separate deferType for undersaturated function calls (92ecb5d)

[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/92ecb5d951488c56f92c3ac91354e12449f4d6d5/ghc

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

commit 92ecb5d951488c56f92c3ac91354e12449f4d6d5
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Nov 29 12:18:19 2013 +0000

    Separate deferType for undersaturated function calls


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

92ecb5d951488c56f92c3ac91354e12449f4d6d5
 compiler/basicTypes/Demand.lhs |    7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 9cddcb5..c016d68 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -1171,10 +1171,15 @@ deferAndUse False Many ty = useType ty
 deferAndUse True  One  ty = deferType ty
 deferAndUse False One  ty = ty
 
+-- Used for thunks
 deferType :: DmdType -> DmdType
 -- Ie it might be used, or not 
 deferType (DmdType fv _ r) = DmdType (deferEnv fv) [] (deferResult r)
 
+-- Used for undersaturated functions
+deferTypeAndForgetCPR :: DmdType -> DmdType
+deferTypeAndForgetCPR (DmdType fv _ _) = DmdType (deferEnv fv) [] topRes
+
 deferEnv :: DmdEnv -> DmdEnv
 deferEnv fv = mapVarEnv deferDmd fv
 
@@ -1375,7 +1380,7 @@ dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _))
   = dmd_ty2
   where
     dmd_ty1 | str_sat   = dmd_ty
-            | otherwise = deferType dmd_ty
+            | otherwise = deferTypeAndForgetCPR dmd_ty
     dmd_ty2 | abs_sat   = dmd_ty1
             | otherwise = useType dmd_ty1