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

1 files changed, 24 insertions, 11 deletions

diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index 977e257e8..855ad0132 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -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
-tag Nothing _ = Empty
-tag _ [] = Empty
-tag (Just fmt) ts = Tag "tag" [] [Data (prSISR fmt ts)]
 
+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 (Just fmt) t = case t fmt of
+                     [] -> Empty
+                     ts -> Tag "tag" [] [Data (prSISR ts)]
 
 catFormId :: String -> String
 catFormId = (++ "_cat")