- | i _GE_ ILIT(100) = panic ("Over-long notElem in: " ++ msg)
- | otherwise = x /= y && notElem (i _ADD_ ILIT(1)) x ys
-
-# endif {- DEBUG -}
-
-#endif {- COMPILING_GHC -}
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Utils-assoc]{Association lists}
-%* *
-%************************************************************************
-
-See also @assocMaybe@ and @mkLookupFun@ in module @Maybes@.
-
-\begin{code}
-assoc :: (Eq a) => String -> [(a, b)] -> a -> b
-
-assoc crash_msg lst key
- = if (null res)
- then panic ("Failed in assoc: " ++ crash_msg)
- else head res
- where res = [ val | (key', val) <- lst, key == key']
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Utils-dups]{Duplicate-handling}
-%* *
-%************************************************************************
-
-\begin{code}
-hasNoDups :: (Eq a) => [a] -> Bool
-
-hasNoDups xs = f [] xs
- where
- f seen_so_far [] = True
- f seen_so_far (x:xs) = if x `is_elem` seen_so_far then
- False
- else
- f (x:seen_so_far) xs
-
-#if defined(COMPILING_GHC)
- is_elem = isIn "hasNoDups"
-#else
- is_elem = elem
-#endif
-\end{code}
-
-\begin{code}
-equivClasses :: (a -> a -> TAG_) -- Comparison
- -> [a]
- -> [[a]]
-
-equivClasses cmp stuff@[] = []
-equivClasses cmp stuff@[item] = [stuff]
-equivClasses cmp items
- = runs eq (sortLt lt items)
- where
- eq a b = case cmp a b of { EQ_ -> True; _ -> False }
- lt a b = case cmp a b of { LT_ -> True; _ -> False }
-\end{code}
-
-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.
-
-\begin{code}
-runs :: (a -> a -> Bool) -- Equality
- -> [a]
- -> [[a]]
-
-runs p [] = []
-runs p (x:xs) = case (span (p x) xs) of
- (first, rest) -> (x:first) : (runs p rest)
-\end{code}
-
-\begin{code}
-removeDups :: (a -> a -> TAG_) -- Comparison function
- -> [a]
- -> ([a], -- List with no duplicates
- [[a]]) -- List of duplicate groups. One representative from
- -- each group appears in the first result
-
-removeDups cmp [] = ([], [])
-removeDups cmp [x] = ([x],[])
-removeDups cmp xs
- = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
- (xs', dups) }
- where
- collect_dups dups_so_far [x] = (dups_so_far, x)
- collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x)
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Utils-sorting]{Sorting}
-%* *
-%************************************************************************
-
-%************************************************************************
-%* *
-\subsubsection[Utils-quicksorting]{Quicksorts}
-%* *
-%************************************************************************
-
-\begin{code}
--- tail-recursive, etc., "quicker sort" [as per Meira thesis]
-quicksort :: (a -> a -> Bool) -- Less-than predicate
- -> [a] -- Input list
- -> [a] -- Result list in increasing order
-
-quicksort lt [] = []
-quicksort lt [x] = [x]
-quicksort lt (x:xs) = split x [] [] xs
- where
- split x lo hi [] = quicksort lt lo ++ (x : quicksort lt hi)
- split x lo hi (y:ys) | y `lt` x = split x (y:lo) hi ys
- | True = split x lo (y:hi) ys
-\end{code}
-
-Quicksort variant from Lennart's Haskell-library contribution. This
-is a {\em stable} sort.
-
-\begin{code}
-stableSortLt = sortLt -- synonym; when we want to highlight stable-ness
-
-sortLt :: (a -> a -> Bool) -- Less-than predicate
- -> [a] -- Input list
- -> [a] -- Result list
-
-sortLt lt l = qsort lt l []
-
--- qsort is stable and does not concatenate.
-qsort :: (a -> a -> Bool) -- Less-than predicate
- -> [a] -- xs, Input list
- -> [a] -- r, Concatenate this list to the sorted input list
- -> [a] -- Result = sort xs ++ r
-
-qsort lt [] r = r
-qsort lt [x] r = x:r
-qsort lt (x:xs) r = qpart lt x xs [] [] r
-
--- qpart partitions and sorts the sublists
--- rlt contains things less than x,
--- rge contains the ones greater than or equal to x.
--- Both have equal elements reversed with respect to the original list.
-
-qpart lt x [] rlt rge r =
- -- rlt and rge are in reverse order and must be sorted with an
- -- anti-stable sorting
- rqsort lt rlt (x : rqsort lt rge r)
-
-qpart lt x (y:ys) rlt rge r =
- if lt y x then
- -- y < x
- qpart lt x ys (y:rlt) rge r
- else
- -- y >= x
- qpart lt x ys rlt (y:rge) r
-
--- rqsort is as qsort but anti-stable, i.e. reverses equal elements
-rqsort lt [] r = r
-rqsort lt [x] r = x:r
-rqsort lt (x:xs) r = rqpart lt x xs [] [] r
-
-rqpart lt x [] rle rgt r =
- qsort lt rle (x : qsort lt rgt r)
-
-rqpart lt x (y:ys) rle rgt r =
- if lt x y then
- -- y > x
- rqpart lt x ys rle (y:rgt) r
- else
- -- y <= x
- rqpart lt x ys (y:rle) rgt r
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection[Utils-dull-mergesort]{A rather dull mergesort}
-%* *
-%************************************************************************
-
-\begin{code}
-mergesort :: (a -> a -> TAG_) -> [a] -> [a]
-
-mergesort cmp xs = merge_lists (split_into_runs [] xs)
- where
- a `le` b = case cmp a b of { LT_ -> True; EQ_ -> True; GT__ -> False }
- a `ge` b = case cmp a b of { LT_ -> False; EQ_ -> True; GT__ -> True }
-
- split_into_runs [] [] = []
- split_into_runs run [] = [run]
- split_into_runs [] (x:xs) = split_into_runs [x] xs
- split_into_runs [r] (x:xs) | x `ge` r = split_into_runs [r,x] xs
- split_into_runs rl@(r:rs) (x:xs) | x `le` r = split_into_runs (x:rl) xs
- | True = rl : (split_into_runs [x] xs)
-
- merge_lists [] = []
- merge_lists (x:xs) = merge x (merge_lists xs)
-
- merge [] ys = ys
- merge xs [] = xs
- merge xl@(x:xs) yl@(y:ys)
- = case cmp x y of
- EQ_ -> x : y : (merge xs ys)
- LT_ -> x : (merge xs yl)
- GT__ -> y : (merge xl ys)