GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Added tag-format attribute to SRGS XML when using SISR.

Browse Source
This commit is contained in:
bringert
2006-12-10 20:53:51 +00:00
parent 7e8d0e49b2
commit 51ed253c75
2 changed files with 23 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/GF/Speech/PrSRGS.hs
View File

@@ -29,6 +29,7 @@ import GF.Probabilistic.Probabilistic (Probs)
import Data.Char (toUpper,toLower) import Data.Char (toUpper,toLower)
import Data.List import Data.List
import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
@@ -48,13 +49,14 @@ prSrgsXml sisr (SRG{grammarName=name,startCat=start,
= showsXMLDoc xmlGr = showsXMLDoc xmlGr
where where
root = cfgCatToGFCat origStart root = cfgCatToGFCat origStart
xmlGr = grammar root l ([meta "description" xmlGr = grammar sisr root l $
("SRGS XML speech recognition grammar for " ++ name [meta "description"
++ ". " ++ "Original start category: " ++ origStart), ("SRGS XML speech recognition grammar for " ++ name
meta "generator" ("Grammatical Framework " ++ version ++ ". " ++ "Original start category: " ++ origStart),
++ " (compiled " ++ today ++ ")")] meta "generator" ("Grammatical Framework " ++ version
++ topCatRules ++ " (compiled " ++ today ++ ")")]
++ map ruleToXML rs) ++ topCatRules
++ map ruleToXML rs
ruleToXML (SRGRule cat origCat alts) = ruleToXML (SRGRule cat origCat alts) =
rule (prCat cat) (comments ["Category " ++ origCat] ++ prRhs isList alts) rule (prCat cat) (comments ["Category " ++ origCat] ++ prRhs isList alts)
where isList = False 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] topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- topCats]
where topCats = buildMultiMap [(cfgCatToGFCat origCat, cat) | SRGRule cat origCat _ <- rs] where topCats = buildMultiMap [(cfgCatToGFCat origCat, cat) | SRGRule cat origCat _ <- rs]
it i c = Tag "item" [] [Tag "ruleref" [("uri","#" ++ prCat c)] [], 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 topRule i is = Tag "rule" [("id",i),("scope","public")] is
rule :: String -> [XML] -> XML rule :: String -> [XML] -> XML
@@ -140,14 +142,17 @@ oneOf :: [XML] -> XML
oneOf [x] = x oneOf [x] = x
oneOf xs = Tag "one-of" [] xs oneOf xs = Tag "one-of" [] xs
grammar :: String -- ^ root grammar :: Maybe SISRFormat
-> String -- ^ root
-> String -- ^language -> String -- ^language
-> [XML] -> XML -> [XML] -> XML
grammar root l = Tag "grammar" [("xml:lang", l), grammar sisr root l =
("xmlns","http://www.w3.org/2001/06/grammar"), Tag "grammar" $ [("xml:lang", l),
("version","1.0"), ("xmlns","http://www.w3.org/2001/06/grammar"),
("mode","voice"), ("version","1.0"),
("root",root)] ("mode","voice"),
("root",root)]
++ (if isJust sisr then [("tag-format","semantics/1.0")] else [])
meta :: String -> String -> XML meta :: String -> String -> XML
meta n c = Tag "meta" [("name",n),("content",c)] [] meta n c = Tag "meta" [("name",n),("content",c)] []

5
src/GF/Speech/SISR.hs
View File

@@ -17,7 +17,10 @@ import Data.List
infixl 8 :. infixl 8 :.
infixr 1 := 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 deriving Show
data SISRExpr = SISRExpr := SISRExpr data SISRExpr = SISRExpr := SISRExpr