----------------------------------------------------------------------------- -- A few base functions for analysing dependencies in FlatCurry programs: -- -- Michael Hanus, December 2018 ----------------------------------------------------------------------------- module CurryBrowseAnalysis.Dependency (analyseWithDependencies, indirectlyDependent, funcsInExpr, callsDirectly, externalDependent, dependencyGraphs, localDependencyGraphs) where import Maybe(fromJust) import Sort(leqString) import Data.Set.RBTree ( SetRBT, member, empty, insert, toList, union ) import FlatCurry.Types -- Generic global function analysis where the property of each function is a combination -- of a property of the function and all its dependent functions. -- 1. parameter: a function that associates a property to each function declaration -- 2. parameter: an operation to combine the properties of function/dependent functions analyseWithDependencies :: (FuncDecl->a) -> ([a]->a) -> [FuncDecl] -> [(QName,a)] analyseWithDependencies funproperty combine funs = map anaFun alldeps where anaFun (name,depfuns) = (name, combine (map (lookupProp funprops) (name:depfuns))) funprops = map (\f->(funcName f, funproperty f)) funs alldeps = indirectlyDependent funs lookupProp :: [(QName,a)] -> QName -> a lookupProp fprops fun = fromJust (lookup fun fprops) funcName (Func fname _ _ _ _) = fname -- external functions on which a function depends externalDependent :: [FuncDecl] -> [(QName,[QName])] externalDependent funcs = map (\ (f,fs)->(f,filter (`elem` externalFuncs) fs)) (indirectlyDependent funcs) where externalFuncs = concatMap getExternal funcs getExternal (Func _ _ _ _ (Rule _ _)) = [] getExternal (Func f _ _ _ (External _)) = [f] -- Computes the list of indirect dependencies for all functions. -- Argument: a list of function declarations -- Result: a list of pairs of qualified functions names and the corresponding -- called functions indirectlyDependent :: [FuncDecl] -> [(QName,[QName])] indirectlyDependent funs = map (\ (f,ds) -> (f,toList ds)) (depsClosure (map directlyDependent funs)) -- list of direct dependencies for a function callsDirectly :: FuncDecl -> [QName] callsDirectly fun = toList (snd (directlyDependent fun)) -- set of direct dependencies for a function directlyDependent :: FuncDecl -> (QName,SetRBT QName) directlyDependent (Func f _ _ _ (Rule _ e)) = (f,funcSetOfExpr e) directlyDependent (Func f _ _ _ (External _)) = (f,emptySet) -- compute the transitive closure of all dependencies based on a list of -- direct dependencies: depsClosure :: [(QName,SetRBT QName)] -> [(QName,SetRBT QName)] depsClosure directdeps = map (\(f,ds)->(f,closure ds (toList ds))) directdeps where closure olddeps [] = olddeps closure olddeps (f:fs) = let newdeps = filter (\e->not (member e olddeps)) (toList (maybe emptySet id (lookup f directdeps))) in closure (foldr insert olddeps newdeps) (newdeps++fs) -- Computes the list of all direct dependencies for all functions. -- This is useful to represent the dependency graph for each function. -- Argument: a list of function declarations -- Result: a list of pairs of qualified functions names and the corresponding list of -- direct dependencies for all functions on which this functions depend dependencyGraphs :: [FuncDecl] -> [(QName,[(QName,[QName])])] dependencyGraphs funs = let directdeps = map directlyDependent funs in map (\(f,ds) -> (f,map (\g->(g,toList (fromJust (lookup g directdeps)))) (toList (insert f ds)))) (depsClosure directdeps) -- Computes for all functions the list of all direct local dependencies, i.e., -- dependencies occurring in the module where the function is defined. -- Thus, dependencies outside the module are not represented. -- This is useful to represent the local dependency graph for each function. -- Argument: a list of function declarations -- Result: a list of pairs of qualified functions names and the corresponding list of -- direct local dependencies for all functions on which this functions depend localDependencyGraphs :: [FuncDecl] -> [(QName,[(QName,[QName])])] localDependencyGraphs funs = let directdeps = map directlyDependent funs in map (\(f,ds) -> (f,map (\g->(g,if fst f == fst g then toList (fromJust (lookup g directdeps)) else [])) (toList (insert f ds)))) (localDepsClosure directdeps) -- compute the transitive closure of all local dependencies based on a list of -- direct dependencies: localDepsClosure :: [(QName,SetRBT QName)] -> [(QName,SetRBT QName)] localDepsClosure directdeps = map (\(f,ds)->(f,closure (fst f) ds (toList ds))) directdeps where closure _ olddeps [] = olddeps closure mod olddeps (f:fs) | mod == fst f -- f is local in this module: add dependencies = let newdeps = filter (\e->not (member e olddeps)) (toList (maybe emptySet id (lookup f directdeps))) in closure mod (foldr insert olddeps newdeps) (newdeps++fs) | otherwise = closure mod olddeps fs -- Gets a list of all functions (including partially applied functions) -- called in an expression: funcsInExpr :: Expr -> [QName] funcsInExpr e = toList (funcSetOfExpr e) -- Gets the set of all functions (including partially applied functions) -- called in an expression: funcSetOfExpr :: Expr -> SetRBT QName funcSetOfExpr (Var _) = emptySet funcSetOfExpr (Lit _) = emptySet funcSetOfExpr (Comb ct f es) = if isConstructorComb ct then unionMap funcSetOfExpr es else insert f (unionMap funcSetOfExpr es) funcSetOfExpr (Free _ e) = funcSetOfExpr e funcSetOfExpr (Let bs e) = union (unionMap (funcSetOfExpr . snd) bs) (funcSetOfExpr e) funcSetOfExpr (Or e1 e2) = union (funcSetOfExpr e1) (funcSetOfExpr e2) funcSetOfExpr (Case _ e bs) = union (funcSetOfExpr e) (unionMap funcSetOfBranch bs) where funcSetOfBranch (Branch _ be) = funcSetOfExpr be funcSetOfExpr (Typed e _) = funcSetOfExpr e isConstructorComb :: CombType -> Bool isConstructorComb ct = case ct of ConsCall -> True ConsPartCall _ -> True _ -> False unionMap :: (a -> SetRBT QName) -> [a] -> SetRBT QName unionMap f = foldr union emptySet . map f emptySet :: SetRBT QName emptySet = empty leqQName leqQName :: QName -> QName -> Bool leqQName (m1,n1) (m2,n2) = leqString (m1++('.':n1)) (m2++('.':n2)) -- end of Dependency