Made removeIdenticalRules faster by using sortNubBy instead of nubBy.

src/GF/Data/Utilities.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/22 16:56:05 $ 
+-- > CVS $Date: 2005/10/26 18:47:16 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- Basic functions not in the standard libraries
 -----------------------------------------------------------------------------
@@ -76,6 +76,10 @@ safeInit xs = init xs
 sortNub :: Ord a => [a] -> [a]
 sortNub = map head . group . sort
 
+-- | Like 'nubBy', but more efficient as it uses sorting internally.
+sortNubBy :: (a -> a -> Ordering) -> [a] -> [a]
+sortNubBy f = map head . groupBy (compareEq f) . sortBy f
+
 -- | Take the union of a list of lists.
 unionAll :: Eq a => [[a]] -> [a]
 unionAll = nub . concat
@@ -89,6 +93,14 @@ lookup' x = fromJust . lookup x
 find' :: (a -> Bool) -> [a] -> a
 find' p = fromJust . find p
 
+-- * equality functions
+
+-- | Use an ordering function as an equality predicate.
+compareEq :: (a -> a -> Ordering) -> a -> a -> Bool
+compareEq f x y = case f x y of
+                             EQ -> True
+                             _ -> False
+
 -- * ordering functions
 
 compareBy :: Ord b => (a -> b) -> a -> a -> Ordering

src/GF/Speech/TransformCFG.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/14 15:17:30 $ 
+-- > CVS $Date: 2005/10/26 18:47:16 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.22 $
+-- > CVS $Revision: 1.23 $
 --
 --  This module does some useful transformations on CFGs.
 --
@@ -76,8 +76,11 @@ removeEmptyCats = fix removeEmptyCats'
 
 -- | Remove rules which are identical, not caring about the rule names.
 removeIdenticalRules :: CFRules -> CFRules
-removeIdenticalRules g = [(c,nubBy sameCatAndRhs rs) | (c,rs) <- g]
-    where sameCatAndRhs (CFRule c1 ss1 _) (CFRule c2 ss2 _) = c1 == c2 && ss1 == ss2
+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
 
 removeLeftRecursion :: CFRules -> CFRules
 removeLeftRecursion rs = concatMap removeDirectLeftRecursion $ map handleProds rs