summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Speech/CFG.hs7
-rw-r--r--src/GF/Speech/SRG.hs2
2 files changed, 8 insertions, 1 deletions
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)