Rename SRG categories after preprocessing, since pp may introduce illegal category names.

src-3.0/GF/Speech/SRG.hs

@@ -10,7 +10,6 @@
 ----------------------------------------------------------------------
 module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
                      , SRGNT, CFTerm
-                     , makeSRG
                      , makeSimpleSRG
                      , makeNonRecursiveSRG
                      , getSpeechLanguage
@@ -73,9 +72,10 @@ type SRGNT = (Cat, Int)
 makeSimpleSRG :: PGF
               -> CId -- ^ Concrete syntax name.
 	      -> SRG
-makeSimpleSRG = makeSRG preprocess 
+makeSimpleSRG pgf cnc = makeSRG preprocess pgf cnc
     where
-      preprocess = traceStats "After mergeIdentical"
+      preprocess =   renameCats (prCId cnc)
+                   . traceStats "After mergeIdentical"
                    . mergeIdentical
                    . traceStats "After removeLeftRecursion"
                    . removeLeftRecursion 
@@ -120,8 +120,16 @@ mkSRG mkRules pgf cnc =
           srgExternalCats = cfgExternalCats cfg,
           srgLanguage = getSpeechLanguage pgf cnc,
 	  srgRules = mkRules cfg }
-    where cfg = renameExternal $ pgfToCFG pgf cnc
-          renameExternal cfg' = mapCFGCats (\c -> if c `Set.member` cfgExternalCats cfg' then c ++ "_cat" else c) cfg'
+    where cfg = pgfToCFG pgf cnc
+
+-- | Renames all external cats C to C_cat, and all internal cats to
+--   GrammarName_N where N is an integer.
+renameCats :: String -> CFG -> CFG
+renameCats prefix cfg = mapCFGCats renameCat cfg
+  where renameCat c | isExternal c = c ++ "_cat"
+                    | otherwise = fromMaybe ("renameCats: " ++ c) (Map.lookup c names)
+        isExternal c = c `Set.member` cfgExternalCats cfg        
+        names = Map.fromList $ zip (allCats cfg) [prefix ++ "_" ++ show x | x <- [0..]]
 
 getSpeechLanguage :: PGF -> CId -> Maybe String
 getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language")