Added options to support SRG printing.

3 files changed, 42 insertions, 11 deletions

diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs
index d6780147e..81d9e3140 100644
--- a/src-3.0/GF/Compile/Export.hs
+++ b/src-3.0/GF/Compile/Export.hs
@@ -1,11 +1,13 @@
 module GF.Compile.Export where
 
-import PGF.Data (PGF)
+import PGF.CId
+import PGF.Data (PGF(..))
 import PGF.Raw.Print (printTree)
 import PGF.Raw.Convert (fromPGF)
 import GF.Compile.GFCCtoHaskell
 import GF.Compile.GFCCtoJS
 import GF.Infra.Option
+import GF.Speech.SRGS
 import GF.Text.UTF8
 
 -- top-level access to code generation
@@ -16,10 +18,18 @@ prPGF :: OutputFormat
                 -- module name.
       -> String
 prPGF fmt gr name = case fmt of
-  FmtPGF         -> printPGF gr
-  FmtJavaScript  -> pgf2js gr
-  FmtHaskell     -> grammar2haskell gr name
-  FmtHaskellGADT -> grammar2haskellGADT gr name
+  FmtPGF          -> printPGF gr
+  FmtJavaScript   -> pgf2js gr
+  FmtHaskell      -> grammar2haskell gr name
+  FmtHaskell_GADT -> grammar2haskellGADT gr name
+  FmtSRGS_XML     -> srgsXmlPrinter Nothing gr (outputConcr gr)
+
+-- | Get the name of the concrete syntax to generate output from.
+-- FIXME: there should be an option to change this.
+outputConcr :: PGF -> CId
+outputConcr pgf = case cncnames pgf of
+                    []     -> error "No concrete syntax."
+                    cnc:_  -> cnc
 
 printPGF :: PGF -> String
 printPGF = encodeUTF8 . printTree . fromPGF
diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs
index 3b390e98e..be3ddfadb 100644
--- a/src-3.0/GF/Infra/Option.hs
+++ b/src-3.0/GF/Infra/Option.hs
@@ -78,7 +78,18 @@ data Phase = Preproc | Convert | Compile | Link
 data Encoding = UTF_8 | ISO_8859_1
   deriving (Show,Eq,Ord)
 
-data OutputFormat = FmtPGF | FmtJavaScript | FmtHaskell | FmtHaskellGADT
+data OutputFormat = FmtPGF 
+                  | FmtJavaScript 
+                  | FmtHaskell 
+                  | FmtHaskell_GADT 
+                  | FmtSRGS_XML 
+                  | FmtSRGS_ABNF 
+                  | FmtJSGF 
+                  | FmtGSL 
+                  | FmtVoiceXML
+                  | FmtSLF
+                  | FmtRegExp
+                  | FmtFA
   deriving (Eq,Ord)
 
 data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
@@ -406,7 +417,16 @@ outputFormats =
     [("pgf",          FmtPGF),
      ("js",           FmtJavaScript),
      ("haskell",      FmtHaskell),
-     ("haskell_gadt", FmtHaskellGADT)]
+     ("haskell_gadt", FmtHaskell_GADT),
+     ("srgs",         FmtSRGS_XML),
+     ("srgs_xml",     FmtSRGS_XML),
+     ("srgs_abnf",    FmtSRGS_ABNF),
+     ("jsgf",         FmtJSGF),
+     ("gsl",          FmtGSL),
+     ("vxml",         FmtVoiceXML),
+     ("slf",          FmtSLF),
+     ("regexp",       FmtRegExp),
+     ("fa",           FmtFA)]
 
 instance Show OutputFormat where
     show = lookupShow outputFormats
diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs
index 4e553659b..8967ca495 100644
--- a/src-3.0/GFC.hs
+++ b/src-3.0/GFC.hs
@@ -41,10 +41,11 @@ outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt
         addDir = maybe id (</>) (flag optOutputDir opts)
 
 fmtExtension :: OutputFormat -> String
-fmtExtension FmtPGF         = "pgf"
-fmtExtension FmtJavaScript  = "js"
-fmtExtension FmtHaskell     = "hs"
-fmtExtension FmtHaskellGADT = "hs"
+fmtExtension FmtPGF          = "pgf"
+fmtExtension FmtJavaScript   = "js"
+fmtExtension FmtHaskell      = "hs"
+fmtExtension FmtHaskell_GADT = "hs"
+fmtExtension FmtSRGS_XML     = "grxml"
 
 writeOutputFile :: FilePath -> String -> IOE ()
 writeOutputFile outfile output = ioeIO $