Got GSL generation working.

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)
 
 

src-3.0/GF/Speech/GSL.hs

@@ -1,34 +1,20 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : PrGSL
+-- Module      : GF.Speech.GSL
--- Maintainer  : BB
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/01 20:09:04 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.22 $
 --
 -- 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 PGF.CId
-import GF.Formalism.CFG
+import PGF.Data
-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 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 :: PGF -> CId -> String
-gslPrinter opts s = renderStyle st $ prGSL $ makeSimpleSRG opts s
+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})
+prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))
-    = header $++$ mainCat $++$ foldr ($++$) empty (map prRule rs)
     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) $$
+    mainCat = text ".MAIN" <+> prCat (srgStartCat srg)
-	      text ".MAIN" <+> prCat start
+    prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs)
-    prRule (SRGRule cat origCat rhs) = 
-	comment (prt origCat) $$ 
-        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 = symbol (prCat . fst) (doubleQuotes . showToken)
-prSymbol (Tok t) = doubleQuotes (showToken t)
 
 -- GSL requires an upper case letter in category names
-prCat :: SRGCat -> Doc
+prCat :: Cat -> Doc
-prCat c = text (firstToUpper c)
+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` "-_.:;.,?!()[]{}"

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 ()