[project @ 2002-12-05 23:49:43 by mthomas]

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

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 8c86eea..4949515 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,15 @@ module Util (
        nOfThem, 
        lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
        isSingleton, only,
-       snocView,
+       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,32 +40,33 @@ module Util (
        foldl', seqList,
 
        -- pairs
-       IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
-       IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
-       unzipWith
+       unzipWith,
 
-       , global
-
-#if __GLASGOW_HASKELL__ <= 408
-       , catchJust
-       , ioErrors
-       , throwTo
-#endif
+       global,
 
+       -- module names
+       looksLikeModuleName,
     ) where
 
 #include "../includes/config.h"
 #include "HsVersions.h"
 
-import qualified List  ( elem, notElem )
-import List            ( zipWith4 )
-import Maybe           ( Maybe(..) )
 import Panic           ( panic, trace )
-import IOExts          ( IORef, newIORef, unsafePerformIO )
 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
+
+import Char            ( isUpper, isAlphaNum )
 
 infixr 9 `thenCmp`
 \end{code}
@@ -133,18 +122,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}
 %*                                                                     *
 %************************************************************************
@@ -257,10 +234,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)
@@ -280,6 +258,19 @@ isSingleton :: [a] -> Bool
 isSingleton [x] = True
 isSingleton  _  = False
 
+notNull :: [a] -> Bool
+notNull [] = False
+notNull _  = True
+
+snocView :: [a] -> Maybe ([a],a)
+       -- Split off the last element
+snocView [] = Nothing
+snocView xs = go [] xs
+           where
+               -- Invariant: second arg is non-empty
+             go acc [x]    = Just (reverse acc, x)
+             go acc (x:xs) = go (x:acc) xs
+
 only :: [a] -> a
 #ifdef DEBUG
 only [a] = a
@@ -288,14 +279,6 @@ only (a:_) = a
 #endif
 \end{code}
 
-\begin{code}
-snocView :: [a] -> ([a], a)    -- Split off the last element
-snocView xs = go xs []
-           where
-             go [x]    acc = (reverse acc, x)
-             go (x:xs) acc = go xs (x:acc)
-\end{code}
-
 Debugging/specialising versions of \tr{elem} and \tr{notElem}
 
 \begin{code}
@@ -367,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
@@ -550,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}
 
@@ -759,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)
 
@@ -775,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
@@ -800,12 +788,11 @@ global :: a -> IORef a
 global a = unsafePerformIO (newIORef a)
 \end{code}
 
-Compatibility stuff:
+Module names:
 
 \begin{code}
-#if __GLASGOW_HASKELL__ <= 408
-catchJust = catchIO
-ioErrors  = justIoErrors
-throwTo   = raiseInThread
-#endif
+looksLikeModuleName [] = False
+looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
+
+isAlphaNumEx c = isAlphaNum c || c == '_' || c == '.'
 \end{code}