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

Use ENBF to generate SRGS.

Browse Source
This commit is contained in:
bringert
2007-01-07 23:58:41 +00:00
parent a4aec2da49
commit 3e9d2b4a2f
2 changed files with 23 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/GF/Speech/PrJSGF.hs
View File

@@ -58,7 +58,7 @@ prJSGF sisr srg@(SRG{grammarName=name,startCat=start,origStartCat=origStart,rule
rule False cat (map prAlt (ebnfSRGAlts rhs))
-- rule False cat (map prAlt rhs)
-- FIXME: use the probability
prAlt (EBnfSRGAlt mp n rhs) = sep [initTag, prItem sisr n rhs, finalTag]
prAlt (EBnfSRGAlt mp n rhs) = sep [initTag, parens (prItem sisr n rhs), finalTag]
-- prAlt (SRGAlt mp n rhs) = initTag <+> prItem sisr n rhs <+> finalTag
where initTag | isEmpty t = empty
| otherwise = text "<NULL>" <+> t

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

@@ -57,7 +57,7 @@ prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
++ topCatRules
++ concatMap ruleToXML rs
ruleToXML (SRGRule cat origCat alts) =
comments ["Category " ++ origCat] ++ [rule cat (prRhs alts)]
comments ["Category " ++ origCat] ++ [rule cat (prRhs (ebnfSRGAlts alts))]
prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)]
-- externally visible rules for each of the GF categories
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
@@ -68,22 +68,28 @@ prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
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]
w = maybe [] (\p -> [("weight", show p)]) mp
t = [tag sisr (profileInitSISR n)]
mkProd :: Maybe SISRFormat -> Bool -> EBnfSRGAlt -> XML
mkProd sisr probs (EBnfSRGAlt mp n rhs) = Tag "item" w (ti ++ [x] ++ tf)
where x = mkItem sisr n rhs
w | probs = maybe [] (\p -> [("weight", show p)]) mp
| otherwise = []
ti = [tag sisr (profileInitSISR n)]
tf = [tag sisr (profileFinalSISR n)]
mkItem :: Maybe SISRFormat -> EBnfSRGItem -> XML
mkItem sisr = f
mkItem :: Maybe SISRFormat -> CFTerm -> EBnfSRGItem -> XML
mkItem sisr cn = f
where
f (REUnion xs) = oneOf (map f xs)
f (REUnion []) = ETag "ruleref" [("special","VOID")]
f (REUnion xs)
| not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)]
| otherwise = oneOf (map f xs)
where (es,nes) = partition isEpsilon xs
f (REConcat []) = ETag "ruleref" [("special","NULL")]
f (REConcat xs) = Tag "item" [] (map f xs)
f (RERepeat x) = Tag "item" [("repeat","0-")] [f x]
f (RESymbol s) = symItem sisr s
-}
f (RESymbol s) = symItem sisr cn s
{-
mkProd :: Maybe SISRFormat -> Bool -> SRGAlt -> XML
mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf)
where xs = mkItem sisr n rhs
@@ -95,6 +101,7 @@ mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf)
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,_)) =
@@ -134,6 +141,8 @@ meta n c = Tag "meta" [("name",n),("content",c)] []
optimizeSRGS :: XML -> XML
optimizeSRGS = bottomUpXML f
where f (Tag "item" [] [x@(Tag "item" [] _)]) = x
where f (Tag "item" [] [x@(Tag "item" _ _)]) = x
f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x
f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs
f (Tag "one-of" [] [x]) = x
f x = x