diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Compile/Export.hs | 2 | ||||
| -rw-r--r-- | src/GF/Infra/Option.hs | 2 | ||||
| -rw-r--r-- | src/GF/Speech/PrRegExp.hs | 4 | ||||
| -rw-r--r-- | src/GF/Speech/RegExp.hs | 12 | ||||
| -rw-r--r-- | src/GF/Speech/SRG.hs | 19 |
5 files changed, 29 insertions, 10 deletions
diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs index d36fe2634..e89fbd033 100644 --- a/src/GF/Compile/Export.hs +++ b/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 diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index bf530ff4e..111d2eedc 100644 --- a/src/GF/Infra/Option.hs +++ b/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), diff --git a/src/GF/Speech/PrRegExp.hs b/src/GF/Speech/PrRegExp.hs index ae450dee8..0fc35d541 100644 --- a/src/GF/Speech/PrRegExp.hs +++ b/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)] diff --git a/src/GF/Speech/RegExp.hs b/src/GF/Speech/RegExp.hs index 5ee40828e..902569629 100644 --- a/src/GF/Speech/RegExp.hs +++ b/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 diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index f9065dae9..650728be4 100644 --- a/src/GF/Speech/SRG.hs +++ b/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 |