From d80c71f688b5f4f1893f51c29d1c8b4d93a7d924 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Fri, 26 Sep 2008 09:39:48 +0000
Subject: [PATCH] Changed SRG category renaming to use GF cat + index among CFG
 cats for that GF cat, instead of the old Concrete syntax name + index among
 all CFG cats.

---
 src/GF/Speech/SRG.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 667febcf9..128b459dc 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -117,14 +117,15 @@ mkSRG mkRules preprocess pgf cnc =
 	  srgRules = mkRules cfg }
     where cfg = renameCats (prCId cnc) $ preprocess $ pgfToCFG pgf cnc
 
--- | Renames all external cats C to C_cat, and all internal cats to
---   GrammarName_N where N is an integer.
+-- | Renames all external cats C to C_cat, and all internal cats C_X (where X is any string), 
+--   to C_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)
+                    | otherwise = Map.findWithDefault (error ("renameCats: " ++ c)) c names
         isExternal c = c `Set.member` cfgExternalCats cfg        
-        names = Map.fromList $ zip (allCats cfg) [prefix ++ "_" ++ show x | x <- [0..]]
+        catsByPrefix = buildMultiMap [(takeWhile (/='_') cat, cat) | cat <- allCats cfg]
+        names = Map.fromList [(c,pref++"_"++show i) | (pref,cs) <- catsByPrefix, (c,i) <- zip cs [1..]]
 
 getSpeechLanguage :: PGF -> CId -> Maybe String
 getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language")