msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

SRGS ABNF generation: semicolon after meta decls, no $NULL before initTag since the standard doesn't require it, and it crashes Opera, include tag-format declaration.

Browse Source
This commit is contained in:
bringert
2007-01-21 16:01:36 +00:00
parent d40e559e04
commit 2fcafc2022
1 changed files with 8 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/GF/Speech/PrSRGS_ABNF.hs
View File

@@ -35,6 +35,7 @@ import GF.Today
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe
import Text.PrettyPrint.HughesPJ import Text.PrettyPrint.HughesPJ
import Debug.Trace import Debug.Trace
@@ -48,23 +49,24 @@ srgsAbnfPrinter sisr probs opts s = show $ prABNF sisr probs $ makeSimpleSRG opt
prABNF :: Maybe SISRFormat -> Bool -> SRG -> Doc prABNF :: Maybe SISRFormat -> Bool -> SRG -> Doc
prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage = l, prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage = l,
startCat=start,origStartCat=origStart,rules=rs}) startCat=start,origStartCat=origStart,rules=rs})
= header $++$ mainCat $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs) = header $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
where where
header = text "#ABNF 1.0 UTF-8;" $$ header = text "#ABNF 1.0 UTF-8;" $$
meta "description" meta "description"
("Speech recognition grammar for " ++ name ("Speech recognition grammar for " ++ name
++ ". " ++ "Original start category: " ++ origStart) $$ ++ ". " ++ "Original start category: " ++ origStart) $$
meta "generator" ("Grammatical Framework " ++ version) $$ meta "generator" ("Grammatical Framework " ++ version) $$
text "language" <+> text l <> char ';' language $$ tagFormat $$ mainCat
language = text "language" <+> text l <> char ';'
tagFormat | isJust sisr = text "tag-format" <+> text "<semantics/1.0>" <> char ';'
| otherwise = empty
mainCat = text "root" <+> prCat start <> char ';' mainCat = text "root" <+> prCat start <> char ';'
prRule (SRGRule cat origCat rhs) = prRule (SRGRule cat origCat rhs) =
comment origCat $$ comment origCat $$
rule False cat (map prAlt (ebnfSRGAlts rhs)) rule False cat (map prAlt (ebnfSRGAlts rhs))
-- FIXME: use the probability -- FIXME: use the probability
prAlt (EBnfSRGAlt mp n rhs) = sep [initTag, parens (prItem sisr n rhs), finalTag] prAlt (EBnfSRGAlt mp n rhs) = sep [initTag, parens (prItem sisr n rhs), finalTag]
where initTag | isEmpty t = empty where initTag = tag sisr (profileInitSISR n)
| otherwise = text "$NULL" <+> t
where t = tag sisr (profileInitSISR n)
finalTag = tag sisr (profileFinalSISR n) finalTag = tag sisr (profileFinalSISR n)
topCatRules = [rule True (catFormId tc) (map (it tc) cs) | (tc,cs) <- srgTopCats srg] topCatRules = [rule True (catFormId tc) (map (it tc) cs) | (tc,cs) <- srgTopCats srg]
@@ -119,7 +121,7 @@ rule pub c xs = sep [p <+> prCat c <+> char '=', nest 2 (alts xs) <+> char ';']
where p = if pub then text "public" else empty where p = if pub then text "public" else empty
meta :: String -> String -> Doc meta :: String -> String -> Doc
meta n v = text "meta" <+> text (show n) <+> text "is" <+> text (show v) meta n v = text "meta" <+> text (show n) <+> text "is" <+> text (show v) <> char ';'
-- Pretty-printing utilities -- Pretty-printing utilities