content: {-
  (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 Eta.Utils.ListSetOps (
          unionLists, minusList, insertList,
  
          -- Association lists
          Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,
  
          -- Duplicate handling
          hasNoDups, runs, removeDups, findDupsEq,
          equivClasses, equivClassesByUniq,
  
          -- Indexing
          getNth
     ) where
  
  import Eta.Utils.Outputable
  import Eta.BasicTypes.Unique
  import Eta.Utils.UniqFM
  import Eta.Utils.Util
  
  import Data.List
  
  #include "HsVersions.h"
  
  {-
  ---------
  -- #ifndef DEBUG
  -- getNth :: [a] -> Int -> a
  -- getNth xs n = xs !! n
  -- #else
  -- getNth :: Outputable a => [a] -> Int -> a
  -- getNth xs n = ASSERT2( xs `lengthAtLeast` n, ppr n $$ ppr xs )
  --               xs !! n
  -- #endif
  ----------
  -}
  
  getNth :: Outputable a => [a] -> Int -> a
  getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )
                xs !! n
  
  {-
  ************************************************************************
  *                                                                      *
          Treating lists as sets
          Assumes the lists contain no duplicates, but are unordered
  *                                                                      *
  ************************************************************************
  -}
  
  insertList :: Eq a => a -> [a] -> [a]
  -- Assumes the arg list contains no dups; guarantees the result has no dups
  insertList x xs | isIn "insert" x xs = xs
                  | otherwise          = x : xs
  
  unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a]
  -- Assumes that the arguments contain no duplicates
  unionLists xs ys
    = --WARN(length xs > 100 || length ys > 100, ppr xs $$ ppr ys)
      [x | x <- xs, isn'tIn "unionLists" x ys] ++ ys
  
  minusList :: (Eq a) => [a] -> [a] -> [a]
  -- Everything in the first list that is not in the second list:
  minusList xs ys = [ x | x <- xs, isn'tIn "minusList" x 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 _  deflt []             _   = deflt
  assocDefaultUsing eq deflt ((k,v) : rest) key
    | k `eq` key = v
    | otherwise  = assocDefaultUsing eq deflt rest key
  
  assoc crash_msg         list key = assocDefaultUsing (==) (panic ("Failed in assoc: " ++ crash_msg)) list key
  assocDefault deflt      list key = assocDefaultUsing (==) deflt list key
  assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc: " ++ crash_msg)) list key
  
  assocMaybe alist key
    = lookup alist
    where
      lookup []             = Nothing
      lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection[Utils-dups]{Duplicate-handling}
  *                                                                      *
  ************************************************************************
  -}
  
  hasNoDups :: (Eq a) => [a] -> Bool
  
  hasNoDups xs = f [] xs
    where
      f _           []     = True
      f seen_so_far (x:xs) = if x `is_elem` seen_so_far
                             then False
                             else f (x:seen_so_far) xs
  
      is_elem = isIn "hasNoDups"
  
  equivClasses :: (a -> a -> Ordering) -- Comparison
               -> [a]
               -> [[a]]
  
  equivClasses _         []  = []
  equivClasses _   stuff@[_] = [stuff]
  equivClasses cmp items     = runs eq (sortBy cmp items)
    where
      eq a b = case cmp a b of { EQ -> True; _ -> False }
  
  {-
  The first cases in @equivClasses@ above are just to cut to the point
  more quickly...
  
  @runs@ groups a list into a list of lists, each sublist being a run of
  identical elements of the input list. It is passed a predicate @p@ which
  tells when two elements are equal.
  -}
  
  runs :: (a -> a -> Bool) -- Equality
       -> [a]
       -> [[a]]
  
  runs _ []     = []
  runs p (x:xs) = case (span (p x) xs) of
                  (first, rest) -> (x:first) : (runs p rest)
  
  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
  
  removeDups _   []  = ([], [])
  removeDups _   [x] = ([x],[])
  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)
  
  findDupsEq :: (a->a->Bool) -> [a] -> [[a]]
  findDupsEq _  [] = []
  findDupsEq eq (x:xs) | null eq_xs  = findDupsEq eq xs
                       | otherwise   = (x:eq_xs) : findDupsEq eq neq_xs
      where (eq_xs, neq_xs) = partition (eq x) xs
  
  equivClassesByUniq :: (a -> Unique) -> [a] -> [[a]]
          -- NB: it's *very* important that if we have the input list [a,b,c],
          -- where a,b,c all have the same unique, then we get back the list
          --      [a,b,c]
          -- not
          --      [c,b,a]
          -- Hence the use of foldr, plus the reversed-args tack_on below
  equivClassesByUniq get_uniq xs
    = eltsUFM (foldr add emptyUFM xs)
    where
      add a ufm = addToUFM_C tack_on ufm (get_uniq a) [a]
      tack_on old new = new++old
  