[project @ 1999-06-03 08:18:15 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 1165334..c9b1883 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -12,11 +12,10 @@ module Util (
        Eager, thenEager, returnEager, mapEager, appEager, runEager,
 
        -- general list processing
-       IF_NOT_GHC(forall COMMA exists COMMA)
        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
         zipLazy, stretchZipEqual,
        mapAndUnzip, mapAndUnzip3,
-       nOfThem, lengthExceeds, isSingleton,
+       nOfThem, lengthExceeds, isSingleton, only,
        snocView,
        isIn, isn'tIn,
 
@@ -36,11 +35,14 @@ module Util (
        transitiveClosure,
 
        -- accumulating
-       mapAccumL, mapAccumR, mapAccumB,
+       mapAccumL, mapAccumR, mapAccumB, foldl2, count,
 
        -- comparisons
        thenCmp, cmpList,
 
+       -- strictness
+       seqList, ($!),
+
        -- pairs
        IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
        IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
@@ -95,18 +97,6 @@ mapEager f (x:xs) = f x                      `thenEager` \ y ->
 %*                                                                     *
 %************************************************************************
 
-Quantifiers are not standard in Haskell. The following fill in the gap.
-
-\begin{code}
-forall :: (a -> Bool) -> [a] -> Bool
-forall pred []     = True
-forall pred (x:xs) = pred x && forall pred xs
-
-exists :: (a -> Bool) -> [a] -> Bool
-exists pred []     = False
-exists pred (x:xs) = pred x || exists pred xs
-\end{code}
-
 A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
 are of equal length.  Alastair Reid thinks this should only happen if
 DEBUGging on; hey, why not?
@@ -187,17 +177,23 @@ mapAndUnzip3 f (x:xs)
 
 \begin{code}
 nOfThem :: Int -> a -> [a]
-nOfThem n thing = take n (repeat thing)
+nOfThem n thing = replicate n thing
 
 lengthExceeds :: [a] -> Int -> Bool
-
-[]     `lengthExceeds` n =  0 > n
-(x:xs) `lengthExceeds` n = (1 > n) || (xs `lengthExceeds` (n - 1))
+-- (lengthExceeds xs n) is True if   length xs > n
+(x:xs) `lengthExceeds` n = n < 1 || xs `lengthExceeds` (n - 1)
+[]     `lengthExceeds` n = n < 0
 
 isSingleton :: [a] -> Bool
-
 isSingleton [x] = True
 isSingleton  _  = False
+
+only :: [a] -> a
+#ifdef DEBUG
+only [a] = a
+#else
+only (a:_) = a
+#endif
 \end{code}
 
 \begin{code}
@@ -663,6 +659,24 @@ mapAccumB f a b (x:xs) = (a'',b'',y:ys)
        (a'',b',ys) = mapAccumB f a' b xs
 \end{code}
 
+A combination of foldl with zip.  It works with equal length lists.
+
+\begin{code}
+foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
+foldl2 k z [] [] = z
+foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
+\end{code}
+
+Count the number of times a predicate is true
+
+\begin{code}
+count :: (a -> Bool) -> [a] -> Int
+count p [] = 0
+count p (x:xs) | p x       = 1 + count p xs
+              | otherwise = count p xs
+\end{code}
+
+
 %************************************************************************
 %*                                                                     *
 \subsection[Utils-comparison]{Comparisons}
@@ -694,12 +708,9 @@ cmpString (x:xs) (y:ys) = if         x == y then cmpString xs ys
                          else                GT
 cmpString []     ys    = LT
 cmpString xs     []    = GT
-
-cmpString _ _ = panic "cmpString"
 \end{code}
 
 
-y
 %************************************************************************
 %*                                                                     *
 \subsection[Utils-pairs]{Pairs}
@@ -737,4 +748,28 @@ unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
 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
+
+#if __HASKELL1__ <= 4
+($!)    :: (Eval a) => (a -> b) -> a -> b
+f $! x  = x `seq` f x
+#endif
+\end{code}
 
+\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
+#endif
+\end{code}