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

This commit is contained in:
bjorn
2008-06-22 20:28:39 +00:00
parent 8ffd695a12
commit 6ebf615655
2 changed files with 17 additions and 9 deletions

View File

@@ -169,9 +169,9 @@ removeLeftRecursion gr
retainedLeftRecursive = filter (isLeftRecursive . NonTerminal) $ Set.toList retained retainedLeftRecursive = filter (isLeftRecursive . NonTerminal) $ Set.toList retained
mkCat :: CFSymbol -> CFSymbol -> Cat mkCat :: CFSymbol -> CFSymbol -> Cat
mkCat x y = showSymbol x ++ "-" ++ showSymbol y mkCat x y = showSymbol x ++ "-" ++ showSymbol y
where showSymbol = symbol id show where showSymbol = symbol id show
-- | Get the sets of mutually recursive non-terminals for a grammar. -- | Get the sets of mutually recursive non-terminals for a grammar.
mutRecCats :: Bool -- ^ If true, all categories will be in some set. mutRecCats :: Bool -- ^ If true, all categories will be in some set.

View File

@@ -10,7 +10,6 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
, SRGNT, CFTerm , SRGNT, CFTerm
, makeSRG
, makeSimpleSRG , makeSimpleSRG
, makeNonRecursiveSRG , makeNonRecursiveSRG
, getSpeechLanguage , getSpeechLanguage
@@ -73,9 +72,10 @@ type SRGNT = (Cat, Int)
makeSimpleSRG :: PGF makeSimpleSRG :: PGF
-> CId -- ^ Concrete syntax name. -> CId -- ^ Concrete syntax name.
-> SRG -> SRG
makeSimpleSRG = makeSRG preprocess makeSimpleSRG pgf cnc = makeSRG preprocess pgf cnc
where where
preprocess = traceStats "After mergeIdentical" preprocess = renameCats (prCId cnc)
. traceStats "After mergeIdentical"
. mergeIdentical . mergeIdentical
. traceStats "After removeLeftRecursion" . traceStats "After removeLeftRecursion"
. removeLeftRecursion . removeLeftRecursion
@@ -114,14 +114,22 @@ makeSRG preprocess = mkSRG mkRules
mkRules = map cfRulesToSRGRule . snd . unzip . allRulesGrouped . preprocess mkRules = map cfRulesToSRGRule . snd . unzip . allRulesGrouped . preprocess
mkSRG :: (CFG -> [SRGRule]) -> PGF -> CId -> SRG mkSRG :: (CFG -> [SRGRule]) -> PGF -> CId -> SRG
mkSRG mkRules pgf cnc = mkSRG mkRules pgf cnc =
SRG { srgName = prCId cnc, SRG { srgName = prCId cnc,
srgStartCat = cfgStartCat cfg, srgStartCat = cfgStartCat cfg,
srgExternalCats = cfgExternalCats cfg, srgExternalCats = cfgExternalCats cfg,
srgLanguage = getSpeechLanguage pgf cnc, srgLanguage = getSpeechLanguage pgf cnc,
srgRules = mkRules cfg } srgRules = mkRules cfg }
where cfg = renameExternal $ pgfToCFG pgf cnc where cfg = pgfToCFG pgf cnc
renameExternal cfg' = mapCFGCats (\c -> if c `Set.member` cfgExternalCats cfg' then c ++ "_cat" else c) cfg'
-- | 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 -> CId -> Maybe String
getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language") getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language")