import PrelGHC
infixr 9 .
-infixl 9 !!
-infixl 7 *
-infixl 6 +, -
infixr 5 ++, :
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
%*********************************************************
%* *
-\subsection{Standard classes @Eq@, @Ord@, @Bounded@
+\subsection{Standard classes @Eq@, @Ord@}
%* *
%*********************************************************
-- Using compare can be more efficient for complex types.
compare x y
| x == y = EQ
- | x <= y = LT
+ | x <= y = LT -- NB: must be '<=' not '<' to validate the
+ -- above claim about the minimal things that can
+ -- be defined for an instance of Ord
| otherwise = GT
- x <= y = compare x y /= GT
- x < y = compare x y == LT
- x >= y = compare x y /= LT
- x > y = compare x y == GT
- max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
- min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
+ x <= y = case compare x y of { GT -> False; _other -> True }
+ x < y = case compare x y of { LT -> True; _other -> False }
+ x >= y = case compare x y of { LT -> False; _other -> True }
+ x > y = case compare x y of { GT -> True; _other -> False }
-class Bounded a where
- minBound, maxBound :: a
+ -- These two default methods use '>' rather than compare
+ -- because the latter is often more expensive
+ max x y = if x > y then x else y
+ min x y = if x > y then y else x
\end{code}
%*********************************************************
%*********************************************************
%* *
-\subsection{Classes @Num@ and @Enum@}
-%* *
-%*********************************************************
-
-\begin{code}
-class Enum a where
- succ, pred :: a -> a
- toEnum :: Int -> a
- fromEnum :: a -> Int
- enumFrom :: a -> [a] -- [n..]
- enumFromThen :: a -> a -> [a] -- [n,n'..]
- enumFromTo :: a -> a -> [a] -- [n..m]
- enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
-
- succ = toEnum . (+1) . fromEnum
- pred = toEnum . (+(-1)) . fromEnum
- enumFromTo n m = map toEnum [fromEnum n .. fromEnum m]
- enumFromThenTo n n' m
- = map toEnum [fromEnum n, fromEnum n' .. fromEnum m]
-
-class (Eq a, Show a) => Num a where
- (+), (-), (*) :: a -> a -> a
- negate :: a -> a
- abs, signum :: a -> a
- fromInteger :: Integer -> a
- fromInt :: Int -> a -- partain: Glasgow extension
-
- x - y = x + negate y
- negate x = 0 - x
- fromInt (I# i#) = fromInteger (case int2Integer# i# of
- (# a, s, d #) -> J# a s d)
- -- Go via the standard class-op if the
- -- non-standard one ain't provided
-\end{code}
-
-\begin{code}
-chr :: Int -> Char
-chr = toEnum
-ord :: Char -> Int
-ord = fromEnum
-
-ord_0 :: Num a => a
-ord_0 = fromInt (ord '0')
-
-{-# SPECIALISE subtract :: Int -> Int -> Int #-}
-subtract :: (Num a) => a -> a -> a
-subtract x y = y - x
-\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{The @Show@ class}
-%* *
-%*********************************************************
-
-\begin{code}
-type ShowS = String -> String
-
-class Show a where
- showsPrec :: Int -> a -> ShowS
- show :: a -> String
- showList :: [a] -> ShowS
-
- showList ls = showList__ (showsPrec 0) ls
- showsPrec _ x s = show x ++ s
- show x = showsPrec 0 x ""
-\end{code}
-
-%*********************************************************
-%* *
\subsection{The list type}
%* *
%*********************************************************
data [] a = [] | a : [a] -- do explicitly: deriving (Eq, Ord)
-- to avoid weird names like con2tag_[]#
-
-
instance (Eq a) => Eq [a] where
+ {-# SPECIALISE instance Eq [Char] #-}
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
_xs == _ys = False
xs /= ys = if (xs == ys) then False else True
instance (Ord a) => Ord [a] where
+ {-# SPECIALISE instance Ord [Char] #-}
a < b = case compare a b of { LT -> True; EQ -> False; GT -> False }
a <= b = case compare a b of { LT -> True; EQ -> True; GT -> False }
a >= b = case compare a b of { LT -> False; EQ -> True; GT -> True }
a > b = case compare a b of { LT -> False; EQ -> False; GT -> True }
- max a b = case compare a b of { LT -> b; EQ -> a; GT -> a }
- min a b = case compare a b of { LT -> a; EQ -> a; GT -> b }
-
compare [] [] = EQ
compare (_:_) [] = GT
compare [] (_:_) = LT
GT -> GT
EQ -> compare xs ys
-map :: (a -> b) -> [a] -> [b]
-map _ [] = []
-map f (x:xs) = f x : map f xs
-
-(++) :: [a] -> [a] -> [a]
-[] ++ ys = ys
-(x:xs) ++ ys = x : (xs ++ ys)
-
instance Functor [] where
fmap = map
m >> k = foldr ((++) . (\ _ -> k)) [] m
return x = [x]
fail _ = []
+\end{code}
-instance (Show a) => Show [a] where
- showsPrec _ = showList
- showList ls = showList__ (showsPrec 0) ls
+A few list functions that appear here because they are used here.
+The rest of the prelude list functions are in PrelList.
+
+----------------------------------------------
+-- foldr/build/augment
+----------------------------------------------
+
+\begin{code}
+foldr :: (a -> b -> b) -> b -> [a] -> b
+-- foldr _ z [] = z
+-- foldr f z (x:xs) = f x (foldr f z xs)
+{-# INLINE foldr #-}
+foldr k z xs = go xs
+ where
+ go [] = z
+ go (x:xs) = x `k` go xs
+
+build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# INLINE 2 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
+
+build g = g (:) []
+
+augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
+{-# INLINE 2 augment #-}
+augment g xs = g (:) xs
+
+{-# RULES
+"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) .
+ foldr k z (build g) = g k z
+
+"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
+ foldr k z (augment g xs) = g k (foldr k z 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)
+"foldr/nil" forall k z. foldr k z [] = z
+ #-}
\end{code}
+
+----------------------------------------------
+-- map
+----------------------------------------------
+
+\begin{code}
+map :: (a -> b) -> [a] -> [b]
+{-# INLINE map #-}
+map f xs = build (\c n -> foldr (mapFB c f) n xs)
+
+-- Note eta expanded
+mapFB c f x ys = c (f x) ys
+
+mapList :: (a -> b) -> [a] -> [b]
+mapList _ [] = []
+mapList f (x:xs) = f x : mapList f xs
+
+{-# RULES
+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
+"mapList" forall f. foldr (mapFB (:) f) [] = mapList f
+ #-}
\end{code}
-A few list functions that appear here because they are used here.
-The rest of the prelude list functions are in PrelList.
+----------------------------------------------
+-- append
+----------------------------------------------
\begin{code}
-foldr :: (a -> b -> b) -> b -> [a] -> b
-foldr _ z [] = z
-foldr f z (x:xs) = f x (foldr f z xs)
-
--- takeWhile, applied to a predicate p and a list xs, returns the longest
--- prefix (possibly empty) of xs of elements that satisfy p. dropWhile p xs
--- returns the remaining suffix. Span p xs is equivalent to
--- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
-
-takeWhile :: (a -> Bool) -> [a] -> [a]
-takeWhile _ [] = []
-takeWhile p (x:xs)
- | p x = x : takeWhile p xs
- | otherwise = []
-
-dropWhile :: (a -> Bool) -> [a] -> [a]
-dropWhile _ [] = []
-dropWhile p xs@(x:xs')
- | p x = dropWhile p xs'
- | otherwise = xs
-
--- List index (subscript) operator, 0-origin
-(!!) :: [a] -> Int -> a
-#ifdef USE_REPORT_PRELUDE
-(x:_) !! 0 = x
-(_:xs) !! n | n > 0 = xs !! (n-1)
-(_:_) !! _ = error "Prelude.(!!): negative index"
-[] !! _ = error "Prelude.(!!): index too large"
-#else
--- HBC version (stolen), then unboxified
--- The semantics is not quite the same for error conditions
--- in the more efficient version.
---
-_ !! n | n < 0 = error "Prelude.(!!): negative index\n"
-xs !! n = sub xs (case n of { I# n# -> n# })
- where sub :: [a] -> Int# -> a
- sub [] _ = error "Prelude.(!!): index too large\n"
- sub (y:ys) n# = if n# ==# 0#
- then y
- else sub ys (n# -# 1#)
-#endif
+(++) :: [a] -> [a] -> [a]
+{-# INLINE (++) #-}
+xs ++ ys = augment (\c n -> foldr c n xs) ys
+
+append :: [a] -> [a] -> [a]
+append [] ys = ys
+append (x:xs) ys = x : append xs ys
\end{code}
%*********************************************************
\begin{code}
-data Bool = False | True deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
+data Bool = False | True deriving (Eq, Ord)
+ -- Read in PrelRead, Show in PrelShow
-- Boolean functions
the renamer currently *always* asks for () to be in scope, so that
ccalls can use () as their default type; so when compiling PrelBase we
need (). (We could arrange suck in () only if -fglasgow-exts, but putting
-it here seems more direct.
+it here seems more direct.)
\begin{code}
-data () = () --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
- -- (avoids weird-named functions, e.g., con2tag_()#
+data () = ()
instance Eq () where
() == () = True
max () () = ()
min () () = ()
compare () () = EQ
-
-instance Enum () where
- succ x = error "Prelude.Enum.succ{()}: not possible"
- pred x = error "Prelude.Enum.pred{()}: not possible"
- toEnum 0 = ()
- toEnum _ = error "Prelude.Enum.toEnum{()}: argument not 0"
- fromEnum () = 0
- enumFrom () = [()]
- enumFromThen () () = [()]
- enumFromTo () () = [()]
- enumFromThenTo () () () = [()]
-
-instance Show () where
- showsPrec _ () = showString "()"
- showList ls = showList__ (showsPrec 0) ls
\end{code}
+
%*********************************************************
%* *
\subsection{Type @Ordering@}
%*********************************************************
\begin{code}
-data Ordering = LT | EQ | GT deriving (Eq, Ord, Enum, Bounded, Show {- in PrelRead: Read -})
+data Ordering = LT | EQ | GT deriving (Eq, Ord)
+ -- Read in PrelRead, Show in PrelShow
\end{code}
\begin{code}
type String = [Char]
-data Char = C# Char# deriving (Eq, Ord)
-
-instance Enum Char where
- succ c@(C# c#)
- | not (ord# c# ==# 255#) = C# (chr# (ord# c# +# 1#))
- | otherwise = error ("Prelude.Enum.succ{Char}: tried to take `succ' of maxBound")
- pred c@(C# c#)
- | not (ord# c# ==# 0#) = C# (chr# (ord# c# -# 1#))
- | otherwise = error ("Prelude.Enum.pred{Char}: tried to to take `pred' of minBound")
-
- toEnum (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
- | otherwise = error ("Prelude.Enum.toEnum{Char}: out of range: " ++ show (I# i))
- fromEnum (C# c) = I# (ord# c)
-
- enumFrom (C# c) = efttCh (ord# c) 1# (># 255#)
- enumFromTo (C# c1) (C# c2)
- | c1 `leChar#` c2 = efttCh (ord# c1) 1# (># (ord# c2))
- | otherwise = []
-
- enumFromThen (C# c1) (C# c2)
- | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># 255#)
- | otherwise = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# 0#)
-
- enumFromThenTo (C# c1) (C# c2) (C# c3)
- | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># (ord# c3))
- | otherwise = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# (ord# c3))
-
-efttCh :: Int# -> Int# -> (Int# -> Bool) -> [Char]
-efttCh init step done
- = go init
- where
- go now | done now = []
- | otherwise = C# (chr# now) : go (now +# step)
-
-instance Show Char where
- showsPrec _ '\'' = showString "'\\''"
- showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
-
- showList cs = showChar '"' . showl cs
- where showl "" = showChar '"'
- showl ('"':xs) = showString "\\\"" . showl xs
- showl (x:xs) = showLitChar x . showl xs
-\end{code}
+data Char = C# Char#
+-- We don't use deriving for Eq and Ord, because for Ord the derived
+-- instance defines only compare, which takes two primops. Then
+-- '>' uses compare, and therefore takes two primops instead of one.
-\begin{code}
-isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
- isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
-isAscii c = c < '\x80'
-isLatin1 c = c <= '\xff'
-isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
-isPrint c = not (isControl c)
-
--- isSpace includes non-breaking space
--- Done with explicit equalities both for efficiency, and to avoid a tiresome
--- recursion with PrelList elem
-isSpace c = c == ' ' ||
- c == '\t' ||
- c == '\n' ||
- c == '\r' ||
- c == '\f' ||
- c == '\v' ||
- c == '\xa0'
-
--- The upper case ISO characters have the multiplication sign dumped
--- randomly in the middle of the range. Go figure.
-isUpper c = c >= 'A' && c <= 'Z' ||
- c >= '\xC0' && c <= '\xD6' ||
- c >= '\xD8' && c <= '\xDE'
--- The lower case ISO characters have the division sign dumped
--- randomly in the middle of the range. Go figure.
-isLower c = c >= 'a' && c <= 'z' ||
- c >= '\xDF' && c <= '\xF6' ||
- c >= '\xF8' && c <= '\xFF'
-isAsciiLower c = c >= 'a' && c <= 'z'
-isAsciiUpper c = c >= 'A' && c <= 'Z'
-
-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
-
--- Case-changing operations
-
-toUpper, toLower :: Char -> Char
-toUpper c@(C# c#)
- | isAsciiLower c = C# (chr# (ord# c# -# 32#))
- | isAscii c = c
- -- fall-through to the slower stuff.
- | isLower c && c /= '\xDF' && c /= '\xFF'
- = toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
- | otherwise
- = c
-
-
-
-toLower c@(C# c#)
- | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
- | isAscii c = c
- | isUpper c = toEnum (fromEnum c - fromEnum 'A'
- + fromEnum 'a')
- | otherwise = c
-
-asciiTab :: [String]
-asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
- ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
- "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
- "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
- "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
- "SP"]
+instance Eq Char where
+ (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
+
+chr :: Int -> Char
+chr (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
+ | otherwise = error ("Prelude.chr: bad argument")
+
+unsafeChr :: Int -> Char
+unsafeChr (I# i) = C# (chr# i)
+
+ord :: Char -> Int
+ord (C# c) = I# (ord# c)
\end{code}
+
%*********************************************************
%* *
\subsection{Type @Int@}
\begin{code}
data Int = I# Int#
+zeroInt, oneInt, twoInt, maxInt, minInt :: Int
+zeroInt = I# 0#
+oneInt = I# 1#
+twoInt = I# 2#
+minInt = I# (-2147483648#) -- GHC <= 2.09 had this at -2147483647
+maxInt = I# 2147483647#
+
instance Eq Int where
(==) x y = x `eqInt` y
(/=) x y = x `neInt` 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 }
compareInt :: Int -> Int -> Ordering
(I# x) `compareInt` (I# y) | x <# y = LT
| x ==# y = EQ
| otherwise = GT
-
-instance Bounded Int where
- minBound = -2147483648 -- GHC <= 2.09 had this at -2147483647
- maxBound = 2147483647
-
-instance Enum Int where
- succ x
- | x == maxBound = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
- | otherwise = x+1
- pred x
- | x == minBound = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
- | otherwise = x-1
-
- toEnum x = x
- fromEnum x = x
-
-#ifndef USE_FOLDR_BUILD
- enumFrom (I# c) = efttInt True c 1# (\ _ -> False)
-
- enumFromTo (I# c1) (I# c2)
- | c1 <=# c2 = efttInt True c1 1# (># c2)
- | otherwise = []
-
- enumFromThen (I# c1) (I# c2)
- | c1 <# c2 = efttInt True c1 (c2 -# c1) (\ _ -> False)
- | otherwise = efttInt False c1 (c2 -# c1) (\ _ -> False)
-
- enumFromThenTo (I# c1) (I# c2) (I# c3)
- | c1 <=# c2 = efttInt True c1 (c2 -# c1) (># c3)
- | otherwise = efttInt False c1 (c2 -# c1) (<# c3)
-
-#else
- {-# INLINE enumFrom #-}
- {-# INLINE enumFromTo #-}
- enumFrom x = build (\ c _ ->
- let g x = x `c` g (x `plusInt` 1) in g x)
- enumFromTo x y = build (\ c n ->
- let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
-#endif
-
-efttInt :: Bool -> Int# -> Int# -> (Int# -> Bool) -> [Int]
-efttInt increasing init step done = go init
- where
- go now
- | done now = []
- | increasing && now ># nxt = [I# now] -- overflowed
- | not increasing && now <# nxt = [I# now] -- underflowed
- | otherwise = I# now : go nxt
- where
- nxt = now +# step
-
-instance Num Int where
- (+) x y = plusInt x y
- (-) x y = minusInt x y
- negate x = negateInt x
- (*) x y = timesInt x y
- abs n = if n `geInt` 0 then n else (negateInt n)
-
- signum n | n `ltInt` 0 = negateInt 1
- | n `eqInt` 0 = 0
- | otherwise = 1
-
- fromInteger (J# a# s# d#)
- = case (integer2Int# a# s# d#) of { i# -> I# i# }
-
- fromInt n = n
-
-instance Show Int where
- showsPrec p n = showSignedInt p n
- showList ls = showList__ (showsPrec 0) ls
\end{code}
\begin{code}
data Float = F# Float#
data Double = D# Double#
-data Integer = J# Int# Int# ByteArray#
-
-instance Eq Integer where
- (J# a1 s1 d1) == (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
- (J# a1 s1 d1) /= (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
+data Integer
+ = S# Int# -- small integers
+ | J# Int# ByteArray# -- large integers
+instance Eq Integer where
+ (S# i) == (S# j) = i ==# j
+ (S# i) == (J# s d) = cmpIntegerInt# s d i ==# 0#
+ (J# s d) == (S# i) = cmpIntegerInt# s d i ==# 0#
+ (J# s1 d1) == (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
+
+ (S# i) /= (S# j) = i /=# j
+ (S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0#
+ (J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0#
+ (J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+
+instance Ord Integer where
+ (S# i) <= (S# j) = i <=# j
+ (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
+ (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
+ (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
+
+ (S# i) > (S# j) = i ># j
+ (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
+ (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
+ (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
+
+ (S# i) < (S# j) = i <# j
+ (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
+ (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
+ (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
+
+ (S# i) >= (S# j) = i >=# j
+ (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
+ (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
+ (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
+
+ compare (S# i) (S# j)
+ | i ==# j = EQ
+ | i <=# j = LT
+ | otherwise = GT
+ compare (J# s d) (S# i)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# <# 0# then LT else
+ if res# ># 0# then GT else EQ
+ }
+ compare (S# i) (J# s d)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# ># 0# then LT else
+ if res# <# 0# then GT else EQ
+ }
+ compare (J# s1 d1) (J# s2 d2)
+ = case cmpInteger# s1 d1 s2 d2 of { res# ->
+ if res# <# 0# then LT else
+ if res# ># 0# then GT else EQ
+ }
\end{code}
+
%*********************************************************
%* *
\subsection{The function type}
%*********************************************************
\begin{code}
-instance Show (a -> b) where
- showsPrec _ _ = showString "<<function>>"
- showList ls = showList__ (showsPrec 0) ls
-
-
-- identity function
id :: a -> a
id x = x
%*********************************************************
%* *
-\subsection{Support code for @Show@}
-%* *
-%*********************************************************
-
-\begin{code}
-shows :: (Show a) => a -> ShowS
-shows = showsPrec 0
-
-showChar :: Char -> ShowS
-showChar = (:)
-
-showString :: String -> ShowS
-showString = (++)
-
-showParen :: Bool -> ShowS -> ShowS
-showParen b p = if b then showChar '(' . p . showChar ')' else p
-
-showList__ :: (a -> ShowS) -> [a] -> ShowS
-
-showList__ _ [] = showString "[]"
-showList__ showx (x:xs) = showChar '[' . showx x . showl xs
- where
- showl [] = showChar ']'
- showl (y:ys) = showChar ',' . showx y . showl ys
-
-showSpace :: ShowS
-showSpace = {-showChar ' '-} \ xs -> ' ' : xs
-\end{code}
-
-Code specific for characters
-
-\begin{code}
-showLitChar :: Char -> ShowS
-showLitChar c | c > '\DEL' = showChar '\\' . protectEsc isDigit (shows (ord c))
-showLitChar '\DEL' = showString "\\DEL"
-showLitChar '\\' = showString "\\\\"
-showLitChar c | c >= ' ' = showChar c
-showLitChar '\a' = showString "\\a"
-showLitChar '\b' = showString "\\b"
-showLitChar '\f' = showString "\\f"
-showLitChar '\n' = showString "\\n"
-showLitChar '\r' = showString "\\r"
-showLitChar '\t' = showString "\\t"
-showLitChar '\v' = showString "\\v"
-showLitChar '\SO' = protectEsc (== 'H') (showString "\\SO")
-showLitChar c = showString ('\\' : asciiTab!!ord c)
-
-protectEsc :: (Char -> Bool) -> ShowS -> ShowS
-protectEsc p f = f . cont
- where cont s@(c:_) | p c = "\\&" ++ s
- cont s = s
-
-intToDigit :: Int -> Char
-intToDigit i
- | i >= 0 && i <= 9 = toEnum (fromEnum '0' + i)
- | i >= 10 && i <= 15 = toEnum (fromEnum 'a' + i - 10)
- | otherwise = error ("Char.intToDigit: not a digit " ++ show i)
-
-\end{code}
-
-Code specific for Ints.
-
-\begin{code}
-showSignedInt :: Int -> Int -> ShowS
-showSignedInt p (I# n) r
- | n <# 0# && p > 6 = '(':itos n (')':r)
- | otherwise = itos n r
-
-itos :: Int# -> String -> String
-itos n r
- | n >=# 0# = itos' n r
- | negateInt# n <# 0# = -- n is minInt, a difficult number
- itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
- | otherwise = '-':itos' (negateInt# n) r
- where
- itos' :: Int# -> String -> String
- itos' x cs
- | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
- | otherwise = itos' (x `quotInt#` 10#)
- (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
-\end{code}
-
-%*********************************************************
-%* *
\subsection{Numeric primops}
%* *
%*********************************************************
\begin{code}
{-# INLINE eqInt #-}
{-# INLINE neInt #-}
+{-# INLINE gtInt #-}
+{-# INLINE geInt #-}
+{-# INLINE ltInt #-}
+{-# INLINE leInt #-}
+{-# INLINE plusInt #-}
+{-# INLINE minusInt #-}
+{-# INLINE timesInt #-}
+{-# INLINE quotInt #-}
+{-# INLINE remInt #-}
+{-# INLINE negateInt #-}
plusInt, minusInt, timesInt, quotInt, remInt :: Int -> Int -> Int
plusInt (I# x) (I# y) = I# (x +# y)
{-# INLINE int2Integer #-}
{-# INLINE addr2Integer #-}
int2Integer :: Int# -> Integer
-int2Integer i = case int2Integer# i of (# a, s, d #) -> J# a s d
+int2Integer i = S# i
addr2Integer :: Addr# -> Integer
-addr2Integer x = case addr2Integer# x of (# a, s, d #) -> J# a s d
-
-integer_0, integer_1, integer_2, integer_m1 :: Integer
-integer_0 = int2Integer 0#
-integer_1 = int2Integer 1#
-integer_2 = int2Integer 2#
-integer_m1 = int2Integer (negateInt# 1#)
+addr2Integer x = case addr2Integer# x of (# s, d #) -> J# s d
\end{code}
projects / ghc-hetmet.git / blobdiff