[project @ 2001-05-28 03:31:19 by sof]

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

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 50587e2..423ab3f 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -24,6 +24,9 @@ module Util (
        -- for-loop
        nTimes,
 
+       -- maybe-ish
+       unJust,
+
        -- sorting
        IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
        sortLt,
@@ -34,32 +37,41 @@ module Util (
        transitiveClosure,
 
        -- accumulating
-       mapAccumL, mapAccumR, mapAccumB, foldl2, count,
+       mapAccumL, mapAccumR, mapAccumB, 
+       foldl2, count,
 
        -- comparisons
-       thenCmp, cmpList,
+       thenCmp, cmpList, prefixMatch, suffixMatch,
 
        -- strictness
-       seqList, ($!),
+       foldl', seqList,
 
        -- pairs
        IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
        IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
        unzipWith
 
-       -- I/O
-#if __GLASGOW_HASKELL__ < 402
-       , bracket
+       , global
+
+#if __GLASGOW_HASKELL__ <= 408
+       , catchJust
+       , ioErrors
+       , throwTo
 #endif
 
     ) where
 
+#include "../includes/config.h"
 #include "HsVersions.h"
 
 import List            ( zipWith4 )
+import Maybe           ( Maybe(..) )
 import Panic           ( panic )
-import Unique          ( Unique )
-import UniqFM          ( eltsUFM, emptyUFM, addToUFM_C )
+import IOExts          ( IORef, newIORef, unsafePerformIO )
+import FastTypes
+#if __GLASGOW_HASKELL__ <= 408
+import Exception       ( catchIO, justIoErrors, raiseInThread )
+#endif
 
 infixr 9 `thenCmp`
 \end{code}
@@ -113,6 +125,17 @@ nTimes 1 f = f
 nTimes n f = f . nTimes (n-1) f
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\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}
 
 %************************************************************************
 %*                                                                     *
@@ -248,20 +271,20 @@ notElem__ x (y:ys) =  x /= y && notElem__ x ys
 
 # else {- DEBUG -}
 isIn msg x ys
-  = elem ILIT(0) x ys
+  = elem (_ILIT 0) x ys
   where
     elem i _ []            = False
     elem i x (y:ys)
-      | i _GE_ ILIT(100) = panic ("Over-long elem in: " ++ msg)
-      | otherwise       = x == y || elem (i _ADD_ ILIT(1)) x ys
+      | i ># _ILIT 100 = panic ("Over-long elem in: " ++ msg)
+      | otherwise       = x == y || elem (i +# _ILIT(1)) x ys
 
 isn'tIn msg x ys
-  = notElem ILIT(0) x ys
+  = notElem (_ILIT 0) x ys
   where
     notElem i x [] =  True
     notElem i x (y:ys)
-      | i _GE_ ILIT(100) = panic ("Over-long notElem in: " ++ msg)
-      | otherwise       =  x /= y && notElem (i _ADD_ ILIT(1)) x ys
+      | i ># _ILIT 100 = panic ("Over-long notElem in: " ++ msg)
+      | otherwise       =  x /= y && notElem (i +# _ILIT(1)) x ys
 
 # endif {- DEBUG -}
 
@@ -581,6 +604,16 @@ mapAccumB f a b (x:xs) = (a'',b'',y:ys)
        (a'',b',ys) = mapAccumB f a' b xs
 \end{code}
 
+A strict version of foldl.
+
+\begin{code}
+foldl'        :: (a -> b -> a) -> a -> [b] -> a
+foldl' f z xs = lgo z xs
+            where
+               lgo z []     =  z
+               lgo z (x:xs) = (lgo $! (f z x)) xs
+\end{code}
+
 A combination of foldl with zip.  It works with equal length lists.
 
 \begin{code}
@@ -622,17 +655,16 @@ cmpList cmp (a:as) (b:bs)
 \end{code}
 
 \begin{code}
-cmpString :: String -> String -> Ordering
-
-cmpString []     []    = EQ
-cmpString (x:xs) (y:ys) = if     x == y then cmpString xs ys
-                         else if x  < y then LT
-                         else                GT
-cmpString []     ys    = LT
-cmpString xs     []    = GT
+prefixMatch :: Eq a => [a] -> [a] -> Bool
+prefixMatch [] _str = True
+prefixMatch _pat [] = False
+prefixMatch (p:ps) (s:ss) | p == s    = prefixMatch ps ss
+                         | otherwise = False
+
+suffixMatch :: Eq a => [a] -> [a] -> Bool
+suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection[Utils-pairs]{Pairs}
@@ -671,27 +703,24 @@ unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
 \end{code}
 
 \begin{code}
-#if __HASKELL1__ > 4
 seqList :: [a] -> b -> b
-#else
-seqList :: (Eval a) => [a] -> b -> b
-#endif
 seqList [] b = b
 seqList (x:xs) b = x `seq` seqList xs b
+\end{code}
 
-#if __HASKELL1__ <= 4
-($!)    :: (Eval a) => (a -> b) -> a -> b
-f $! x  = x `seq` f x
-#endif
+Global variables:
+
+\begin{code}
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
 \end{code}
 
+Compatibility stuff:
+
 \begin{code}
-#if __GLASGOW_HASKELL__ < 402
-bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
-bracket before after thing = do
-  a <- before 
-  r <- (thing a) `catch` (\err -> after a >> fail err)
-  after a
-  return r
+#if __GLASGOW_HASKELL__ <= 408
+catchJust = catchIO
+ioErrors  = justIoErrors
+throwTo   = raiseInThread
 #endif
 \end{code}