Documented SRGS XML generation. Started working on support for probabilities in SRG generation. Added support for probabilities in for SRGS.

1 files changed, 20 insertions, 14 deletions

diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index dc4e1c126..3604f34cd 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/31 16:48:08 $ 
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- This module prints a CFG as an SRGS XML grammar.
 --
@@ -26,6 +26,7 @@ import GF.Formalism.Utilities (Symbol(..))
 import GF.Conversion.Types
 import GF.Infra.Print
 import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
 
 import Data.Char (toUpper,toLower)
 
@@ -35,9 +36,11 @@ data XML = Data String | Tag String [Attr] [XML] | Comment String
 type Attr = (String,String)
 
 srgsXmlPrinter :: Ident -- ^ Grammar name
-	   -> Options -> CGrammar -> String
-srgsXmlPrinter name opts cfg = prSrgsXml srg ""
-    where srg = makeSRG name opts cfg
+	       -> Options 
+	       -> Maybe Probs
+	       -> CGrammar -> String
+srgsXmlPrinter name opts probs cfg = prSrgsXml srg ""
+    where srg = makeSRG name opts probs cfg
 
 prSrgsXml :: SRG -> ShowS
 prSrgsXml (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
@@ -50,13 +53,12 @@ prSrgsXml (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
 			   "Generated by GF",
 			   "Original start category: " ++ origStart]
 			  ++ map ruleToXML rs)
-    ruleToXML (SRGRule cat origCat rhss) = 
-	rule (prCat cat) (comments ["Category " ++ origCat] ++ [prRhs rhss])
-    prRhs rhss = oneOf (map item (map prAlt rhss))
-    -- FIXME: don't use one-of if there is only one
-    prAlt rhs = map prSymbol rhs
+    ruleToXML (SRGRule cat origCat alts) = 
+	rule (prCat cat) (comments ["Category " ++ origCat] ++ [prRhs alts])
+    prRhs rhss = oneOf (map prAlt rhss)
+    prAlt (SRGAlt p rhs) = item p (map prSymbol rhs)
     prSymbol (Cat c) = Tag "ruleref" [("uri","#" ++ prCat c)] []
-    prSymbol (Tok t) = item [Data (showToken t)]
+    prSymbol (Tok t) = item Nothing [Data (showToken t)]
     prCat c = c -- FIXME: escape something?
     showToken t = t -- FIXME: escape something?
 
@@ -64,9 +66,13 @@ rule :: String -- ^ id
      -> [XML] -> XML
 rule i = Tag "rule" [("id",i)]
 
-item :: [XML] -> XML
-item [x@(Tag "item" _ _)] = x
-item xs = Tag "item" [] xs
+item :: Maybe Double -> [XML] -> XML
+-- FIXME: what is the weight called?
+item mp xs = Tag "item" as cs
+  where as = maybe [] (\p -> [("weight", show p)]) mp
+	cs = case xs of
+		     [Tag "item" [] xs'] -> xs'
+		     _ -> xs
 
 oneOf :: [XML] -> XML
 oneOf [x] = x