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

Produce less verbose SRGS XML, by eliminating redundant item tags.

Browse Source
This commit is contained in:
bringert
2007-06-26 12:19:30 +00:00
parent 8e012e656d
commit 7eaa2af27c
1 changed files with 9 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -35,7 +35,6 @@ 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
srgsXmlPrinter :: Maybe SISRFormat srgsXmlPrinter :: Maybe SISRFormat
-> Bool -- ^ Include probabilities -> Bool -- ^ Include probabilities
-> Options -> Options
@@ -64,8 +63,8 @@ prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)] prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)]
-- externally visible rules for each of the GF categories -- externally visible rules for each of the GF categories
topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg] topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
where it i c = Tag "item" [] [ETag "ruleref" [("uri","#" ++ c)], where it i c = Tag "item" [] ([ETag "ruleref" [("uri","#" ++ c)]]
tag sisr (topCatSISR c)] ++ tag sisr (topCatSISR c))
topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is
rule :: String -> [XML] -> XML rule :: String -> [XML] -> XML
@@ -76,8 +75,8 @@ mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ [x] ++ tf)
where x = mkItem sisr n rhs where x = mkItem sisr n rhs
w | probs = maybe [] (\p -> [("weight", show p)]) mp w | probs = maybe [] (\p -> [("weight", show p)]) mp
| otherwise = [] | otherwise = []
ti = [tag sisr (profileInitSISR n)] ti = tag sisr (profileInitSISR n)
tf = [tag sisr (profileFinalSISR n)] tf = tag sisr (profileFinalSISR n)
mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML
mkItem sisr cn = f mkItem sisr cn = f
@@ -108,14 +107,14 @@ mkItem sisr cn ss = map (symItem sisr cn) ss
symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
symItem sisr cn (Cat n@(c,_)) = symItem sisr cn (Cat n@(c,_)) =
Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)], tag sisr (catSISR cn n)] Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n)
symItem _ _ (Tok t) = Tag "item" [] [Data (showToken t)] symItem _ _ (Tok t) = Tag "item" [] [Data (showToken t)]
tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> XML tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> [XML]
tag Nothing _ = Empty tag Nothing _ = []
tag (Just fmt) t = case t fmt of tag (Just fmt) t = case t fmt of
[] -> Empty [] -> []
ts -> Tag "tag" [] [Data (prSISR ts)] ts -> [Tag "tag" [] [Data (prSISR ts)]]
catFormId :: String -> String catFormId :: String -> String
catFormId = (++ "_cat") catFormId = (++ "_cat")