diff options
Diffstat (limited to 'compiler/utils/ListSetOps.hs')
| -rw-r--r-- | compiler/utils/ListSetOps.hs | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs index f1aa2c3755..7fa441402c 100644 --- a/compiler/utils/ListSetOps.hs +++ b/compiler/utils/ListSetOps.hs @@ -27,6 +27,8 @@ import Outputable import Util import Data.List +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Set as S getNth :: Outputable a => [a] -> Int -> a @@ -131,19 +133,19 @@ hasNoDups xs = f [] xs equivClasses :: (a -> a -> Ordering) -- Comparison -> [a] - -> [[a]] + -> [NonEmpty a] -equivClasses _ [] = [] -equivClasses _ stuff@[_] = [stuff] -equivClasses cmp items = groupBy eq (sortBy cmp items) +equivClasses _ [] = [] +equivClasses _ [stuff] = [stuff :| []] +equivClasses cmp items = NE.groupBy eq (sortBy cmp items) where eq a b = case cmp a b of { EQ -> True; _ -> False } 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 + -> ([a], -- List with no duplicates + [NonEmpty a]) -- List of duplicate groups. One representative + -- from each group appears in the first result removeDups _ [] = ([], []) removeDups _ [x] = ([x],[]) @@ -151,12 +153,12 @@ removeDups cmp xs = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') -> (xs', dups) } where - collect_dups _ [] = panic "ListSetOps: removeDups" - collect_dups dups_so_far [x] = (dups_so_far, x) - collect_dups dups_so_far dups@(x:_) = (dups:dups_so_far, x) + collect_dups :: [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a) + collect_dups dups_so_far (x :| []) = (dups_so_far, x) + collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x) -findDupsEq :: (a->a->Bool) -> [a] -> [[a]] +findDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a] findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs - | otherwise = (x:eq_xs) : findDupsEq eq neq_xs + | otherwise = (x :| eq_xs) : findDupsEq eq neq_xs where (eq_xs, neq_xs) = partition (eq x) xs |