diff --git a/src/GF/Speech/CFGToFiniteState.hs b/src/GF/Speech/CFGToFiniteState.hs index 6f93da40e..692d12a67 100644 --- a/src/GF/Speech/CFGToFiniteState.hs +++ b/src/GF/Speech/CFGToFiniteState.hs @@ -52,7 +52,7 @@ type MutRecSets = Map Cat_ MutRecSet -- data MFALabel a = MFASym a | MFASub String - deriving Eq + deriving (Eq,Ord) data MFA a = MFA (DFA (MFALabel a)) [(String,DFA (MFALabel a))] diff --git a/src/GF/Speech/PrRegExp.hs b/src/GF/Speech/PrRegExp.hs index 50156c42b..d0e2f0138 100644 --- a/src/GF/Speech/PrRegExp.hs +++ b/src/GF/Speech/PrRegExp.hs @@ -8,7 +8,7 @@ -- This module prints a grammar as a regular expression. ----------------------------------------------------------------------------- -module GF.Speech.PrRegExp (regexpPrinter) where +module GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter) where import GF.Conversion.Types import GF.Infra.Ident @@ -20,3 +20,16 @@ import GF.Compile.ShellState (StateGrammar) regexpPrinter :: Options -> StateGrammar -> String regexpPrinter opts s = prRE $ dfa2re $ cfgToFA opts s + +multiRegexpPrinter :: Options -> StateGrammar -> String +multiRegexpPrinter opts s = prREs $ mfa2res $ cfgToMFA opts s + +prREs :: [(String,RE (MFALabel String))] -> String +prREs res = unlines [l ++ " = " ++ prRE (mapRE showLabel re) | (l,re) <- res] + where showLabel (MFASym s) = s + showLabel (MFASub l) = "<" ++ l ++ ">" + +mfa2res :: MFA String -> [(String,RE (MFALabel String))] +mfa2res (MFA start dfas) = + [("START",f start)] ++ [(l,f dfa) | (l,dfa) <- dfas] + where f = minimizeRE . dfa2re \ No newline at end of file diff --git a/src/GF/Speech/RegExp.hs b/src/GF/Speech/RegExp.hs index 6c787b714..120a43d26 100644 --- a/src/GF/Speech/RegExp.hs +++ b/src/GF/Speech/RegExp.hs @@ -19,14 +19,14 @@ data RE a = deriving (Eq,Ord,Show) -dfa2re :: (Show a,Ord a) => DFA a -> RE a +dfa2re :: (Ord a) => DFA a -> RE a dfa2re = finalRE . elimStates . modifyTransitions merge . addLoops . oneFinalState () epsilonRE . mapTransitions RESymbol where addLoops fa = newTransitions [(s,s,nullRE) | (s,_) <- states fa] fa merge es = [(f,t,unionRE ls) | ((f,t),ls) <- buildMultiMap [((f,t),l) | (f,t,l) <- es]] -elimStates :: (Show a, Ord a) => DFA (RE a) -> DFA (RE a) +elimStates :: (Ord a) => DFA (RE a) -> DFA (RE a) elimStates fa = case [s | (s,_) <- states fa, isInternal fa s] of [] -> fa @@ -120,10 +120,10 @@ joinRE (RESymbol ss) = ss -- Debugging -prRE :: Show a => RE a -> String +prRE :: RE String -> String prRE (REUnion []) = "" prRE (REUnion xs) = "(" ++ concat (intersperse " | " (map prRE xs)) ++ ")" prRE (REConcat xs) = "(" ++ unwords (map prRE xs) ++ ")" prRE (RERepeat x) = "(" ++ prRE x ++ ")*" -prRE (RESymbol s) = show s +prRE (RESymbol s) = s diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 132c832cd..eeb2b0ae2 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -65,7 +65,7 @@ import GF.Speech.PrSRGS_ABNF import qualified GF.Speech.SISR as SISR import GF.Speech.PrSLF import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) -import GF.Speech.PrRegExp (regexpPrinter) +import GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter) import GF.Speech.GrammarToVoiceXML (grammar2vxml) import GF.Data.Zipper @@ -264,6 +264,7 @@ customGrammarPrinter = ,(strCI "fa_graphviz", faGraphvizPrinter) ,(strCI "fa_c", faCPrinter) ,(strCI "regexp", regexpPrinter) + ,(strCI "regexps", multiRegexpPrinter) ,(strCI "regular", regularPrinter) ,(strCI "plbnf", \_ -> prLBNF True) ,(strCI "lbnf", \_ -> prLBNF False)