[gettng all allowed calls from a CallDep
martin.hofmann@uni-bamberg.de**20090423125957] hunk ./src/Data/CallDependencies.hs 1
-
+{-# OPTIONS_GHC -fglasgow-exts   #-}
hunk ./src/Data/CallDependencies.hs 6
-        admissible 
+        admissible, allowedCalls
hunk ./src/Data/CallDependencies.hs 10
+import Data.Maybe (maybeToList)
+import Data.Function (on)
+import Data.Bimap (Bimap)
+import qualified Data.Bimap as B (toAscList, empty, insert, member, lookup, lookupR)
+
hunk ./src/Data/CallDependencies.hs 16
-import qualified Data.Map as M (empty, insert, member, lookup)
+import qualified Data.Map as M (empty, insert, fromList)
hunk ./src/Data/CallDependencies.hs 21
-    insMapEdgeM, delMapEdgeM
+    insMapEdgeM, delMapEdgeM, grev
hunk ./src/Data/CallDependencies.hs 28
-import Data.List (delete)
-import Logging
+import Data.List (delete, maximumBy, sortBy, groupBy)
+import Logging hiding (group)
hunk ./src/Data/CallDependencies.hs 65
+   
+--deriving instance Eq Calls
+--deriving instance Ord Calls
hunk ./src/Data/CallDependencies.hs 80
-    , nodes :: Map Name Node    
+    , nodes :: Bimap Name Node    
hunk ./src/Data/CallDependencies.hs 82
-    deriving(Show, Eq, Ord)
+    deriving(Show)
+
+instance Eq CallDep where
+    (==) c1 c2 = ( on (==) callings c1 c2) &&
+                 ( on (==) (B.toAscList.nodes) c1 c2) 
+instance Ord CallDep where
+    compare c1 c2 = ( on compare callings c1 c2) `compare`
+                    ( on compare (B.toAscList.nodes) c1 c2)      
hunk ./src/Data/CallDependencies.hs 95
-noCalls = CD (Calls G.empty) M.empty
+noCalls = CD (Calls G.empty) B.empty
hunk ./src/Data/CallDependencies.hs 115
-    | f == g    = o == LT 
+    | f == g    = o == LT  -- direct recursive calls must be smaller
hunk ./src/Data/CallDependencies.hs 123
-    check LT (_,LT) = True -- f -LT-> g  => g -LT-> f  
-    check LT (_,EQ) = True -- f -LT-> g  => g -EQ-> f
-    check EQ (_,LT) = True -- f -EQ-> g  => g -LT-> f
-    check _  _      = False
+    check LT (_,LT) = True  -- f -LT-> g  => g -LT-> f  
+    check LT (_,EQ) = True  -- f -LT-> g  => g -EQ-> f
+    check EQ (_,LT) = True  -- f -EQ-> g  => g -LT-> f
+    check _  _      = False -- f -GT-> g  => g -//-> f
+
+
+--getAdmissibles :: Name -> CallDep -> [[LNode l]] --[Call]
+allowedCalls :: Name -> CallDep -> Map Name [Ordering]
+allowedCalls n (CD cs ns) =
+    M.fromList $ concatMap (buildAllowed ns) (secure revdeps)
+    where
+    revdeps = compress.concat.maybeToList $ 
+                liftM (flip pathsFrom  (grev.unC $ cs))
+                                       (asNode n ns)
+    -- get the reversed call dependencies: (f,GT) means n -GT-> f 
+    secure = (map (maximumBy (compare `on` snd))) .
+             (groupBy ((==) `on` fst)).
+             (sortBy (compare `on` fst))
+    buildAllowed ns (nd,o) = case (fromNode nd ns,o) of
+        (Just n,GT)  -> [(n, [])]
+        (Just n,EQ)  -> [(n, [LT])]
+        (Just n,LT)  -> [(n, [LT,EQ])]
+        (Nothing,_)  -> [] 
+        
hunk ./src/Data/CallDependencies.hs 151
-asNode :: Name -> Map Name Node -> Maybe Node
-asNode n ns =  M.lookup n ns
+asNode :: Name -> Bimap Name Node -> Maybe Node
+asNode n ns =  B.lookup n ns
hunk ./src/Data/CallDependencies.hs 154
+{- 
+ | Get a the Name by a node 
+-}   
+fromNode :: Node -> Bimap Name Node -> Maybe Name
+fromNode n ns = B.lookupR n ns
hunk ./src/Data/CallDependencies.hs 174
-    if M.member n ns
+    if B.member n ns
hunk ./src/Data/CallDependencies.hs 177
-               ns' = M.insert n (noNodes cs')  ns               
+               ns' = B.insert n (noNodes cs')  ns               
hunk ./src/Data/CallDependencies.hs 205
-compress = map (foldl1 accumulate)
+compress [] = []
+compress (x:xs) = map (foldl1 accumulate) (x:xs)
hunk ./src/Data/CallDependencies.hs 208
--- merge two LNodes by by maxing the Ordering
+-- merge two LNodes by by maxing the Ordering, keeping the left label
hunk ./src/Data/CallDependencies.hs 210
-accumulate (n,l1) (_,l2) = (n, max l1 l2)            
+accumulate (n,l1) (_,l2) = (n, max l1 l2)
+         
hunk ./src/Data/CallDependencies.hs 237
---f = mkName "f"
---g = mkName "g"
---h = mkName "h"
---i = mkName "i"
---j = mkName "j"
---
---c1 = addCall (h,i,GT) $ addCall (g,h,EQ) $ addCall (f,g,LT) $ noCalls
+f = mkName "f"
+g = mkName "g"
+h = mkName "h"
+i = mkName "i"
+j = mkName "j"
+
+c1 = addCall (f,g,LT)$ addCall (h,i,GT) $ addCall (g,h,EQ) $ addCall (f,g,LT) $ noCalls