{-# LANGUAGE CPP #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

-}



-- | Set-like operations on lists
--
-- Avoid using them as much as possible
module GHC.Data.List.SetOps (
        unionLists, unionListsOrd, minusList,

        -- Association lists
        Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,

        -- Duplicate handling
        hasNoDups, removeDups, nubOrdBy, findDupsEq,
        equivClasses,

        -- Indexing
        getNth,

        -- Membership
        isIn, isn'tIn,
   ) where

import GHC.Prelude

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc

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 = Bool -> SDoc -> a -> a
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([a]
xs [a] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthExceeds` Int
n) (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
xs) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
             [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
n

{-
************************************************************************
*                                                                      *
        Treating lists as sets
        Assumes the lists contain no duplicates, but are unordered
*                                                                      *
************************************************************************
-}



-- | Combines the two lists while keeping their order, placing the first argument
-- first in the result.
--
-- Uses a set internally to record duplicates. This makes it slightly slower for
-- very small lists but avoids quadratic behaviour for large lists.
unionListsOrd :: (HasDebugCallStack, Outputable a, Ord a) => [a] -> [a] -> [a]
unionListsOrd :: forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [a]
xs [a]
ys
  -- Since both arguments don't have internal duplicates we can just take all of xs
  -- and every element of ys that's not already in xs.
  = let set_ys :: Set a
set_ys = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
ys
    in ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
e -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
e Set a
set_ys) [a]
xs) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

-- | Assumes that the arguments contain no duplicates
unionLists :: (HasDebugCallStack, Outputable a, Eq a) => [a] -> [a] -> [a]
-- We special case some reasonable common patterns.
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
  | String -> a -> [a] -> Bool
forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"unionLists" a
x [a]
ys = [a]
ys
  | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys
unionLists [a]
xs [a
y]
  | String -> a -> [a] -> Bool
forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"unionLists" a
y [a]
xs = [a]
xs
  | Bool
otherwise = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
unionLists [a]
xs [a]
ys
  = Bool -> String -> SDoc -> [a] -> [a]
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace ([a] -> Int -> Bool
forall a. [a] -> Int -> Bool
lengthExceeds [a]
xs Int
100 Bool -> Bool -> Bool
|| [a] -> Int -> Bool
forall a. [a] -> Int -> Bool
lengthExceeds [a]
ys Int
100) String
"unionLists" ([a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
xs SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
ys) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
    [a
x | a
x <- [a]
xs, String -> a -> [a] -> Bool
forall a. Eq a => String -> a -> [a] -> Bool
isn'tIn String
"unionLists" a
x [a]
ys] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

-- | Calculate the set difference of two lists. This is
-- /O((m + n) log n)/, where we subtract a list of /n/ elements
-- from a list of /m/ elements.
--
-- Extremely short cases are handled specially:
-- When /m/ or /n/ is 0, this takes /O(1)/ time. When /m/ is 1,
-- it takes /O(n)/ time.
minusList :: Ord a => [a] -> [a] -> [a]
-- There's no point building a set to perform just one lookup, so we handle
-- extremely short lists specially. It might actually be better to use
-- an O(m*n) algorithm when m is a little longer (perhaps up to 4 or even 5).
-- The tipping point will be somewhere in the area of where /m/ and /log n/
-- become comparable, but we probably don't want to work too hard on this.
minusList :: forall a. Ord a => [a] -> [a] -> [a]
minusList [] [a]
_ = []
minusList xs :: [a]
xs@[a
x] [a]
ys
  | a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys = []
  | Bool
otherwise = [a]
xs
-- Using an empty set or a singleton would also be silly, so let's not.
minusList [a]
xs [] = [a]
xs
minusList [a]
xs [a
y] = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y) [a]
xs
-- When each list has at least two elements, we build a set from the
-- second argument, allowing us to filter the first argument fairly
-- efficiently.
minusList [a]
xs [a]
ys = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
yss) [a]
xs
  where
    yss :: Set a
yss = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
ys

{-
************************************************************************
*                                                                      *
\subsection[Utils-assoc]{Association lists}
*                                                                      *
************************************************************************

Inefficient finite maps based on association lists and equality.
-}

-- | A finite mapping based on equality and association lists.
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
-- | Lookup key, fail gracefully using Nothing if not found.
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  = (a -> a -> Bool) -> b -> [(a, b)] -> a -> b
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 = (a -> a -> Bool) -> b -> Assoc a b -> a -> b
forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> b
forall a. HasCallStack => String -> a
panic (String
"Failed in assoc: " String -> String -> String
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 = (a -> a -> Bool) -> b -> Assoc a b -> a -> b
forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
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 = (a -> a -> Bool) -> b -> Assoc a b -> a -> b
forall a b. (a -> a -> Bool) -> b -> Assoc a b -> a -> b
assocDefaultUsing a -> a -> Bool
eq (String -> b
forall a. HasCallStack => String -> a
panic (String
"Failed in assoc: " String -> String -> String
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 []             = Maybe b
forall a. Maybe a
Nothing
    lookup ((a
tv,b
ty):Assoc a b
rest) = if a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
tv then b -> Maybe b
forall a. a -> Maybe a
Just b
ty else Assoc a b -> Maybe b
lookup Assoc a b
rest

{-
************************************************************************
*                                                                      *
\subsection[Utils-dups]{Duplicate-handling}
*                                                                      *
************************************************************************
-}

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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
seen_so_far) [a]
xs

    is_elem :: a -> [a] -> Bool
is_elem = String -> a -> [a] -> Bool
forall a. Eq a => String -> a -> [a] -> Bool
isIn String
"hasNoDups"

equivClasses :: (a -> a -> Ordering) -- Comparison
             -> [a]
             -> [NonEmpty a]

equivClasses :: forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a]
equivClasses a -> a -> Ordering
_   []      = []
equivClasses a -> a -> Ordering
_   [a
stuff] = [a
stuff a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []]
equivClasses a -> a -> Ordering
cmp [a]
items   = (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy a -> a -> Bool
eq ((a -> a -> Ordering) -> [a] -> [a]
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 }

-- | Remove the duplicates from a list using the provided
-- comparison function. Might change the order of elements.
--
-- Returns the list without duplicates, and accumulates
-- all the duplicates in the second component of its result.
removeDups :: (a -> a -> Ordering) -- Comparison function
           -> [a]
           -> ([a],          -- List with no duplicates
               [NonEmpty a]) -- List of duplicate groups.  One representative
                             -- from each group appears in the first result

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 ([NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a))
-> [NonEmpty a] -> [NonEmpty a] -> ([NonEmpty a], [a])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumR [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
forall a. [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
collect_dups [] ((a -> a -> Ordering) -> [a] -> [NonEmpty a]
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
dupsNonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
:[NonEmpty a]
dups_so_far, a
x)

-- | Remove the duplicates from a list using the provided
-- comparison function.
nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy a -> a -> Ordering
cmp [a]
xs = ([a], [NonEmpty a]) -> [a]
forall a b. (a, b) -> a
fst ((a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups a -> a -> Ordering
cmp [a]
xs)

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) | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [a]
eq_xs  = (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq a -> a -> Bool
eq [a]
xs
                     | Bool
otherwise     = (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
eq_xs) NonEmpty a -> [NonEmpty a] -> [NonEmpty a]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [NonEmpty a]
forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
findDupsEq a -> a -> Bool
eq [a]
neq_xs
    where ([a]
eq_xs, [a]
neq_xs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (a -> a -> Bool
eq a
x) [a]
xs

-- Debugging/specialising versions of \tr{elem} and \tr{notElem}

# if !defined(DEBUG)
isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
isIn :: forall a. Eq a => String -> a -> [a] -> Bool
isIn    String
_msg a
x [a]
ys = a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys
isn'tIn :: forall a. Eq a => String -> a -> [a] -> Bool
isn'tIn String
_msg a
x [a]
ys = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ys

# else /* DEBUG */
isIn, isn'tIn :: (HasDebugCallStack, Eq a) => String -> a -> [a] -> Bool
isIn msg x ys
  = elem100 0 x ys
  where
    elem100 :: Eq a => Int -> a -> [a] -> Bool
    elem100 _ _ [] = False
    elem100 i x (y:ys)
      | i > 100 = warnPprTrace True ("Over-long elem in " ++ msg) empty (x `elem` (y:ys))
      | otherwise = x == y || elem100 (i + 1) x ys

isn'tIn msg x ys
  = notElem100 0 x ys
  where
    notElem100 :: Eq a => Int -> a -> [a] -> Bool
    notElem100 _ _ [] =  True
    notElem100 i x (y:ys)
      | i > 100 = warnPprTrace True ("Over-long notElem in " ++ msg) empty (x `notElem` (y:ys))
      | otherwise = x /= y && notElem100 (i + 1) x ys
# endif /* DEBUG */