1 % -----------------------------------------------------------------------------
2 % $Id: PrelBase.lhs,v 1.55 2001/10/17 15:40:02 simonpj Exp $
4 % (c) The University of Glasgow, 1992-2000
6 \section[PrelBase]{Module @PrelBase@}
9 The overall structure of the GHC Prelude is a bit tricky.
11 a) We want to avoid "orphan modules", i.e. ones with instance
12 decls that don't belong either to a tycon or a class
13 defined in the same module
15 b) We want to avoid giant modules
17 So the rough structure is as follows, in (linearised) dependency order
20 PrelGHC Has no implementation. It defines built-in things, and
21 by importing it you bring them into scope.
22 The source file is PrelGHC.hi-boot, which is just
23 copied to make PrelGHC.hi
25 Classes: CCallable, CReturnable
27 PrelBase Classes: Eq, Ord, Functor, Monad
28 Types: list, (), Int, Bool, Ordering, Char, String
30 PrelTup Types: tuples, plus instances for PrelBase classes
32 PrelShow Class: Show, plus instances for PrelBase/PrelTup types
34 PrelEnum Class: Enum, plus instances for PrelBase/PrelTup types
36 PrelMaybe Type: Maybe, plus instances for PrelBase classes
38 PrelNum Class: Num, plus instances for Int
39 Type: Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
41 Integer is needed here because it is mentioned in the signature
42 of 'fromInteger' in class Num
44 PrelReal Classes: Real, Integral, Fractional, RealFrac
45 plus instances for Int, Integer
46 Types: Ratio, Rational
47 plus intances for classes so far
49 Rational is needed here because it is mentioned in the signature
50 of 'toRational' in class Real
52 Ix Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
54 PrelArr Types: Array, MutableArray, MutableVar
56 Does *not* contain any ByteArray stuff (see PrelByteArr)
57 Arrays are used by a function in PrelFloat
59 PrelFloat Classes: Floating, RealFloat
60 Types: Float, Double, plus instances of all classes so far
62 This module contains everything to do with floating point.
63 It is a big module (900 lines)
64 With a bit of luck, many modules can be compiled without ever reading PrelFloat.hi
66 PrelByteArr Types: ByteArray, MutableByteArray
68 We want this one to be after PrelFloat, because it defines arrays
72 Other Prelude modules are much easier with fewer complex dependencies.
76 {-# OPTIONS -fno-implicit-prelude #-}
83 module PrelGHC, -- Re-export PrelGHC and PrelErr, to avoid lots
84 module PrelErr -- of people having to import it explicitly
89 import {-# SOURCE #-} PrelErr
93 infix 4 ==, /=, <, <=, >=, >
99 default () -- Double isn't available yet
103 %*********************************************************
105 \subsection{DEBUGGING STUFF}
106 %* (for use when compiling PrelBase itself doesn't work)
108 %*********************************************************
112 data Bool = False | True
113 data Ordering = LT | EQ | GT
121 (&&) True True = True
127 unpackCString# :: Addr# -> [Char]
128 unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
129 unpackAppendCString# :: Addr# -> [Char] -> [Char]
130 unpackCStringUtf8# :: Addr# -> [Char]
131 unpackCString# a = error "urk"
132 unpackFoldrCString# a = error "urk"
133 unpackAppendCString# a = error "urk"
134 unpackCStringUtf8# a = error "urk"
139 %*********************************************************
141 \subsection{Standard classes @Eq@, @Ord@}
143 %*********************************************************
147 (==), (/=) :: a -> a -> Bool
149 x /= y = not (x == y)
150 x == y = not (x /= y)
152 class (Eq a) => Ord a where
153 compare :: a -> a -> Ordering
154 (<), (<=), (>), (>=) :: a -> a -> Bool
155 max, min :: a -> a -> a
157 -- An instance of Ord should define either 'compare' or '<='.
158 -- Using 'compare' can be more efficient for complex types.
162 | x <= y = LT -- NB: must be '<=' not '<' to validate the
163 -- above claim about the minimal things that
164 -- can be defined for an instance of Ord
167 x < y = case compare x y of { LT -> True; _other -> False }
168 x <= y = case compare x y of { GT -> False; _other -> True }
169 x > y = case compare x y of { GT -> True; _other -> False }
170 x >= y = case compare x y of { LT -> False; _other -> True }
172 -- These two default methods use '<=' rather than 'compare'
173 -- because the latter is often more expensive
174 max x y = if x <= y then y else x
175 min x y = if x <= y then x else y
178 %*********************************************************
180 \subsection{Monadic classes @Functor@, @Monad@ }
182 %*********************************************************
185 class Functor f where
186 fmap :: (a -> b) -> f a -> f b
189 (>>=) :: m a -> (a -> m b) -> m b
190 (>>) :: m a -> m b -> m b
192 fail :: String -> m a
194 m >> k = m >>= \_ -> k
199 %*********************************************************
201 \subsection{The list type}
203 %*********************************************************
206 data [] a = [] | a : [a] -- do explicitly: deriving (Eq, Ord)
207 -- to avoid weird names like con2tag_[]#
210 instance (Eq a) => Eq [a] where
211 {-# SPECIALISE instance Eq [Char] #-}
213 (x:xs) == (y:ys) = x == y && xs == ys
216 instance (Ord a) => Ord [a] where
217 {-# SPECIALISE instance Ord [Char] #-}
219 compare [] (_:_) = LT
220 compare (_:_) [] = GT
221 compare (x:xs) (y:ys) = case compare x y of
225 instance Functor [] where
228 instance Monad [] where
229 m >>= k = foldr ((++) . k) [] m
230 m >> k = foldr ((++) . (\ _ -> k)) [] m
235 A few list functions that appear here because they are used here.
236 The rest of the prelude list functions are in PrelList.
238 ----------------------------------------------
239 -- foldr/build/augment
240 ----------------------------------------------
243 foldr :: (a -> b -> b) -> b -> [a] -> b
245 -- foldr f z (x:xs) = f x (foldr f z xs)
246 {-# INLINE [0] foldr #-}
247 -- Inline only in the final stage, after the foldr/cons rule has had a chance
251 go (y:ys) = y `k` go ys
253 build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
254 {-# INLINE [1] build #-}
255 -- The INLINE is important, even though build is tiny,
256 -- because it prevents [] getting inlined in the version that
257 -- appears in the interface file. If [] *is* inlined, it
258 -- won't match with [] appearing in rules in an importing module.
260 -- The "1" says to inline in phase 1
264 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
265 {-# INLINE [1] augment #-}
266 augment g xs = g (:) xs
269 "fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) .
270 foldr k z (build g) = g k z
272 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
273 foldr k z (augment g xs) = g k (foldr k z xs)
275 "foldr/id" foldr (:) [] = \x->x
276 "foldr/app" forall xs ys. foldr (:) ys xs = append xs ys
278 -- The foldr/cons rule looks nice, but it can give disastrously
279 -- bloated code when commpiling
280 -- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
281 -- i.e. when there are very very long literal lists
282 -- So I've disabled it for now. We could have special cases
283 -- for short lists, I suppose.
284 -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
286 "foldr/nil" forall k z. foldr k z [] = z
288 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
289 (h::forall b. (a->b->b) -> b -> b) .
290 augment g (build h) = build (\c n -> g c (h c n))
291 "augment/nil" forall (g::forall b. (a->b->b) -> b -> b) .
292 augment g [] = build g
295 -- This rule is true, but not (I think) useful:
296 -- augment g (augment h t) = augment (\cn -> g c (h c n)) t
300 ----------------------------------------------
302 ----------------------------------------------
305 map :: (a -> b) -> [a] -> [b]
306 {-# NOINLINE [1] map #-}
310 mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
311 mapFB c f x ys = c (f x) ys
313 mapList :: (a -> b) -> [a] -> [b]
315 mapList f (x:xs) = f x : mapList f xs
318 "map" forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
319 "mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
320 "mapList" forall f. foldr (mapFB (:) f) [] = mapList f
325 ----------------------------------------------
327 ----------------------------------------------
329 (++) :: [a] -> [a] -> [a]
330 {-# NOINLINE [1] (++) #-}
334 "++" forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
337 append :: [a] -> [a] -> [a]
339 append (x:xs) ys = x : append xs ys
343 %*********************************************************
345 \subsection{Type @Bool@}
347 %*********************************************************
350 data Bool = False | True deriving (Eq, Ord)
351 -- Read in PrelRead, Show in PrelShow
355 (&&), (||) :: Bool -> Bool -> Bool
370 %*********************************************************
372 \subsection{The @()@ type}
374 %*********************************************************
376 The Unit type is here because virtually any program needs it (whereas
377 some programs may get away without consulting PrelTup). Furthermore,
378 the renamer currently *always* asks for () to be in scope, so that
379 ccalls can use () as their default type; so when compiling PrelBase we
380 need (). (We could arrange suck in () only if -fglasgow-exts, but putting
381 it here seems more direct.)
390 instance Ord () where
401 %*********************************************************
403 \subsection{Type @Ordering@}
405 %*********************************************************
408 data Ordering = LT | EQ | GT deriving (Eq, Ord)
409 -- Read in PrelRead, Show in PrelShow
413 %*********************************************************
415 \subsection{Type @Char@ and @String@}
417 %*********************************************************
424 -- We don't use deriving for Eq and Ord, because for Ord the derived
425 -- instance defines only compare, which takes two primops. Then
426 -- '>' uses compare, and therefore takes two primops instead of one.
428 instance Eq Char where
429 (C# c1) == (C# c2) = c1 `eqChar#` c2
430 (C# c1) /= (C# c2) = c1 `neChar#` c2
432 instance Ord Char where
433 (C# c1) > (C# c2) = c1 `gtChar#` c2
434 (C# c1) >= (C# c2) = c1 `geChar#` c2
435 (C# c1) <= (C# c2) = c1 `leChar#` c2
436 (C# c1) < (C# c2) = c1 `ltChar#` c2
439 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
440 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
441 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
442 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
443 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
444 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
448 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
449 | otherwise = error "Prelude.chr: bad argument"
451 unsafeChr :: Int -> Char
452 unsafeChr (I# i#) = C# (chr# i#)
455 ord (C# c#) = I# (ord# c#)
458 String equality is used when desugaring pattern-matches against strings.
461 eqString :: String -> String -> Bool
462 eqString [] [] = True
463 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
464 eqString cs1 cs2 = False
466 {-# RULES "eqString" (==) = eqString #-}
470 %*********************************************************
472 \subsection{Type @Int@}
474 %*********************************************************
479 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
484 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
485 #if WORD_SIZE_IN_BITS == 31
486 minInt = I# (-0x40000000#)
487 maxInt = I# 0x3FFFFFFF#
488 #elif WORD_SIZE_IN_BITS == 32
489 minInt = I# (-0x80000000#)
490 maxInt = I# 0x7FFFFFFF#
492 minInt = I# (-0x8000000000000000#)
493 maxInt = I# 0x7FFFFFFFFFFFFFFF#
496 instance Eq Int where
500 instance Ord Int where
507 compareInt :: Int -> Int -> Ordering
508 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
510 compareInt# :: Int# -> Int# -> Ordering
518 %*********************************************************
520 \subsection{The function type}
522 %*********************************************************
533 -- function composition
535 (.) :: (b -> c) -> (a -> b) -> a -> c
538 -- flip f takes its (first) two arguments in the reverse order of f.
539 flip :: (a -> b -> c) -> b -> a -> c
542 -- right-associating infix application operator (useful in continuation-
545 ($) :: (a -> b) -> a -> b
548 -- until p f yields the result of applying f until p holds.
549 until :: (a -> Bool) -> (a -> a) -> a -> a
550 until p f x | p x = x
551 | otherwise = until p f (f x)
553 -- asTypeOf is a type-restricted version of const. It is usually used
554 -- as an infix operator, and its typing forces its first argument
555 -- (which is usually overloaded) to have the same type as the second.
556 asTypeOf :: a -> a -> a
560 %*********************************************************
562 \subsection{CCallable instances}
564 %*********************************************************
566 Defined here to avoid orphans
569 instance CCallable Char
570 instance CReturnable Char
572 instance CCallable Int
573 instance CReturnable Int
575 instance CReturnable () -- Why, exactly?
579 %*********************************************************
581 \subsection{Generics}
583 %*********************************************************
587 data a :+: b = Inl a | Inr b
588 data a :*: b = a :*: b
592 %*********************************************************
594 \subsection{Numeric primops}
596 %*********************************************************
599 divInt#, modInt# :: Int# -> Int# -> Int#
601 | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
602 | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
603 | otherwise = x# `quotInt#` y#
605 | (x# ># 0#) && (y# <# 0#) ||
606 (x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0#
612 Definitions of the boxed PrimOps; these will be
613 used in the case of partial applications, etc.
622 {-# INLINE plusInt #-}
623 {-# INLINE minusInt #-}
624 {-# INLINE timesInt #-}
625 {-# INLINE quotInt #-}
626 {-# INLINE remInt #-}
627 {-# INLINE negateInt #-}
629 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
630 (I# x) `plusInt` (I# y) = I# (x +# y)
631 (I# x) `minusInt` (I# y) = I# (x -# y)
632 (I# x) `timesInt` (I# y) = I# (x *# y)
633 (I# x) `quotInt` (I# y) = I# (x `quotInt#` y)
634 (I# x) `remInt` (I# y) = I# (x `remInt#` y)
635 (I# x) `divInt` (I# y) = I# (x `divInt#` y)
636 (I# x) `modInt` (I# y) = I# (x `modInt#` y)
639 "x# +# 0#" forall x#. x# +# 0# = x#
640 "0# +# x#" forall x#. 0# +# x# = x#
641 "x# -# 0#" forall x#. x# -# 0# = x#
642 "x# -# x#" forall x#. x# -# x# = 0#
643 "x# *# 0#" forall x#. x# *# 0# = 0#
644 "0# *# x#" forall x#. 0# *# x# = 0#
645 "x# *# 1#" forall x#. x# *# 1# = x#
646 "1# *# x#" forall x#. 1# *# x# = x#
649 gcdInt (I# a) (I# b) = g a b
650 where g 0# 0# = error "PrelBase.gcdInt: gcd 0 0 is undefined"
653 g _ _ = I# (gcdInt# absA absB)
655 absInt x = if x <# 0# then negateInt# x else x
660 negateInt :: Int -> Int
661 negateInt (I# x) = I# (negateInt# x)
663 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
664 (I# x) `gtInt` (I# y) = x ># y
665 (I# x) `geInt` (I# y) = x >=# y
666 (I# x) `eqInt` (I# y) = x ==# y
667 (I# x) `neInt` (I# y) = x /=# y
668 (I# x) `ltInt` (I# y) = x <# y
669 (I# x) `leInt` (I# y) = x <=# y
672 "x# ># x#" forall x#. x# ># x# = False
673 "x# >=# x#" forall x#. x# >=# x# = True
674 "x# ==# x#" forall x#. x# ==# x# = True
675 "x# /=# x#" forall x#. x# /=# x# = False
676 "x# <# x#" forall x#. x# <# x# = False
677 "x# <=# x#" forall x#. x# <=# x# = True
680 #if WORD_SIZE_IN_BITS == 32
682 "narrow32Int#" forall x#. narrow32Int# x# = x#
683 "narrow32Word#" forall x#. narrow32Word# x# = x#
688 "int2Word2Int" forall x#. int2Word# (word2Int# x#) = x#
689 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
694 %********************************************************
696 \subsection{Unpacking C strings}
698 %********************************************************
700 This code is needed for virtually all programs, since it's used for
701 unpacking the strings of error messages.
704 unpackCString# :: Addr# -> [Char]
705 {-# NOINLINE [1] unpackCString# #-}
706 unpackCString# a = unpackCStringList# a
708 unpackCStringList# :: Addr# -> [Char]
709 unpackCStringList# addr
713 | ch `eqChar#` '\0'# = []
714 | otherwise = C# ch : unpack (nh +# 1#)
716 ch = indexCharOffAddr# addr nh
718 unpackAppendCString# :: Addr# -> [Char] -> [Char]
719 unpackAppendCString# addr rest
723 | ch `eqChar#` '\0'# = rest
724 | otherwise = C# ch : unpack (nh +# 1#)
726 ch = indexCharOffAddr# addr nh
728 unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
729 {-# NOINLINE [0] unpackFoldrCString# #-}
730 -- Don't inline till right at the end;
731 -- usually the unpack-list rule turns it into unpackCStringList
732 unpackFoldrCString# addr f z
736 | ch `eqChar#` '\0'# = z
737 | otherwise = C# ch `f` unpack (nh +# 1#)
739 ch = indexCharOffAddr# addr nh
741 unpackCStringUtf8# :: Addr# -> [Char]
742 unpackCStringUtf8# addr
746 | ch `eqChar#` '\0'# = []
747 | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
748 | ch `leChar#` '\xDF'# =
749 C# (chr# ((ord# ch -# 0xC0#) `iShiftL#` 6# +#
750 (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
752 | ch `leChar#` '\xEF'# =
753 C# (chr# ((ord# ch -# 0xE0#) `iShiftL#` 12# +#
754 (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 6# +#
755 (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
758 C# (chr# ((ord# ch -# 0xF0#) `iShiftL#` 18# +#
759 (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
760 (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#` 6# +#
761 (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
764 ch = indexCharOffAddr# addr nh
766 unpackNBytes# :: Addr# -> Int# -> [Char]
767 unpackNBytes# _addr 0# = []
768 unpackNBytes# addr len# = unpack [] (len# -# 1#)
773 case indexCharOffAddr# addr i# of
774 ch -> unpack (C# ch : acc) (i# -# 1#)
777 "unpack" forall a . unpackCString# a = build (unpackFoldrCString# a)
778 "unpack-list" forall a . unpackFoldrCString# a (:) [] = unpackCStringList# a
779 "unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n
781 -- There's a built-in rule (in PrelRules.lhs) for
782 -- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n