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 +12/−5
- GraphRewriting/Graph/Write/Unsafe.hs +2/−0
- GraphRewriting/Rule.hs +14/−16
- graph-rewriting.cabal +1/−1
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