{-# LANGUAGE CPP #-}
module GHC.Data.List.SetOps (
unionLists, minusList,
Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,
hasNoDups, removeDups, findDupsEq,
equivClasses,
getNth
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Driver.Ppr
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Set as S
getNth :: Outputable a => [a] -> Int -> a
getNth :: forall a. Outputable a => [a] -> Int -> a
getNth [a]
xs Int
n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )
[a]
xs forall a. [a] -> Int -> a
!! Int
n
unionLists :: (HasDebugCallStack, Outputable a, Eq a) => [a] -> [a] -> [a]
unionLists :: forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
unionLists [a]
xs [] = [a]
xs
unionLists [] [a]
ys = [a]
ys
unionLists [a
x] [a]
ys
| forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"unionLists" a
x [a]
ys = [a]
ys
| Bool
otherwise = a
xforall a. a -> [a] -> [a]
:[a]
ys
unionLists [a]
xs [a
y]
| forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"unionLists" a
y [a]
xs = [a]
xs
| Bool
otherwise = a
yforall a. a -> [a] -> [a]
:[a]
xs
unionLists [a]
xs [a]
ys
= WARN(lengthExceeds xs 100 || lengthExceeds ys 100, ppr xs $$ ppr ys)
[a
x | a
x <- [a]
xs, forall a. Eq a => String -> a -> [a] -> Bool
isn'tIn String
"unionLists" a
x [a]
ys] forall a. [a] -> [a] -> [a]
++ [a]
ys
minusList :: Ord a => [a] -> [a] -> [a]
minusList :: forall a. Ord a => [a] -> [a] -> [a]
minusList [] [a]
_ = []
minusList xs :: [a]
xs@[a
x] [a]
ys
| a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys = []
| Bool
otherwise = [a]
xs
minusList [a]
xs [] = [a]
xs
minusList [a]
xs [a
y] = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= a
y) [a]
xs
minusList [a]
xs [a]
ys = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
yss) [a]
xs
where
yss :: Set a
yss = forall a. Ord a => [a] -> Set a
S.fromList [a]
ys
type Assoc a b = [(a,b)]
assoc :: (Eq a) => String -> Assoc a b -> a -> b
assocDefault :: (Eq a) => b -> Assoc a b -> a -> b
assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b
assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b
assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing :: forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
_ b
deflt [] a
_ = b
deflt
assocDefaultUsing a -> a -> Bool
eq b
deflt ((a
k,b
v) : [(a, b)]
rest) a
key
| a
k a -> a -> Bool
`eq` a
key = b
v
| Bool
otherwise = forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
eq b
deflt [(a, b)]
rest a
key
assoc :: forall a b. Eq a => String -> Assoc a b -> a -> b
assoc String
crash_msg Assoc a b
list a
key = forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing forall a. Eq a => a -> a -> Bool
(==) (forall a. String -> a
panic (String
"Failed in assoc: " forall a. [a] -> [a] -> [a]
++ String
crash_msg)) Assoc a b
list a
key
assocDefault :: forall a b. Eq a => b -> Assoc a b -> a -> b
assocDefault b
deflt Assoc a b
list a
key = forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing forall a. Eq a => a -> a -> Bool
(==) b
deflt Assoc a b
list a
key
assocUsing :: forall a b. (a -> a -> Bool) -> String -> Assoc a b -> a -> b
assocUsing a -> a -> Bool
eq String
crash_msg Assoc a b
list a
key = forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
eq (forall a. String -> a
panic (String
"Failed in assoc: " forall a. [a] -> [a] -> [a]
++ String
crash_msg)) Assoc a b
list a
key
assocMaybe :: forall a b. Eq a => Assoc a b -> a -> Maybe b
assocMaybe Assoc a b
alist a
key
= Assoc a b -> Maybe b
lookup Assoc a b
alist
where
lookup :: Assoc a b -> Maybe b
lookup [] = forall a. Maybe a
Nothing
lookup ((a
tv,b
ty):Assoc a b
rest) = if a
key forall a. Eq a => a -> a -> Bool
== a
tv then forall a. a -> Maybe a
Just b
ty else Assoc a b -> Maybe b
lookup Assoc a b
rest
hasNoDups :: (Eq a) => [a] -> Bool
hasNoDups :: forall a. Eq a => [a] -> Bool
hasNoDups [a]
xs = [a] -> [a] -> Bool
f [] [a]
xs
where
f :: [a] -> [a] -> Bool
f [a]
_ [] = Bool
True
f [a]
seen_so_far (a
x:[a]
xs) = if a
x a -> [a] -> Bool
`is_elem` [a]
seen_so_far
then Bool
False
else [a] -> [a] -> Bool
f (a
xforall a. a -> [a] -> [a]
:[a]
seen_so_far) [a]
xs
is_elem :: a -> [a] -> Bool
is_elem = forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"hasNoDups"
equivClasses :: (a -> a -> Ordering)
-> [a]
-> [NonEmpty a]
equivClasses :: forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a]
equivClasses a -> a -> Ordering
_ [] = []
equivClasses a -> a -> Ordering
_ [a
stuff] = [a
stuff forall a. a -> [a] -> NonEmpty a
:| []]
equivClasses a -> a -> Ordering
cmp [a]
items = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy a -> a -> Bool
eq (forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
cmp [a]
items)
where
eq :: a -> a -> Bool
eq a
a a
b = case a -> a -> Ordering
cmp a
a a
b of { Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False }
removeDups :: (a -> a -> Ordering)
-> [a]
-> ([a],
[NonEmpty a])
removeDups :: forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups a -> a -> Ordering
_ [] = ([], [])
removeDups a -> a -> Ordering
_ [a
x] = ([a
x],[])
removeDups a -> a -> Ordering
cmp [a]
xs
= case forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumR forall a. [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
collect_dups [] (forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a]
equivClasses a -> a -> Ordering
cmp [a]
xs) of { ([NonEmpty a]
dups, [a]
xs') ->
([a]
xs', [NonEmpty a]
dups) }
where
collect_dups :: [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
collect_dups :: forall a. [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
collect_dups [NonEmpty a]
dups_so_far (a
x :| []) = ([NonEmpty a]
dups_so_far, a
x)
collect_dups [NonEmpty a]
dups_so_far dups :: NonEmpty a
dups@(a
x :| [a]
_) = (NonEmpty a
dupsforall a. a -> [a] -> [a]
:[NonEmpty a]
dups_so_far, a
x)
findDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a]
findDupsEq :: forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq a -> a -> Bool
_ [] = []
findDupsEq a -> a -> Bool
eq (a
x:[a]
xs) | forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [a]
eq_xs = forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq a -> a -> Bool
eq [a]
xs
| Bool
otherwise = (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
eq_xs) forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq a -> a -> Bool
eq [a]
neq_xs
where ([a]
eq_xs, [a]
neq_xs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (a -> a -> Bool
eq a
x) [a]
xs