module Futhark.Analysis.CallGraph
( CallGraph
, buildCallGraph
)
where
import Control.Monad.Writer.Strict
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe (isJust)
import Data.List
import Futhark.Representation.SOACS
type FunctionTable = M.Map Name FunDef
buildFunctionTable :: Prog -> FunctionTable
buildFunctionTable = foldl expand M.empty . progFunctions
where expand ftab f = M.insert (funDefName f) f ftab
type CallGraph = M.Map Name (S.Set Name)
buildCallGraph :: Prog -> CallGraph
buildCallGraph prog = foldl' (buildCGfun ftable) M.empty entry_points
where entry_points = map funDefName $ filter (isJust . funDefEntryPoint) $ progFunctions prog
ftable = buildFunctionTable prog
buildCGfun :: FunctionTable -> CallGraph -> Name -> CallGraph
buildCGfun ftable cg fname =
case M.lookup fname ftable of
Just f | Nothing <- M.lookup fname cg -> do
let callees = buildCGbody $ funDefBody f
cg' = M.insert fname callees cg
foldl' (buildCGfun ftable) cg' callees
_ -> cg
buildCGbody :: Body -> S.Set Name
buildCGbody = mconcat . map (buildCGexp . stmExp) . stmsToList . bodyStms
buildCGexp :: Exp -> S.Set Name
buildCGexp (Apply fname _ _ _) = S.singleton fname
buildCGexp (Op op) = execWriter $ mapSOACM folder op
where folder = identitySOACMapper {
mapOnSOACLambda = \lam -> do tell $ buildCGbody $ lambdaBody lam
return lam
}
buildCGexp e = execWriter $ mapExpM folder e
where folder = identityMapper {
mapOnBody = \_ body -> do tell $ buildCGbody body
return body
}