From 51ed253c7586e3f7b44490fff81a4f76567fd47d Mon Sep 17 00:00:00 2001
From: bringert <bringert@cs.chalmers.se>
Date: Sun, 10 Dec 2006 20:53:51 +0000
Subject: [PATCH] Added tag-format attribute to SRGS XML when using SISR.

---
 src/GF/Speech/PrSRGS.hs | 33 +++++++++++++++++++--------------
 src/GF/Speech/SISR.hs   |  5 ++++-
 2 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index 89014b1d3..09957997c 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -29,6 +29,7 @@ import GF.Probabilistic.Probabilistic (Probs)
 
 import Data.Char (toUpper,toLower)
 import Data.List
+import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
@@ -48,13 +49,14 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start,
     = showsXMLDoc xmlGr
     where
     root = cfgCatToGFCat origStart 
-    xmlGr = grammar root l ([meta "description" 
-                             ("SRGS XML speech recognition grammar for " ++ name
-                              ++ ". " ++ "Original start category: " ++ origStart),
-                             meta "generator" ("Grammatical Framework " ++ version 
-                                               ++ " (compiled " ++ today ++ ")")]
-                            ++ topCatRules
-			    ++ map ruleToXML rs)
+    xmlGr = grammar sisr root l $
+              [meta "description" 
+               ("SRGS XML speech recognition grammar for " ++ name
+                ++ ". " ++ "Original start category: " ++ origStart),
+               meta "generator" ("Grammatical Framework " ++ version 
+                                 ++ " (compiled " ++ today ++ ")")]
+            ++ topCatRules
+	    ++ map ruleToXML rs
     ruleToXML (SRGRule cat origCat alts) = 
 	rule (prCat cat) (comments ["Category " ++ origCat] ++ prRhs isList alts)
       where isList = False 
@@ -67,7 +69,7 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start,
     topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- topCats]
         where topCats = buildMultiMap [(cfgCatToGFCat origCat, cat) | SRGRule cat origCat _ <- rs]
               it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ prCat c)] [],
-                                      tag sisr [(EThis :. i) := (ERef c)]]
+                                      tag sisr [EThis := (ERef c)]]
               topRule i is = Tag "rule" [("id",i),("scope","public")] is
 
 rule :: String -> [XML] -> XML
@@ -140,14 +142,17 @@ oneOf :: [XML] -> XML
 oneOf [x] = x
 oneOf xs = Tag "one-of" [] xs
 
-grammar :: String  -- ^ root
+grammar :: Maybe SISRFormat
+        -> String  -- ^ root
         -> String -- ^language
 	-> [XML] -> XML
-grammar root l = Tag "grammar" [("xml:lang", l),
-                                ("xmlns","http://www.w3.org/2001/06/grammar"),
-			        ("version","1.0"),
-			        ("mode","voice"),
-			        ("root",root)]
+grammar sisr root l = 
+    Tag "grammar" $ [("xml:lang", l),
+                     ("xmlns","http://www.w3.org/2001/06/grammar"),
+		     ("version","1.0"),
+		     ("mode","voice"),
+		     ("root",root)]
+                 ++ (if isJust sisr then [("tag-format","semantics/1.0")] else [])
 
 meta :: String -> String -> XML
 meta n c = Tag "meta" [("name",n),("content",c)] []
diff --git a/src/GF/Speech/SISR.hs b/src/GF/Speech/SISR.hs
index 15ab98027..20c6f7fe4 100644
--- a/src/GF/Speech/SISR.hs
+++ b/src/GF/Speech/SISR.hs
@@ -17,7 +17,10 @@ import Data.List
 infixl 8 :.
 infixr 1 :=
 
-data SISRFormat = SISROld
+data SISRFormat = 
+    -- SISR Working draft 1 April 2003
+    -- http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/
+    SISROld
  deriving Show
 
 data SISRExpr = SISRExpr := SISRExpr