module GraphRewriting.Strategies.LeftmostOutermost where
import GraphRewriting.Pattern
import GraphRewriting.Graph.Write
import GraphRewriting.Graph.Read
import GraphRewriting.Rule
import GraphRewriting.Strategies.Control
import Data.List (intersect, (\\))
class LeftmostOutermost n where lmoPort ∷ n → Maybe Port
instance LeftmostOutermost n ⇒ LeftmostOutermost (Wrapper n) where lmoPort = lmoPort . wrapped
getLmoPort ∷ (LeftmostOutermost n) ⇒ Node → Pattern n Port
getLmoPort n = do
node ← liftReader $ readNode n
case lmoPort node of
Nothing → fail "Term is in WHNF"
Just lo → return lo
moveControl ∷ (View [Port] n, View Control n, LeftmostOutermost n) => Rule n
moveControl = do
Control {stack = s} ← node
control ← previous
lmo1 ← getLmoPort control
n ← branchNodes =<< liftReader . adverseNodes control =<< getLmoPort control
return $ do
updateNode control NoControl
updateNode n (Control {stack = control : s})
leftmostOutermost ∷ (View Control n, View [Port] n) ⇒ Rule n → Rule n
leftmostOutermost r = do
rewrite ← r
ns ← history
let topnode = last ns
Control {stack = s} ← liftReader $ inspectNode topnode
return $ do
updateNode topnode NoControl
oldNodes ← readNodeList
rewrite
newNodes ← readNodeList
let s' = intersect s newNodes
if null s'
then do
let addedNodes = newNodes \\ oldNodes
updateNode (head addedNodes) (Control {stack = []})
else do
updateNode (head s') (Control {stack = tail s'})