{- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 \section[ListSetOps]{Set-like operations on lists} -} {-# LANGUAGE CPP #-} module ListSetOps ( unionLists, minusList, deleteBys, -- Association lists Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing getNth ) where #include "HsVersions.h" import GhcPrelude import Outputable import Util 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 :: [a] -> Int -> a getNth [a] xs Int n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs ) [a] xs [a] -> Int -> a forall a. [a] -> Int -> a !! Int n deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a] -- (deleteBys eq xs ys) returns xs-ys, using the given equality function -- Just like 'Data.List.delete' but with an equality function deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a] deleteBys a -> a -> Bool eq [a] xs [a] ys = ([a] -> a -> [a]) -> [a] -> [a] -> [a] forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a] forall a b c. (a -> b -> c) -> b -> a -> c flip ((a -> a -> Bool) -> a -> [a] -> [a] forall a. (a -> a -> Bool) -> a -> [a] -> [a] L.deleteBy a -> a -> Bool eq)) [a] xs [a] ys {- ************************************************************************ * * Treating lists as sets Assumes the lists contain no duplicates, but are unordered * * ************************************************************************ -} -- | Assumes that the arguments contain no duplicates unionLists :: (HasDebugCallStack, Outputable a, Eq a) => [a] -> [a] -> [a] -- We special case some reasonable common patterns. unionLists :: [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 = WARN(lengthExceeds xs 100 || lengthExceeds ys 100, ppr xs $$ ppr ys) [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 :: [a] -> [a] -> [a] minusList [] [a] _ = [] minusList xs :: [a] xs@[a x] [a] ys | a x 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 assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b assocDefaultUsing :: (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) : Assoc a b rest) a key | a k a -> a -> Bool `eq` a key = b v | Bool otherwise = (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 b deflt Assoc a b rest a key assoc :: 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. 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 :: 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 :: (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. 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 :: Assoc a b -> a -> Maybe b assocMaybe Assoc a b alist a key = Assoc a b -> Maybe b forall a. [(a, a)] -> Maybe a lookup Assoc a b alist where lookup :: [(a, a)] -> Maybe a lookup [] = Maybe a forall a. Maybe a Nothing lookup ((a tv,a ty):[(a, a)] rest) = if a key a -> a -> Bool forall a. Eq a => a -> a -> Bool == a tv then a -> Maybe a forall a. a -> Maybe a Just a ty else [(a, a)] -> Maybe a lookup [(a, a)] rest {- ************************************************************************ * * \subsection[Utils-dups]{Duplicate-handling} * * ************************************************************************ -} hasNoDups :: (Eq a) => [a] -> Bool hasNoDups :: [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 :: (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 } 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 :: (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 :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) 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 :: [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) findDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a] findDupsEq :: (a -> a -> Bool) -> [a] -> [NonEmpty a] findDupsEq a -> a -> Bool _ [] = [] findDupsEq a -> a -> Bool eq (a x:[a] xs) | [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