diff --git a/src/GF/Speech/CFGToFiniteState.hs b/src/GF/Speech/CFGToFiniteState.hs index 0f121fec5..444f4bb6e 100644 --- a/src/GF/Speech/CFGToFiniteState.hs +++ b/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 [] = [] diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs index 94ac10f15..31450d9f0 100644 --- a/src/GF/Speech/PrSLF.hs +++ b/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), diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 57d8ec87b..a32da82fe 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/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 -- diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 2c6b26a95..e9a72f0f4 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/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)