msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

6
src-3.0/GF/Speech/CFG.hs
View File

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

20
src-3.0/GF/Speech/SRG.hs
View File

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