% -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.47 2001/04/28 04:44:05 qrczak Exp $
+% $Id: PrelBase.lhs,v 1.53 2001/10/01 09:40:26 simonpj Exp $
%
% (c) The University of Glasgow, 1992-2000
%
return :: a -> m a
fail :: String -> m a
- m >> k = m >>= \_ -> k
+ m >> k = m >>= \_ -> k
fail s = error s
\end{code}
-- to avoid weird names like con2tag_[]#
-instance (Eq a) => Eq [a] where
+instance (Eq a) => Eq [a] where
{-# SPECIALISE instance Eq [Char] #-}
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
instance (Ord a) => Ord [a] where
{-# SPECIALISE instance Ord [Char] #-}
-
compare [] [] = EQ
compare [] (_:_) = LT
compare (_:_) [] = GT
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
\begin{code}
map :: (a -> b) -> [a] -> [b]
+{-# NOINLINE [1] map #-}
map = mapList
-- Note eta expanded
"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}
----------------------------------------------
\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
it here seems more direct.)
\begin{code}
-data () = ()
+data () = ()
instance Eq () where
() == () = True
-- '>' uses compare, and therefore takes two primops instead of one.
instance Eq Char where
- (C# c1) == (C# c2) = c1 `eqChar#` c2
- (C# c1) /= (C# c2) = c1 `neChar#` c2
+ (C# c1) == (C# c2) = c1 `eqChar#` c2
+ (C# c1) /= (C# c2) = c1 `neChar#` c2
instance Ord Char where
- (C# c1) > (C# c2) = c1 `gtChar#` c2
- (C# c1) >= (C# c2) = c1 `geChar#` c2
- (C# c1) <= (C# c2) = c1 `leChar#` c2
- (C# c1) < (C# c2) = c1 `ltChar#` c2
+ (C# c1) > (C# c2) = c1 `gtChar#` c2
+ (C# c1) >= (C# c2) = c1 `geChar#` c2
+ (C# c1) <= (C# c2) = c1 `leChar#` c2
+ (C# c1) < (C# c2) = c1 `ltChar#` c2
-{- XXX
{-# 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#)
\begin{code}
eqString :: String -> String -> Bool
-eqString = (==)
+eqString [] [] = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+
+{-# RULES "eqString" (==) = eqString #-}
\end{code}
+
%*********************************************************
%* *
\subsection{Type @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
instance Ord Int where
compare = compareInt
-
- (<) = ltInt
- (<=) = leInt
- (>=) = geInt
- (>) = gtInt
+ (<) = ltInt
+ (<=) = leInt
+ (>=) = geInt
+ (>) = gtInt
compareInt :: Int -> Int -> Ordering
-(I# x) `compareInt` (I# y) = compareInt# x y
+(I# x#) `compareInt` (I# y#) = compareInt# x# y#
compareInt# :: Int# -> Int# -> Ordering
compareInt# x# y#
- | x# <# y# = LT
- | x# ==# y# = EQ
- | otherwise = GT
+ | x# <# y# = LT
+ | x# ==# y# = EQ
+ | otherwise = GT
\end{code}
(I# x) `divInt` (I# y) = I# (x `divInt#` y)
(I# x) `modInt` (I# y) = I# (x `modInt#` y)
-{- XXX
{-# RULES
"x# +# 0#" forall x#. x# +# 0# = x#
"0# +# x#" forall x#. 0# +# x# = x#
"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"
(I# x) `ltInt` (I# y) = x <# y
(I# x) `leInt` (I# y) = x <=# y
-{- XXX
{-# RULES
-"x# ># x#" forall x#. x# ># x# = False
+"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# = False
"x# <=# x#" forall x#. x# <=# x# = True
- #-}
+ #-}
-#if WORD_SIZE_IN_BYTES == 4
+#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}
\begin{code}
unpackCString# :: Addr# -> [Char]
+{-# NOINLINE [1] unpackCString# #-}
unpackCString# a = unpackCStringList# a
unpackCStringList# :: Addr# -> [Char]
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