\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
-module PrelBase where
+module PrelBase(
+ module PrelBase,
+ module GHC -- Re-export GHC, to avoid lots of people having
+ -- to import it explicitly
+ ) where
import {-# SOURCE #-} IOBase ( error )
import GHC
showsPrec :: Int -> a -> ShowS
showList :: [a] -> ShowS
- showList [] = showString "[]"
- showList (x:xs)
- = showChar '[' . shows x . showl xs
- where showl [] = showChar ']'
- showl (x:xs) = showString ", " . shows x . showl xs
+ showList ls = showList__ (showsPrec 0) ls
\end{code}
%*********************************************************
instance (Eq a) => Eq [a] where
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
- [] == ys = False
- xs == [] = False
+ xs == ys = False
xs /= ys = if (xs == ys) then False else True
instance (Ord a) => Ord [a] where
instance Monad [] where
m >>= k = foldr ((++) . k) [] m
+ m >> k = foldr ((++) . (\ _ -> k)) [] m
return x = [x]
instance MonadZero [] where
instance (Show a) => Show [a] where
showsPrec p = showList
- showList = showList__ (showsPrec 0)
+ showList ls = showList__ (showsPrec 0) ls
\end{code}
\end{code}
The type @Void@ is built in, but it needs a @Show@ instance.
\begin{code}
+void :: Void
+void = error "You tried to evaluate void"
+
instance Show Void where
showsPrec p f = showString "<<void>>"
- showList = showList__ (showsPrec 0)
+ showList ls = showList__ (showsPrec 0) ls
\end{code}
(&&), (||) :: Bool -> Bool -> Bool
True && x = x
-False && _ = False
-True || _ = True
+False && x = False
+True || x = True
False || x = x
not :: Bool -> Bool
\begin{code}
data Maybe a = Nothing | Just a deriving (Eq, Ord, Show {- Read -})
+maybe :: b -> (a -> b) -> Maybe a -> b
+maybe n f Nothing = n
+maybe n f (Just x) = f x
+
instance Functor Maybe where
map f Nothing = Nothing
map f (Just a) = Just (f a)
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= k = Nothing
+
+ (Just x) >> k = k
+ Nothing >> k = Nothing
+
return = Just
instance MonadZero Maybe where
\begin{code}
data () = () --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
-- (avoids weird-named functions, e.g., con2tag_()#
-
instance Eq () where
() == () = True
() /= () = False
instance Show () where
showsPrec p () = showString "()"
+ showList ls = showList__ (showsPrec 0) ls
\end{code}
%*********************************************************
instance Enum Char where
toEnum (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
- | otherwise = error "Prelude.Enum.Char.toEnum:out of range"
+ | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
fromEnum (C# c) = I# (ord# c)
enumFrom (C# c) = eftt (ord# c) 1# 255#
enumFromThen (C# c1) (C# c2) = eftt (ord# c1) (ord# c2 -# ord# c1) 255#
+ enumFromTo (C# c1) (C# c2) = eftt (ord# c1) 1# (ord# c2)
enumFromThenTo (C# c1) (C# c2) (C# c3) = eftt (ord# c1) (ord# c2 -# ord# c1) (ord# c3)
eftt :: Int# -> Int# -> Int# -> [Char]
\begin{code}
-isAscii, isControl, isPrint, isSpace, isUpper,
+isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
isAscii c = fromEnum c < 128
+isLatin1 c = c <= '\xff'
isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
isPrint c = not (isControl c)
isLower c = c >= 'a' && c <= 'z' ||
c >= '\xDF' && c <= '\xF6' ||
c >= '\xF8' && c <= '\xFF'
-isAlpha c = isUpper c || isLower c
+isAlpha c = isLower c || isUpper c
isDigit c = c >= '0' && c <= '9'
isOctDigit c = c >= '0' && c <= '7'
isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
c >= 'a' && c <= 'f'
isAlphanum c = isAlpha c || isDigit c
--- These almost work for ISO-Latin-1 (except for =DF <-> =FF)
+-- Case-changing operations
toUpper, toLower :: Char -> Char
-toUpper c | isLower c = toEnum (fromEnum c - fromEnum 'a'
- + fromEnum 'A')
- | otherwise = c
+toUpper c | isLower c && c /= '\xDF' && c /= '\xFF'
+ = toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
+ | otherwise = c
toLower c | isUpper c = toEnum (fromEnum c - fromEnum 'A'
+ fromEnum 'a')
data Int = I# Int#
instance Eq Int where
- (I# x) == (I# y) = x ==# y
+ (==) x y = x `eqInt` y
+ (/=) x y = x `neInt` y
instance Ord Int where
- (I# x) `compare` (I# y) | x <# y = LT
- | x ==# y = EQ
- | otherwise = GT
-
- (I# x) < (I# y) = x <# y
- (I# x) <= (I# y) = x <=# y
- (I# x) >= (I# y) = x >=# y
- (I# x) > (I# y) = x ># y
+ compare x y = compareInt x y
+ (<) x y = ltInt x y
+ (<=) x y = leInt x y
+ (>=) x y = geInt x y
+ (>) x y = gtInt x y
+ max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
+ min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
+(I# x) `compareInt` (I# y) | x <# y = LT
+ | x ==# y = EQ
+ | otherwise = GT
instance Enum Int where
toEnum x = x
enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
(enumFromThen n m)
+
instance Bounded Int where
minBound = negate 2147483647 -- **********************
maxBound = 2147483647 -- **********************
instance Show Int where
showsPrec p n = showSignedInt p n
- showList = showList__ (showsPrec 0)
+ showList ls = showList__ (showsPrec 0) ls
\end{code}
\begin{code}
instance Show (a -> b) where
showsPrec p f = showString "<<function>>"
- showList = showList__ (showsPrec 0)
+ showList ls = showList__ (showsPrec 0) ls
+
-- identity function
id :: a -> a
\begin{code}
data Addr = A# Addr# deriving (Eq, Ord) -- Glasgow extension
data Word = W# Word# deriving (Eq, Ord) -- Glasgow extension
+data ForeignObj = ForeignObj ForeignObj# -- another one
data Lift a = Lift a
{-# GENERATE_SPECS data a :: Lift a #-}
used in the case of partial applications, etc.
\begin{code}
+{-# INLINE eqInt #-}
+{-# INLINE neInt #-}
+
plusInt (I# x) (I# y) = I# (x +# y)
minusInt(I# x) (I# y) = I# (x -# y)
timesInt(I# x) (I# y) = I# (x *# y)
projects / ghc-hetmet.git / blobdiff