module DDC.Llvm.Transform.LinkPhi
(linkPhi)
where
import DDC.Llvm.Analysis.Parents
import DDC.Llvm.Syntax
import DDC.Llvm.Graph
import qualified Data.Sequence as Seq
linkPhi :: Module -> Module
linkPhi mm
= mm { modFuncs = map (linkPhiFunction) $ modFuncs mm }
linkPhiFunction :: Function -> Function
linkPhiFunction fun
= fun { funBlocks
= let Just graph = graphOfBlocks () (funBlocks fun)
in blocksOfGraph
$ linkPhiGraph graph }
linkPhiGraph :: Graph () -> Graph Parents
linkPhiGraph graph
= let graph' = mapAnnotsOfGraph snd
$ annotParentsOfGraph graph
in mapNodesOfGraph (linkPhiNode graph') graph'
linkPhiNode :: Graph Parents -> Node Parents -> Node Parents
linkPhiNode graph node@(Node label instrs parents)
| (Seq.viewl -> instr Seq.:< rest) <- instrs
= case instr of
AnnotInstr IPhi{} _
-> let Just instr' = linkPhiInstr graph label instr
in Node label (instr' Seq.<| rest) parents
_ -> node
| otherwise
= node
linkPhiInstr
:: Graph Parents
-> Label
-> AnnotInstr
-> Maybe AnnotInstr
linkPhiInstr graph lNode (AnnotInstr (IPhi vDst xls) meta)
= Just $ AnnotInstr (IPhi vDst xls') meta
where
xls' = [(x, linkLabel x lMerge) | (x, lMerge) <- xls]
linkLabel (XVar var) lMerge
= case lineageOfVar graph var lNode of
Just (_ : lParent : _) -> lParent
_ -> lMerge
linkLabel _ lMerge = lMerge
linkPhiInstr _graph _ _
= Nothing