Better dupe elimination

Data/List/Extra.hs

@@ -2,7 +2,7 @@
 module Data.List.Extra where
 
 import Control.DeepSeq (NFData(..))
-import Data.List (groupBy)
+import Data.List (foldl')
 
 -- * Regular lists
 
@@ -16,19 +16,13 @@ moreThan [] n = n < 0
 moreThan _ 0  = True
 moreThan (_:xs) n = moreThan xs (n-1)
 
--- | Like 'groupBy', but also handle things which are separated by a
--- couple of elements.
-groupByIsh :: (a -> a -> Bool) -> [a] -> [[a]]
-groupByIsh f = merge Nothing . merge Nothing . merge Nothing . groupBy f where
-  merge Nothing (xs:ys:rest) = merge (Just (xs, ys)) rest
-  merge Nothing groups = groups
-
-  merge (Just (xs,ys)) (zs:zss)
-    | head xs `f` head zs = merge (Just (xs ++ zs, ys)) zss
-    | head ys `f` head zs = merge (Just (xs, ys ++ zs)) zss
-    | otherwise = xs : merge (Just (ys, zs)) zss
-
-  merge (Just (xs, ys)) zs = xs : ys : zs
+-- | For all sets of mutually comparable elements (hence the partial
+-- ordering), remove all non-minimal ones.
+sortNubBy :: (a -> a -> Maybe Ordering) -> [a] -> [a]
+sortNubBy cmp = foldl' (flip insert) [] where
+  insert x xs
+    | any (\a -> a `cmp` x == Just LT) xs = xs
+    | otherwise = x : filter (\a -> a `cmp` x /= Just GT) xs
 
 -- * Non-empty lists
 

Test/DejaFu.hs

@@ -84,11 +84,9 @@ import Control.Applicative ((<$>))
 import Control.Arrow (first)
 import Control.DeepSeq (NFData(..))
 import Control.Monad (when)
-import Data.Function (on)
-import Data.List (nubBy, sortBy)
 import Data.List.Extra
 import Data.Maybe (isJust, isNothing)
-import Data.Monoid ((<>))
+import Data.Monoid (mconcat)
 import Test.DejaFu.Deterministic
 import Test.DejaFu.Deterministic.Internal
 import Test.DejaFu.Deterministic.IO (ConcIO)
@@ -185,19 +183,21 @@ runTestIO' pb predicate conc = do
 
 -- | Strip out duplicates
 uniques :: Eq a => [(Maybe a, Trace)] -> [(Maybe a, Trace)]
-uniques = concatMap simplest . groupByIsh ((==) `on` fst) . nubBy resEq where
-  -- Restrict a list of failures to the simplest ones
-  simplest as = let xs@((_,trc):_) = sortBy (simpler `on` snd) as in filter (\(_,trc') -> simpler trc trc' == EQ) xs
+uniques = sortNubBy simplicity
 
-  -- Of two traces, determine which (if either) is the simpler
-  simpler a b = emps <> cswit <> lexico where
-    a' = map (\(d,_,_) -> d) a
-    b' = map (\(d,_,_) -> d) b
+-- | Determine which of two failures is simpler, if they are comparable.
+simplicity :: Eq a => (Maybe a, Trace) -> (Maybe a, Trace) -> Maybe Ordering
+simplicity (r, t) (s, u)
+  | r /= s = Nothing
+  | otherwise = Just $ mconcat
+    [ preEmpCount t' `compare` preEmpCount u'
+    , contextSwitchCount t' `compare` contextSwitchCount u'
+    , lexicographic t' u'
+    ]
 
-    -- Comparisons we care about (in order)
-    emps   = preEmpCount a' `compare` preEmpCount b'
-    cswit  = contextSwitchCount a' `compare` contextSwitchCount b'
-    lexico = lexicographic a' b'
+  where
+    t' = map (\(d,_,_) -> d) t
+    u' = map (\(d,_,_) -> d) u
 
     contextSwitchCount (Start _:ss) = 1 + contextSwitchCount ss
     contextSwitchCount (_:ss) = contextSwitchCount ss
@@ -211,14 +211,6 @@ uniques = concatMap simplest . groupByIsh ((==) `on` fst) . nubBy resEq where
     lexicographic [] _  = LT
     lexicographic _ []  = GT
 
-  -- Check if two failures are approximately equal (same result & pre-emptions)
-  resEq (res, trc) (res', trc') = res == res' && restrict trc == restrict trc'
-
-  -- Restrict a trace to just pre-emptions
-  restrict ((SwitchTo i,_,_):xs) = i : restrict xs
-  restrict (_:xs) = restrict xs
-  restrict [] = []
-
 -- * Predicates
 
 -- | A @Predicate@ is a function which collapses a list of results