GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-06 17:52:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

SRG generation: start categories etc should be checked after category renaming.

Browse Source
This commit is contained in:
bjorn
2008-06-22 21:01:38 +00:00
parent 377d5664c7
commit 9d6e3c7b95
1 changed files with 10 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -66,16 +66,11 @@ type SRGSymbol = Symbol SRGNT Token
type SRGNT = (Cat, Int) type SRGNT = (Cat, Int)
-- | Create a non-left-recursive SRG. -- | Create a compact filtered non-left-recursive SRG.
-- FIXME: the probabilities in the returned makeSimpleSRG :: PGF -> CId -> SRG
-- grammar may be meaningless. makeSimpleSRG = mkSRG cfgToSRG preprocess
makeSimpleSRG :: PGF
-> CId -- ^ Concrete syntax name.
-> SRG
makeSimpleSRG pgf cnc = makeSRG preprocess pgf cnc
where where
preprocess = renameCats (prCId cnc) preprocess = traceStats "After mergeIdentical"
. traceStats "After mergeIdentical"
. mergeIdentical . mergeIdentical
. traceStats "After removeLeftRecursion" . traceStats "After removeLeftRecursion"
. removeLeftRecursion . removeLeftRecursion
@@ -86,6 +81,7 @@ makeSimpleSRG pgf cnc = makeSRG preprocess pgf cnc
. traceStats "After removeCycles" . traceStats "After removeCycles"
. removeCycles . removeCycles
. traceStats "Inital CFG" . traceStats "Inital CFG"
cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g
@@ -96,31 +92,23 @@ stats g = "Categories: " ++ show (countCats g)
makeNonRecursiveSRG :: PGF makeNonRecursiveSRG :: PGF
-> CId -- ^ Concrete syntax name. -> CId -- ^ Concrete syntax name.
-> SRG -> SRG
makeNonRecursiveSRG = mkSRG mkRules makeNonRecursiveSRG = mkSRG cfgToSRG id
where where
mkRules cfg = [SRGRule l [SRGAlt Nothing dummyCFTerm (dfaToSRGItem dfa)] | (l,dfa) <- dfas] cfgToSRG cfg = [SRGRule l [SRGAlt Nothing dummyCFTerm (dfaToSRGItem dfa)] | (l,dfa) <- dfas]
where where
MFA _ dfas = cfgToMFA cfg MFA _ dfas = cfgToMFA cfg
dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re
dummyCFTerm = CFMeta (mkCId "dummy") dummyCFTerm = CFMeta (mkCId "dummy")
dummySRGNT = mapSymbol (\c -> (c,0)) id dummySRGNT = mapSymbol (\c -> (c,0)) id
makeSRG :: (CFG -> CFG) mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
-> PGF mkSRG mkRules preprocess pgf cnc =
-> CId -- ^ Concrete syntax name.
-> SRG
makeSRG preprocess = mkSRG mkRules
where
mkRules = map cfRulesToSRGRule . snd . unzip . allRulesGrouped . preprocess
mkSRG :: (CFG -> [SRGRule]) -> PGF -> CId -> SRG
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 = pgfToCFG pgf cnc where cfg = renameCats (prCId cnc) $ preprocess $ pgfToCFG pgf cnc
-- | Renames all external cats C to C_cat, and all internal cats to -- | Renames all external cats C to C_cat, and all internal cats to
-- GrammarName_N where N is an integer. -- GrammarName_N where N is an integer.