module G2.Language.CallGraph ( CallGraph , getCallGraph , functions , calls , calledBy , nameLevels , reachable ) where import qualified G2.Language.ExprEnv as E import G2.Language.Naming import G2.Language.Syntax import Data.Graph hiding (reachable) import qualified Data.Graph as G import Data.Maybe data CallGraph = CallGraph { graph :: Graph , nfv :: Vertex -> ((), Name, [Name]) , vert :: Name -> Maybe Vertex} getCallGraph :: E.ExprEnv -> CallGraph getCallGraph eenv = let funcs = E.keys eenv (g, nfv', vert') = graphFromEdges . map (\(n, e) -> let clls = filter (\n' -> n' `elem` funcs) . map idName $ varIds e in ((), n, clls)) $ E.toList eenv in CallGraph g nfv' vert' functions :: CallGraph -> [Name] functions cg = map (\(_, n, _) -> n) . map (nfv cg) . vertices $ graph cg callsList :: CallGraph -> [(Name, Name)] callsList cg = map (\(v1, v2) -> (mid $ nfv cg v1, mid $ nfv cg v2)) . edges $ graph cg where mid (_, m, _) = m nodeName :: CallGraph -> Vertex -> Name nodeName g v = (\(_, n, _) -> n) $ nfv g v -- | Functions directly called by the named function calls :: Name -> CallGraph -> Maybe [Name] calls n g = fmap (\(_, _, ns) -> ns) . fmap (nfv g) $ vert g n calledBy :: Name -> CallGraph -> [Name] calledBy n g = map fst . filter ((==) n . snd) . map (\(v1, v2) -> (nodeName g v1, nodeName g v2)) $ edges (graph g) -- Functions directly and indirectly called by the named function reachable :: Name -> CallGraph -> [Name] reachable n g = map ((\(_, x, _) -> x) . nfv g) . maybe [] (G.reachable $ graph g) $ vert g n -- | Returns: -- (1) a list of list of names, where the first list contains functions -- that are not called by any functions (except themselves), and the nth list, n > 2, -- includes functions called by functions in the (n - 1)th list. nameLevels :: CallGraph -> [[Name]] nameLevels cg = let fs = functions cg eds = callsList cg callers = fs called_by_others = mapMaybe (\(n1, n2) -> if n1 /= n2 then Just n2 else Nothing) eds only_caller = filter (`notElem` called_by_others) callers in only_caller:nameLevels' only_caller (removeEdgesTo only_caller eds) nameLevels' :: [Name] -> [(Name, Name)] -> [[Name]] nameLevels' [] _ = [] nameLevels' callers eds = let called = map snd $ filter (\(n1, _) -> n1 `elem` callers) eds in called:nameLevels' called (removeEdgesTo called eds) removeEdgesTo :: [Name] -> [(Name, Name)] -> [(Name, Name)] removeEdgesTo ns = filter (\(_, n2) -> n2 `notElem` ns)