[commit: ghc] wip/nested-cpr: Disentangle postProcessDmdTypeM and postProcessUnsat (764044f)
git at git.haskell.org
git at git.haskell.org
Sat Dec 14 22:31:34 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nested-cpr
Link : http://ghc.haskell.org/trac/ghc/changeset/764044f3f1ce79c67bf940ddaf6a1bbc4d6f69fd/ghc
>---------------------------------------------------------------
commit 764044f3f1ce79c67bf940ddaf6a1bbc4d6f69fd
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Mon Dec 9 18:40:09 2013 +0000
Disentangle postProcessDmdTypeM and postProcessUnsat
Make different postProcess code paths for function arguments (which are
post-processed just to be both'ed) and unsaturated functions (which are
post-processed for other reasons.)
>---------------------------------------------------------------
764044f3f1ce79c67bf940ddaf6a1bbc4d6f69fd
compiler/basicTypes/Demand.lhs | 14 +++++++++++++-
1 file changed, 13 insertions(+), 1 deletion(-)
diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 54cc6d7..76e96b1 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -1131,7 +1131,19 @@ postProcessDmdTypeM Nothing _ = nopDmdType
-- Incoming demand was Absent, so just discard all usage information
-- We only processed the thing at all to analyse the body
-- See Note [Always analyse in virgin pass]
-postProcessDmdTypeM (Just du) ty = postProcessUnsat du ty
+postProcessDmdTypeM (Just du) (DmdType fv _ res_ty)
+ = DmdType (postProcessDmdEnv du fv) [] (postProcessDmdResult du res_ty)
+
+postProcessDmdResult :: DeferAndUse -> DmdResult -> DmdResult
+postProcessDmdResult (True,_) _ = topRes
+postProcessDmdResult (False,_) r = r
+
+postProcessDmdEnv :: DeferAndUse -> DmdEnv -> DmdEnv
+postProcessDmdEnv (True, Many) env = deferReuseEnv env
+postProcessDmdEnv (False, Many) env = reuseEnv env
+postProcessDmdEnv (True, One) env = deferEnv env
+postProcessDmdEnv (False, One) env = env
+
postProcessUnsat :: DeferAndUse -> DmdType -> DmdType
postProcessUnsat (True, Many) ty = deferReuse ty
More information about the ghc-commits
mailing list