Prepared for generation of finite automata in C.

src/GF/Speech/CFGToFiniteState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 17:13:13 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- Approximates CFGs with finite state networks.
 -----------------------------------------------------------------------------
@@ -28,7 +28,7 @@ import GF.Speech.Relation
 import GF.Speech.TransformCFG
 
 cfgToFA :: Ident -- ^ Grammar name
-	-> Options -> CGrammar -> NFA String
+	-> Options -> CGrammar -> DFA String
 cfgToFA name opts = minimize . compileAutomaton start . makeSimpleRegular
   where start = getStartCat opts
 

src/GF/Speech/FiniteState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/27 09:16:30 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.15 $
+-- > CVS $Revision: 1.16 $
 --
 -- A simple finite state network module.
 -----------------------------------------------------------------------------
@@ -19,6 +19,7 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA,
 			      newState, newTransition,
 			      mapStates, mapTransitions,
 			      moveLabelsToNodes, minimize,
+                              dfa2nfa,
 			      prFAGraphviz) where
 
 import Data.List
@@ -36,7 +37,7 @@ data FA n a b = FA (Graph n a b) n [n]
 
 type NFA a = FA State () (Maybe a)
 
-type DFA a = FA [State] () a
+type DFA a = FA State () a
 
 
 startState :: FA n a b -> n
@@ -72,8 +73,8 @@ mapStates f = onGraph (nmap f)
 mapTransitions :: (b -> c) -> FA n a b -> FA n a c
 mapTransitions f = onGraph (emap f)
 
-minimize :: Ord a => NFA a -> NFA a
+minimize :: Ord a => NFA a -> DFA a
-minimize = dfa2nfa . determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
+minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
 
 onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d
 onGraph f (FA g s ss) = FA (f g) s ss
@@ -114,11 +115,11 @@ alphabet = nub . catMaybes . map getLabel . edges
 determinize :: Ord a => NFA a -> DFA a
 determinize (FA g s f) = let (ns,es) = h [start] [] []
                              final = filter (not . null . (f `intersect`)) ns
- 		          in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start final
+                             fa = FA (Graph undefined [(n,()) | n <- ns] es) start final
+ 		          in numberStates fa
   where out = outgoing g
 	start = closure out [s]
 	isDFAFinal n = not (null (f `intersect` n))
-	freshDFANodes (Graph ns _ _) = map (:[]) ns
 	-- Get the new DFA states and edges produced by a set of DFA states.
 	new ns = unzip [ (s, (n,s,c)) | n <- ns, (c,s) <- reachable out n]
 	h currentStates oldStates oldEdges 
@@ -128,6 +129,14 @@ determinize (FA g s f) = let (ns,es) = h [start] [] []
 		  allOldStates = currentStates ++ oldStates
 		  newStates' = nub newStates \\ allOldStates
 
+numberStates :: (Ord x,Enum y) => FA x a b -> FA y a b
+numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs'
+    where (ns,rest) = splitAt (length (nodes g)) $ [toEnum 0 .. ]
+          newNodes = zip (map fst (nodes g)) ns
+	  newName n = lookup' n newNodes
+          s' = newName s
+          fs' = map newName fs
+
 -- | Get all the nodes reachable from a set of nodes by only empty edges.
 closure :: Eq n => Outgoing n a (Maybe b) -> [n] -> [n]
 closure out = fix closure_
@@ -146,15 +155,7 @@ reverseNFA (FA g s fs) = FA g''' s' [s]
 	  g''' = newEdges [(s',f,Nothing) | f <- fs] g''
 
 dfa2nfa :: DFA a -> NFA a
-dfa2nfa (FA (Graph _ ns es) s fs) = FA (Graph c ns' es') s' fs'
+dfa2nfa = mapTransitions Just
-    where newNodes = zip (map fst ns) [0..]
-	  newNode n = lookup' n newNodes
-	  c = [length ns..]  
-	  ns' = [ (n,()) | (_,n) <- newNodes ]
-	  es' = [ (newNode f, newNode t,Just l) | (f,t,l) <- es]
-	  s' = newNode s
-	  fs' = map newNode fs
-	  
 
 --
 -- * Visualization

src/GF/Speech/Graph.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 17:13:13 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- A simple graph module.
 -----------------------------------------------------------------------------
@@ -16,7 +16,7 @@ module GF.Speech.Graph ( Graph(..), Node, Edge, Incoming, Outgoing
                         , nmap, emap, newNode, newEdge, newEdges
                         , incoming, outgoing, getOutgoing
                         , getFrom, getTo, getLabel
-                        , reverseGraph                             
+                        , reverseGraph, renameNodes
                        ) where
 
 import GF.Data.Utilities
@@ -41,9 +41,11 @@ nodes (Graph _ ns _) = ns
 edges :: Graph n a b -> [Edge n b]
 edges (Graph _ _ es) = es
 
+-- | Map a function over the node label.s
 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
 
+-- | Map a function over the edge labels.
 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]
 
@@ -86,3 +88,12 @@ getLabel (_,_,l) = l
 reverseGraph :: Graph n a b -> Graph n a b
 reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]
 
+
+-- | Re-name the nodes in the graph.
+renameNodes :: (n -> m) -- ^ renaming function
+            -> [m] -- ^ infinite supply of fresh node names, to
+                   --   use when adding nodes in the future.
+            -> Graph n a b -> Graph m a b
+renameNodes newName c (Graph _ ns es) = Graph c ns' es'
+    where ns' = [ (newName n,x) | (n,x) <- ns ]
+	  es' = [ (newName f, newName t, l) | (f,t,l) <- es]

src/GF/Speech/PrFA.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/10 14:19:33 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- This module prints finite automata and regular grammars 
 -- for a context-free grammar.
@@ -16,7 +16,7 @@
 -- categories in the grammar
 -----------------------------------------------------------------------------
 
-module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter) where
+module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) where
 
 import GF.Data.Utilities
 import GF.Conversion.Types
@@ -37,7 +37,7 @@ import Data.Maybe (fromMaybe)
 faGraphvizPrinter :: Ident -- ^ Grammar name
 		   -> Options -> CGrammar -> String
 faGraphvizPrinter name opts cfg = 
-    prFAGraphviz (mapStates (const "") $ mapTransitions (fromMaybe "") $ cfgToFA name opts cfg)
+    prFAGraphviz $ mapStates (const "") $ cfgToFA name opts cfg
 
 
 -- | Convert the grammar to a regular grammar and print it in BNF
@@ -48,3 +48,10 @@ regularPrinter = prCFRules . makeSimpleRegular
   prCFRules g = unlines [ c ++ " ::= " ++ join " | " (map (showRhs . ruleRhs) rs) | (c,rs) <- g]
   join g = concat . intersperse g
   showRhs = unwords . map (symbol id show)
+
+faCPrinter :: Ident -- ^ Grammar name
+	   -> Options -> CGrammar -> String
+faCPrinter name opts cfg = fa2c $ cfgToFA name opts cfg
+
+fa2c :: DFA String -> String
+fa2c fa = undefined

src/GF/Speech/PrSLF.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/10 14:19:33 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.11 $
+-- > CVS $Revision: 1.12 $
 --
 -- This module converts a CFG to an SLF finite-state network
 -- for use with the ATK recognizer. The SLF format is described
@@ -48,12 +48,12 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
 
 slfPrinter :: Ident -- ^ Grammar name
 	   -> Options -> CGrammar -> String
-slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ cfgToFA name opts cfg) ""
+slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg) ""
 
 slfGraphvizPrinter :: Ident -- ^ Grammar name
 		   -> Options -> CGrammar -> String
 slfGraphvizPrinter name opts cfg = 
-    prFAGraphviz (mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ cfgToFA name opts cfg)
+    prFAGraphviz $ mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg
 
 automatonToSLF :: FA State (Maybe String) () -> SLF
 automatonToSLF fa = 

src/GF/UseGrammar/Custom.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/10 14:19:33 $ 
+-- > CVS $Date: 2005/11/10 16:43:45 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.83 $
+-- > CVS $Revision: 1.84 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -59,7 +59,7 @@ import GF.Speech.PrGSL (gslPrinter)
 import GF.Speech.PrJSGF (jsgfPrinter)
 import GF.Speech.PrSRGS (srgsXmlPrinter)
 import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter)
-import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter)
+import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter)
 
 import GF.Data.Zipper
 
@@ -261,6 +261,9 @@ customGrammarPrinter =
   ,(strCI "fa_graphviz", \s -> let opts = stateOptions s
                                    name = cncId s
                                  in faGraphvizPrinter name opts $ stateCFG s)
+  ,(strCI "fa_c", \s -> let opts = stateOptions s
+                            name = cncId s
+                        in faCPrinter name opts $ stateCFG s)
   ,(strCI "regular", regularPrinter . stateCFG)
   ,(strCI "plbnf",   prLBNF True)
   ,(strCI "lbnf",    prLBNF False)