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