From 215bf61115a1b78c6466830c89574091459bebdb Mon Sep 17 00:00:00 2001
From: bringert <bringert@cs.chalmers.se>
Date: Fri, 15 Dec 2006 16:09:58 +0000
Subject: Towards smaller SRGs when lots of variants are used.

---
 src/GF/Speech/Graph.hs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

(limited to 'src/GF/Speech/Graph.hs')

diff --git a/src/GF/Speech/Graph.hs b/src/GF/Speech/Graph.hs
index c23c5e384..1a0ebe0c0 100644
--- a/src/GF/Speech/Graph.hs
+++ b/src/GF/Speech/Graph.hs
@@ -14,7 +14,8 @@
 module GF.Speech.Graph ( Graph(..), Node, Edge, NodeInfo
                         , newGraph, nodes, edges
                         , nmap, emap, newNode, newNodes, newEdge, newEdges
-                        , removeNodes
+                        , insertEdgeWith
+                        , removeNode, removeNodes
                         , nodeInfo
                         , getIncoming, getOutgoing, getNodeLabel
                         , inDegree, outDegree
@@ -82,6 +83,17 @@ newEdges es g = foldl' (flip newEdge) g es
 -- lazy version:
 -- newEdges es' (Graph c ns es) = Graph c ns (es'++es)
 
+insertEdgeWith :: Eq n => 
+                  (b -> b -> b) -> Edge n b -> Graph n a b -> Graph n a b
+insertEdgeWith f e@(x,y,l) (Graph c ns es) = Graph c ns (h es)
+  where h [] = [e]
+        h (e'@(x',y',l'):es') | x' == x && y' == y = (x',y', f l l'):es'
+                              | otherwise = e':h es'
+
+-- | Remove a node and all edges to and from that node.
+removeNode :: Ord n => n -> Graph n a b -> Graph n a b
+removeNode n = removeNodes (Set.singleton n)
+
 -- | Remove a set of nodes and all edges to and from those nodes.
 removeNodes :: Ord n => Set n -> Graph n a b -> Graph n a b
 removeNodes xs (Graph c ns es) = Graph c ns' es'
-- 
cgit v1.2.3