[project @ 2001-10-17 15:40:02 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / PrelBase.lhs

diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs
index 86e7dff..b74da36 100644 (file)
--- a/ghc/lib/std/PrelBase.lhs
+++ b/ghc/lib/std/PrelBase.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.49 2001/04/29 11:01:13 qrczak Exp $
+% $Id: PrelBase.lhs,v 1.55 2001/10/17 15:40:02 simonpj Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -243,25 +243,26 @@ The rest of the prelude list functions are in PrelList.
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
-{-# INLINE foldr #-}
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
 foldr k z xs = go xs
             where
               go []     = z
               go (y:ys) = y `k` go ys
 
 build  :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE 2 build #-}
+{-# INLINE [1] build #-}
        -- The INLINE is important, even though build is tiny,
        -- because it prevents [] getting inlined in the version that
        -- appears in the interface file.  If [] *is* inlined, it
        -- won't match with [] appearing in rules in an importing module.
        --
-       -- The "2" says to inline in phase 2
+       -- The "1" says to inline in phase 1
 
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE 2 augment #-}
+{-# INLINE [1] augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
@@ -274,7 +275,14 @@ augment g xs = g (:) xs
 "foldr/id"     foldr (:) [] = \x->x
 "foldr/app"            forall xs ys. foldr (:) ys xs = append xs ys
 
-"foldr/cons"   forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+-- The foldr/cons rule looks nice, but it can give disastrously
+-- bloated code when commpiling
+--     array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
+-- i.e. when there are very very long literal lists
+-- So I've disabled it for now. We could have special cases
+-- for short lists, I suppose.
+-- "foldr/cons"        forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+
 "foldr/nil"    forall k z.      foldr k z []     = z 
 
 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
@@ -295,6 +303,7 @@ augment g xs = g (:) xs
 
 \begin{code}
 map :: (a -> b) -> [a] -> [b]
+{-# NOINLINE [1] map #-}
 map = mapList
 
 -- Note eta expanded
@@ -309,7 +318,7 @@ mapList f (x:xs) = f x : mapList f xs
 "map"      forall f xs.        map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 "mapFB"            forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
 "mapList"   forall f.          foldr (mapFB (:) f) []  = mapList f
- #-}
+  #-}
 \end{code}
 
 
@@ -318,11 +327,12 @@ mapList f (x:xs) = f x : mapList f xs
 ----------------------------------------------
 \begin{code}
 (++) :: [a] -> [a] -> [a]
+{-# NOINLINE [1] (++) #-}
 (++) = append
 
 {-# RULES
-"++"   forall xs ys. (++) xs ys = augment (\c n -> foldr c n xs) ys
- #-}
+"++"   forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+  #-}
 
 append :: [a] -> [a] -> [a]
 append []     ys = ys
@@ -426,13 +436,13 @@ instance Ord Char where
     (C# c1) <  (C# c2) = c1 `ltChar#` c2
 
 {-# RULES
-"x# `eqChar#` x#" forall x#. eqChar# x# x# = True
-"x# `neChar#` x#" forall x#. neChar# x# x# = False
-"x# `gtChar#` x#" forall x#. gtChar# x# x# = False
-"x# `geChar#` x#" forall x#. geChar# x# x# = True
-"x# `leChar#` x#" forall x#. leChar# x# x# = True
-"x# `ltChar#` x#" forall x#. ltChar# x# x# = False
-    #-}
+"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
+"x# `neChar#` x#" forall x#. x# `neChar#` x# = False
+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True
+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True
+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
+  #-}
 
 chr :: Int -> Char
 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
@@ -449,9 +459,14 @@ String equality is used when desugaring pattern-matches against strings.
 
 \begin{code}
 eqString :: String -> String -> Bool
-eqString = (==)
+eqString []       []      = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString cs1      cs2     = False
+
+{-# RULES "eqString" (==) = eqString #-}
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Type @Int@}
@@ -465,10 +480,15 @@ zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 zeroInt = I# 0#
 oneInt  = I# 1#
 twoInt  = I# 2#
-#if WORD_SIZE_IN_BYTES == 4
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt  = I# (-0x40000000#)
+maxInt  = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
 minInt  = I# (-0x80000000#)
 maxInt  = I# 0x7FFFFFFF#
-#else
+#else 
 minInt  = I# (-0x8000000000000000#)
 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 #endif
@@ -616,15 +636,15 @@ plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> I
 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
 
 {-# RULES
-"x# +# 0#" forall x#. (+#) x# 0# = x#
-"0# +# x#" forall x#. (+#) 0# x# = x#
-"x# -# 0#" forall x#. (-#) x# 0# = x#
-"x# -# x#" forall x#. (-#) x# x# = 0#
-"x# *# 0#" forall x#. (*#) x# 0# = 0#
-"0# *# x#" forall x#. (*#) 0# x# = 0#
-"x# *# 1#" forall x#. (*#) x# 1# = x#
-"1# *# x#" forall x#. (*#) 1# x# = x#
-    #-}
+"x# +# 0#" forall x#. x# +# 0# = x#
+"0# +# x#" forall x#. 0# +# x# = x#
+"x# -# 0#" forall x#. x# -# 0# = x#
+"x# -# x#" forall x#. x# -# x# = 0#
+"x# *# 0#" forall x#. x# *# 0# = 0#
+"0# *# x#" forall x#. 0# *# x# = 0#
+"x# *# 1#" forall x#. x# *# 1# = x#
+"1# *# x#" forall x#. 1# *# x# = x#
+  #-}
 
 gcdInt (I# a) (I# b) = g a b
    where g 0# 0# = error "PrelBase.gcdInt: gcd 0 0 is undefined"
@@ -649,25 +669,25 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 (I# x) `leInt` (I# y) = x <=# y
 
 {-# RULES
-"x# ># x#"  forall x#. (>#)  x# x# = False
-"x# >=# x#" forall x#. (>=#) x# x# = True
-"x# ==# x#" forall x#. (==#) x# x# = True
-"x# /=# x#" forall x#. (/=#) x# x# = False
-"x# <# x#"  forall x#. (<#)  x# x# = False
-"x# <=# x#" forall x#. (<=#) x# x# = True
-    #-}
-
-#if WORD_SIZE_IN_BYTES == 4
+"x# ># x#"  forall x#. x# >#  x# = False
+"x# >=# x#" forall x#. x# >=# x# = True
+"x# ==# x#" forall x#. x# ==# x# = True
+"x# /=# x#" forall x#. x# /=# x# = False
+"x# <# x#"  forall x#. x# <#  x# = False
+"x# <=# x#" forall x#. x# <=# x# = True
+  #-}
+
+#if WORD_SIZE_IN_BITS == 32
 {-# RULES
-"intToInt32#"   forall x#. intToInt32#   x# = x#
-"wordToWord32#" forall x#. wordToWord32# x# = x#
-     #-}
+"narrow32Int#"  forall x#. narrow32Int#   x# = x#
+"narrow32Word#" forall x#. narrow32Word#   x# = x#
+   #-}
 #endif
 
 {-# RULES
 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
-    #-}
+  #-}
 \end{code}
 
 
@@ -682,6 +702,7 @@ unpacking the strings of error messages.
 
 \begin{code}
 unpackCString# :: Addr# -> [Char]
+{-# NOINLINE [1] unpackCString# #-}
 unpackCString# a = unpackCStringList# a
 
 unpackCStringList# :: Addr# -> [Char]
@@ -705,6 +726,9 @@ unpackAppendCString# addr rest
        ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
+{-# NOINLINE [0] unpackFoldrCString# #-}
+-- Don't inline till right at the end;
+-- usually the unpack-list rule turns it into unpackCStringList
 unpackFoldrCString# addr f z 
   = unpack 0#
   where