Added --sisr option for including SISR tags in generated SRGs.

src-3.0/GF/Command/Commands.hs

@@ -17,6 +17,7 @@ import PGF.Data ----
 import PGF.Morphology
 import PGF.Quiz
 import GF.Compile.Export
+import GF.Infra.Option (noOptions)
 import GF.Infra.UseIO
 import GF.Data.ErrM ----
 import PGF.ExprSyntax (readExp)
@@ -446,7 +447,7 @@ allCommands pgf = Map.fromList [
            unlines $ [unwords (la:":": map prCId cs) | 
                        la <- optLangs opts, let cs = missingLins pgf (mkCId la)]
      _ -> case valIdOpts "printer" "pgf" opts of
-       v -> prPGF (read v) pgf (prCId (absname pgf))
+       v -> prPGF noOptions (read v) pgf (prCId (absname pgf))
 
    morphos opts s = 
      [lookupMorpho (buildMorpho pgf (mkCId la)) s | la <- optLangs opts]

src-3.0/GF/Compile/Export.hs

@@ -16,19 +16,20 @@ import GF.Text.UTF8
 
 -- top-level access to code generation
 
-prPGF :: OutputFormat 
+prPGF :: Options
+      -> OutputFormat 
       -> PGF 
       -> String -- ^ Output name, for example used for generated Haskell
                 -- module name.
       -> String
-prPGF fmt gr name = case fmt of
+prPGF opts fmt gr name = case fmt of
   FmtPGF          -> printPGF gr
   FmtJavaScript   -> pgf2js gr
   FmtHaskell      -> grammar2haskell gr name
   FmtHaskell_GADT -> grammar2haskellGADT gr name
   FmtBNF          -> prCFG $ pgfToCFG gr (outputConcr gr)
-  FmtSRGS_XML     -> srgsXmlPrinter Nothing gr (outputConcr gr)
-  FmtJSGF         -> jsgfPrinter Nothing gr (outputConcr gr)
+  FmtSRGS_XML     -> srgsXmlPrinter (flag optSISR opts) gr (outputConcr gr)
+  FmtJSGF         -> jsgfPrinter (flag optSISR opts) gr (outputConcr gr)
   FmtVoiceXML     -> grammar2vxml gr (outputConcr gr)
 
 

src-3.0/GF/Infra/Option.hs

@@ -3,7 +3,8 @@ module GF.Infra.Option
      -- * Option types
      Options, ModuleOptions,
      Flags(..), ModuleFlags(..),
-     Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), Optimization(..),
+     Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), 
+     SISRFormat(..), Optimization(..),
      Dump(..), Printer(..), Recomp(..),
      -- * Option parsing 
      parseOptions, parseModuleOptions,
@@ -93,6 +94,13 @@ data OutputFormat = FmtPGF
                   | FmtFA
   deriving (Eq,Ord)
 
+data SISRFormat = 
+    -- | SISR Working draft 1 April 2003
+    --   <http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/>
+    SISR_WD20030401    
+  | SISR_1_0
+ deriving (Show,Eq,Ord)
+
 data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
   deriving (Show,Eq,Ord)
 
@@ -137,6 +145,7 @@ data Flags = Flags {
       optEmitGFO         :: Bool,
       optGFODir          :: FilePath,
       optOutputFormats   :: [OutputFormat],
+      optSISR            :: Maybe SISRFormat,
       optOutputFile      :: Maybe FilePath,
       optOutputDir       :: Maybe FilePath,
       optRecomp          :: Recomp,
@@ -279,6 +288,7 @@ defaultFlags = Flags {
       optEmitGFO         = True,
       optGFODir          = ".",
       optOutputFormats   = [FmtPGF],
+      optSISR            = Nothing,
       optOutputFile      = Nothing,
       optOutputDir       = Nothing,
       optRecomp          = RecompIfNewer,
@@ -383,6 +393,9 @@ optDescr =
                   "Multiple concrete: pgf (default), gar, js, ...",
                   "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
                   "Abstract only: haskell, ..."]),
+     Option [] ["sisr"] (ReqArg sisrFmt "FMT") 
+        (unlines ["Include SISR tags in generated speech recognition grammars.",
+                  "FMT can be one of: old, 1.0"]),
      Option ['o'] ["output-file"] (ReqArg outFile "FILE") 
            "Save output in FILE (default is out.X, where X depends on output format.",
      Option ['D'] ["output-dir"] (ReqArg outDir "DIR") 
@@ -410,6 +423,10 @@ optDescr =
        gfoDir      x = set $ \o -> o { optGFODir = x }
        outFmt      x = readOutputFormat x >>= \f ->
                          set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] }
+       sisrFmt     x = case x of
+                         "old" -> set $ \o -> o { optSISR = Just SISR_WD20030401 }
+                         "1.0" -> set $ \o -> o { optSISR = Just SISR_1_0 }
+                         _     -> fail $ "Unknown SISR format: " ++ show x
        outFile     x = set $ \o -> o { optOutputFile = Just x }
        outDir      x = set $ \o -> o { optOutputDir = Just x }
        recomp      x = set $ \o -> o { optRecomp = x }

src-3.0/GF/Speech/SISR.hs

@@ -12,6 +12,7 @@ import Data.List
 
 import GF.Data.Utilities
 import GF.Infra.Ident
+import GF.Infra.Option (SISRFormat(..))
 import GF.Speech.CFG
 import GF.Speech.SRG (SRGNT)
 import PGF.CId
@@ -19,12 +20,6 @@ import PGF.CId
 import qualified GF.JavaScript.AbsJS   as JS
 import qualified GF.JavaScript.PrintJS as JS
 
-data SISRFormat = 
-    -- SISR Working draft 1 April 2003
-    -- http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/
-    SISROld
- deriving Show
-
 type SISRTag = [JS.DeclOrExpr]
 
 
@@ -62,9 +57,9 @@ profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]
         f (CFVar v) = JS.EVar (var v)
         f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (prCId typ))]
 
-fmtOut SISROld = JS.EVar (JS.Ident "$")
+fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")
 
-fmtRef SISROld c = JS.EVar (JS.Ident ("$" ++ c))
+fmtRef SISR_WD20030401 c = JS.EVar (JS.Ident ("$" ++ c))
 
 args = JS.Ident "a"
 

src-3.0/GFC.hs

@@ -32,7 +32,7 @@ writeOutput :: Options -> OutputFormat-> PGF -> IOE ()
 writeOutput opts fmt pgf =
     do let name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts)
            path = outputFilePath opts fmt name
-           s = prPGF fmt pgf name
+           s = prPGF opts fmt pgf name
        writeOutputFile path s
 
 outputFilePath :: Options -> OutputFormat -> String -> FilePath