diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs index 5af2fe1ae..9abdc6789 100644 --- a/src-3.0/GF/Compile/Export.hs +++ b/src-3.0/GF/Compile/Export.hs @@ -11,6 +11,7 @@ import GF.Speech.CFG import GF.Speech.PGFToCFG import GF.Speech.SRGS_XML import GF.Speech.JSGF +import GF.Speech.GSL import GF.Speech.VoiceXML import GF.Text.UTF8 @@ -30,6 +31,7 @@ prPGF opts fmt gr name = case fmt of FmtBNF -> prCFG $ pgfToCFG gr (outputConcr gr) FmtSRGS_XML -> srgsXmlPrinter (flag optSISR opts) gr (outputConcr gr) FmtJSGF -> jsgfPrinter (flag optSISR opts) gr (outputConcr gr) + FmtGSL -> gslPrinter gr (outputConcr gr) FmtVoiceXML -> grammar2vxml gr (outputConcr gr) diff --git a/src-3.0/GF/Speech/PrGSL.hs b/src-3.0/GF/Speech/GSL.hs similarity index 58% rename from src-3.0/GF/Speech/PrGSL.hs rename to src-3.0/GF/Speech/GSL.hs index 248991380..637552bf4 100644 --- a/src-3.0/GF/Speech/PrGSL.hs +++ b/src-3.0/GF/Speech/GSL.hs @@ -1,34 +1,20 @@ ---------------------------------------------------------------------- -- | --- Module : PrGSL --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/11/01 20:09:04 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.22 $ +-- Module : GF.Speech.GSL -- -- This module prints a CFG as a Nuance GSL 2.0 grammar. -- --- FIXME: remove \/ warn \/ fail if there are int \/ string literal --- categories in the grammar ----------------------------------------------------------------------------- -module GF.Speech.PrGSL (gslPrinter) where +module GF.Speech.GSL (gslPrinter) where import GF.Data.Utilities +import GF.Speech.CFG import GF.Speech.SRG import GF.Speech.RegExp import GF.Infra.Ident - -import GF.Formalism.CFG -import GF.Formalism.Utilities (Symbol(..)) -import GF.Conversion.Types -import GF.Infra.Print -import GF.Infra.Option -import GF.Probabilistic.Probabilistic (Probs) -import GF.Compile.ShellState (StateGrammar) +import PGF.CId +import PGF.Data import Data.Char (toUpper,toLower) import Data.List (partition) @@ -37,22 +23,18 @@ import Text.PrettyPrint.HughesPJ width :: Int width = 75 -gslPrinter :: Options -> StateGrammar -> String -gslPrinter opts s = renderStyle st $ prGSL $ makeSimpleSRG opts s +gslPrinter :: PGF -> CId -> String +gslPrinter pgf cnc = renderStyle st $ prGSL $ makeSimpleSRG pgf cnc where st = style { lineLength = width } prGSL :: SRG -> Doc -prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs}) - = header $++$ mainCat $++$ foldr ($++$) empty (map prRule rs) +prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg)) where header = text ";GSL2.0" $$ - comment ("Nuance speech recognition grammar for " ++ name) $$ + comment ("Nuance speech recognition grammar for " ++ srgName srg) $$ comment ("Generated by GF") - mainCat = comment ("Start category: " ++ origStart) $$ - text ".MAIN" <+> prCat start - prRule (SRGRule cat origCat rhs) = - comment (prt origCat) $$ - prCat cat <+> union (map prAlt rhs) + mainCat = text ".MAIN" <+> prCat (srgStartCat srg) + prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs) -- FIXME: use the probability prAlt (SRGAlt mp _ rhs) = prItem rhs @@ -72,12 +54,11 @@ union [x] = x union xs = text "[" <> fsep xs <> text "]" prSymbol :: Symbol SRGNT Token -> Doc -prSymbol (Cat (c,_)) = prCat c -prSymbol (Tok t) = doubleQuotes (showToken t) +prSymbol = symbol (prCat . fst) (doubleQuotes . showToken) -- GSL requires an upper case letter in category names -prCat :: SRGCat -> Doc -prCat c = text (firstToUpper c) +prCat :: Cat -> Doc +prCat = text . firstToUpper firstToUpper :: String -> String @@ -95,7 +76,7 @@ keepSymbol _ = True -- Nuance does not like upper case characters in tokens showToken :: Token -> Doc -showToken t = text (map toLower (prt t)) +showToken = text . map toLower isPunct :: Char -> Bool isPunct c = c `elem` "-_.:;.,?!()[]{}" diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs index a3a0db44d..c663f46c9 100644 --- a/src-3.0/GFC.hs +++ b/src-3.0/GFC.hs @@ -48,6 +48,7 @@ fmtExtension FmtHaskell_GADT = "hs" fmtExtension FmtBNF = "bnf" fmtExtension FmtSRGS_XML = "grxml" fmtExtension FmtJSGF = "jsgf" +fmtExtension FmtGSL = "gsl" fmtExtension FmtVoiceXML = "vxml" writeOutputFile :: FilePath -> String -> IOE ()