packages feed

graph-rewriting 0.5.1 → 0.5.2

raw patch · 4 files changed

+29/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

GraphRewriting/Graph/Write.hs view
@@ -13,6 +13,7 @@ import GraphRewriting.Graph.Read import qualified GraphRewriting.Graph.Write.Unsafe as Unsafe import Control.Monad+import Data.Maybe (catMaybes) import Data.View import Data.List import qualified Data.IntMap as Map@@ -75,11 +76,17 @@ 	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+	where+	disconnectPorts n = do+		ports ← inspectNode n+		(freshEdges, ports') ← liftM unzip $ mapM substPort ports+		updateNode n ports'+		return $ catMaybes freshEdges+	substPort p = if p ≡ e+		then do+			p' ← newEdge+			return (Just p', p')+		else return (Nothing, p)  -- | 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 ()
GraphRewriting/Graph/Write/Unsafe.hs view
@@ -15,6 +15,8 @@ import qualified Data.IntSet as Set  +-- TODO: For the major version change Adjust parameter orders to the ones used in GraphRewriting.Graph.Write+ modifyNode ∷ Node → (n → n) → Rewrite n () modifyNode n@(Node i) f = modifyNodeMap . Map.insert i . f =<< readNode n 
GraphRewriting/Rule.hs view
@@ -19,6 +19,12 @@ -- | A rewriting rule is defined as a 'Pattern' that returns a 'Rewrite' type Rule n = Pattern n (Rewrite n ()) +-- | Apply rule at an arbitrary position if applicable+apply ∷ Rule n → Rewrite n ()+apply r = do+	contractions ← liftM (evalPattern r) ask+	when (not $ null contractions) (head contractions >> return ())+ -- rule construction ---------------------------------------------------------  -- | primitive rule construction with the matched nodes of the left hand side as a parameter@@ -29,15 +35,13 @@  -- | constructs a rule that deletes all of the matched nodes from the graph erase ∷ View [Port] n ⇒ Rule n-erase = liftM (mapM_ deleteNode . nub) history+erase = rewrite $ mapM_ deleteNode . nub  -- | 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+rewire ess = rewrite $ \hist → do+	mapM_ mergeEs $ joinEdges ess+	mapM_ deleteNode $ nub hist  data RHS v = Node v | Wire Edge Edge | Merge [Edge] @@ -45,14 +49,14 @@ 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")+	lhsNodes ← liftM nub history+	when (null lhsNodes ∧ 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-		zipWithM_ copyNode (cycle hist) vs+		zipWithM_ copyNode (cycle lhsNodes) vs 		mapM_ mergeEs $ joinEdges ess-		mapM_ deleteNode $ nub hist+		mapM_ deleteNode lhsNodes 	where partition es = partitionEithers $ map splitRHS (rhs es) where 		splitRHS (Node v) = Left v 		splitRHS (Wire e1 e2) = Right [e1,e2]@@ -91,9 +95,3 @@ everywhere r = do 	ms ← amnesia $ matches r 	exhaustive $ restrictOverlap (\hist future → future ∈ ms) r---- | Apply rule at an arbitrary position if applicable-apply ∷ Rule n → Rewrite n ()-apply r = do-	contractions ← liftM (evalPattern r) ask-	when (not $ null contractions) (head contractions >> return ())
graph-rewriting.cabal view
@@ -1,5 +1,5 @@ Name:           graph-rewriting-Version:        0.5.1+Version:        0.5.2 Copyright:      (c) 2010, Jan Rochel License:        BSD3 License-File:   LICENSE