1
0
forked from GitHub/gf-core

Use ENBF to generate SRGS.

This commit is contained in:
bringert
2007-01-07 23:58:41 +00:00
parent 118468ce16
commit 998c20d098
2 changed files with 23 additions and 14 deletions

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 (ebnfSRGAlts rhs))
-- rule False cat (map prAlt rhs) -- rule False cat (map prAlt rhs)
-- FIXME: use the probability -- 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 -- prAlt (SRGAlt mp n rhs) = initTag <+> prItem sisr n rhs <+> finalTag
where initTag | isEmpty t = empty where initTag | isEmpty t = empty
| otherwise = text "<NULL>" <+> t | otherwise = text "<NULL>" <+> t

View File

@@ -57,7 +57,7 @@ prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
++ topCatRules ++ topCatRules
++ concatMap ruleToXML rs ++ concatMap ruleToXML rs
ruleToXML (SRGRule cat origCat alts) = 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)] prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)]
-- externally visible rules for each of the GF categories -- externally visible rules for each of the GF categories
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg] 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 :: String -> [XML] -> XML
rule i = Tag "rule" [("id",i)] rule i = Tag "rule" [("id",i)]
{- mkProd :: Maybe SISRFormat -> Bool -> EBnfSRGAlt -> XML
mkProd :: Maybe SISRFormat -> EBnfSRGAlt -> XML mkProd sisr probs (EBnfSRGAlt mp n rhs) = Tag "item" w (ti ++ [x] ++ tf)
mkProd sisr (EBnfSRGAlt mp n rhs) = Tag "item" w (t ++ xs) where x = mkItem sisr n rhs
where xs = [mkItem sisr rhs] w | probs = maybe [] (\p -> [("weight", show p)]) mp
w = maybe [] (\p -> [("weight", show p)]) mp | otherwise = []
t = [tag sisr (profileInitSISR n)] ti = [tag sisr (profileInitSISR n)]
tf = [tag sisr (profileFinalSISR n)]
mkItem :: Maybe SISRFormat -> EBnfSRGItem -> XML mkItem :: Maybe SISRFormat -> CFTerm -> EBnfSRGItem -> XML
mkItem sisr = f mkItem sisr cn = f
where 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 (REConcat xs) = Tag "item" [] (map f xs)
f (RERepeat x) = Tag "item" [("repeat","0-")] [f x] 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 :: Maybe SISRFormat -> Bool -> SRGAlt -> XML
mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf) mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf)
where xs = mkItem sisr n rhs 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 :: Maybe SISRFormat -> CFTerm -> [Symbol SRGNT Token] -> [XML]
mkItem sisr cn ss = map (symItem sisr cn) ss mkItem sisr cn ss = map (symItem sisr cn) ss
-}
symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
symItem sisr cn (Cat n@(c,_)) = symItem sisr cn (Cat n@(c,_)) =
@@ -134,6 +141,8 @@ meta n c = Tag "meta" [("name",n),("content",c)] []
optimizeSRGS :: XML -> XML optimizeSRGS :: XML -> XML
optimizeSRGS = bottomUpXML f 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 (Tag "one-of" [] [x]) = x
f x = x f x = x