forked from GitHub/gf-core
Use ENBF to generate SRGS.
This commit is contained in:
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user