X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUtil.lhs;h=7cb7a3de512128da9b4a3a13eccfc65f2cbef133;hb=bbc670f4ac4428a3a13ab34c2843381a82698ff4;hp=2aaec61a283785a9e929f1f32f36892af7a37005;hpb=c49d51f812da9b1c2ceca7e0dad8f2a3626041a9;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 2aaec61..7cb7a3d 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -1,55 +1,31 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[Util]{Highly random utility functions}
 
 \begin{code}
-#if defined(COMPILING_GHC)
-# include "HsVersions.h"
-# define IF_NOT_GHC(a) {--}
-#else
-# define panic error
-# define TAG_ _CMP_TAG
-# define LT_ _LT
-# define EQ_ _EQ
-# define GT_ _GT
-# define GT__ _
-# define tagCmp_ _tagCmp
-# define FAST_STRING String
-# define ASSERT(x) {-nothing-}
-# define IF_NOT_GHC(a) a
-# define COMMA ,
-#endif
-
-#ifndef __GLASGOW_HASKELL__
-# undef TAG_
-# undef LT_
-# undef EQ_
-# undef GT_
-# undef tagCmp_
-#endif
+-- IF_NOT_GHC is meant to make this module useful outside the context of GHC
+#define IF_NOT_GHC(a)
 
 module Util (
-	-- Haskell-version support
-#ifndef __GLASGOW_HASKELL__
-	tagCmp_,
-	TAG_(..),
+#if NOT_USED
+	-- The Eager monad
+	Eager, thenEager, returnEager, mapEager, appEager, runEager,
 #endif
+
 	-- general list processing
-	IF_NOT_GHC(forall COMMA exists COMMA)
 	zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
-        zipLazy,
-	nOfThem, lengthExceeds, isSingleton,
-	startsWith, endsWith,
-#if defined(COMPILING_GHC)
+        zipLazy, stretchZipWith,
+	mapAndUnzip, mapAndUnzip3,
+	nOfThem, lengthExceeds, isSingleton, only,
+	snocView,
 	isIn, isn'tIn,
-#endif
 
-	-- association lists
-	assoc,
+	-- for-loop
+	nTimes,
 
-	-- duplicate handling
-	hasNoDups, equivClasses, runs, removeDups,
+	-- maybe-ish
+	unJust,
 
 	-- sorting
 	IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
@@ -61,118 +37,148 @@ module Util (
 	transitiveClosure,
 
 	-- accumulating
-	mapAccumL, mapAccumR, mapAccumB,
+	mapAccumL, mapAccumR, mapAccumB, 
+	foldl2, count,
 
 	-- comparisons
-	Ord3(..), thenCmp, cmpList,
-	IF_NOT_GHC(cmpString COMMA)
-#ifdef USE_FAST_STRINGS
-	cmpPString,
-#else
-	substr,
-#endif
+	thenCmp, cmpList, prefixMatch, suffixMatch,
+
+	-- strictness
+	foldl', seqList,
+
 	-- pairs
 	IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
 	IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
 	unzipWith
 
-	-- error handling
-#if defined(COMPILING_GHC)
-	, panic, panic#, pprPanic, pprPanic#, pprError, pprTrace
-# ifdef DEBUG
-	, assertPanic
-# endif
-#endif {- COMPILING_GHC -}
-
-	-- and to make the interface self-sufficient...
-#if __HASKELL1__ < 3
-# if defined(COMPILING_GHC)
-	, Maybe(..){-.. for pragmas...-}, PrettyRep, Pretty(..)
-# else
-	, Maybe
-# endif
+	, global
+	, myGetProcessID
+
+#if __GLASGOW_HASKELL__ <= 408
+	, catchJust
+	, ioErrors
+	, throwTo
 #endif
 
     ) where
 
-#if defined(COMPILING_GHC)
+#include "../includes/config.h"
+#include "HsVersions.h"
 
-CHK_Ubiq() -- debugging consistency check
-
-import Pretty
+import List		( zipWith4 )
+import Maybe		( Maybe(..) )
+import Panic		( panic )
+import IOExts		( IORef, newIORef, unsafePerformIO )
+import FastTypes
+#if __GLASGOW_HASKELL__ <= 408
+import Exception	( catchIO, justIoErrors, raiseInThread )
 #endif
-#if __HASKELL1__ < 3
-import Maybes		( Maybe(..) )
+#ifndef mingw32_TARGET_OS
+import Posix
 #endif
+infixr 9 `thenCmp`
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection[Utils-version-support]{Functions to help pre-1.2 versions of (non-Glasgow) Haskell}
+\subsection{The Eager monad}
 %*									*
 %************************************************************************
 
-This is our own idea:
+The @Eager@ monad is just an encoding of continuation-passing style,
+used to allow you to express "do this and then that", mainly to avoid
+space leaks. It's done with a type synonym to save bureaucracy.
+
 \begin{code}
-#ifndef __GLASGOW_HASKELL__
-data TAG_ = LT_ | EQ_ | GT_
+#if NOT_USED
+
+type Eager ans a = (a -> ans) -> ans
+
+runEager :: Eager a a -> a
+runEager m = m (\x -> x)
+
+appEager :: Eager ans a -> (a -> ans) -> ans
+appEager m cont = m cont
+
+thenEager :: Eager ans a -> (a -> Eager ans b) -> Eager ans b
+thenEager m k cont = m (\r -> k r cont)
 
-tagCmp_ :: Ord a => a -> a -> TAG_
-tagCmp_ a b = if a == b then EQ_ else if a < b then LT_ else GT_
+returnEager :: a -> Eager ans a
+returnEager v cont = cont v
+
+mapEager :: (a -> Eager ans b) -> [a] -> Eager ans [b]
+mapEager f [] = returnEager []
+mapEager f (x:xs) = f x			`thenEager` \ y ->
+		    mapEager f xs	`thenEager` \ ys ->
+		    returnEager (y:ys)
 #endif
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection[Utils-lists]{General list processing}
+\subsection{A for loop}
 %*									*
 %************************************************************************
 
-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
+-- Compose a function with itself n times.  (nth rather than twice)
+nTimes :: Int -> (a -> a) -> (a -> a)
+nTimes 0 _ = id
+nTimes 1 f = f
+nTimes n f = f . nTimes (n-1) f
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Maybe-ery}
+%*									*
+%************************************************************************
 
-exists :: (a -> Bool) -> [a] -> Bool
-exists pred []     = False
-exists pred (x:xs) = pred x || exists pred xs
+\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}
+%*									*
+%************************************************************************
+
 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?
 
 \begin{code}
-zipEqual	:: [a] -> [b] -> [(a,b)]
-zipWithEqual	:: (a->b->c) -> [a]->[b]->[c]
-zipWith3Equal	:: (a->b->c->d) -> [a]->[b]->[c]->[d]
-zipWith4Equal	:: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipEqual	:: String -> [a] -> [b] -> [(a,b)]
+zipWithEqual	:: String -> (a->b->c) -> [a]->[b]->[c]
+zipWith3Equal	:: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith4Equal	:: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
 
 #ifndef DEBUG
-zipEqual      = zip
-zipWithEqual  = zipWith
-zipWith3Equal = zipWith3
-zipWith4Equal = zipWith4
+zipEqual      _ = zip
+zipWithEqual  _ = zipWith
+zipWith3Equal _ = zipWith3
+zipWith4Equal _ = zipWith4
 #else
-zipEqual []     []     = []
-zipEqual (a:as) (b:bs) = (a,b) : zipEqual as bs
-zipEqual as     bs     = panic "zipEqual: unequal lists"
-
-zipWithEqual z (a:as) (b:bs)	=  z a b : zipWithEqual z as bs
-zipWithEqual _ [] []		=  []
-zipWithEqual _ _ _		=  panic "zipWithEqual: unequal lists"
-
-zipWith3Equal z (a:as) (b:bs) (c:cs)
-				=  z a b c : zipWith3Equal z as bs cs
-zipWith3Equal _ [] []  []	=  []
-zipWith3Equal _ _  _   _	=  panic "zipWith3Equal: unequal lists"
-
-zipWith4Equal z (a:as) (b:bs) (c:cs) (d:ds)
-				=  z a b c d : zipWith4Equal z as bs cs ds
-zipWith4Equal _ [] [] [] []	=  []
-zipWith4Equal _ _  _  _  _	=  panic "zipWith4Equal: unequal lists"
+zipEqual msg []     []     = []
+zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
+zipEqual msg as     bs     = panic ("zipEqual: unequal lists:"++msg)
+
+zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs
+zipWithEqual msg _ [] []	=  []
+zipWithEqual msg _ _ _		=  panic ("zipWithEqual: unequal lists:"++msg)
+
+zipWith3Equal msg z (a:as) (b:bs) (c:cs)
+				=  z a b c : zipWith3Equal msg z as bs cs
+zipWith3Equal msg _ [] []  []	=  []
+zipWith3Equal msg _ _  _   _	=  panic ("zipWith3Equal: unequal lists:"++msg)
+
+zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
+				=  z a b c d : zipWith4Equal msg z as bs cs ds
+zipWith4Equal msg _ [] [] [] []	=  []
+zipWith4Equal msg _ _  _  _  _	=  panic ("zipWith4Equal: unequal lists:"++msg)
 #endif
 \end{code}
 
@@ -184,35 +190,75 @@ zipLazy [] ys = []
 zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
 \end{code}
 
+
+\begin{code}
+stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
+-- (stretchZipWith p z f xs ys) stretches ys by inserting z in 
+-- the places where p returns *True*
+
+stretchZipWith p z f [] ys = []
+stretchZipWith p z f (x:xs) ys
+  | p x       = f x z : stretchZipWith p z f xs ys
+  | otherwise = case ys of
+		  []     -> []
+		  (y:ys) -> f x y : stretchZipWith p z f xs ys
+\end{code}
+
+
+\begin{code}
+mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
+
+mapAndUnzip f [] = ([],[])
+mapAndUnzip f (x:xs)
+  = let
+	(r1,  r2)  = f x
+	(rs1, rs2) = mapAndUnzip f xs
+    in
+    (r1:rs1, r2:rs2)
+
+mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
+
+mapAndUnzip3 f [] = ([],[],[])
+mapAndUnzip3 f (x:xs)
+  = let
+	(r1,  r2,  r3)  = f x
+	(rs1, rs2, rs3) = mapAndUnzip3 f xs
+    in
+    (r1:rs1, r2:rs2, r3:rs3)
+\end{code}
+
 \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
 
-startsWith, endsWith :: String -> String -> Maybe String
-
-startsWith []     str = Just str
-startsWith (c:cs) (s:ss)
-  = if c /= s then Nothing else startsWith cs ss
+only :: [a] -> a
+#ifdef DEBUG
+only [a] = a
+#else
+only (a:_) = a
+#endif
+\end{code}
 
-endsWith cs ss
-  = case (startsWith (reverse cs) (reverse ss)) of
-      Nothing -> Nothing
-      Just rs -> Just (reverse rs)
+\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}
-#if defined(COMPILING_GHC)
 isIn, isn'tIn :: (Eq a) => String -> a -> [a] -> Bool
 
 # ifndef DEBUG
@@ -228,155 +274,23 @@ 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 -}
 
-# ifdef USE_ATTACK_PRAGMAS
-{-# SPECIALIZE isIn :: String -> Literal -> [Literal] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> Class -> [Class] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> Id -> [Id] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> Int -> [Int] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> MagicId -> [MagicId] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> Name -> [Name] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> TyCon -> [TyCon] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> TyVar -> [TyVar] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> TyVarTemplate -> [TyVarTemplate] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> Unique -> [Unique] -> Bool #-}
-{-# SPECIALIZE isIn :: String -> _PackedString -> [_PackedString] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> (Id, Id) -> [(Id, Id)] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> Int -> [Int] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> Id -> [Id] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> MagicId -> [MagicId] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> TyCon -> [TyCon] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> TyVar -> [TyVar] -> Bool #-}
-{-# SPECIALIZE isn'tIn :: String -> TyVarTemplate -> [TyVarTemplate] -> Bool #-}
-# endif
-
-#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']
-
-#if defined(COMPILING_GHC)
-# ifdef USE_ATTACK_PRAGMAS
-{-# SPECIALIZE assoc :: String -> [(Id,            a)] -> Id		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(Class,         a)] -> Class		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(Name,          a)] -> Name		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(PrimRep,      a)] -> PrimRep	-> a #-}
-{-# SPECIALIZE assoc :: String -> [(String,        a)] -> String        -> a #-}
-{-# SPECIALIZE assoc :: String -> [(TyCon,         a)] -> TyCon		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(TyVar,         a)] -> TyVar		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(TyVarTemplate, a)] -> TyVarTemplate -> a #-}
-{-# SPECIALIZE assoc :: String -> [(Type,          a)] -> Type		-> a #-}
-{-# SPECIALIZE assoc :: String -> [(_PackedString, a)] -> _PackedString -> a #-}
-# endif
-#endif
-\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
-#if defined(COMPILING_GHC)
-# ifdef USE_ATTACK_PRAGMAS
-{-# SPECIALIZE hasNoDups :: [TyVar] -> Bool #-}
-# endif
-#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}
 
 %************************************************************************
@@ -392,6 +306,8 @@ removeDups cmp xs
 %************************************************************************
 
 \begin{code}
+#if NOT_USED
+
 -- tail-recursive, etc., "quicker sort" [as per Meira thesis]
 quicksort :: (a -> a -> Bool)		-- Less-than predicate
 	  -> [a]			-- Input list
@@ -404,6 +320,7 @@ quicksort lt (x:xs)  = split x [] [] xs
     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
+#endif
 \end{code}
 
 Quicksort variant from Lennart's Haskell-library contribution.  This
@@ -470,12 +387,13 @@ rqpart lt x (y:ys) rle rgt r =
 %************************************************************************
 
 \begin{code}
-mergesort :: (a -> a -> TAG_) -> [a] -> [a]
+#if NOT_USED
+mergesort :: (a -> a -> Ordering) -> [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  }
+    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]
@@ -491,9 +409,10 @@ mergesort cmp xs = merge_lists (split_into_runs [] xs)
     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)
+	  EQ  -> x : y : (merge xs ys)
+	  LT  -> x : (merge xs yl)
+	  GT -> y : (merge xl ys)
+#endif
 \end{code}
 
 %************************************************************************
@@ -615,11 +534,11 @@ transitiveClosure :: (a -> [a])		-- Successor function
 		  -> [a]		-- The transitive closure
 
 transitiveClosure succ eq xs
- = do [] xs
+ = go [] xs
  where
-   do done [] 			   = done
-   do done (x:xs) | x `is_in` done = do done xs
-   		  | otherwise      = do (x:done) (succ x ++ xs)
+   go done [] 			   = done
+   go done (x:xs) | x `is_in` done = go done xs
+   		  | otherwise      = go (x:done) (succ x ++ xs)
 
    x `is_in` []                 = False
    x `is_in` (y:ys) | eq x y    = True
@@ -688,84 +607,65 @@ mapAccumB f a b (x:xs) = (a'',b'',y:ys)
 	(a'',b',ys) = mapAccumB f a' b xs
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection[Utils-comparison]{Comparisons}
-%*									*
-%************************************************************************
-
-See also @tagCmp_@ near the versions-compatibility section.
-
-The Ord3 class will be subsumed into Ord in Haskell 1.3.
+A strict version of foldl.
 
 \begin{code}
-class Ord3 a where
-  cmp :: a -> a -> TAG_
-
-thenCmp :: TAG_ -> TAG_ -> TAG_
-{-# INLINE thenCmp #-}
-thenCmp EQ_   any = any
-thenCmp other any = other
-
-cmpList :: (a -> a -> TAG_) -> [a] -> [a] -> TAG_
-    -- `cmpList' uses a user-specified comparer
-
-cmpList cmp []     [] = EQ_
-cmpList cmp []     _  = LT_
-cmpList cmp _      [] = GT_
-cmpList cmp (a:as) (b:bs)
-  = case cmp a b of { EQ_ -> cmpList cmp as bs; xxx -> xxx }
+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}
-instance Ord3 a => Ord3 [a] where
-  cmp []     []     = EQ_
-  cmp (x:xs) []     = GT_
-  cmp []     (y:ys) = LT_
-  cmp (x:xs) (y:ys) = (x `cmp` y) `thenCmp` (xs `cmp` ys)
-
-instance Ord3 a => Ord3 (Maybe a) where
-  cmp Nothing  Nothing  = EQ_
-  cmp Nothing  (Just y) = LT_
-  cmp (Just x) Nothing  = GT_
-  cmp (Just x) (Just y) = x `cmp` y
-
-instance Ord3 Int where
-  cmp a b | a < b     = LT_
- 	  | a > b     = GT_
-	  | otherwise = EQ_
+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}
-cmpString :: String -> String -> TAG_
+count :: (a -> Bool) -> [a] -> Int
+count p [] = 0
+count p (x:xs) | p x       = 1 + count p xs
+	       | otherwise = count p xs
+\end{code}
 
-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_
 
-cmpString _ _ = panic# "cmpString"
-\end{code}
+%************************************************************************
+%*									*
+\subsection[Utils-comparison]{Comparisons}
+%*									*
+%************************************************************************
 
 \begin{code}
-#ifdef USE_FAST_STRINGS
-cmpPString :: FAST_STRING -> FAST_STRING -> TAG_
+thenCmp :: Ordering -> Ordering -> Ordering
+{-# INLINE thenCmp #-}
+thenCmp EQ   any = any
+thenCmp other any = other
 
-cmpPString x y
-  = case (_tagCmp x y) of { _LT -> LT_ ; _EQ -> EQ_ ; _GT -> GT_ }
-#endif
+cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
+    -- `cmpList' uses a user-specified comparer
+
+cmpList cmp []     [] = EQ
+cmpList cmp []     _  = LT
+cmpList cmp _      [] = GT
+cmpList cmp (a:as) (b:bs)
+  = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
 \end{code}
 
 \begin{code}
-#ifndef USE_FAST_STRINGS
-substr :: FAST_STRING -> Int -> Int -> FAST_STRING
-
-substr str beg end
-  = ASSERT (beg >= 0 && beg <= end)
-    take (end - beg + 1) (drop beg str)
-#endif
+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}
 
 %************************************************************************
@@ -805,35 +705,32 @@ unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
 unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection[Utils-errors]{Error handling}
-%*									*
-%************************************************************************
+\begin{code}
+seqList :: [a] -> b -> b
+seqList [] b = b
+seqList (x:xs) b = x `seq` seqList xs b
+\end{code}
+
+Global variables:
 
 \begin{code}
-#if defined(COMPILING_GHC)
-panic x = error ("panic! (the `impossible' happened):\n\t"
-	      ++ x ++ "\n\n"
-	      ++ "Please report it as a compiler bug "
-	      ++ "to glasgow-haskell-bugs@dcs.glasgow.ac.uk.\n\n" )
-
-pprPanic heading pretty_msg = panic (heading++(ppShow 80 pretty_msg))
-pprError heading pretty_msg = error (heading++(ppShow 80 pretty_msg))
-pprTrace heading pretty_msg = trace (heading++(ppShow 80 pretty_msg))
-
--- #-versions because panic can't return an unboxed int, and that's
--- what TAG_ is with GHC at the moment.  Ugh. (Simon)
--- No, man -- Too Beautiful! (Will)
-
-panic# :: String -> TAG_
-panic# s = case (panic s) of () -> EQ_
-
-pprPanic# heading pretty_msg = panic# (heading++(ppShow 80 pretty_msg))
-
-# ifdef DEBUG
-assertPanic :: String -> Int -> a
-assertPanic file line = panic ("ASSERT failed! file "++file++", line "++show line)
-# endif
-#endif {- COMPILING_GHC -}
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+\end{code}
+
+Compatibility stuff:
+
+\begin{code}
+#if __GLASGOW_HASKELL__ <= 408
+catchJust = catchIO
+ioErrors  = justIoErrors
+throwTo   = raiseInThread
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import "_getpid" myGetProcessID :: IO Int 
+#else
+myGetProcessID :: IO Int
+myGetProcessID = Posix.getProcessID
+#endif
 \end{code}