Use ENBF to generate SRGS.

2 files changed, 24 insertions, 15 deletions

diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs
index 9d6dca598..8b12443a0 100644
--- a/src/GF/Speech/PrJSGF.hs
+++ b/src/GF/Speech/PrJSGF.hs
@@ -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
diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index 1e188f17e..e6b006e48 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -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)]
-
-mkItem :: Maybe SISRFormat -> EBnfSRGItem -> XML
-mkItem sisr = f
+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 -> 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