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)