From eedd2094580857bcd4d30b301552cc1c48e9ed90 Mon Sep 17 00:00:00 2001 From: bjorn Date: Sun, 9 Nov 2008 14:27:34 +0000 Subject: [PATCH] SRG generation: renameCats now gives new names to all cates used in the grammar, on RHS or LHS. This avoids a crash in non-recursive SRGS generation. The crash happend becase the bottom-up filter has not yet been done when renameCats is called. --- src/GF/Speech/CFG.hs | 7 +++++++ src/GF/Speech/SRG.hs | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/GF/Speech/CFG.hs b/src/GF/Speech/CFG.hs index 52db2827a..254024f5c 100644 --- a/src/GF/Speech/CFG.hs +++ b/src/GF/Speech/CFG.hs @@ -237,6 +237,13 @@ allRulesGrouped = Map.toList . Map.map Set.toList . cfgRules allCats :: CFG -> [Cat] allCats = Map.keys . cfgRules +-- | Gets all categories which have rules or occur in a RHS. +allCats' :: CFG -> [Cat] +allCats' cfg = Set.toList (Map.keysSet (cfgRules cfg) `Set.union` + Set.fromList [c | rs <- Map.elems (cfgRules cfg), + r <- Set.toList rs, + NonTerminal c <- ruleRhs r]) + -- | Gets all rules for the given category. catRules :: CFG -> Cat -> [CFRule] catRules gr c = Set.toList $ Map.findWithDefault Set.empty c (cfgRules gr) diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index 622ba4ca3..03f6c0be7 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -128,7 +128,7 @@ renameCats prefix cfg = mapCFGCats renameCat cfg where renameCat c | isExternal c = c ++ "_cat" | 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)] + 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)