From 2cf7a7d07eaa394c56ca020f7383ba747d9374a3 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Tue, 17 Jun 2008 12:06:27 +0000
Subject: Got GSL generation working.

---
 src-3.0/GF/Compile/Export.hs |   2 +
 src-3.0/GF/Speech/GSL.hs     |  94 +++++++++++++++++++++++++++++++++++
 src-3.0/GF/Speech/PrGSL.hs   | 113 -------------------------------------------
 src-3.0/GFC.hs               |   1 +
 4 files changed, 97 insertions(+), 113 deletions(-)
 create mode 100644 src-3.0/GF/Speech/GSL.hs
 delete mode 100644 src-3.0/GF/Speech/PrGSL.hs

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/GSL.hs b/src-3.0/GF/Speech/GSL.hs
new file mode 100644
index 000000000..637552bf4
--- /dev/null
+++ b/src-3.0/GF/Speech/GSL.hs
@@ -0,0 +1,94 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.Speech.GSL
+--
+-- This module prints a CFG as a Nuance GSL 2.0 grammar.
+--
+-----------------------------------------------------------------------------
+
+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 PGF.Data
+
+import Data.Char (toUpper,toLower)
+import Data.List (partition)
+import Text.PrettyPrint.HughesPJ
+
+width :: Int
+width = 75
+
+gslPrinter :: PGF -> CId -> String
+gslPrinter pgf cnc = renderStyle st $ prGSL $ makeSimpleSRG pgf cnc
+  where st = style { lineLength = width } 
+
+prGSL :: SRG -> Doc
+prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))
+    where
+    header = text ";GSL2.0" $$
+	     comment ("Nuance speech recognition grammar for " ++ srgName srg) $$
+             comment ("Generated by GF") 
+    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
+
+
+prItem :: SRGItem -> Doc
+prItem = f
+  where
+    f (REUnion xs) = (if null es then empty else text "?") <> union (map f nes)
+      where (es,nes) = partition isEpsilon xs
+    f (REConcat [x]) = f x
+    f (REConcat xs) = text "(" <> fsep (map f xs) <> text ")"
+    f (RERepeat x)  = text "*" <> f x
+    f (RESymbol s)  = prSymbol s
+
+union :: [Doc] -> Doc
+union [x] = x
+union xs = text "[" <> fsep xs <> text "]"
+
+prSymbol :: Symbol SRGNT Token -> Doc
+prSymbol = symbol (prCat . fst) (doubleQuotes . showToken)
+
+-- GSL requires an upper case letter in category names
+prCat :: Cat -> Doc
+prCat = text . firstToUpper
+
+
+firstToUpper :: String -> String
+firstToUpper [] = []
+firstToUpper (x:xs) = toUpper x : xs
+
+{-
+rmPunctCFG :: CGrammar -> CGrammar
+rmPunctCFG g = [CFRule c (filter keepSymbol ss) n | CFRule c ss n <- g]
+
+keepSymbol :: Symbol c Token -> Bool
+keepSymbol (Tok t) = not (all isPunct (prt t))
+keepSymbol _ = True
+-}
+
+-- Nuance does not like upper case characters in tokens
+showToken :: Token -> Doc
+showToken = text . map toLower
+
+isPunct :: Char -> Bool
+isPunct c = c `elem` "-_.:;.,?!()[]{}"
+
+comment :: String -> Doc
+comment s = text ";" <+> text s
+
+
+-- Pretty-printing utilities
+
+emptyLine :: Doc
+emptyLine = text ""
+
+($++$) :: Doc -> Doc -> Doc
+x $++$ y = x $$ emptyLine $$ y
diff --git a/src-3.0/GF/Speech/PrGSL.hs b/src-3.0/GF/Speech/PrGSL.hs
deleted file mode 100644
index 248991380..000000000
--- a/src-3.0/GF/Speech/PrGSL.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : PrGSL
--- 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
-
-import GF.Data.Utilities
-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 Data.Char (toUpper,toLower)
-import Data.List (partition)
-import Text.PrettyPrint.HughesPJ
-
-width :: Int
-width = 75
-
-gslPrinter :: Options -> StateGrammar -> String
-gslPrinter opts s = renderStyle st $ prGSL $ makeSimpleSRG opts s
-  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)
-    where
-    header = text ";GSL2.0" $$
-	     comment ("Nuance speech recognition grammar for " ++ name) $$
-             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)
-    -- FIXME: use the probability
-    prAlt (SRGAlt mp _ rhs) = prItem rhs
-
-
-prItem :: SRGItem -> Doc
-prItem = f
-  where
-    f (REUnion xs) = (if null es then empty else text "?") <> union (map f nes)
-      where (es,nes) = partition isEpsilon xs
-    f (REConcat [x]) = f x
-    f (REConcat xs) = text "(" <> fsep (map f xs) <> text ")"
-    f (RERepeat x)  = text "*" <> f x
-    f (RESymbol s)  = prSymbol s
-
-union :: [Doc] -> Doc
-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)
-
--- GSL requires an upper case letter in category names
-prCat :: SRGCat -> Doc
-prCat c = text (firstToUpper c)
-
-
-firstToUpper :: String -> String
-firstToUpper [] = []
-firstToUpper (x:xs) = toUpper x : xs
-
-{-
-rmPunctCFG :: CGrammar -> CGrammar
-rmPunctCFG g = [CFRule c (filter keepSymbol ss) n | CFRule c ss n <- g]
-
-keepSymbol :: Symbol c Token -> Bool
-keepSymbol (Tok t) = not (all isPunct (prt t))
-keepSymbol _ = True
--}
-
--- Nuance does not like upper case characters in tokens
-showToken :: Token -> Doc
-showToken t = text (map toLower (prt t))
-
-isPunct :: Char -> Bool
-isPunct c = c `elem` "-_.:;.,?!()[]{}"
-
-comment :: String -> Doc
-comment s = text ";" <+> text s
-
-
--- Pretty-printing utilities
-
-emptyLine :: Doc
-emptyLine = text ""
-
-($++$) :: Doc -> Doc -> Doc
-x $++$ y = x $$ emptyLine $$ y
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 ()
-- 
cgit v1.2.3