graph-rewriting (empty) → 0.4.8

raw patch · 16 files changed

+709/−0 lines, 16 filesdep +basedep +base-unicode-symbolsdep +containerssetup-changed

Dependencies added: base, base-unicode-symbols, containers, mtl

Files

• Data/View.hs +20/−0
• GraphRewriting.hs +34/−0
• GraphRewriting/Graph.hs +39/−0
• GraphRewriting/Graph/Internal.hs +41/−0
• GraphRewriting/Graph/Read.hs +81/−0
• GraphRewriting/Graph/Types.hs +3/−0
• GraphRewriting/Graph/Write.hs +91/−0
• GraphRewriting/Graph/Write/Unsafe.hs +41/−0
• GraphRewriting/Pattern.hs +113/−0
• GraphRewriting/Pattern/InteractionNet.hs +31/−0
• GraphRewriting/Pattern/Internal.hs +34/−0
• GraphRewriting/Rule.hs +104/−0
• GraphRewriting/Rule/Internal.hs +24/−0
• LICENSE +10/−0
• Setup.hs +2/−0
• graph-rewriting.cabal +41/−0

@@ -0,0 +1,20 @@+-- | The multi-parameter type-class 'View' provides an abstraction @View v n@ of a type @n@ that exposes a value of type (@v@). It allows both to 'inspect' and 'update' the value, while hiding the internal structure of the value type (@n@).+module Data.View where++-- | Minimal complete definition: @inspect@ and one of {@update@, @adjust@}+class View v n where+	inspect ∷ n → v+	update  ∷ v → n → n+	adjust  ∷ (v → v) → n → n++	update v = adjust (const v)+	adjust f n = update (f $ inspect n) n++-- | convenience function that can be used to access record fields of the exposed type+examine ∷ View v n ⇒ (v → field) → n → field+examine field = field . inspect++adjustM ∷ (Monad m, View v n) ⇒ (v → m v) → n → m n+adjustM f n = do+	n' ← f $ inspect n+	return $ update n' n

@@ -0,0 +1,34 @@+-- | This is a monadic graph rewriting library for port (hyper)graphs with a strong emphasis on nodes. It aims primarily at making it as convenient as possible to specify graph rewriting systems in Haskell and to experiment with them. There are a few aspects of the design to be pointed out:+--+-- 1. The graph structure is essentially representated as a collection of nodes. The nodes have a user-defined type, where each node features a list of 'Port's to each of which an 'Edge' is attached. Edges are unlabeled and can not exist autonomously, i.e. each edge is connected to at least one port. Two ports are connected if (and only if) they share the same edge. What is particularly convenient is how these ports can be modeled as constructor fields of a user-defined node type.+--+-- 2. An important abstraction used in this library is the multi-parameter type-class 'View'. It permits to expose a certain aspect of a node, allowing both to 'inspect' or 'update' it, while hiding the internal representation of the node. By that it is easy to specify the rewrite system in a way, that it can not only be applied to a graph with nodes of a fixed node type, but also to a 'Graph' with polymorphic node type @n@. The nodes merely have to /expose/ values of type @v@ by means of defining a @View v@ on @n@. The 'View' abstraction is also used to expose the nodes' ports (and therefore the graph structure) to this library.+--+-- 3. Rewrite 'Rule' are represented as 'Pattern's that return a 'Rewrite'. A 'Pattern' is a branching scrutinisation of the graph that returns a result for every possible matching position in the graph. A 'Rule' is essentially a 'Pattern' that returns a 'Rewrite'. A 'Rewrite' is a monadic modification of the graph structure. In a 'Rule' the 'Rewrite' part can conveniently use the variables bound in the 'Pattern' code.+--+-- For an example of a simple rewrite system, see the graph-rewriting-ski package, an implementation of SKI combinators. Together with the graph-rewriting-layout and the graph-rewriting-gl packages it is easy to build a graphical and interactive application to experiment with your rewrite system.+--+-- What the library does not (yet) offer are combinators to define strategies, since the emphasis of the project was to create an interactive graph-rewriting tool where rules and rewriting positions are selected manually.+module GraphRewriting+	(-- | graph representation, 'Rewrite' monad+	 module GraphRewriting.Graph.Types,+	 -- | mapping over nodes, graph creation, applying a 'Rewrite' +	 module GraphRewriting.Graph,+	 -- | monadic graph scrutinisation+	 module GraphRewriting.Graph.Read,+	 -- | monadic graph modification+	 module GraphRewriting.Graph.Write,+	 -- | branching graph scrutinisation that keeps track of scrutinised nodes+	 module GraphRewriting.Pattern,+	 -- | combine a 'Pattern' with a 'Rewrite' to obtain a rewrite rule+	 module GraphRewriting.Rule,+	 module Data.View)+where++import GraphRewriting.Graph+import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Read+import GraphRewriting.Graph.Write+import GraphRewriting.Pattern+import GraphRewriting.Rule+import Data.View

@@ -0,0 +1,39 @@+-- | Most of the functions for graph scrutinisation ('GraphRewriting.Graph.Read') and modification ('GraphRewriting.Graph.Write') are defined monadically. This module defines functions for extracting these monadic values and a few non-monadic graph scrutinisation/modification functions.+module GraphRewriting.Graph (module GraphRewriting.Graph, module GraphRewriting.Graph.Types) where++import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Internal+import Control.Monad.State+import qualified Data.IntMap as Map+import qualified Data.IntSet as Set+import Data.Maybe (fromJust)+++emptyGraph ∷ Graph n+emptyGraph = Graph {nodeMap = Map.empty, edgeMap = Map.empty, nextKey = 0}++nodes ∷ Graph n → [n]+nodes = Map.elems . nodeMap++-- | Each edge corresponds to the set of nodes it connects+edges ∷ Graph n → [(Edge, [n])]+edges g = map lookupNodes $ Map.assocs (edgeMap g) where+	lookupNodes (e,ns) = (Edge e, map (\n → fromJust $ Map.lookup n $ nodeMap g) $ Set.elems ns)++-- | unsafe, as no check for changed edge references is performed+unsafeMapNodes ∷ (n → n') → Graph n → Graph n'+unsafeMapNodes f g = g {nodeMap = Map.map f $ nodeMap g}++-- | unsafe map that supplies an additional unique key to the mapping function+unsafeMapNodesUnique ∷ (Int → n → n') → Graph n → Graph n'+unsafeMapNodesUnique f g = g {nodeMap = Map.mapWithKey f $ nodeMap g}++-- | apply a monadic graph modification to a graph+runGraph ∷ Rewrite n a → Graph n → (a, Graph n)+runGraph = runState++evalGraph ∷ Rewrite n a → Graph n → a+evalGraph = evalState++execGraph ∷ Rewrite n a → Graph n → Graph n+execGraph = execState

@@ -0,0 +1,41 @@+module GraphRewriting.Graph.Internal where++import Control.Monad.State+import Data.IntMap as Map (IntMap, lookup)+import Data.IntSet (IntSet)+import Control.Monad.Reader.Class+++-- | Hypergraph that holds nodes of type @n@. Nodes can be referenced by type 'Node', edges by type 'Edge', see "GraphRewriting.Graph.Read" and "GraphRewriting.Graph.Write"+data Graph n = Graph {nodeMap ∷ IntMap n, edgeMap ∷ IntMap IntSet, nextKey ∷ Int}++type Rewrite n = State (Graph n)++newtype Node = Node {nKey ∷ Int} deriving (Eq, Ord)+newtype Port = Edge {eKey ∷ Int} deriving (Eq, Ord)+type Edge = Port -- ^ a hyperedge really, connecting a non-empty subset of the graph's nodes (see 'attachedNodes')++instance Show Node where show = show . nKey+instance Show Edge where show = show . eKey++instance MonadReader s (State s) where+	ask = get+	local mod reader = liftM (evalState reader . mod) ask++readRef ∷ Monad m ⇒ Int → IntMap a → m a+readRef key = maybe (fail "readRef: referentiation failed") return . Map.lookup key++readEdge ∷ MonadReader (Graph n) r ⇒ Edge → r IntSet+readEdge (Edge p) = readRef p =<< asks edgeMap++modifyNodeMap ∷ (IntMap n → IntMap n) → Rewrite n ()+modifyNodeMap f = modify $ \g → g {nodeMap = f $ nodeMap g}++modifyEdgeMap ∷ (IntMap IntSet → IntMap IntSet) → Rewrite n ()+modifyEdgeMap f = modify $ \g → g {edgeMap = f $ edgeMap g}++newRef ∷ Rewrite n Int+newRef = do+	i ← gets nextKey+	modify $ \g → g {nextKey = i + 1}+	return i

@@ -0,0 +1,81 @@+-- | Enquiry of the graph structure. Note: In this module the term "node" is often used synonymously to "node reference" and "node value". The two can easily distinguished by their type: the former has type 'Node' the latter usually 'n'.+module GraphRewriting.Graph.Read+	(module GraphRewriting.Graph.Read, module GraphRewriting.Graph.Types, module Data.View)+where++import Prelude.Unicode+import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Internal+import Control.Monad.Reader+import qualified Data.IntMap as Map+import qualified Data.IntSet as Set+import Data.View+import Data.List (nub)+++type WithGraph n = Reader (Graph n)++-- | This forces the use of the 'Reader' monad. Wrapping a sequence of monadic read-only operations (such as those defined below) into a read-only block can save much overhead e.g. in the state monad.+readOnly ∷ WithGraph n a → Rewrite n a+readOnly r = liftM (runReader r) ask++readNode ∷ MonadReader (Graph n) m ⇒ Node → m n+readNode (Node n) = readRef n =<< asks nodeMap++-- | a wrapper to 'inspect' the given node+inspectNode ∷ (View v n, MonadReader (Graph n) m) ⇒ Node → m v+inspectNode = liftM inspect . readNode++-- | a wrapper to 'examine' the given node+examineNode ∷ (View v n, MonadReader (Graph n) m) ⇒ (v → a) → Node → m a+examineNode f = liftM (examine f) . readNode++-- | all of the graph's nodes+readNodeList ∷ MonadReader (Graph n) m ⇒ m [Node]+readNodeList = liftM (map Node . Map.keys) (asks nodeMap)++-- | all of the graph's edges+readEdgeList ∷ MonadReader (Graph n) m ⇒ m [Edge]+readEdgeList = liftM (map Edge . Map.keys) (asks edgeMap)++-- | edges attached to the given node+attachedEdges ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Node → m [Edge]+attachedEdges = liftM nub . inspectNode++-- | non-empty set of nodes attached to the given edge+attachedNodes ∷ MonadReader (Graph n) m ⇒ Edge → m [Node]+attachedNodes = liftM (map Node . Set.elems) . readEdge++-- | amount of ports the given hyperedge is connected to+edgeCardinality ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Edge → m Int+edgeCardinality e = liftM (length . filter (e ≡) . concat) (mapM inspectNode =<< attachedNodes e)++-- | list of nodes that are connected to the given node, not including the node itself+neighbours ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Node → m [Node]+neighbours n@(Node i) = do+	is ← liftM Set.unions $ mapM readEdge =<< inspectNode n+	return $ map Node $ Set.elems $ Set.delete i is++-- | list of nodes that are connected to the given node, including the node itself+relatives ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Node → m [Node]+relatives n@(Node i) = do+	is ← liftM Set.unions $ mapM readEdge =<< inspectNode n+	return $ map Node $ Set.elems is++-- | nodes connected to given port of the specified node, not including the node itself+adverseNodes ∷ MonadReader (Graph n) m ⇒ Node → Port → m [Node]+adverseNodes (Node n) p = liftM (map Node . Set.elems . Set.delete n) (readEdge p)++-- | whether two nodes are connected+connected ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Node → Node → m Bool+connected n1 n2 = liftM (n2 ∈) (relatives n2)++-- | whether the given ports features a dangling edge+free ∷ (View [Port] n, MonadReader (Graph n) m) ⇒ Port → m Bool+free p = do+	c ← edgeCardinality p+	return (c ≡ 1)++-- | Map node-relative enquiry over the nodes of the graph.+withNodes ∷ MonadReader (Graph n) m ⇒ (Node → m a) → m [a]+withNodes p = mapM p =<< readNodeList

@@ -0,0 +1,3 @@+module GraphRewriting.Graph.Types (Graph, Rewrite, Node, Port, Edge) where++import GraphRewriting.Graph.Internal

@@ -0,0 +1,91 @@+-- | Functions for modifying the graph. Although the graph structure is entirely expressed by the graph's node collection, for better convenience and efficiency the graph representation also comprises a complementary node set, that has to be synchronised with the node collection. Therefore each of the functions below involves a test for whether the graph structure has been changed, and if so, measures are taken to ensure the graph remains consistent.++-- Invariants for graph consistency:+-- - ∀n∊N ∀e∊E: n→e ⇔ e→n+-- - ∀e∊E ∃n∊N: e→n+module GraphRewriting.Graph.Write+	(module GraphRewriting.Graph.Write, module GraphRewriting.Graph.Types, module Data.View)+where++import Prelude.Unicode+import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Internal+import GraphRewriting.Graph.Read+import qualified GraphRewriting.Graph.Write.Unsafe as Unsafe+import Control.Monad+import Data.View+import Data.List+import qualified Data.IntMap as Map+import qualified Data.IntSet as Set+++-- | assign new value to given node+writeNode ∷ View [Port] n ⇒ Node → n → Rewrite n ()+writeNode r = modifyNode r . const++-- | modify the node value+modifyNode ∷ View [Port] n ⇒ Node → (n → n) → Rewrite n ()+modifyNode n@(Node i) f = do+	esBefore ← liftM nub (inspectNode n)+	Unsafe.modifyNode n f+	esAfter ← liftM nub (inspectNode n)+	Unsafe.register n (esAfter \\ esBefore)+	Unsafe.unregister n (esBefore \\ esAfter)++-- | Wraps 'update' to update aspect @v@ of a node.+updateNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n ()+updateNode n = adjustNode n . const++-- | Wraps 'adjust' to adjust aspect @v@ of a node.+adjustNode ∷ (View [Port] n, View v n) ⇒ Node → (v → v) → Rewrite n ()+adjustNode n = modifyNode n . adjust++adjustNodeM ∷ (View [Port] n, View v n) ⇒ Node → (v → Rewrite n v) → Rewrite n ()+adjustNodeM n f = do+	v' ← f =<< inspectNode n+	updateNode n v'++-- | add a new node with value @n@ to the graph+newNode ∷ View [Port] n ⇒ n → Rewrite n Node+newNode v = do+	key ← newRef+	let n = Node key+	modifyNodeMap $ Map.insert key v+	Unsafe.register n (inspect v)+	return n++-- | Create a new node by cloning another, at the same time updating aspect @v@. When defining rewrites in a context where it is not known what type @n@ the nodes of the graph have, this is the only way to add new nodes to the graph.+copyNode ∷ (View [Port] n, View v n) ⇒ Node → v → Rewrite n Node+copyNode n f = newNode . update f =<< readNode n++-- | Create a new (unconnected) edge. It is expected that the created edge is connected to a port sooner or later. Otherwise the graph will invove unconnected edges.+newEdge ∷ Rewrite n Edge+newEdge = liftM Edge newRef++-- | remove node from the graph+deleteNode ∷ View [Port] n ⇒ Node → Rewrite n ()+deleteNode n = do+	es ← liftM nub (inspectNode n)+	Unsafe.unregister n es+	modifyNodeMap (Map.delete $ nKey n)++-- | Disconnect ports connected to the given edge by assigning a new (dangling) edge to each of the ports. Then the edge is deleted.+deleteEdge ∷ View [Port] n ⇒ Edge → Rewrite n [Edge]+deleteEdge e = do+	es ← liftM concat $ mapM disconnectPorts =<< attachedNodes e+	modifyEdgeMap $ Map.delete (eKey e)+	return es+	where disconnectPorts n = do+		ps ← inspectNode n+		es ← mapM (\p → if p ≡ e then newEdge else return p) ps+		updateNode n es+		return es++-- | Reconnects the ports connected to the second edge to the first one. Then the second edge is deleted.+mergeEdges ∷ View [Port] n ⇒ Edge → Edge → Rewrite n ()+mergeEdges e1 e2 = when (e1 ≢ e2) $ do+		ns ← attachedNodes e2+		mapM_ (Unsafe.adjustNode $ map replacePort) ns+		modifyEdgeMap $ Map.adjust (Set.union $ Set.fromList $ map nKey ns) (eKey e1)+		deleteEdge e2 >> return ()+	where replacePort p = if p ≡ e2 then e1 else p

@@ -0,0 +1,41 @@+-- | This modules provides variants of the functions in "GraphRewriting.Graph.Write" for transforming the graph, but without checking for changed port assignments, which could lead to an inconsistent state. Therefore these should only be used (for increased efficiency) if the modifications do not change the graph structure (such as in layouting), or you really know what you are doing. Note that the functions provided by this library never change the length of the port list++-- (TODO: use Functor/Traversable/Foldable instead of lists?)+module GraphRewriting.Graph.Write.Unsafe+	(module GraphRewriting.Graph.Write.Unsafe, module GraphRewriting.Graph.Types, module Data.View)+where++import Prelude.Unicode+import Data.Maybe (fromMaybe)+import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Internal+import GraphRewriting.Graph.Read+import Data.View+import qualified Data.IntMap as Map+import qualified Data.IntSet as Set+++modifyNode ∷ Node → (n → n) → Rewrite n ()+modifyNode n@(Node i) f = modifyNodeMap . Map.insert i . f =<< readNode n++updateNode ∷ View v n ⇒ v → Node → Rewrite n ()+updateNode v = adjustNode (const v)++adjustNode ∷ View v n ⇒ (v → v) → Node → Rewrite n ()+adjustNode f n = modifyNode n $ adjust f++adjustNodeM ∷ (View [Port] n, View v n) ⇒ (v → Rewrite n v) → Node → Rewrite n ()+adjustNodeM f n = do+	v' ← f =<< inspectNode n+	updateNode v' n++writeNode ∷ Node → n → Rewrite n ()+writeNode r = modifyNode r . const++unregister ∷ Node → [Edge] → Rewrite n ()+unregister (Node n) es = modifyEdgeMap $ flip (foldr $ Map.update deleteN) (map eKey es)+	where deleteN ns = if ns ≡ Set.singleton n then Nothing else Just $ Set.delete n ns++register ∷ Node → [Edge] → Rewrite n ()+register (Node n) es = modifyEdgeMap $ flip (foldr $ Map.alter addN) (map eKey es)+	where addN ns = Just (Set.insert n $ fromMaybe Set.empty ns)

@@ -0,0 +1,113 @@+-- | Patterns allow monadic scrutinisation of the graph (modifications are not possible) while keeping track of matched nodes. A 'Pattern' is interpreted by 'runPattern' that returns a result for each position in the graph where the pattern matches. It is allowed to 'fail' inside the 'Pattern' monad, indicating that the pattern does not match, which corresponds to conditional rewriting.+module GraphRewriting.Pattern (module GraphRewriting.Pattern, Pattern, Match) where++import Prelude.Unicode+import GraphRewriting.Pattern.Internal+import GraphRewriting.Graph.Read+import Control.Monad.Reader+import Data.List (nub)+++-- | Apply a pattern on a graph returning a result for each matching position in the graph together with the matched nodes.+runPattern ∷ Pattern n a → Graph n → [(Match,a)]+runPattern p = runReaderT $ pattern p []++evalPattern ∷ Pattern n a → Graph n → [a]+evalPattern p = map snd . runPattern p++execPattern ∷ Pattern n a → Graph n → [Match]+execPattern p = map fst . runPattern p++-- combinators ---------------------------------------------------------------++-- | probe a pattern returning the matches it has on the graph+matches ∷ Pattern n a → Pattern n [Match]+matches p = Pattern $ \m → do+	lma ← liftM (runReaderT $ pattern p m) ask+	return ([], map fst lma)++-- | choice+(<|>) ∷ Pattern n a → Pattern n a → Pattern n a+(<|>) = mplus++-- | choice over a list of patterns+anyOf ∷ [Pattern n a] → Pattern n a+anyOf [] = fail "anyOf []"+anyOf xs = foldr1 (<|>) xs++-- | 'fail' if given pattern succeeds, succeed if it fails.+--requireFailure ∷ Pattern n a → Pattern n ()+--requireFailure p = require . not =<< probe p++-- TODO: Control.Monad.guard+-- | conditional rewriting: 'fail' when predicate is not met+require ∷ Monad m ⇒ Bool → m ()+require p = unless p $ fail "requirement not met"++-- | 'fail' when monadic predicate is not met+requireM ∷ Monad m ⇒ m Bool → m ()+requireM p = p >>= require++-- inspections that yield a list packed into a pattern match -----------------++-- | Lift a scrutinisation from 'Reader' to 'Pattern'. Attention: This does not contribute to returned 'Match'.+liftReader ∷ Reader (Graph n) a → Pattern n a+liftReader r = Pattern $ \m → do+	x ← liftM (runReader r) ask+	return ([],x)++-- | any node anywhere in the graph+node ∷ View v n ⇒ Pattern n v+node = liftReader . inspectNode =<< liftMatches readNodeList++-- | a reference to the lastly matched node+previous ∷ Pattern n Node+previous = liftM head history++-- | any edge anywhere in the graph+edge ∷ Pattern n Edge+edge = liftList readEdgeList++-- | node that is connected to given edge+nodeAt ∷ View v n ⇒ Edge → Pattern n v+nodeAt e = liftReader . inspectNode =<< liftMatches (attachedNodes e)++-- | edge that is attached to given node+edgeOf ∷ View [Port] n ⇒ Node → Pattern n Edge+edgeOf = liftList . attachedEdges++-- | node that is connected to the given node, but not that node itself+neighbour ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v+neighbour n = liftReader . inspectNode =<< liftMatches (neighbours n)++-- | node that is connected to the given node, permitting the node itself+relative ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v+relative n = liftReader . inspectNode =<< liftMatches (relatives n)++-- | nodes connected to given port of the specified node, not including the node itself+adverse ∷ (View [Port] n, View v n) ⇒ Port → Node → Pattern n v+adverse p n = liftReader . inspectNode =<< liftMatches (adverseNodes n p)++-- controlling history and future --------------------------------------------++-- | list of nodes matched until now with the most recent node in head position+history ∷ Pattern n Match+history = Pattern $ \m → return ([],m)++-- | only match nodes in the next node pattern that have not been matched before+nextFresh ∷ Pattern n a → Pattern n a+nextFresh = restrictOverlap $ \hist (n:ns) → not (n ∈ hist)++-- | only accept the given node in the next match+nextIs ∷ Node → Pattern n a → Pattern n a+nextIs next = restrictOverlap $ \hist (n:ns) → n ≡ next++-- | First match is the history with the most recently matched node in head position. Second match is the future with the next matched node in head position.+restrictOverlap ∷ (Match → Match → Bool) → Pattern n a → Pattern n a+restrictOverlap c p = Pattern $ \m → do+	(m',x) ← pattern p m+	if c m m' then return (m',x) else fail "requirement on history not met"++-- | Nodes in the future may not be matched more than once.+linear ∷ Pattern n a → Pattern n a+linear = restrictOverlap $ \hist future → length future ≡ length (nub future)

@@ -0,0 +1,31 @@+-- | Offers an 'activePair' pattern for convenient implementation of interaction nets.+module GraphRewriting.Pattern.InteractionNet where++import Prelude.Unicode+import Data.View+import GraphRewriting.Graph.Types+import GraphRewriting.Graph.Read+import GraphRewriting.Pattern+++-- | Index that identifies the principal port within the list of ports+class INet v where principalPort ∷ v → Int++-- | Instead of @(,)@ to save parentheses+data Pair x = x :-: x++pair ∷ Pair a → (a,a)+pair (x :-: y) = (x,y)++activePair ∷ (View [Port] n, View v n, INet v) ⇒ Pattern n (Pair v)+activePair = do+	v1 ← node+	n1 ← previous+	ports1 ← liftReader (inspectNode n1)+	let pp1 = ports1 !! principalPort v1+	v2 ← adverse pp1 n1+	n2 ← previous+	ports2 ← liftReader (inspectNode n2)+	let pp2 = ports2 !! principalPort v2+	require (pp1 ≡ pp2)+	return (v1 :-: v2)

@@ -0,0 +1,34 @@+module GraphRewriting.Pattern.Internal where++import Prelude.Unicode+import GraphRewriting.Graph.Types+import Control.Monad.Reader+++newtype Pattern n a = Pattern {pattern ∷ Match → ReaderT (Graph n) [] (Match, a)}++type Match = [Node]++instance Monad (Pattern n) where+	return x = Pattern $ \m → return ([],x)+	p >>= f = Pattern $ \m → do+		(m1,x) ← pattern p m+		(m2,y) ← pattern (f x) (m1 ⧺ m)+		return (m1 ⧺ m2, y)+	fail str = Pattern $ \m → lift []++instance MonadPlus (Pattern n) where+	mzero = fail "empty result list"+	mplus p q = Pattern $ \m → do+		g ← ask+		lift $ runReaderT (pattern p m) g ⧺ runReaderT (pattern q m) g++liftList ∷ Reader (Graph n) [a] → Pattern n a+liftList r = Pattern $ \m → do+	xs ← liftM (runReader r) ask+	lift [([],x) | x ← xs]++liftMatches ∷ Reader (Graph n) [Node] → Pattern n Node+liftMatches r = Pattern $ \m → do+	ns ← liftM (runReader r) ask+	lift [([n],n) | n ← ns]

@@ -0,0 +1,104 @@+-- | Rewrite rules are represented as nested monads: a 'Rule' is a 'Pattern' that returns a 'Rewrite' the latter directly defining the transformation of the graph. The 'Rewrite' itself is expected to return a list of newly created nodes.+--+-- For rule construction a few functions a provided: The most basic one is 'rewrite'. But in most cases 'erase', 'rewire', and 'replace*' should be more convenient. These functions express rewrites that /replace/ the matched nodes of the 'Pattern', which comes quite close to the @L -> R@ form in which graph rewriting rules are usually expressed.+module GraphRewriting.Rule where++import Prelude.Unicode+import Data.Maybe (listToMaybe)+import GraphRewriting.Graph+import GraphRewriting.Graph.Internal (Port (Edge))+import GraphRewriting.Graph.Write+import GraphRewriting.Rule.Internal+import GraphRewriting.Pattern+import Control.Monad.State+import Control.Monad.Reader+import Data.List (nub)+import Data.Either+++-- A rewriting rule is defined as a 'Pattern' that returns a 'Rewrite'+type Rule n = Pattern n (Rewrite n [Node])++-- rule construction ---------------------------------------------------------++-- | primitive rule construction with the matched nodes of the left hand side as a parameter+rewrite ∷ (Match → Rewrite n [Node]) → Rule n+rewrite r = liftM r history++-- | constructs a rule that deletes all of the matched nodes from the graph+erase ∷ View [Port] n ⇒ Rule n+erase = do+	hist ← history+	return $ do+		mapM_ deleteNode $ nub hist+		return []++-- | Constructs a rule from a list of rewirings. Each rewiring specifies a list of hyperedges that are to be merged into a single hyperedge. All matched nodes of the left-hand side are removed.+rewire ∷ View [Port] n ⇒ [[Edge]] → Rule n+rewire ess = do+	hist ← history+	return $ do+		mapM_ mergeEs $ joinEdges ess+		mapM_ deleteNode $ nub hist+		return []++data RHS v = Node v | Wire Edge Edge | Merge [Edge]++-- | Constructs a rule that replaces the matched nodes of the left-hand side by new nodes and rewirings. It generates an amount of new edges specified by the 'Int'. In most cases the functions below named @replace*@ should be sufficient.+replace ∷ (View [Port] n, View v n) ⇒ Int → ([Edge] → [RHS v]) → Rule n+replace n rhs = do+	let vs = fst $ partition (replicate n $ Edge 0)+	hist ← history+	when (null hist ∧ not (null vs)) (fail "need at least one matching node to clone new nodes from")+	return $ do+		es ← replicateM n newEdge+		let (vs,ess) = partition es+		ns ← zipWithM copyNode (cycle hist) vs+		mapM_ mergeEs $ joinEdges ess+		mapM_ deleteNode $ nub hist+		return ns+	where partition es = partitionEithers $ map splitRHS (rhs es) where+		splitRHS (Node v) = Left v+		splitRHS (Wire e1 e2) = Right [e1,e2]+		splitRHS (Merge es) = if length es < 2+			then error "Merge requires list length >= 2"+			else Right es++-- | Replaces the matched nodes by a list of new nodes and rewirings.+replace0 vs = replace 0 $ \[]                        → vs+-- | Replaces the matched nodes by a list of new nodes and rewirings. It also generates one new edge.+replace1 vs = replace 1 $ \[e1]                      → vs e1+-- | Replaces the matched nodes by a list of new nodes and rewirings. It also generates two new edges.+replace2 vs = replace 2 $ \[e1,e2]                   → vs e1 e2+-- | You get the idea.+replace3 vs = replace 3 $ \[e1,e2,e3]                → vs e1 e2 e3+replace4 vs = replace 4 $ \[e1,e2,e3,e4]             → vs e1 e2 e3 e4+replace5 vs = replace 5 $ \[e1,e2,e3,e4,e5]          → vs e1 e2 e3 e4 e5+replace6 vs = replace 6 $ \[e1,e2,e3,e4,e5,e6]       → vs e1 e2 e3 e4 e5 e6+replace7 vs = replace 7 $ \[e1,e2,e3,e4,e5,e6,e7]    → vs e1 e2 e3 e4 e5 e6 e7+replace8 vs = replace 8 $ \[e1,e2,e3,e4,e5,e6,e7,e8] → vs e1 e2 e3 e4 e5 e6 e7 e8++-- combinators ---------------------------------------------------------------++-- | Apply two rules consecutively. Second rule is only applied if first one succeeds. Fails if (and only if) first rule fails.+(>>>) ∷ Rule n → Rule n → Rule n+r1 >>> r2 = do+	rw1 ← r1+	return $ do+		ns1 ← rw1+		ns2 ← apply r2+		return (ns1 ⧺ ns2)++-- | Apply a rule repeatedly as long as it is applicable. Fails if rule cannot be applied at all.+exhaustive ∷ Rule n → Rule n+exhaustive = foldr1 (>>>) . repeat++-- | Apply a rule to all current redexes one by one. Neither new redexes or destroyed redexes are reduced.+everywhere ∷ Rule n → Rule n+everywhere r = do+	ms ← matches r+	exhaustive $ restrictOverlap (\hist future → future ∈ ms) r++-- | Apply rule at an arbitrary position if applicable+apply ∷ Rule n → Rewrite n [Node]+apply r = maybe (return []) snd . listToMaybe =<< liftM (runPattern r) ask

@@ -0,0 +1,24 @@+module GraphRewriting.Rule.Internal where++import GraphRewriting.Graph.Internal+import GraphRewriting.Graph.Write+import qualified Data.IntSet as Set+++mergeEs (e:es) = mapM_ (mergeEdges e) es++type Set = Set.IntSet++joinEdges ∷ [[Edge]] → [[Edge]]+joinEdges = map (map Edge . Set.elems) . join . map (Set.fromList . map eKey)++-- | Join pairs of sets with a common element until all sets are disjoint.+join ∷ [Set] → [Set]+join = foldr join1 []++-- | Add to a list of disjoint sets a further set and join sets with common elements such that the resulting list again only contains disjoint sets.+join1 ∷ Set → [Set] → [Set]+join1 x [    ] = [x]+join1 x (y:ys) = if Set.null $ Set.intersection x y+	then y : join1 x ys+	else join1 (Set.union x y) ys

@@ -0,0 +1,10 @@+Copyright (c) 2010, Jan Rochel+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+* Neither the name of the <ORGANIZATION> nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,41 @@+Name:           graph-rewriting+Version:        0.4.8+Copyright:      (c) 2010, Jan Rochel+License:        BSD3+License-File:   LICENSE+Author:         Jan Rochel+Maintainer:     jan@rochel.info+Stability:      beta+Build-Type:     Simple+Synopsis:       Monadic graph rewriting of hypergraphs with ports and multiedges+Description:+	This library provides a monadic EDSL to define your own graph rewrite system in Haskell. Once you have specified the signature of your graph and a set of rewrite rules, you can apply these rules on a graph to effect a graph transformation. The aim of this library is to make it as convenient as possible to define such a system and experiment with it and is not designed as a backend for high-performance computation.+Category:       Graphs, Data+Cabal-Version:  >= 1.6+Build-Depends:+	base >= 4 && < 4.3,+	base-unicode-symbols >= 0.2 && < 0.3,+	mtl >= 1.1 && < 1.2,+	containers >= 0.3 && < 0.4+Exposed-Modules:+	Data.View+	GraphRewriting+	GraphRewriting.Graph+	GraphRewriting.Graph.Types+	GraphRewriting.Graph.Read+	GraphRewriting.Graph.Write+	GraphRewriting.Graph.Write.Unsafe+	GraphRewriting.Pattern+	GraphRewriting.Pattern.InteractionNet+	GraphRewriting.Rule+Other-Modules:+	GraphRewriting.Graph.Internal+	GraphRewriting.Pattern.Internal+	GraphRewriting.Rule.Internal+Extensions:+	UnicodeSyntax+	FlexibleContexts+	FlexibleInstances+	TypeSynonymInstances+	MultiParamTypeClasses+GHC-Options:    -fno-warn-duplicate-exports -fwarn-unused-imports