graph-rewriting-strategies-0.2: GraphRewriting/Strategies/LeftmostOutermost.hs

{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
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, (\\))


-- | Gives us the the 'left' port for a given node
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

-- It does not compile with this type signature, even when IncoherentInstances are given in Control.
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})

-- It does not compile with this type signature, even when IncoherentInstances are given in Control.
leftmostOutermost ∷ (View Control n, View [Port] n) ⇒ Rule n → Rule n
leftmostOutermost r = do
	rewrite ← r
	ns ← history -- we want the first node of the matching pattern
	let topnode = last ns
	Control {stack = s} ← liftReader $ inspectNode topnode
	return $ do
		updateNode topnode NoControl -- First we set the topnode to not be the control node any more
		oldNodes ← readNodeList
		rewrite -- then we perform the rewrite
		newNodes ← readNodeList
		let s' = intersect s newNodes -- only consider nodes for the control marker that exist
		if null s' -- even the topmost node has been replaced
			then do -- we assign the control marker to one of the newly created nodes
				let addedNodes = newNodes \\ oldNodes
				updateNode (head addedNodes) (Control {stack = []}) -- finally we set the previous node on the stack as the control node
			else do -- set the previous node on the stack as the control node
				updateNode (head s') (Control {stack = tail s'})