From fd0dfd7d4d9885b8b4cac7bd60308e2890a05caa Mon Sep 17 00:00:00 2001 From: bringert Date: Wed, 1 Feb 2006 16:23:14 +0000 Subject: First version of SRGS with semantic tags. --- src/GF/Speech/TransformCFG.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/GF/Speech/TransformCFG.hs') diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 08aae8897..38148418c 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -37,6 +37,7 @@ import Control.Monad import Data.FiniteMap import Data.List import Data.Maybe (fromMaybe) +import Data.Monoid (mconcat) import Data.Set (Set) import qualified Data.Set as Set @@ -77,14 +78,13 @@ removeEmptyCats = fix removeEmptyCats' emptyCats = filter (nothingOrNull . flip lookup rs) allCats k' = map (\ (c,xs) -> (c, filter (not . anyUsedBy emptyCats) xs)) keep --- | Remove rules which are identical, not caring about the rule names. --- FIXME: this messes up probabilities +-- | Remove rules which have the same rhs. +-- FIXME: this messes up probabilities, names and profiles removeIdenticalRules :: CFRules -> CFRules -removeIdenticalRules g = [(c,sortNubBy compareCatAndRhs rs) | (c,rs) <- g] - where compareCatAndRhs (CFRule c1 ss1 _) (CFRule c2 ss2 _) = - case c1 `compare` c2 of - EQ -> ss1 `compare` ss2 - o -> o +removeIdenticalRules g = [(c,sortNubBy cmpRules rs) | (c,rs) <- g] + where + cmpRules (CFRule c1 ss1 _) (CFRule c2 ss2 _) = + mconcat [c1 `compare` c2, ss1 `compare` ss2] removeLeftRecursion :: CFRules -> CFRules removeLeftRecursion rs = concatMap removeDirectLeftRecursion $ map handleProds rs -- cgit v1.2.3