Added --output-format=ebnf.

src/GF/Compile/Export.hs

@@ -14,6 +14,7 @@ import GF.Speech.SRGS_ABNF
 import GF.Speech.SRGS_XML
 import GF.Speech.JSGF
 import GF.Speech.GSL
+import GF.Speech.SRG (ebnfPrinter)
 import GF.Speech.VoiceXML
 import GF.Speech.SLF
 import GF.Speech.PrRegExp
@@ -37,6 +38,7 @@ exportPGF opts fmt pgf =
       FmtProlog       -> multi "pl"  grammar2prolog 
       FmtProlog_Abs   -> multi "pl"  grammar2prolog_abs 
       FmtBNF          -> single "bnf"   bnfPrinter
+      FmtEBNF         -> single "ebnf"  ebnfPrinter
       FmtNoLR         -> single "bnf"   nonLeftRecursivePrinter
       FmtRegular      -> single "bnf"   regularPrinter
       FmtFCFG         -> single "fcfg"  fcfgPrinter

src/GF/Infra/Option.hs

@@ -87,6 +87,7 @@ data OutputFormat = FmtPGF
                   | FmtProlog
                   | FmtProlog_Abs
                   | FmtBNF
+                  | FmtEBNF
                   | FmtRegular
                   | FmtNoLR
                   | FmtFCFG
@@ -458,6 +459,7 @@ outputFormats =
      ("prolog",       FmtProlog),
      ("prolog_abs",   FmtProlog_Abs),
      ("bnf",          FmtBNF),
+     ("ebnf",         FmtEBNF),
      ("regular",      FmtRegular),
      ("nolr",         FmtNoLR),
      ("fcfg",         FmtFCFG),

src/GF/Speech/PrRegExp.hs

@@ -14,13 +14,13 @@ import GF.Speech.RegExp
 import PGF
 
 regexpPrinter :: PGF -> CId -> String
-regexpPrinter pgf cnc = (++"\n") $ prRE $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc
+regexpPrinter pgf cnc = (++"\n") $ prRE id $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc
 
 multiRegexpPrinter :: PGF -> CId -> String
 multiRegexpPrinter pgf cnc = prREs $ mfa2res $ cfgToMFA $ pgfToCFG pgf cnc
 
 prREs :: [(String,RE CFSymbol)] -> String
-prREs res = unlines [l ++ " = " ++ prRE (mapRE showLabel re) | (l,re) <- res]
+prREs res = unlines [l ++ " = " ++ prRE id (mapRE showLabel re) | (l,re) <- res]
   where showLabel = symbol (\l -> "<" ++ l ++ ">") id
 
 mfa2res :: MFA -> [(String,RE CFSymbol)]

src/GF/Speech/RegExp.hs

@@ -130,14 +130,14 @@ symbolsRE (RESymbol x) = [x]
 
 -- Debugging
 
-prRE :: RE String -> String
+prRE :: (a -> String) -> RE a -> String
 prRE = prRE' 0
 
-prRE' _ (REUnion []) = "<NULL>"
-prRE' n (REUnion xs) = p n 1 (concat (intersperse " | " (map (prRE' 1) xs)))
-prRE' n (REConcat xs) = p n 2 (unwords (map (prRE' 2) xs))
-prRE' n (RERepeat x) = p n 3 (prRE' 3 x) ++ "*"
-prRE' _ (RESymbol s) = s
+prRE' _ _ (REUnion []) = "<NULL>"
+prRE' n f (REUnion xs) = p n 1 (concat (intersperse " | " (map (prRE' 1 f) xs)))
+prRE' n f (REConcat xs) = p n 2 (unwords (map (prRE' 2 f) xs))
+prRE' n f (RERepeat x) = p n 3 (prRE' 3 f x) ++ "*"
+prRE' _ f (RESymbol s) = f s
 
 p n m s | n >= m = "(" ++ s ++ ")"
         | True = s

src/GF/Speech/SRG.hs

@@ -10,6 +10,7 @@
 ----------------------------------------------------------------------
 module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
                      , SRGNT, CFTerm
+                     , ebnfPrinter
                      , makeSimpleSRG
                      , makeNonRecursiveSRG
                      , getSpeechLanguage
@@ -65,9 +66,17 @@ type SRGSymbol = Symbol SRGNT Token
 type SRGNT = (Cat, Int)
 
 
+ebnfPrinter :: PGF -> CId -> String
+ebnfPrinter pgf cnc = prSRG $ makeSRG id pgf cnc
+
+makeSRG :: (CFG -> CFG) -> PGF -> CId -> SRG
+makeSRG preproces = mkSRG cfgToSRG id
+    where
+      cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
+
 -- | Create a compact filtered non-left-recursive SRG. 
 makeSimpleSRG :: PGF -> CId -> SRG
-makeSimpleSRG  = mkSRG cfgToSRG preprocess
+makeSimpleSRG  = makeSRG preprocess
     where
       preprocess =   traceStats "After mergeIdentical"
                    . mergeIdentical
@@ -80,7 +89,6 @@ makeSimpleSRG  = mkSRG cfgToSRG preprocess
                    . traceStats "After removeCycles"
                    . removeCycles 
                    . traceStats "Inital CFG"
-      cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
 
 traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g
 
@@ -165,6 +173,13 @@ ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map
 -- * Utilities for building and printing SRGs
 --
 
+prSRG :: SRG -> String
+prSRG = unlines . map prRule . srgRules
+    where 
+      prRule (SRGRule c alts) = c ++ " ::= " ++ unwords (intersperse "|" (map prAlt alts))
+      prAlt (SRGAlt _ _ rhs) = prRE prSym rhs
+      prSym = symbol fst (\t -> "\""++ t ++"\"")
+
 lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt
 lookupFM_ fm k = Map.findWithDefault err k fm
   where err = error $ "Key not found: " ++ show k