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

Use LCLR algorithm for eliminating left-recursion, with lambda terms in SISR for getting trees right.

Browse Source
This commit is contained in:
bringert
2006-12-20 20:10:15 +00:00
parent c7df9f4167
commit f9621483a0
14 changed files with 541 additions and 308 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/GF/Speech/PrSRGS.hs
View File

@@ -22,7 +22,7 @@ import GF.Infra.Ident
import GF.Today
import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), forestName)
import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), forestName, filterCats)
import GF.Conversion.Types
import GF.Infra.Print
import GF.Infra.Option
@@ -59,17 +59,18 @@ prSrgsXml sisr srg@(SRG{grammarName=name,startCat=start,
++ topCatRules
++ concatMap ruleToXML rs
ruleToXML (SRGRule cat origCat alts) =
comments ["Category " ++ origCat] ++ [rule cat (prRhs $ ebnfSRGAlts alts)]
comments ["Category " ++ origCat] ++ [rule cat (prRhs alts)]
prRhs rhss = [oneOf (map (mkProd sisr) rhss)]
-- externally visible rules for each of the GF categories
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
where it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ c)] [],
tag sisr [(EThis :. catFieldId i) := (ERef c)]]
tag sisr (topCatSISR (catFieldId i) c)]
topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is
rule :: String -> [XML] -> XML
rule i = Tag "rule" [("id",i)]
{-
mkProd :: Maybe SISRFormat -> EBnfSRGAlt -> XML
mkProd sisr (EBnfSRGAlt mp n rhs) = Tag "item" w (t ++ xs)
where xs = [mkItem sisr rhs]
@@ -83,17 +84,29 @@ mkItem sisr = f
f (REConcat xs) = Tag "item" [] (map f xs)
f (RERepeat x) = Tag "item" [("repeat","0-")] [f x]
f (RESymbol s) = symItem sisr s
-}
symItem :: Maybe SISRFormat -> Symbol SRGNT Token -> XML
symItem sisr (Cat n@(c,_)) =
Tag "item" [] [Tag "ruleref" [("uri","#" ++ c)] [], tag sisr (catSISR n)]
symItem _ (Tok t) = Tag "item" [] [Data (showToken t)]
mkProd :: Maybe SISRFormat -> SRGAlt -> XML
mkProd sisr (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf)
where xs = mkItem sisr n rhs
w = maybe [] (\p -> [("weight", show p)]) mp
ti = [tag sisr (profileInitSISR n)]
tf = [tag sisr (profileFinalSISR n)]
tag :: Maybe SISRFormat -> [SISRExpr] -> XML
mkItem :: Maybe SISRFormat -> CFTerm -> [Symbol SRGNT Token] -> [XML]
mkItem sisr cn ss = map (symItem sisr cn) ss
symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
symItem sisr cn (Cat n@(c,_)) =
Tag "item" [] $ [Tag "ruleref" [("uri","#" ++ c)] [], tag sisr (catSISR cn n)]
symItem _ _ (Tok t) = Tag "item" [] [Data (showToken t)]
tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> XML
tag Nothing _ = Empty
tag _ [] = Empty
tag (Just fmt) ts = Tag "tag" [] [Data (prSISR fmt ts)]
tag (Just fmt) t = case t fmt of
[] -> Empty
ts -> Tag "tag" [] [Data (prSISR ts)]
catFormId :: String -> String
catFormId = (++ "_cat")