From e1d90c00b9cc09b81b11716a2085213d2e384ce0 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Tue, 30 Sep 2008 09:32:16 +0000
Subject: [PATCH] SRG conversion: print CFG when a unknown cat is found in
 renameCats. Do filtering in ebnf printer.

---
 src/GF/Speech/GSL.hs       |  2 +-
 src/GF/Speech/JSGF.hs      |  2 +-
 src/GF/Speech/SRG.hs       | 19 +++++++++++++------
 src/GF/Speech/SRGS_ABNF.hs |  2 +-
 src/GF/Speech/SRGS_XML.hs  |  2 +-
 5 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/src/GF/Speech/GSL.hs b/src/GF/Speech/GSL.hs
index 637552bf4..5acf2476e 100644
--- a/src/GF/Speech/GSL.hs
+++ b/src/GF/Speech/GSL.hs
@@ -24,7 +24,7 @@ width :: Int
 width = 75
 
 gslPrinter :: PGF -> CId -> String
-gslPrinter pgf cnc = renderStyle st $ prGSL $ makeSimpleSRG pgf cnc
+gslPrinter pgf cnc = renderStyle st $ prGSL $ makeNonLeftRecursiveSRG pgf cnc
   where st = style { lineLength = width } 
 
 prGSL :: SRG -> Doc
diff --git a/src/GF/Speech/JSGF.hs b/src/GF/Speech/JSGF.hs
index dc9f4170a..171d859a4 100644
--- a/src/GF/Speech/JSGF.hs
+++ b/src/GF/Speech/JSGF.hs
@@ -32,7 +32,7 @@ width = 75
 jsgfPrinter :: Maybe SISRFormat
 	    -> PGF 
             -> CId -> String
-jsgfPrinter sisr pgf cnc = renderStyle st $ prJSGF sisr $ makeSimpleSRG pgf cnc
+jsgfPrinter sisr pgf cnc = renderStyle st $ prJSGF sisr $ makeNonLeftRecursiveSRG pgf cnc
   where st = style { lineLength = width }
 
 prJSGF :: Maybe SISRFormat -> SRG -> Doc
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 107d81e10..64ec8f78b 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -13,7 +13,7 @@ module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
                      , ebnfPrinter
                      , nonLeftRecursivePrinter
                      , regularPrinter
-                     , makeSimpleSRG
+                     , makeNonLeftRecursiveSRG
                      , makeNonRecursiveSRG
                      , getSpeechLanguage
                      , isExternalCat
@@ -69,13 +69,19 @@ type SRGNT = (Cat, Int)
 
 
 ebnfPrinter :: Maybe SISRFormat -> PGF -> CId -> String
-ebnfPrinter sisr pgf cnc = prSRG sisr $ makeSRG id pgf cnc
+ebnfPrinter sisr pgf cnc = prSRG sisr $ makeSRG preprocess pgf cnc
+    where
+      preprocess =   mergeIdentical
+                   . topDownFilter
+                   . bottomUpFilter
 
 nonLeftRecursivePrinter :: Maybe SISRFormat -> PGF -> CId -> String
-nonLeftRecursivePrinter sisr pgf cnc = prSRG sisr $ makeSRG removeLeftRecursion pgf cnc
+nonLeftRecursivePrinter sisr pgf cnc = prSRG sisr $ makeNonLeftRecursiveSRG pgf cnc
 
 regularPrinter :: PGF -> CId -> String
 regularPrinter pgf cnc = prSRG Nothing $ makeSRG makeRegular pgf cnc
+    where
+      preprocess = makeRegular
 
 makeSRG :: (CFG -> CFG) -> PGF -> CId -> SRG
 makeSRG = mkSRG cfgToSRG
@@ -83,8 +89,8 @@ makeSRG = mkSRG cfgToSRG
       cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
 
 -- | Create a compact filtered non-left-recursive SRG. 
-makeSimpleSRG :: PGF -> CId -> SRG
-makeSimpleSRG  = makeSRG preprocess
+makeNonLeftRecursiveSRG :: PGF -> CId -> SRG
+makeNonLeftRecursiveSRG  = makeSRG preprocess
     where
       preprocess =   traceStats "After mergeIdentical"
                    . mergeIdentical
@@ -130,10 +136,11 @@ mkSRG mkRules preprocess pgf cnc =
 renameCats :: String -> CFG -> CFG
 renameCats prefix cfg = mapCFGCats renameCat cfg
   where renameCat c | isExternal c = c ++ "_cat"
-                    | otherwise = Map.findWithDefault (error ("renameCats: " ++ c)) c names
+                    | otherwise = Map.findWithDefault (badCat c) c names
         isExternal c = c `Set.member` cfgExternalCats cfg        
         catsByPrefix = buildMultiMap [(takeWhile (/='_') cat, cat) | cat <- allCats cfg, not (isExternal cat)]
         names = Map.fromList [(c,pref++"_"++show i) | (pref,cs) <- catsByPrefix, (c,i) <- zip cs [1..]]
+        badCat c = error ("GF.Speech.SRG.renameCats: " ++ c ++ "\n" ++ prCFG cfg)
 
 getSpeechLanguage :: PGF -> CId -> Maybe String
 getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language")
diff --git a/src/GF/Speech/SRGS_ABNF.hs b/src/GF/Speech/SRGS_ABNF.hs
index 28f4b5684..544628a25 100644
--- a/src/GF/Speech/SRGS_ABNF.hs
+++ b/src/GF/Speech/SRGS_ABNF.hs
@@ -38,7 +38,7 @@ width = 75
 
 srgsAbnfPrinter :: Maybe SISRFormat
 	        -> PGF -> CId -> String
-srgsAbnfPrinter sisr pgf cnc = showDoc $ prABNF sisr $ makeSimpleSRG pgf cnc
+srgsAbnfPrinter sisr pgf cnc = showDoc $ prABNF sisr $ makeNonLeftRecursiveSRG pgf cnc
 
 srgsAbnfNonRecursivePrinter :: PGF -> CId -> String
 srgsAbnfNonRecursivePrinter pgf cnc = showDoc $ prABNF Nothing $ makeNonRecursiveSRG pgf cnc
diff --git a/src/GF/Speech/SRGS_XML.hs b/src/GF/Speech/SRGS_XML.hs
index 33e2d0374..5846e3157 100644
--- a/src/GF/Speech/SRGS_XML.hs
+++ b/src/GF/Speech/SRGS_XML.hs
@@ -23,7 +23,7 @@ import qualified Data.Map as Map
 
 srgsXmlPrinter :: Maybe SISRFormat 
                -> PGF -> CId -> String
-srgsXmlPrinter sisr pgf cnc = prSrgsXml sisr $ makeSimpleSRG pgf cnc
+srgsXmlPrinter sisr pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG pgf cnc
 
 srgsXmlNonRecursivePrinter :: PGF -> CId -> String
 srgsXmlNonRecursivePrinter pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG pgf cnc