[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