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

More JSGF pretty-printing.

Browse Source
This commit is contained in:
bringert
2006-12-20 21:50:16 +00:00
parent 642809fd3b
commit 514a8d6afa
1 changed files with 15 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/GF/Speech/PrJSGF.hs
View File

@@ -47,18 +47,18 @@ jsgfPrinter name start opts sisr probs cfg = show (prJSGF srg sisr)
prJSGF :: SRG -> Maybe SISRFormat -> Doc prJSGF :: SRG -> Maybe SISRFormat -> Doc
prJSGF srg@(SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs}) sisr prJSGF srg@(SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs}) sisr
= header $$ mainCat $$ vcat topCatRules $$ vcat (map prRule rs) = header $++$ mainCat $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
where where
header = text "#JSGF V1.0 UTF-8;" $$ header = text "#JSGF V1.0 UTF-8;" $$
comment ("JSGF speech recognition grammar for " ++ name) $$ comment ("JSGF speech recognition grammar for " ++ name) $$
comment "Generated by GF" $$ comment "Generated by GF" $$
text ("grammar " ++ name ++ ";") $$ emptyLine text ("grammar " ++ name ++ ";")
mainCat = comment ("Start category: " ++ origStart) $$ mainCat = comment ("Start category: " ++ origStart) $$
rule True "MAIN" [prCat start] $$ emptyLine rule True "MAIN" [prCat start]
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))
rule False cat (map prAlt rhs) $$ emptyLine rule False cat (map prAlt rhs)
-- FIXME: use the probability -- FIXME: use the probability
-- prAlt (EBnfSRGAlt mp n rhs) = tag sisr (profileInitSISR n) . showChar ' '. prItem sisr rhs -- prAlt (EBnfSRGAlt mp n rhs) = tag sisr (profileInitSISR n) . showChar ' '. prItem sisr rhs
prAlt (SRGAlt mp n rhs) = initTag <+> prItem sisr n rhs <+> finalTag prAlt (SRGAlt mp n rhs) = initTag <+> prItem sisr n rhs <+> finalTag
@@ -120,6 +120,15 @@ isPunct c = c `elem` "-_.;.,?!"
comment :: String -> Doc comment :: String -> Doc
comment s = text "//" <+> text s comment s = text "//" <+> text s
rule :: Bool -> SRGCat -> [Doc] -> Doc
rule pub c xs = p <+> prCat c <+> char '='
$$ nest 2 (sep (prepunctuate (text "| ") xs) <+> char ';')
where p = if pub then text "public" else empty
-- Pretty-printing utilities
emptyLine :: Doc emptyLine :: Doc
emptyLine = text "" emptyLine = text ""
@@ -127,7 +136,5 @@ prepunctuate :: Doc -> [Doc] -> [Doc]
prepunctuate _ [] = [] prepunctuate _ [] = []
prepunctuate p (x:xs) = x : map (p <>) xs prepunctuate p (x:xs) = x : map (p <>) xs
rule :: Bool -> SRGCat -> [Doc] -> Doc ($++$) :: Doc -> Doc -> Doc
rule pub c xs = p <+> prCat c <+> char '=' x $++$ y = x $$ emptyLine $$ y
$$ nest 2 (sep (prepunctuate (text "| ") xs) <+> char ';')
where p = if pub then text "public" else empty