The overall structure of the GHC Prelude is a bit tricky.
a) We want to avoid "orphan modules", i.e. ones with instance
- decls that don't belong either to a tycon or a class
- defined in the same module
+ decls that don't belong either to a tycon or a class
+ defined in the same module
b) We want to avoid giant modules
So the rough structure is as follows, in (linearised) dependency order
-GHC.Prim Has no implementation. It defines built-in things, and
- by importing it you bring them into scope.
- The source file is GHC.Prim.hi-boot, which is just
- copied to make GHC.Prim.hi
+GHC.Prim Has no implementation. It defines built-in things, and
+ by importing it you bring them into scope.
+ The source file is GHC.Prim.hi-boot, which is just
+ copied to make GHC.Prim.hi
-GHC.Base Classes: Eq, Ord, Functor, Monad
- Types: list, (), Int, Bool, Ordering, Char, String
+GHC.Base Classes: Eq, Ord, Functor, Monad
+ Types: list, (), Int, Bool, Ordering, Char, String
-Data.Tuple Types: tuples, plus instances for GHC.Base classes
+Data.Tuple Types: tuples, plus instances for GHC.Base classes
-GHC.Show Class: Show, plus instances for GHC.Base/GHC.Tup types
+GHC.Show Class: Show, plus instances for GHC.Base/GHC.Tup types
-GHC.Enum Class: Enum, plus instances for GHC.Base/GHC.Tup types
+GHC.Enum Class: Enum, plus instances for GHC.Base/GHC.Tup types
-Data.Maybe Type: Maybe, plus instances for GHC.Base classes
+Data.Maybe Type: Maybe, plus instances for GHC.Base classes
-GHC.List List functions
+GHC.List List functions
-GHC.Num Class: Num, plus instances for Int
- Type: Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
+GHC.Num Class: Num, plus instances for Int
+ Type: Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
- Integer is needed here because it is mentioned in the signature
- of 'fromInteger' in class Num
+ Integer is needed here because it is mentioned in the signature
+ of 'fromInteger' in class Num
-GHC.Real Classes: Real, Integral, Fractional, RealFrac
- plus instances for Int, Integer
- Types: Ratio, Rational
- plus intances for classes so far
+GHC.Real Classes: Real, Integral, Fractional, RealFrac
+ plus instances for Int, Integer
+ Types: Ratio, Rational
+ plus intances for classes so far
- Rational is needed here because it is mentioned in the signature
- of 'toRational' in class Real
+ Rational is needed here because it is mentioned in the signature
+ of 'toRational' in class Real
-GHC.ST The ST monad, instances and a few helper functions
+GHC.ST The ST monad, instances and a few helper functions
-Ix Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
+Ix Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
-GHC.Arr Types: Array, MutableArray, MutableVar
+GHC.Arr Types: Array, MutableArray, MutableVar
- Arrays are used by a function in GHC.Float
+ Arrays are used by a function in GHC.Float
-GHC.Float Classes: Floating, RealFloat
- Types: Float, Double, plus instances of all classes so far
+GHC.Float Classes: Floating, RealFloat
+ Types: Float, Double, plus instances of all classes so far
- This module contains everything to do with floating point.
- It is a big module (900 lines)
- With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
+ This module contains everything to do with floating point.
+ It is a big module (900 lines)
+ With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
Other Prelude modules are much easier with fewer complex dependencies.
\begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE CPP
+ , NoImplicitPrelude
+ , BangPatterns
+ , ExplicitForAll
+ , MagicHash
+ , UnboxedTuples
+ , ExistentialQuantification
+ , Rank2Types
+ #-}
+-- -fno-warn-orphans is needed for things like:
+-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Base
-- #hide
module GHC.Base
- (
- module GHC.Base,
- module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots
- module GHC.Err -- of people having to import it explicitly
+ (
+ module GHC.Base,
+ module GHC.Classes,
+ --module GHC.Generics, -- JPM: We no longer export GHC.Generics
+ -- by default to avoid name clashes
+ module GHC.Ordering,
+ module GHC.Types,
+ module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots
+ module GHC.Err -- of people having to import it explicitly
)
- where
+ where
+import GHC.Types
+import GHC.Classes
+-- JPM: Since we don't export it, we don't need to import GHC.Generics
+--import GHC.Generics
+import GHC.Ordering
import GHC.Prim
+import {-# SOURCE #-} GHC.Show
import {-# SOURCE #-} GHC.Err
+import {-# SOURCE #-} GHC.IO (failIO)
+
+-- These two are not strictly speaking required by this module, but they are
+-- implicit dependencies whenever () or tuples are mentioned, so adding them
+-- as imports here helps to get the dependencies right in the new build system.
+import GHC.Tuple ()
+import GHC.Unit ()
infixr 9 .
-infixr 5 ++, :
-infix 4 ==, /=, <, <=, >=, >
-infixr 3 &&
-infixr 2 ||
+infixr 5 ++
+infixl 4 <$
infixl 1 >>, >>=
infixr 0 $
-default () -- Double isn't available yet
+default () -- Double isn't available yet
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{DEBUGGING STUFF}
%* (for use when compiling GHC.Base itself doesn't work)
-%* *
+%* *
%*********************************************************
\begin{code}
%*********************************************************
-%* *
-\subsection{Standard classes @Eq@, @Ord@}
-%* *
-%*********************************************************
-
-\begin{code}
-
--- | The 'Eq' class defines equality ('==') and inequality ('/=').
--- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
--- and 'Eq' may be derived for any datatype whose constituents are also
--- instances of 'Eq'.
---
--- Minimal complete definition: either '==' or '/='.
---
-class Eq a where
- (==), (/=) :: a -> a -> Bool
-
- x /= y = not (x == y)
- x == y = not (x /= y)
-
--- | The 'Ord' class is used for totally ordered datatypes.
---
--- Instances of 'Ord' can be derived for any user-defined
--- datatype whose constituent types are in 'Ord'. The declared order
--- of the constructors in the data declaration determines the ordering
--- in derived 'Ord' instances. The 'Ordering' datatype allows a single
--- comparison to determine the precise ordering of two objects.
---
--- Minimal complete definition: either 'compare' or '<='.
--- Using 'compare' can be more efficient for complex types.
---
-class (Eq a) => Ord a where
- compare :: a -> a -> Ordering
- (<), (<=), (>), (>=) :: a -> a -> Bool
- max, min :: a -> a -> a
-
- compare x y
- | x == y = EQ
- | 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 = case compare x y of { LT -> True; _other -> False }
- x <= y = case compare x y of { GT -> False; _other -> True }
- x > y = case compare x y of { GT -> True; _other -> False }
- x >= y = case compare x y of { LT -> False; _other -> True }
-
- -- These two default methods use '<=' rather than 'compare'
- -- because the latter is often more expensive
- max x y = if x <= y then y else x
- min x y = if x <= y then x else y
-\end{code}
-
-%*********************************************************
-%* *
+%* *
\subsection{Monadic classes @Functor@, @Monad@ }
-%* *
+%* *
%*********************************************************
\begin{code}
> fmap (f . g) == fmap f . fmap g
The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
-defined in the "Prelude" satisfy these laws.
+satisfy these laws.
-}
class Functor f where
fmap :: (a -> b) -> f a -> f b
+ -- | Replace all locations in the input with the same value.
+ -- The default definition is @'fmap' . 'const'@, but this may be
+ -- overridden with a more efficient version.
+ (<$) :: a -> f b -> f a
+ (<$) = fmap . const
+
{- | The 'Monad' class defines the basic operations over a /monad/,
a concept from a branch of mathematics known as /category theory/.
From the perspective of a Haskell programmer, however, it is best to
-- by the first, like sequencing operators (such as the semicolon)
-- in imperative languages.
(>>) :: forall a b. m a -> m b -> m b
- -- Explicit for-alls so that we know what order to
- -- give type arguments when desugaring
+ -- Explicit for-alls so that we know what order to
+ -- give type arguments when desugaring
-- | Inject a value into the monadic type.
return :: a -> m a
-- | Fail with a message. This operation is not part of the
-- mathematical definition of a monad, but is invoked on pattern-match
-- failure in a @do@ expression.
- fail :: String -> m a
+ fail :: String -> m a
+ {-# INLINE (>>) #-}
m >> k = m >>= \_ -> k
fail s = error s
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{The list type}
-%* *
+%* *
%*********************************************************
\begin{code}
-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
-
-instance (Ord a) => Ord [a] where
- {-# SPECIALISE instance Ord [Char] #-}
- compare [] [] = EQ
- compare [] (_:_) = LT
- compare (_:_) [] = GT
- compare (x:xs) (y:ys) = case compare x y of
- EQ -> compare xs ys
- other -> other
-
instance Functor [] where
fmap = map
m >>= k = foldr ((++) . k) [] m
m >> k = foldr ((++) . (\ _ -> k)) [] m
return x = [x]
- fail _ = []
+ fail _ = []
\end{code}
A few list functions that appear here because they are used here.
The rest of the prelude list functions are in GHC.List.
----------------------------------------------
--- foldr/build/augment
+-- foldr/build/augment
----------------------------------------------
\begin{code}
-- foldr f z (x:xs) = f x (foldr f z xs)
{-# 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
+-- Also note that we inline it when it has *two* parameters, which are the
+-- ones we are keen about specialising!
+foldr k z = go
+ where
+ go [] = z
+ go (y:ys) = y `k` go ys
-- | A list producer that can be fused with 'foldr'.
-- This function is merely
--
--- > build g = g (:) []
+-- > build g = g (:) []
--
-- but GHC's simplifier will transform an expression of the form
-- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@,
-- which avoids producing an intermediate list.
-build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
{-# 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 "1" says to inline in phase 1
+ -- 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 "1" says to inline in phase 1
build g = g (:) []
-- | A list producer that can be fused with 'foldr'.
-- This function is merely
--
--- > augment g xs = g (:) xs
+-- > augment g xs = g (:) xs
--
-- but GHC's simplifier will transform an expression of the form
-- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to
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
+"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 k z (augment g xs) = g k (foldr k z xs)
-"foldr/id" foldr (:) [] = \x -> x
-"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
- -- Only activate this from phase 1, because that's
- -- when we disable the rule that expands (++) into foldr
+"foldr/id" foldr (:) [] = \x -> x
+"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
+ -- Only activate this from phase 1, because that's
+ -- when we disable the rule that expands (++) into foldr
-- 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... ]
+-- 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/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/single" forall k z x. foldr k z [x] = k x z
-"foldr/nil" forall k z. foldr k z [] = z
+"foldr/single" forall k z x. foldr k z [x] = k x z
+"foldr/nil" forall k z. foldr k z [] = z
"augment/build" forall (g::forall b. (a->b->b) -> b -> b)
- (h::forall b. (a->b->b) -> b -> b) .
- augment g (build h) = build (\c n -> g c (h c n))
+ (h::forall b. (a->b->b) -> b -> b) .
+ augment g (build h) = build (\c n -> g c (h c n))
"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) .
- augment g [] = build g
+ augment g [] = build g
#-}
-- This rule is true, but not (I think) useful:
--- augment g (augment h t) = augment (\cn -> g c (h c n)) t
+-- augment g (augment h t) = augment (\cn -> g c (h c n)) t
\end{code}
----------------------------------------------
--- map
+-- map
----------------------------------------------
\begin{code}
-- Note eta expanded
mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
{-# INLINE [0] mapFB #-}
-mapFB c f x ys = c (f x) ys
+mapFB c f = \x ys -> c (f x) ys
-- The rules for map work like this.
--
-- e.g. append, filter, iterate, repeat, etc.
{-# RULES
-"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
-"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f
-"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
+"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
+"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f
+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g)
#-}
\end{code}
----------------------------------------------
--- append
+-- append
----------------------------------------------
\begin{code}
-- | Append two lists, i.e.,
(++) (x:xs) ys = x : xs ++ ys
{-# RULES
-"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
#-}
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Bool@}
-%* *
+%* *
%*********************************************************
\begin{code}
--- |The 'Bool' type is an enumeration. It is defined with 'False'
--- first so that the corresponding 'Prelude.Enum' instance will give
--- 'Prelude.fromEnum' 'False' the value zero, and
--- 'Prelude.fromEnum' 'True' the value 1.
-data Bool = False | True deriving (Eq, Ord)
- -- Read in GHC.Read, Show in GHC.Show
-
--- Boolean functions
-
--- | Boolean \"and\"
-(&&) :: Bool -> Bool -> Bool
-True && x = x
-False && _ = False
-
--- | Boolean \"or\"
-(||) :: Bool -> Bool -> Bool
-True || _ = True
-False || x = x
-
--- | Boolean \"not\"
-not :: Bool -> Bool
-not True = False
-not False = True
-
-- |'otherwise' is defined as the value 'True'. It helps to make
-- guards more readable. eg.
--
-- > f x | x < 0 = ...
-- > | otherwise = ...
-otherwise :: Bool
-otherwise = True
-\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{The @()@ type}
-%* *
-%*********************************************************
-
-The Unit type is here because virtually any program needs it (whereas
-some programs may get away without consulting GHC.Tup). Furthermore,
-the renamer currently *always* asks for () to be in scope, so that
-ccalls can use () as their default type; so when compiling GHC.Base we
-need (). (We could arrange suck in () only if -fglasgow-exts, but putting
-it here seems more direct.)
-
-\begin{code}
--- | The unit datatype @()@ has one non-undefined member, the nullary
--- constructor @()@.
-data () = ()
-
-instance Eq () where
- () == () = True
- () /= () = False
-
-instance Ord () where
- () <= () = True
- () < () = False
- () >= () = True
- () > () = False
- max () () = ()
- min () () = ()
- compare () () = EQ
+otherwise :: Bool
+otherwise = True
\end{code}
-
-%*********************************************************
-%* *
-\subsection{Type @Ordering@}
-%* *
%*********************************************************
-
-\begin{code}
--- | Represents an ordering relationship between two values: less
--- than, equal to, or greater than. An 'Ordering' is returned by
--- 'compare'.
-data Ordering = LT | EQ | GT deriving (Eq, Ord)
- -- Read in GHC.Read, Show in GHC.Show
-\end{code}
-
-
-%*********************************************************
-%* *
+%* *
\subsection{Type @Char@ and @String@}
-%* *
+%* *
%*********************************************************
\begin{code}
--
type String = [Char]
-{-| The character type 'Char' is an enumeration whose values represent
-Unicode (or equivalently ISO\/IEC 10646) characters
-(see <http://www.unicode.org/> for details).
-This set extends the ISO 8859-1 (Latin-1) character set
-(the first 256 charachers), which is itself an extension of the ASCII
-character set (the first 128 characters).
-A character literal in Haskell has type 'Char'.
-
-To convert a 'Char' to or from the corresponding 'Int' value defined
-by Unicode, use 'Prelude.toEnum' and 'Prelude.fromEnum' from the
-'Prelude.Enum' class respectively (or equivalently 'ord' and 'chr').
--}
-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.
-
-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
-
{-# RULES
"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
"x# `neChar#` x#" forall x#. x# `neChar#` x# = False
-- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
chr :: Int -> Char
-chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
- | otherwise = error "Prelude.chr: bad argument"
+chr i@(I# i#)
+ | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
+ | otherwise
+ = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
unsafeChr :: Int -> Char
unsafeChr (I# i#) = C# (chr# i#)
\begin{code}
eqString :: String -> String -> Bool
-eqString [] [] = True
+eqString [] [] = True
eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
-eqString cs1 cs2 = False
+eqString _ _ = False
{-# RULES "eqString" (==) = eqString #-}
-- eqString also has a BuiltInRule in PrelRules.lhs:
--- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
+-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Int@}
-%* *
+%* *
%*********************************************************
\begin{code}
-data Int = I# Int#
--- ^A fixed-precision integer type with at least the range @[-2^29 .. 2^29-1]@.
--- The exact range for a given implementation can be determined by using
--- 'Prelude.minBound' and 'Prelude.maxBound' from the 'Prelude.Bounded' class.
-
zeroInt, oneInt, twoInt, maxInt, minInt :: Int
zeroInt = I# 0#
oneInt = I# 1#
%*********************************************************
-%* *
+%* *
\subsection{The function type}
-%* *
+%* *
%*********************************************************
\begin{code}
-- | Identity function.
-id :: a -> a
-id x = x
+id :: a -> a
+id x = x
-- | The call '(lazy e)' means the same as 'e', but 'lazy' has a
-- magical strictness property: it is lazy in its first argument,
-- sees it as lazy. Then the worker/wrapper phase inlines it.
-- Result: happiness
-
--- | The call '(inline f)' reduces to 'f', but 'inline' has a BuiltInRule
--- that tries to inline 'f' (if it has an unfolding) unconditionally
--- The 'NOINLINE' pragma arranges that inline only gets inlined (and
--- hence eliminated) late in compilation, after the rule has had
--- a god chance to fire.
-inline :: a -> a
-{-# NOINLINE[0] inline #-}
-inline x = x
-
-- Assertion function. This simply ignores its boolean argument.
-- The compiler may rewrite it to @('assertError' line)@.
-- argument to 'assert' is ignored, and the second argument is
-- returned as the result.
--- SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
--- but from Template Haskell onwards it's simply
--- defined here in Base.lhs
+-- SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
+-- but from Template Haskell onwards it's simply
+-- defined here in Base.lhs
assert :: Bool -> a -> a
-assert pred r = r
+assert _pred r = r
breakpoint :: a -> a
breakpoint r = r
breakpointCond :: Bool -> a -> a
breakpointCond _ r = r
-data Unknown
-data Unknown1 a
-data Unknown2 a b
-data Unknown3 a b c
-data Unknown4 a b c d
-
data Opaque = forall a. O a
-- | Constant function.
-const :: a -> b -> a
-const x _ = x
+const :: a -> b -> a
+const x _ = x
-- | Function composition.
{-# INLINE (.) #-}
-(.) :: (b -> c) -> (a -> b) -> a -> c
-(.) f g x = f (g x)
+-- Make sure it has TWO args only on the left, so that it inlines
+-- when applied to two functions, even if there is no final argument
+(.) :: (b -> c) -> (a -> b) -> a -> c
+(.) f g = \x -> f (g x)
-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
-flip :: (a -> b -> c) -> b -> a -> c
-flip f x y = f y x
+flip :: (a -> b -> c) -> b -> a -> c
+flip f x y = f y x
-- | Application operator. This operator is redundant, since ordinary
-- application @(f x)@ means the same as @(f '$' x)@. However, '$' has
-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
-- or @'Data.List.zipWith' ('$') fs xs@.
{-# INLINE ($) #-}
-($) :: (a -> b) -> a -> b
-f $ x = f x
+($) :: (a -> b) -> a -> b
+f $ x = f x
-- | @'until' p f@ yields the result of applying @f@ until @p@ holds.
-until :: (a -> Bool) -> (a -> a) -> a -> a
-until p f x | p x = x
- | otherwise = until p f (f x)
+until :: (a -> Bool) -> (a -> a) -> a -> a
+until p f x | p x = x
+ | otherwise = until p f (f x)
-- | 'asTypeOf' is a type-restricted version of 'const'. It is usually
-- used as an infix operator, and its typing forces its first argument
-- (which is usually overloaded) to have the same type as the second.
-asTypeOf :: a -> a -> a
-asTypeOf = const
+asTypeOf :: a -> a -> a
+asTypeOf = const
\end{code}
%*********************************************************
-%* *
-\subsection{Generics}
-%* *
+%* *
+\subsection{@Functor@ and @Monad@ instances for @IO@}
+%* *
%*********************************************************
\begin{code}
-data Unit = Unit
-#ifndef __HADDOCK__
-data (:+:) a b = Inl a | Inr b
-data (:*:) a b = a :*: b
-#endif
+instance Functor IO where
+ fmap f x = x >>= (return . f)
+
+instance Monad IO where
+ {-# INLINE return #-}
+ {-# INLINE (>>) #-}
+ {-# INLINE (>>=) #-}
+ m >> k = m >>= \ _ -> k
+ return = returnIO
+ (>>=) = bindIO
+ fail s = GHC.IO.failIO s
+
+returnIO :: a -> IO a
+returnIO x = IO $ \ s -> (# s, x #)
+
+bindIO :: IO a -> (a -> IO b) -> IO b
+bindIO (IO m) k = IO $ \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s
+
+thenIO :: IO a -> IO b -> IO b
+thenIO (IO m) k = IO $ \ s -> case m s of (# new_s, _ #) -> unIO k new_s
+
+unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
+unIO (IO a) = a
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{@getTag@}
-%* *
+%* *
%*********************************************************
Returns the 'tag' of a constructor application; this function is used
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Numeric primops}
-%* *
+%* *
%*********************************************************
\begin{code}
divInt# :: Int# -> Int# -> Int#
x# `divInt#` y#
- -- Be careful NOT to overflow if we do any additional arithmetic
- -- on the arguments... the following previous version of this
- -- code has problems with overflow:
+ -- Be careful NOT to overflow if we do any additional arithmetic
+ -- on the arguments... the following previous version of this
+ -- code has problems with overflow:
-- | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
-- | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
| (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1#
(x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0#
| otherwise = r#
where
- r# = x# `remInt#` y#
+ !r# = x# `remInt#` y#
\end{code}
Definitions of the boxed PrimOps; these will be
{-# INLINE remInt #-}
{-# INLINE negateInt #-}
-plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int
(I# x) `plusInt` (I# y) = I# (x +# y)
(I# x) `minusInt` (I# y) = I# (x -# y)
(I# x) `timesInt` (I# y) = I# (x *# y)
"1# *# x#" forall x#. 1# *# x# = x#
#-}
-gcdInt (I# a) (I# b) = g a b
- where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
- g 0# _ = I# absB
- g _ 0# = I# absA
- g _ _ = I# (gcdInt# absA absB)
-
- absInt x = if x <# 0# then negateInt# x else x
-
- absA = absInt a
- absB = absInt b
-
negateInt :: Int -> Int
negateInt (I# x) = I# (negateInt# x)
"plusDouble x 0.0" forall x#. (+##) x# 0.0## = x#
"plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x#
"minusDouble x 0.0" forall x#. (-##) x# 0.0## = x#
-"minusDouble x x" forall x#. (-##) x# x# = 0.0##
-"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0##
-"timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0##
"timesDouble x 1.0" forall x#. (*##) x# 1.0## = x#
"timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x#
"divideDouble x 1.0" forall x#. (/##) x# 1.0## = x#
#-}
+{-
+We'd like to have more rules, but for example:
+
+This gives wrong answer (0) for NaN - NaN (should be NaN):
+ "minusDouble x x" forall x#. (-##) x# x# = 0.0##
+
+This gives wrong answer (0) for 0 * NaN (should be NaN):
+ "timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0##
+
+This gives wrong answer (0) for NaN * 0 (should be NaN):
+ "timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0##
+
+These are tested by num014.
+-}
+
-- Wrappers for the shift operations. The uncheckedShift# family are
-- undefined when the amount being shifted by is greater than the size
-- in bits of Int#, so these wrappers perform a check and return
-- (which must be non-negative).
shiftL# :: Word# -> Int# -> Word#
a `shiftL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
- | otherwise = a `uncheckedShiftL#` b
+ | otherwise = a `uncheckedShiftL#` b
-- | Shift the argument right by the specified number of bits
-- (which must be non-negative).
shiftRL# :: Word# -> Int# -> Word#
a `shiftRL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
- | otherwise = a `uncheckedShiftRL#` b
+ | otherwise = a `uncheckedShiftRL#` b
-- | Shift the argument left by the specified number of bits
-- (which must be non-negative).
iShiftL# :: Int# -> Int# -> Int#
a `iShiftL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
- | otherwise = a `uncheckedIShiftL#` b
+ | otherwise = a `uncheckedIShiftL#` b
-- | Shift the argument right (signed) by the specified number of bits
-- (which must be non-negative).
iShiftRA# :: Int# -> Int# -> Int#
a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
- | otherwise = a `uncheckedIShiftRA#` b
+ | otherwise = a `uncheckedIShiftRA#` b
-- | Shift the argument right (unsigned) by the specified number of bits
-- (which must be non-negative).
iShiftRL# :: Int# -> Int# -> Int#
a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
- | otherwise = a `uncheckedIShiftRL#` b
+ | otherwise = a `uncheckedIShiftRL#` b
#if WORD_SIZE_IN_BITS == 32
{-# RULES
%********************************************************
-%* *
+%* *
\subsection{Unpacking C strings}
-%* *
+%* *
%********************************************************
This code is needed for virtually all programs, since it's used for
\begin{code}
unpackCString# :: Addr# -> [Char]
-{-# NOINLINE [1] unpackCString# #-}
+{-# NOINLINE unpackCString# #-}
+ -- There's really no point in inlining this, ever, cos
+ -- the loop doesn't specialise in an interesting
+ -- But it's pretty small, so there's a danger that
+ -- it'll be inlined at every literal, which is a waste
unpackCString# addr
= unpack 0#
where
unpack nh
| ch `eqChar#` '\0'# = []
- | otherwise = C# ch : unpack (nh +# 1#)
+ | otherwise = C# ch : unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackAppendCString# :: Addr# -> [Char] -> [Char]
+{-# NOINLINE unpackAppendCString# #-}
+ -- See the NOINLINE note on unpackCString#
unpackAppendCString# addr rest
= unpack 0#
where
unpack nh
| ch `eqChar#` '\0'# = rest
- | otherwise = C# ch : unpack (nh +# 1#)
+ | otherwise = C# ch : unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !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
+
+-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
+
-- It also has a BuiltInRule in PrelRules.lhs:
--- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
--- = unpackFoldrCString# "foobaz" c n
+-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
+-- = unpackFoldrCString# "foobaz" c n
+
+{-# NOINLINE unpackFoldrCString# #-}
+-- At one stage I had NOINLINE [0] on the grounds that, unlike
+-- unpackCString#, there *is* some point in inlining
+-- unpackFoldrCString#, because we get better code for the
+-- higher-order function call. BUT there may be a lot of
+-- literal strings, and making a separate 'unpack' loop for
+-- each is highly gratuitous. See nofib/real/anna/PrettyPrint.
+
unpackFoldrCString# addr f z
= unpack 0#
where
unpack nh
| ch `eqChar#` '\0'# = z
- | otherwise = C# ch `f` unpack (nh +# 1#)
+ | otherwise = C# ch `f` unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackCStringUtf8# :: Addr# -> [Char]
unpackCStringUtf8# addr
(ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
unpack (nh +# 4#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackNBytes# :: Addr# -> Int# -> [Char]
unpackNBytes# _addr 0# = []
unpack acc i#
| i# <# 0# = acc
| otherwise =
- case indexCharOffAddr# addr i# of
- ch -> unpack (C# ch : acc) (i# -# 1#)
+ case indexCharOffAddr# addr i# of
+ ch -> unpack (C# ch : acc) (i# -# 1#)
{-# RULES
-"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
+"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n
-- There's a built-in rule (in PrelRules.lhs) for
--- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n
+-- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n
#-}
\end{code}
projects / ghc-base.git / blobdiff