mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
Rename SRG categories after preprocessing, since pp may introduce illegal category names.
This commit is contained in:
@@ -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.
|
||||||
|
|||||||
@@ -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")
|
||||||
|
|||||||
Reference in New Issue
Block a user