+
+
+%************************************************************************
+%* *
+\subsection[Utils-dups]{Duplicate-handling}
+%* *
+%************************************************************************
+
+\begin{code}
+hasNoDups :: (Eq a) => [a] -> Bool
+
+hasNoDups xs = f [] xs
+ where
+ f seen_so_far [] = True
+ f seen_so_far (x:xs) = if x `is_elem` seen_so_far then
+ False
+ else
+ f (x:seen_so_far) xs
+
+ is_elem = isIn "hasNoDups"
+\end{code}
+
+\begin{code}
+equivClasses :: (a -> a -> Ordering) -- Comparison
+ -> [a]
+ -> [[a]]
+
+equivClasses cmp stuff@[] = []
+equivClasses cmp stuff@[item] = [stuff]
+equivClasses cmp items
+ = runs eq (sortLt lt items)
+ where
+ eq a b = case cmp a b of { EQ -> True; _ -> False }
+ lt a b = case cmp a b of { LT -> True; _ -> False }
+\end{code}
+
+The first cases in @equivClasses@ above are just to cut to the point
+more quickly...
+
+@runs@ groups a list into a list of lists, each sublist being a run of
+identical elements of the input list. It is passed a predicate @p@ which
+tells when two elements are equal.
+
+\begin{code}
+runs :: (a -> a -> Bool) -- Equality
+ -> [a]
+ -> [[a]]
+
+runs p [] = []
+runs p (x:xs) = case (span (p x) xs) of
+ (first, rest) -> (x:first) : (runs p rest)
+\end{code}
+
+\begin{code}
+removeDups :: (a -> a -> Ordering) -- Comparison function
+ -> [a]
+ -> ([a], -- List with no duplicates
+ [[a]]) -- List of duplicate groups. One representative from
+ -- each group appears in the first result
+
+removeDups cmp [] = ([], [])
+removeDups cmp [x] = ([x],[])
+removeDups cmp xs
+ = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
+ (xs', dups) }
+ where
+ collect_dups dups_so_far [x] = (dups_so_far, x)
+ collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x)
+
+removeDupsEq :: Eq a => [a] -> ([a], [[a]])
+-- Same, but with only equality
+-- It's worst case quadratic, but we only use it on short lists
+removeDupsEq [] = ([], [])
+removeDupsEq (x:xs) | x `elem` xs = (ys, (x : filter (== x) xs) : zs)
+ where
+ (ys,zs) = removeDupsEq (filter (/= x) xs)
+removeDupsEq (x:xs) | otherwise = (x:ys, zs)
+ where
+ (ys,zs) = removeDupsEq xs
+\end{code}
+
+
+\begin{code}
+equivClassesByUniq :: (a -> Unique) -> [a] -> [[a]]
+ -- NB: it's *very* important that if we have the input list [a,b,c],
+ -- where a,b,c all have the same unique, then we get back the list
+ -- [a,b,c]
+ -- not
+ -- [c,b,a]
+ -- Hence the use of foldr, plus the reversed-args tack_on below
+equivClassesByUniq get_uniq xs
+ = eltsUFM (foldr add emptyUFM xs)
+ where
+ add a ufm = addToUFM_C tack_on ufm (get_uniq a) [a]
+ tack_on old new = new++old
+\end{code}
+
+