summaryrefslogtreecommitdiff
path: root/src/GF/Speech/PrSRGS.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Speech/PrSRGS.hs')
-rw-r--r--src/GF/Speech/PrSRGS.hs71
1 files changed, 8 insertions, 63 deletions
diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index 9f86c1468..63ca91034 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -15,6 +15,7 @@ module GF.Speech.PrSRGS (SISRFormat(..), srgsXmlPrinter) where
import GF.Data.Utilities
import GF.Data.XML
+import GF.Speech.RegExp
import GF.Speech.SISR as SISR
import GF.Speech.SRG
import GF.Infra.Ident
@@ -85,9 +86,12 @@ mkProd sisr (EBnfSRGAlt mp n@(Name f prs) rhs) = Tag "item" w (t ++ xs)
argInit (Constant f) = maybe "?" prIdent (forestName f)
mkItem :: Maybe SISRFormat -> EBnfSRGItem -> XML
-mkItem sisr (EBnfOneOf xs) = oneOf (map (mkItem sisr) xs)
-mkItem sisr (EBnfSeq xs) = Tag "item" [] (map (mkItem sisr) xs)
-mkItem sisr (EBnfSymbol s) = symItem sisr s
+mkItem sisr = f
+ where
+ f (REUnion xs) = oneOf (map f xs)
+ f (REConcat xs) = Tag "item" [] (map f xs)
+ f (RERepeat x) = Tag "item" [("repeat","0-")] [f x]
+ f (RESymbol s) = symItem sisr s
symItem :: Maybe SISRFormat -> Symbol SRGNT Token -> XML
symItem sisr (Cat (c,slots)) = Tag "item" [] ([Tag "ruleref" [("uri","#" ++ prCat c)] []]++t)
@@ -107,8 +111,7 @@ showToken :: Token -> String
showToken t = t
oneOf :: [XML] -> XML
-oneOf [x] = x
-oneOf xs = Tag "one-of" [] xs
+oneOf = Tag "one-of" []
grammar :: Maybe SISRFormat
-> String -- ^ root
@@ -130,61 +133,3 @@ optimizeSRGS = bottomUpXML f
where f (Tag "item" [] [x@(Tag "item" [] _)]) = x
f (Tag "one-of" [] [x]) = x
f x = x
-
-{-
-
---
--- * SRGS minimization
---
-
-minimizeRule :: XML -> XML
-minimizeRule (Tag "rule" attrs cs)
- = Tag "rule" attrs (map minimizeOneOf cs)
-
-minimizeOneOf :: XML -> XML
-minimizeOneOf (Tag "one-of" attrs cs)
- = Tag "item" [] (p++[Tag "one-of" attrs cs'])
- where
- (pref,cs') = factor cs
- p = if null pref then [] else [Tag "one-of" [] pref]
-minimizeOneOf x = x
-
-factor :: [XML] -> ([XML],[XML])
-factor xs = case f of
- Just (ps,xs') -> (map it ps, map it xs')
- Nothing -> ([],xs)
- where
- -- FIXME: maybe getting all the longest terminal prefixes
- -- is not optimal?
- f = cartesianFactor $ map (terminalPrefix . unIt) xs
- unIt (Tag "item" [] cs) = cs
- it cs = Tag "item" [] cs
-
-terminalPrefix :: [XML] -> ([XML],[XML])
-terminalPrefix cs = (terms, tags ++ cs'')
- where (tags,cs') = span isTag cs
- (terms,cs'') = span isTerminalItem cs'
-
-isTag :: XML -> Bool
-isTag (Tag t _ _) = t == "tag"
-isTag _ = False
-
-isTerminalItem :: XML -> Bool
-isTerminalItem (Tag "item" [] [Data _]) = True
-isTerminalItem _ = False
-
---
--- * Utilities
---
-
-allEqual :: Eq a => [a] -> Bool
-allEqual [] = True
-allEqual (x:xs) = all (x==) xs
-
-cartesianFactor :: (Ord a, Ord b) => [(a,b)] -> Maybe ([a],[b])
-cartesianFactor xs
- | not (null es) && allEqual es = Just (Map.keys m, Set.elems (head es))
- | otherwise = Nothing
- where m = Map.fromListWith Set.union [(x,Set.singleton y) | (x,y) <- xs]
- es = Map.elems m
--} \ No newline at end of file