{- (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 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 getNth :: [a] -> Int -> a getNth xs :: [a] xs n :: 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 eq :: a -> a -> Bool eq xs :: [a] xs ys :: [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] deleteBy a -> a -> Bool eq)) [a] xs [a] ys {- ************************************************************************ * * Treating lists as sets Assumes the lists contain no duplicates, but are unordered * * ************************************************************************ -} unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a] -- Assumes that the arguments contain no duplicates unionLists :: [a] -> [a] -> [a] unionLists xs :: [a] xs ys :: [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 "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 [] _ = [] minusList xs :: [a] xs@[x :: a x] ys :: [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 xs :: [a] xs [] = [a] xs minusList xs :: [a] xs [y :: 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 xs :: [a] xs ys :: [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 _ deflt :: b deflt [] _ = b deflt assocDefaultUsing eq :: a -> a -> Bool eq deflt :: b deflt ((k :: a k,v :: b v) : rest :: Assoc a b rest) key :: 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 crash_msg :: String crash_msg list :: Assoc a b list key :: 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 ("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 deflt :: b deflt list :: Assoc a b list key :: 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 eq :: a -> a -> Bool eq crash_msg :: String crash_msg list :: Assoc a b list key :: 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 ("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 alist :: Assoc a b alist key :: 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 ((tv :: a tv,ty :: a ty):rest :: [(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 xs :: [a] xs = [a] -> [a] -> Bool f [] [a] xs where f :: [a] -> [a] -> Bool f _ [] = Bool True f seen_so_far :: [a] seen_so_far (x :: a x:xs :: [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 "hasNoDups" equivClasses :: (a -> a -> Ordering) -- Comparison -> [a] -> [NonEmpty a] equivClasses :: (a -> a -> Ordering) -> [a] -> [NonEmpty a] equivClasses _ [] = [] equivClasses _ [stuff :: a stuff] = [a stuff a -> [a] -> NonEmpty a forall a. a -> [a] -> NonEmpty a :| []] equivClasses cmp :: a -> a -> Ordering cmp items :: [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] sortBy a -> a -> Ordering cmp [a] items) where eq :: a -> a -> Bool eq a :: a a b :: a b = case a -> a -> Ordering cmp a a a b of { EQ -> Bool True; _ -> 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 _ [] = ([], []) removeDups _ [x :: a x] = ([a x],[]) removeDups cmp :: a -> a -> Ordering cmp xs :: [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) 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 { (dups :: [NonEmpty a] dups, xs' :: [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 dups_so_far :: [NonEmpty a] dups_so_far (x :: a x :| []) = ([NonEmpty a] dups_so_far, a x) collect_dups dups_so_far :: [NonEmpty a] dups_so_far dups :: NonEmpty a dups@(x :: a x :| _) = (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 _ [] = [] findDupsEq eq :: a -> a -> Bool eq (x :: a x:xs :: [a] xs) | [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool 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 (eq_xs :: [a] eq_xs, neq_xs :: [a] neq_xs) = (a -> Bool) -> [a] -> ([a], [a]) forall a. (a -> Bool) -> [a] -> ([a], [a]) partition (a -> a -> Bool eq a x) [a] xs