[project @ 2002-08-29 15:44:11 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / Util.lhs

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 51f53f3..d7b228e 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -1,17 +1,10 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+% (c) The University of Glasgow 1992-2002
 %
 \section[Util]{Highly random utility functions}
 
 \begin{code}
--- IF_NOT_GHC is meant to make this module useful outside the context of GHC
-#define IF_NOT_GHC(a)
-
 module Util (
-#if NOT_USED
-       -- The Eager monad
-       Eager, thenEager, returnEager, mapEager, appEager, runEager,
-#endif
 
        -- general list processing
        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
@@ -20,20 +13,16 @@ module Util (
        nOfThem, 
        lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
        isSingleton, only,
+       notNull,
+
        snocView,
        isIn, isn'tIn,
 
        -- for-loop
        nTimes,
 
-       -- maybe-ish
-       unJust,
-
        -- sorting
-       IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
-       sortLt,
-       IF_NOT_GHC(mergeSort COMMA) naturalMergeSortLe, -- from Carsten
-       IF_NOT_GHC(naturalMergeSort COMMA mergeSortLe COMMA)
+       sortLt, naturalMergeSortLe,
 
        -- transitive closures
        transitiveClosure,
@@ -52,16 +41,12 @@ module Util (
        foldl', seqList,
 
        -- pairs
-       IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
-       IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
-       unzipWith
+       unzipWith,
 
-       , global
+       global,
 
 #if __GLASGOW_HASKELL__ <= 408
-       , catchJust
-       , ioErrors
-       , throwTo
+       catchJust, ioErrors, throwTo
 #endif
 
     ) where
@@ -69,13 +54,19 @@ module Util (
 #include "../includes/config.h"
 #include "HsVersions.h"
 
-import List            ( zipWith4 )
-import Maybe           ( Maybe(..) )
-import Panic           ( panic )
-import IOExts          ( IORef, newIORef, unsafePerformIO )
+import Panic           ( panic, trace )
 import FastTypes
+
 #if __GLASGOW_HASKELL__ <= 408
-import Exception       ( catchIO, justIoErrors, raiseInThread )
+import EXCEPTION       ( catchIO, justIoErrors, raiseInThread )
+#endif
+import DATA_IOREF      ( IORef, newIORef )
+import UNSAFE_IO       ( unsafePerformIO )
+
+import qualified List  ( elem, notElem )
+
+#ifndef DEBUG
+import List            ( zipWith4 )
 #endif
 
 infixr 9 `thenCmp`
@@ -132,18 +123,6 @@ nTimes n f = f . nTimes (n-1) f
 
 %************************************************************************
 %*                                                                     *
-\subsection{Maybe-ery}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-unJust :: String -> Maybe a -> a
-unJust who (Just x) = x
-unJust who Nothing  = panic ("unJust of Nothing, called by " ++ who)
-\end{code}
-
-%************************************************************************
-%*                                                                     *
 \subsection[Utils-lists]{General list processing}
 %*                                                                     *
 %************************************************************************
@@ -256,10 +235,11 @@ atLength atLenPred atEndPred ls n
 
 -- special cases.
 lengthExceeds :: [a] -> Int -> Bool
-lengthExceeds = atLength (not.null) (const False)
+-- (lengthExceeds xs n) = (length xs > n)
+lengthExceeds = atLength notNull (const False)
 
 lengthAtLeast :: [a] -> Int -> Bool
-lengthAtLeast = atLength (not.null) (== 0)
+lengthAtLeast = atLength notNull (== 0)
 
 lengthIs :: [a] -> Int -> Bool
 lengthIs = atLength null (==0)
@@ -279,6 +259,10 @@ isSingleton :: [a] -> Bool
 isSingleton [x] = True
 isSingleton  _  = False
 
+notNull :: [a] -> Bool
+notNull [] = False
+notNull _  = True
+
 only :: [a] -> a
 #ifdef DEBUG
 only [a] = a
@@ -317,19 +301,19 @@ isIn msg x ys
   where
     elem i _ []            = False
     elem i x (y:ys)
-      | i ># _ILIT 100 = panic ("Over-long elem in: " ++ msg)
-      | otherwise       = x == y || elem (i +# _ILIT(1)) x ys
+      | i ># _ILIT 100 = trace ("Over-long elem in " ++ msg) $
+                        x `List.elem` (y:ys)
+      | otherwise      = x == y || elem (i +# _ILIT(1)) x ys
 
 isn'tIn msg x ys
   = notElem (_ILIT 0) x ys
   where
     notElem i x [] =  True
     notElem i x (y:ys)
-      | i ># _ILIT 100 = panic ("Over-long notElem in: " ++ msg)
-      | otherwise       =  x /= y && notElem (i +# _ILIT(1)) x ys
-
+      | i ># _ILIT 100 = trace ("Over-long notElem in " ++ msg) $
+                        x `List.notElem` (y:ys)
+      | otherwise      =  x /= y && notElem (i +# _ILIT(1)) x ys
 # endif {- DEBUG -}
-
 \end{code}
 
 %************************************************************************
@@ -366,8 +350,6 @@ 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
@@ -549,12 +531,15 @@ generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
 generalNaturalMergeSort p [] = []
 generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
 
+#if NOT_USED
 mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
 
 mergeSort = generalMergeSort (<=)
 naturalMergeSort = generalNaturalMergeSort (<=)
 
 mergeSortLe le = generalMergeSort le
+#endif
+
 naturalMergeSortLe le = generalNaturalMergeSort le
 \end{code}
 
@@ -758,14 +743,17 @@ suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
 The following are curried versions of @fst@ and @snd@.
 
 \begin{code}
+#if NOT_USED
 cfst :: a -> b -> a    -- stranal-sem only (Note)
 cfst x y = x
+#endif
 \end{code}
 
 The following provide us higher order functions that, when applied
 to a function, operate on pairs.
 
 \begin{code}
+#if NOT_USED
 applyToPair :: ((a -> c),(b -> d)) -> (a,b) -> (c,d)
 applyToPair (f,g) (x,y) = (f x, g y)
 
@@ -774,6 +762,7 @@ applyToFst f (x,y) = (f x,y)
 
 applyToSnd :: (b -> d) -> (a,b) -> (a,d)
 applyToSnd f (x,y) = (x,f y)
+#endif
 
 foldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b)
 foldPair fg ab [] = ab