[cycles detection in CallDep added and threshold of max 5 cycles added
martin.hofmann@uni-bamberg.de**20090925063957] hunk ./src/Data/CallDependencies.hs 6
-        admissible, allowedMaxCall
+        admissible, allowedMaxCall, cycles
hunk ./src/Data/CallDependencies.hs 10
-import Data.Maybe (maybeToList)
+import Data.Maybe (maybeToList, fromJust)
hunk ./src/Data/CallDependencies.hs 18
-import Data.Graph.Inductive (
-    Graph, Gr, Node, LNode, LPath(..), 
-    lbft, noNodes, run_, insMapNodeM, 
-    insMapEdgeM, delMapEdgeM, grev, equal
-    )
+import Data.List(unfoldr)
+
+import Data.Graph.Inductive hiding (nodes)
+--(
+--    Graph, Gr, Node, LNode, LPath(..), LEdge, DynGraph,
+--    lbft, noNodes, run_, insMapNodeM, 
+--    insMapEdgeM, delMapEdgeM, grev, equal, labEdges, 
+--    )
hunk ./src/Data/CallDependencies.hs 28
+import Control.Arrow
+--import Data.Graph
hunk ./src/Data/CallDependencies.hs 31
-import Language.Haskell.TH
+import Language.Haskell.TH hiding (match)
hunk ./src/Data/CallDependencies.hs 65
-
+-- Not nice but necessary. A constant to ceiling the number calling cycles (f -> b -> f) 
+_MaxCycles :: Int
+_MaxCycles = 5
hunk ./src/Data/CallDependencies.hs 115
-       else fail $ "Call "++ (show c) ++ " not admissible in " ++ (show cd)
+       else fail $ (\s -> (trace s) s ) $ "Call "++ (show c) ++ " not admissible in " ++ (show cd)
hunk ./src/Data/CallDependencies.hs 122
-admissible (f,g,o) (CD cs ns) 
+admissible c@(f,g,o) cd@(CD cs ns) 
hunk ./src/Data/CallDependencies.hs 124
-    | otherwise = and $ map (check o)  deps
+    | otherwise =  ((<= _MaxCycles) . cycles . (addCallUnsafe c) $ cd)
+                     &&  
+                   (and $ map (check o)  deps)
hunk ./src/Data/CallDependencies.hs 138
-
+cycles :: CallDep -> Int 
+cycles = length . cyclesIn . unC . callings
hunk ./src/Data/CallDependencies.hs 216
+--------------------------------------------------------------------------------
+-- stolen from graphalyze 
+--------------------------------------------------------------------------------
+type LNGroup a = [LNode a]
+type NGroup = [Node]
+ -- | Find all cycles in the given graph.
+cyclesIn   :: (DynGraph g) => g a b -> [LNGroup a]
+cyclesIn g = map (addLabels g) (cyclesIn' g)
+
+-- | Find all cycles in the given graph, returning just the nodes.
+cyclesIn' :: (DynGraph g) => g a b -> [NGroup]
+cyclesIn' = concat . unfoldr findCycles
+
+-- | Find all cycles containing a chosen node.
+findCycles :: (DynGraph g) => g a b -> Maybe ([NGroup], g a b)
+findCycles g
+    | isEmpty g = Nothing
+    | otherwise = Just . getCycles . matchAny $ g
+    where
+      getCycles (ctx,g') = (cyclesFor (ctx, g'), g')
+      
+ -- | Find all cycles for the given node.
+cyclesFor :: (DynGraph g) => GDecomp g a b -> [NGroup]
+cyclesFor = map init .
+            filter isCycle .
+            pathTree .
+            first Just
+    where
+      isCycle p = (not $ single p) && ((head p) == (last p))
+      
+-- | Obtain the labels for a list of 'Node's.
+--   It is assumed that each 'Node' is indeed present in the given graph.
+addLabels    :: (Graph g) => g a b -> [Node] -> [LNode a]
+addLabels gr ns = map (\n -> (n, fromJust $ lab gr n)) ns
+
+ -- | Return true if and only if the list contains a single element.
+single     :: [a] -> Bool
+single [_] = True
+single  _  = False
+ 
+-- -----------------------------------------------------------------------------           
+-- -----------------------------------------------------------------------------
+
+-- | Find all possible paths from this given node, avoiding loops,
+--   cycles, etc.
+pathTree             :: (DynGraph g) => Decomp g a b -> [NGroup]
+pathTree (Nothing,_) = []
+pathTree (Just ct,g)
+    | isEmpty g = []
+    | null sucs = [[n]]
+    | otherwise = (:) [n] . map (n:) . concatMap (subPathTree g') $ sucs
+    where
+      n = node' ct
+      sucs = suc' ct
+      -- Avoid infinite loops by not letting it continue any further
+      ct' = makeLeaf ct
+      g' = ct' & g
+      subPathTree gr n' = pathTree $ match n' gr
+
+-- | Remove all outgoing edges
+makeLeaf           :: Context a b -> Context a b
+makeLeaf (p,n,a,_) = (p', n, a, [])
+    where
+      -- Ensure there isn't an edge (n,n)
+      p' = filter (\(_,n') -> n' /= n) p
+
hunk ./src/Data/CallDependencies.hs 332
-c1 = addCall (f,g,LT)$ addCall (h,i,GT) $ addCall (g,h,EQ) $ addCall (f,g,LT) $ noCalls
+c1 = addCall (f,j,LT)$ addCall (j,f,LT)$ addCall (g,f,LT)$ addCall (h,i,GT) $ addCall (g,h,EQ) $ addCall (f,g,LT) $ noCalls