[commit: ghc] wip/nested-cpr: No need to limit the depth of DmdResult any more (b4ccb37)

git at git.haskell.org git at git.haskell.org
Thu Nov 28 15:52:36 UTC 2013


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

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

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

commit b4ccb37795f3f1e818fef7b691caca1116f676d6
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Nov 28 09:55:56 2013 +0000

    No need to limit the depth of DmdResult any more
    
    if we analyize recursive functions with a signature of ⊤.


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

b4ccb37795f3f1e818fef7b691caca1116f676d6
 compiler/basicTypes/Demand.lhs |   22 ++--------------------
 1 file changed, 2 insertions(+), 20 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 92bbf2b..7680d00 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -810,28 +810,10 @@ topRes, botRes :: DmdResult
 topRes = Dunno NoCPR
 botRes = Diverges
 
-maxCPRDepth :: Int
-maxCPRDepth = 3
-
--- With nested CPR, DmdResult can be arbitrarily deep; consider e.g. the
--- DmdResult of repeat
--- 
--- So we need to forget information at a certain depth. We do that at all points
--- where we are building RetCon constructors.
-cutDmdResult :: Int -> DmdResult -> DmdResult
-cutDmdResult 0 _ = topRes
-cutDmdResult _ Diverges = Diverges
-cutDmdResult n (Converges c) = Converges (cutCPRResult n c)
-cutDmdResult n (Dunno c) = Dunno (cutCPRResult n c)
-
-cutCPRResult :: Int -> CPRResult -> CPRResult
-cutCPRResult _ NoCPR = NoCPR
-cutCPRResult n (RetCon tag rs) = RetCon tag (map (cutDmdResult (n-1)) rs)
-
 cprConRes :: ConTag -> [DmdType] -> CPRResult
 cprConRes tag arg_tys
   | opt_CprOff = NoCPR
-  | otherwise  = cutCPRResult maxCPRDepth $ RetCon tag (map get_res arg_tys)
+  | otherwise  = RetCon tag (map get_res arg_tys)
   where
     get_res :: DmdType -> DmdResult
     get_res (DmdType _ [] r) = r       -- Only for data-typed arguments!
@@ -840,7 +822,7 @@ cprConRes tag arg_tys
 vanillaCprConRes :: ConTag -> Arity -> CPRResult
 vanillaCprConRes tag arity
   | opt_CprOff = NoCPR
-  | otherwise  = cutCPRResult maxCPRDepth $ RetCon tag (replicate arity topRes)
+  | otherwise  = RetCon tag (replicate arity topRes)
 
 isTopRes :: DmdResult -> Bool
 isTopRes (Dunno NoCPR) = True



More information about the ghc-commits mailing list