module DDC.Llvm.Analysis.Parents
( Parents (..)
, annotParentsOfGraph
, lineageOfVar)
where
import DDC.Llvm.Graph
import DDC.Llvm.Syntax
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Maybe
data Parents
= Parents (Set Label)
annotParentsOfGraph
:: Graph a -> Graph (a, Parents)
annotParentsOfGraph graph0
= go (zeroParents graph0)
$ labelsOfGraph graph0
where
go graph []
= graph
go graph (label : rest)
= go (pushParents label graph) rest
pushParents label graph
= let Just node = Map.lookup label $ graphNodes graph
lsChildren = childrenOfNode node
in foldr (addParent label) graph $ Set.toList lsChildren
addParent labelParent labelChild graph
= flip (modifyNodeOfGraph labelChild) graph $ \node
-> let (a, Parents ls) = nodeAnnot node
annot' = (a, Parents (Set.insert labelParent ls))
in node { nodeAnnot = annot' }
zeroParents graph
= flip mapNodesOfGraph graph
$ \node -> node { nodeAnnot = (nodeAnnot node, Parents Set.empty) }
lineageOfVar
:: Graph Parents
-> Var
-> Label
-> Maybe [Label]
lineageOfVar graph target start
= go start
where go label
| Just node <- lookupNodeOfGraph graph label
, defs <- defVarsOfBlock $ blockOfNode node
= if Set.member target defs
then Just [nodeLabel node]
else let Parents parents = nodeAnnot node
psLines = map (lineageOfVar graph target)
$ Set.toList parents
in case catMaybes psLines of
line : _ -> Just (nodeLabel node : line)
_ -> Nothing
| otherwise
= Nothing