GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-11 20:22:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
bringert
2005-11-01 19:09:04 +00:00
parent a6cd4c131b
commit 928c84b36c
9 changed files with 108 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -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