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

Use .MAIN for the start category.

Browse Source
This commit is contained in:
bringert
2004-09-15 16:16:34 +00:00
parent a25ee154e7
commit a38f028f04
1 changed files with 6 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/GF/Speech/PrGSL.hs
View File

@@ -77,23 +77,19 @@ cfgToGSL name start =
cfgRulesToGSLRule rs@(r:_) = GSLRule (ruleCat r) (map ruleRhs rs) cfgRulesToGSLRule rs@(r:_) = GSLRule (ruleCat r) (map ruleRhs rs)
mkCatNames :: GSLGrammar -> CatNames mkCatNames :: GSLGrammar -> CatNames
mkCatNames (GSLGrammar name start rules) = mkCatNames (GSLGrammar name start rules) = listToFM (zip lhsCats names)
listToFM (zipWith dotIfStart lhsCats names)
where names = [name ++ "_" ++ show x | x <- [0..]] where names = [name ++ "_" ++ show x | x <- [0..]]
lhsCats = [ c | GSLRule c _ <- rules] lhsCats = [ c | GSLRule c _ <- rules]
dotIfStart c n | c == start = (c, "." ++ n)
| otherwise = (c, n)
prGSLGrammar :: CatNames -> GSLGrammar -> ShowS prGSLGrammar :: CatNames -> GSLGrammar -> ShowS
prGSLGrammar names (GSLGrammar name start g) = prGSLGrammar names (GSLGrammar name start g) =
header . unlinesS (map prGSLrule g) header . mainCat . unlinesS (map prGSLrule g)
where where
header = showString ";GSL2.0" . nl header = showString ";GSL2.0" . nl
. comments ["Nuance speech synthesis grammar for " ++ name, . comments ["Nuance speech recognition grammar for " ++ name,
"Generated by GF", "Generated by GF"] . nl . nl
"Start category: " ++ start mainCat = showString ("; Start category: " ++ start) . nl
++ " (" ++ prGSLCat start ")"] . showString ".MAIN " . prGSLCat start . nl . nl
. nl . nl
prGSLrule (GSLRule cat rhs) = prGSLrule (GSLRule cat rhs) =
showString "; " . prtS cat . nl showString "; " . prtS cat . nl
. prGSLCat cat . sp . wrap "[" (unwordsS (map prGSLAlt rhs)) "]" . nl . prGSLCat cat . sp . wrap "[" (unwordsS (map prGSLAlt rhs)) "]" . nl