[project @ 1996-07-25 20:43:49 by partain]

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

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index b56e4cc..6d51f3a 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -9,12 +9,16 @@
 # define IF_NOT_GHC(a) {--}
 #else
 # define panic error
-# define TAG_ _CMP_TAG
-# define LT_ _LT
-# define EQ_ _EQ
-# define GT_ _GT
+# define TAG_ Ordering
+# define LT_ LT
+# define EQ_ EQ
+# define GT_ GT
+# define _LT LT
+# define _EQ EQ
+# define _GT GT
 # define GT__ _
-# define tagCmp_ _tagCmp
+# define tagCmp_ compare
+# define _tagCmp compare
 # define FAST_STRING String
 # define ASSERT(x) {-nothing-}
 # define IF_NOT_GHC(a) a
@@ -39,10 +43,10 @@ module Util (
        IF_NOT_GHC(forall COMMA exists COMMA)
        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
         zipLazy,
-       mapAndUnzip,
+       mapAndUnzip, mapAndUnzip3,
        nOfThem, lengthExceeds, isSingleton,
-       startsWith, endsWith,
 #if defined(COMPILING_GHC)
+       startsWith, endsWith,
        isIn, isn'tIn,
 #endif
 
@@ -65,13 +69,13 @@ module Util (
        mapAccumL, mapAccumR, mapAccumB,
 
        -- comparisons
+#if defined(COMPILING_GHC)
        Ord3(..), thenCmp, cmpList,
-       IF_NOT_GHC(cmpString COMMA)
-#ifdef USE_FAST_STRINGS
        cmpPString,
 #else
-       substr,
+       cmpString,
 #endif
+
        -- pairs
        IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
        IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
@@ -83,25 +87,16 @@ module Util (
        , assertPanic
 #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
-#endif
-
     ) where
 
 #if defined(COMPILING_GHC)
 
 CHK_Ubiq() -- debugging consistency check
+IMPORT_1_3(List(zipWith4))
 
 import Pretty
-#endif
-#if __HASKELL1__ < 3
-import Maybes          ( Maybe(..) )
+#else
+import List(zipWith4)
 #endif
 
 infixr 9 `thenCmp`
@@ -195,6 +190,16 @@ mapAndUnzip f (x:xs)
        (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}
@@ -216,6 +221,7 @@ startsWith, endsWith :: String -> String -> Maybe String
 startsWith []     str = Just str
 startsWith (c:cs) (s:ss)
   = if c /= s then Nothing else startsWith cs ss
+startsWith  _    []  = Nothing
 
 endsWith cs ss
   = case (startsWith (reverse cs) (reverse ss)) of
@@ -587,11 +593,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
@@ -718,26 +724,18 @@ cmpString (x:xs) (y:ys) = if        x == y then cmpString xs ys
 cmpString []     ys    = LT_
 cmpString xs     []    = GT_
 
+#ifdef COMPILING_GHC
 cmpString _ _ = panic# "cmpString"
+#else
+cmpString _ _ = error "cmpString"
+#endif
 \end{code}
 
 \begin{code}
-#ifdef USE_FAST_STRINGS
 cmpPString :: FAST_STRING -> FAST_STRING -> TAG_
 
 cmpPString x y
   = case (_tagCmp x y) of { _LT -> LT_ ; _EQ -> EQ_ ; _GT -> GT_ }
-#endif
-\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
 \end{code}
 
 %************************************************************************
@@ -788,11 +786,15 @@ unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
 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" )
+             ++ "to glasgow-haskell-bugs@dcs.gla.ac.uk.\n\n" )
 
 pprPanic heading pretty_msg = panic (heading++(ppShow 80 pretty_msg))
 pprError heading pretty_msg = error (heading++(ppShow 80 pretty_msg))
+#if __GLASGOW_HASKELL__ >= 200
+pprTrace heading pretty_msg = GHCbase.trace (heading++(ppShow 80 pretty_msg))
+#else
 pprTrace heading pretty_msg = trace (heading++(ppShow 80 pretty_msg))
+#endif
 
 -- #-versions because panic can't return an unboxed int, and that's
 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)