[commit: ghc] wip/cpr-vs-jp: Add isJoinPointOf function (360bd08)

[git at git.haskell.org]

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

On branch  : wip/cpr-vs-jp
Link       : http://ghc.haskell.org/trac/ghc/changeset/360bd08000ae852f802caa4440cb6088377568f2/ghc

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

commit 360bd08000ae852f802caa4440cb6088377568f2
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Jan 7 09:47:54 2014 +0000

    Add isJoinPointOf function
    
    hackish and non-efficient version; Can be improved, or even turned into
    a phase of its own which annotates the binder (isJoinPoint :: Id ->
    Bool), and does one traversal to detect all join points.


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

360bd08000ae852f802caa4440cb6088377568f2
 compiler/stranal/DmdAnal.lhs |   27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index a942c4e..11a60c7 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -18,8 +18,10 @@ import DynFlags
 import WwLib            ( deepSplitProductType_maybe )
 import Demand	-- All of it
 import CoreSyn
+import CoreFVs
 import Outputable
 import VarEnv
+import VarSet
 import BasicTypes	
 import FastString
 import Data.List
@@ -1155,3 +1157,28 @@ of the Id, and start from "bottom".  Nowadays the Id can have a current
 strictness, because interface files record strictness for nested bindings.
 To know when we are in the first iteration, we look at the ae_virgin
 field of the AnalEnv.
+
+\begin{code}
+
+-- Quick and dirty join-point-detection
+
+isJoinPointOf :: Var -> CoreExpr -> Bool
+isJoinPointOf v (Var x) | v == x = True
+isJoinPointOf _ (Var _) = False
+isJoinPointOf _ (Lit _) = False
+isJoinPointOf _ (Type _) = False
+isJoinPointOf _ (Coercion _) = False
+isJoinPointOf _ (Lam _ _) = False
+isJoinPointOf v (Let bndr body) = v `notInBinder` bndr && isJoinPointOf v body
+isJoinPointOf v (App f e) = v `notInExpr` e && isJoinPointOf v f
+isJoinPointOf v (Tick _ e) = isJoinPointOf v e
+isJoinPointOf v (Cast e _) = isJoinPointOf v e
+isJoinPointOf v (Case e _ _ alts) = v `notInExpr` e &&
+    all (\(_,_,e) -> isJoinPointOf v e || v `notInExpr` e) alts
+
+notInExpr :: Var -> CoreExpr -> Bool
+notInExpr v e = not $ v `elemVarSet` exprFreeVars e
+notInBinder :: Var -> CoreBind -> Bool
+notInBinder v e = not $ v `elemVarSet` bindFreeVars e
+
+\end{code}