Added an FCFG output format (--output-format=fcfg). This now lives in GF.Speech.PGFToCFG, but should probably move somewhere else.

3 files changed, 22 insertions, 1 deletions

diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs
index 739079c9c..b387a576f 100644
--- a/src/GF/Compile/Export.hs
+++ b/src/GF/Compile/Export.hs
@@ -37,6 +37,7 @@ exportPGF opts fmt pgf =
       FmtProlog       -> multi "pl"  grammar2prolog 
       FmtProlog_Abs   -> multi "pl"  grammar2prolog_abs 
       FmtBNF          -> single "bnf"   bnfPrinter
+      FmtFCFG         -> single "fcfg"  fcfgPrinter
       FmtSRGS_XML     -> single "grxml" (srgsXmlPrinter sisr)
       FmtSRGS_XML_NonRec -> single "grxml" srgsXmlNonRecursivePrinter
       FmtSRGS_ABNF    -> single "gram" (srgsAbnfPrinter sisr)
@@ -67,3 +68,4 @@ outputConcr pgf = case cncnames pgf of
 
 printPGF :: PGF -> String
 printPGF = encodeUTF8 . printTree . fromPGF
+
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 39e9e4209..8d296b281 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -87,6 +87,7 @@ data OutputFormat = FmtPGF
                   | FmtProlog
                   | FmtProlog_Abs
                   | FmtBNF
+                  | FmtFCFG
                   | FmtSRGS_XML
                   | FmtSRGS_XML_NonRec
                   | FmtSRGS_ABNF 
@@ -455,6 +456,7 @@ outputFormats =
      ("prolog",       FmtProlog),
      ("prolog_abs",   FmtProlog_Abs),
      ("bnf",          FmtBNF),
+     ("fcfg",         FmtFCFG),
      ("srgs_xml",     FmtSRGS_XML),
      ("srgs_xml_nonrec",     FmtSRGS_XML_NonRec),
      ("srgs_abnf",    FmtSRGS_ABNF),
diff --git a/src/GF/Speech/PGFToCFG.hs b/src/GF/Speech/PGFToCFG.hs
index 1f3ebaeb4..b51501c18 100644
--- a/src/GF/Speech/PGFToCFG.hs
+++ b/src/GF/Speech/PGFToCFG.hs
@@ -4,7 +4,7 @@
 --
 -- Approximates PGF grammars with context-free grammars.
 ----------------------------------------------------------------------
-module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where
+module GF.Speech.PGFToCFG (bnfPrinter, fcfgPrinter, pgfToCFG) where
 
 import PGF.CId
 import PGF.Data as PGF
@@ -13,6 +13,7 @@ import GF.Infra.Ident
 import GF.Speech.CFG
 
 import Data.Array as Array
+import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
@@ -22,6 +23,22 @@ import qualified Data.Set as Set
 bnfPrinter :: PGF -> CId -> String
 bnfPrinter pgf cnc = prCFG $ pgfToCFG pgf cnc
 
+-- FIXME: move this somewhere else
+fcfgPrinter :: PGF -> CId -> String
+fcfgPrinter pgf cnc = unlines (map showRule rules)
+  where
+    pinfo = fromMaybe (error "fcfgPrinter") (lookParser pgf cnc)
+
+    rules :: [FRule]
+    rules = Array.elems (PGF.allRules pinfo)
+
+    showRule (FRule cid ps cs fc arr) = prCId cid ++ " " ++ show ps ++ ". " ++ showCat fc ++ " ::= " ++ unwords (map showCat cs) ++ " = " ++ showLin arr
+        where
+          showLin arr = "[" ++ concat (intersperse ", " [ unwords (map showFSymbol (Array.elems r)) | r <- Array.elems arr]) ++ "]"
+          showFSymbol (FSymCat i j) = showCat (cs!!j) ++ "_" ++ show j ++ "." ++ show i
+          showFSymbol (FSymTok t) = t
+    showCat c = "C" ++ show c
+
 pgfToCFG :: PGF 
           -> CId   -- ^ Concrete syntax name
           -> CFG