Added printer for regular grammars. Changed some foldrs to foldls to improve stack usage.

src/GF/Speech/CFGToFiniteState.hs

@@ -5,14 +5,14 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/12 15:46:44 $ 
+-- > CVS $Date: 2005/09/12 16:10:23 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Approximates CFGs with finite state networks.
 -----------------------------------------------------------------------------
 
-module GF.Speech.CFGToFiniteState (cfgToFA) where
+module GF.Speech.CFGToFiniteState (cfgToFA, makeSimpleRegular) where
 
 import Data.List
 
@@ -27,10 +27,11 @@ import GF.Speech.TransformCFG
 
 cfgToFA :: Ident -- ^ Grammar name
 	-> Options -> CGrammar -> FA () (Maybe String)
-cfgToFA name opts cfg = minimize $ compileAutomaton start rgr
+cfgToFA name opts = minimize . compileAutomaton start . makeSimpleRegular
   where start = getStartCat opts
-	rgr = makeRegular $ removeIdenticalRules $ removeEmptyCats $ cfgToCFRules cfg
 
+makeSimpleRegular :: CGrammar -> CFRules
+makeSimpleRegular = makeRegular . removeIdenticalRules . removeEmptyCats . cfgToCFRules
 
 -- Use the transformation algorithm from \"Regular Approximation of Context-free
 -- Grammars through Approximation\", Mohri and Nederhof, 2000
@@ -99,7 +100,7 @@ compileAutomaton start g = make_fa s [Cat start] f fa''
 							in newTransition (getState a) q1 Nothing fa'''
 				-- a is not recursive
 				Nothing -> let rs = catRules g a
-					       in foldr (\ (CFRule _ b _) -> make_fa q0 b q1) fa rs
+					       in foldl (\fa -> \ (CFRule _ b _) -> make_fa q0 b q1 fa) fa rs
 		   (x:beta) -> let (fa',q) = newState () fa
 				in make_fa q beta q1 $ make_fa q0 [x] q fa'
 	addStatesForCats [] fa = (fa,[])
@@ -164,7 +165,7 @@ equivalenceClasses r = equivalenceClasses_ (nub (map fst r)) r
 --
 
 foldFuns :: [a -> a] -> a -> a
-foldFuns fs x = foldr ($) x fs
+foldFuns fs x = foldl (flip ($)) x fs
 
 safeInit :: [a] -> [a]
 safeInit [] = []

src/GF/Speech/PrSLF.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/12 15:46:44 $ 
+-- > CVS $Date: 2005/09/12 16:10:23 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- This module converts a CFG to an SLF finite-state network
 -- for use with the ATK recognizer. The SLF format is described
@@ -18,7 +18,7 @@
 -- categories in the grammar
 -----------------------------------------------------------------------------
 
-module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,faGraphvizPrinter) where
+module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,faGraphvizPrinter,regularPrinter) where
 
 import GF.Speech.SRG
 import GF.Speech.TransformCFG
@@ -27,12 +27,13 @@ import GF.Speech.FiniteState
 import GF.Infra.Ident
 
 import GF.Formalism.CFG
-import GF.Formalism.Utilities (Symbol(..))
+import GF.Formalism.Utilities (Symbol(..),symbol)
 import GF.Conversion.Types
 import GF.Infra.Print
 import GF.Infra.Option
 
 import Data.Char (toUpper,toLower)
+import Data.List
 import Data.Maybe (fromMaybe)
 
 import Data.Graph.Inductive (emap,nmap)
@@ -62,6 +63,15 @@ faGraphvizPrinter :: Ident -- ^ Grammar name
 faGraphvizPrinter name opts cfg = 
     graphviz (nmap (const "") $ emap (fromMaybe "") $ asGraph $ cfgToFA name opts cfg) (prIdent name) (8.5,11.0) (1,1) Landscape
 
+-- | Convert the grammar to a regular grammar and print it in BNF
+regularPrinter :: CGrammar -> String
+regularPrinter = prCFRules . makeSimpleRegular
+  where
+  prCFRules :: CFRules -> String
+  prCFRules g = unlines [ c ++ " ::= " ++ join " | " (map (showRhs . ruleRhs) rs) | (c,rs) <- g]
+  join g = concat . intersperse g
+  showRhs = unwords . map (symbol id show)
+
 automatonToSLF :: FA (Maybe String) () -> SLF
 automatonToSLF fa = 
     SLF { slfNodes = map mkSLFNode (states fa), 

src/GF/Speech/TransformCFG.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/12 15:46:44 $ 
+-- > CVS $Date: 2005/09/12 16:10:23 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.20 $
+-- > CVS $Revision: 1.21 $
 --
 --  This module does some useful transformations on CFGs.
 --
@@ -135,7 +135,6 @@ anyUsedBy cs (CFRule _ ss _) = any (`elem` cs) (filterCats ss)
 mkName :: String -> Name
 mkName n = Name (IC n) []
 
-
 --
 -- * Utilities
 --

src/GF/UseGrammar/Custom.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/12 15:46:44 $ 
+-- > CVS $Date: 2005/09/12 16:10:24 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.71 $
+-- > CVS $Revision: 1.72 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -57,7 +57,7 @@ import GF.Canon.MkGFC
 import GF.CF.CFtoSRG
 import GF.Speech.PrGSL (gslPrinter)
 import GF.Speech.PrJSGF (jsgfPrinter)
-import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,faGraphvizPrinter)
+import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,faGraphvizPrinter,regularPrinter)
 
 import GF.Data.Zipper
 
@@ -247,6 +247,7 @@ customGrammarPrinter =
   ,(strCI "fa_graphviz", \s -> let opts = stateOptions s
                                    name = cncId s
                                  in faGraphvizPrinter name opts $ stateCFG s)
+  ,(strCI "regular", regularPrinter . stateCFG)
   ,(strCI "plbnf",   prLBNF True)
   ,(strCI "lbnf",    prLBNF False)
   ,(strCI "bnf",     prBNF False)