Parametrized the Graph type over the node type.

1 files changed, 33 insertions, 39 deletions

diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index 374732426..428ad8f76 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/14 15:17:29 $ 
+-- > CVS $Date: 2005/09/14 15:29:53 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
+-- > CVS $Revision: 1.8 $
 --
 -- A simple finite state network module.
 -----------------------------------------------------------------------------
@@ -28,7 +28,7 @@ import GF.Data.Utilities
 import qualified GF.Visualization.Graphviz as Dot
 
 
-data FA a b = FA (Graph a b) State [State]
+data FA a b = FA (Graph State a b) State [State]
 
 type State = Node
 
@@ -47,16 +47,16 @@ transitions (FA g _ _) = edges g
 newFA :: a -- ^ Start node label
       -> FA a b
 newFA l = FA g s []
-    where (g,s) = newNode l newGraph
+    where (g,s) = newNode l (newGraph [0..])
 
-addFinalState :: Node -> FA a b -> FA a b
+addFinalState :: State -> FA a b -> FA a b
 addFinalState f (FA g s ss) = FA g s (f:ss)
 
 newState :: a -> FA a b -> (FA a b, State)
 newState x (FA g s ss) = (FA g' s ss, n)
     where (g',n) = newNode x g
 
-newTransition :: Node -> Node -> b -> FA a b -> FA a b
+newTransition :: State -> State -> b -> FA a b -> FA a b
 newTransition f t l = onGraph (newEdge f t l)
 
 mapStates :: (a -> c) -> FA a b -> FA c b
@@ -65,12 +65,12 @@ mapStates f = onGraph (nmap f)
 mapTransitions :: (b -> c) -> FA a b -> FA a c
 mapTransitions f = onGraph (emap f)
 
-asGraph :: FA a b -> Graph a b
-asGraph (FA g _ _) = g
-
 minimize :: FA () (Maybe a) -> FA () (Maybe a)
 minimize = onGraph mimimizeGr1
 
+onGraph :: (Graph State a b -> Graph State c d) -> FA a b -> FA c d
+onGraph f (FA g s ss) = FA (f g) s ss
+
 -- | Transform a standard finite automaton with labelled edges
 --   to one where the labels are on the nodes instead. This can add
 --   up to one extra node per edge.
@@ -90,57 +90,51 @@ prFAGraphviz  = Dot.prGraphviz . mkGraphviz
 --
 -- * Graphs 
 --
-type Node = Int
 
-data Graph a b = Graph Node [(Node,a)] [(Node,Node,b)]
+data Graph n a b = Graph [n] [(n,a)] [(n,n,b)]
 		 deriving (Eq,Show)
 
-onGraph :: (Graph a b -> Graph c d) -> FA a b -> FA c d
-onGraph f (FA g s ss) = FA (f g) s ss
-
--- graphToFA :: State -> [State] -> Graph a b -> FA a b
--- graphToFA s fs (Graph _ ss ts) = buildFA s fs ss ts
+type Node = Int
 
-newGraph :: Graph a b
-newGraph = Graph 0 [] []
+newGraph :: [n] -> Graph n a b
+newGraph ns = Graph ns [] []
 
-nodes :: Graph a b -> [(Node,a)]
+nodes :: Graph n a b -> [(n,a)]
 nodes (Graph _ ns _) = ns
 
-edges :: Graph a b -> [(Node,Node,b)]
+edges :: Graph n a b -> [(n,n,b)]
 edges (Graph _ _ es) = es
 
-nmap :: (a -> c) -> Graph a b -> Graph c b
+nmap :: (a -> c) -> Graph n a b -> Graph n c b
 nmap f (Graph c ns es) = Graph c [(n,f l) | (n,l) <- ns] es
 
-emap :: (b -> c) -> Graph a b -> Graph a c
+emap :: (b -> c) -> Graph n a b -> Graph n a c
 emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es]
 
-newNode :: a -> Graph a b -> (Graph a b,State)
-newNode l (Graph c ns es) = (Graph s ((s,l):ns) es, s)
-  where s = c+1
+newNode :: a -> Graph n a b -> (Graph n a b,n)
+newNode l (Graph (c:cs) ns es) = (Graph cs ((c,l):ns) es, c)
 
-newEdge :: State -> State -> b -> Graph a b -> Graph a b
+newEdge :: n -> n -> b -> Graph n a b -> Graph n a b
 newEdge f t l (Graph c ns es) = Graph c ns ((f,t,l):es)
 
-incoming :: Graph a b -> [(Node,a,[(Node,Node,b)])]
+incoming :: Ord n => Graph n a b -> [(n,a,[(n,n,b)])]
 incoming (Graph _ ns es) = snd $ mapAccumL f (sortBy compareDest es) (sortBy compareFst ns)
   where destIs d (_,t,_) = t == d
         compareDest (_,t1,_) (_,t2,_) = compare t1 t2
 	compareFst p1 p2 = compare (fst p1) (fst p2)
 	f es' (n,l) = let (nes,es'') = span (destIs n) es' in (es'',(n,l,nes))
 
-moveLabelsToNodes_ :: Eq a => Graph () (Maybe a) -> Graph (Maybe a) ()
+moveLabelsToNodes_ :: (Ord n, Eq a) => Graph n () (Maybe a) -> Graph n (Maybe a) ()
 moveLabelsToNodes_ gr@(Graph c _ _) = mimimizeGr2 $ Graph c' (zip ns ls) (concat ess)
   where is = incoming gr
 	(c',is') = mapAccumL fixIncoming c is
 	(ns,ls,ess) = unzip3 (concat is')
 
-fixIncoming :: Eq a => Node -> (Node,(),[(Node,Node,Maybe a)]) -> (Node,[(Node,Maybe a,[(Node,Node,())])])
-fixIncoming next c@(n,(),es) = (next', (n,Nothing,es'):newContexts)
+fixIncoming :: (Eq n, Eq a) => [n] -> (n,(),[(n,n,Maybe a)]) -> ([n],[(n,Maybe a,[(n,n,())])])
+fixIncoming cs c@(n,(),es) = (cs'', (n,Nothing,es'):newContexts)
   where ls = nub $ map getLabel es
-	next' = next + length ls
-	newNodes = zip [next..next'-1] ls
+	(cs',cs'') = splitAt (length ls) cs
+	newNodes = zip cs' ls
 	es' = [ (x,n,()) | x <- map fst newNodes ]
 	-- separate cyclic and non-cyclic edges
 	(cyc,ncyc) = partition (\ (f,_,_) -> f == n) es
@@ -151,22 +145,22 @@ fixIncoming next c@(n,(),es) = (next', (n,Nothing,es'):newContexts)
 		 ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]
 	newContexts = [ (x, l, to x l) | (x,l) <- newNodes ]
 
-getLabel :: (Node,Node,b) -> b
+getLabel :: (n,n,b) -> b
 getLabel (_,_,l) = l
 
-mimimizeGr1 :: Graph () (Maybe a) -> Graph () (Maybe a)
+mimimizeGr1 :: Eq n => Graph n () (Maybe a) -> Graph n () (Maybe a)
 mimimizeGr1 = removeEmptyLoops1
 
-removeEmptyLoops1 :: Graph () (Maybe a) -> Graph () (Maybe a)
+removeEmptyLoops1 :: Eq n => Graph n () (Maybe a) -> Graph n () (Maybe a)
 removeEmptyLoops1 (Graph c ns es) = Graph c ns (filter (not . isEmptyLoop) es)
     where isEmptyLoop (f,t,Nothing) | f == t = True
 	  isEmptyLoop _ = False
 
-mimimizeGr2 :: Graph (Maybe a) () -> Graph (Maybe a) ()
+mimimizeGr2 :: Graph n (Maybe a) () -> Graph n (Maybe a) ()
 mimimizeGr2 = id
 
-removeDuplicateEdges :: Ord b => Graph a b -> Graph a b
-removeDuplicateEdges (Graph c ns es) = Graph c ns (sortNub es)
+removeDuplicateEdges :: (Eq n, Ord b) => Graph n a b -> Graph n a b
+removeDuplicateEdges (Graph c ns es) = Graph c ns (nub es)
 
-reverseGraph :: Graph a b -> Graph a b
+reverseGraph :: Graph n a b -> Graph n a b
 reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]