Added regexps grammar printer. This is a first step towards recursion-free SRGS.

3 files changed, 19 insertions, 6 deletions

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 []) = "<NULL>"
 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