X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=fe4299119c642ed19c41929b2d7eaf7ac55fd0e1;hb=281853c0c595211e4a56c547f475f1949da46674;hp=968d703755656ef908e5689bad62d70ffcd45784;hpb=5545727d5a6a1fc6d5d00f32a92a8fdf0fb7ca77;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 968d703..fe42991 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -1,11 +1,5 @@ -% ----------------------------------------------------------------------------- -% $Id: Base.lhs,v 1.2 2001/07/03 11:37:50 simonmar Exp $ -% -% (c) The University of Glasgow, 1992-2000 -% \section[GHC.Base]{Module @GHC.Base@} - The overall structure of the GHC Prelude is a bit tricky. a) We want to avoid "orphan modules", i.e. ones with instance @@ -33,7 +27,7 @@ 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.Maybe Type: Maybe, plus instances for GHC.Base classes +Data.Maybe Type: Maybe, plus instances for GHC.Base classes GHC.Num Class: Num, plus instances for Int Type: Integer, plus instances for all classes so far (Eq, Ord, Num, Show) @@ -71,16 +65,28 @@ GHC.ByteArr Types: ByteArray, MutableByteArray Other Prelude modules are much easier with fewer complex dependencies. - \begin{code} {-# OPTIONS -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Basic data types and classes. +-- +----------------------------------------------------------------------------- #include "MachDeps.h" module GHC.Base ( module GHC.Base, - module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots + module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots module GHC.Err -- of people having to import it explicitly ) where @@ -143,6 +149,14 @@ unpackCStringUtf8# a = error "urk" %********************************************************* \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 @@ -243,25 +257,26 @@ The rest of the prelude list functions are in GHC.List. 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 @@ -271,11 +286,21 @@ augment g xs = g (:) xs "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/id" foldr (:) [] = \x->x +"foldr/app" [1] forall xs 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... ] +-- 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/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) . @@ -295,20 +320,36 @@ augment g xs = g (:) xs \begin{code} map :: (a -> b) -> [a] -> [b] -map = mapList +map _ [] = [] +map f (x:xs) = f x : map f xs -- Note eta expanded mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst +{-# INLINE [0] mapFB #-} mapFB c f x ys = c (f x) ys -mapList :: (a -> b) -> [a] -> [b] -mapList _ [] = [] -mapList f (x:xs) = f x : mapList f xs +-- The rules for map work like this. +-- +-- Up to (but not including) phase 1, we use the "map" rule to +-- rewrite all saturated applications of map with its build/fold +-- form, hoping for fusion to happen. +-- In phase 1 and 0, we switch off that rule, inline build, and +-- switch on the "mapList" rule, which rewrites the foldr/mapFB +-- thing back into plain map. +-- +-- It's important that these two rules aren't both active at once +-- (along with build's unfolding) else we'd get an infinite loop +-- in the rules. Hence the activation control below. +-- +-- The "mapFB" rule optimises compositions of map. +-- +-- This same pattern is followed by many other functions: +-- e.g. append, filter, iterate, repeat, etc. {-# RULES -"map" forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) +"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) -"mapList" forall f. foldr (mapFB (:) f) [] = mapList f #-} \end{code} @@ -318,15 +359,13 @@ mapList f (x:xs) = f x : mapList f xs ---------------------------------------------- \begin{code} (++) :: [a] -> [a] -> [a] -(++) = append +(++) [] ys = ys +(++) (x:xs) ys = x : xs ++ ys {-# RULES -"++" 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 #-} -append :: [a] -> [a] -> [a] -append [] ys = ys -append (x:xs) ys = x : append xs ys \end{code} @@ -337,21 +376,34 @@ append (x:xs) ys = x : append xs ys %********************************************************* \begin{code} +-- |The 'Bool' type is an enumeration. It is defined with 'False' +-- first so that the corresponding 'Enum' instance will give @'fromEnum' +-- False@ the value zero, and @'fromEnum' True@ the value 1. data Bool = False | True deriving (Eq, Ord) -- Read in GHC.Read, Show in GHC.Show -- Boolean functions -(&&), (||) :: Bool -> Bool -> Bool +-- | 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} @@ -371,6 +423,8 @@ 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 @@ -395,6 +449,9 @@ instance Ord () where %********************************************************* \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} @@ -407,8 +464,18 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord) %********************************************************* \begin{code} +-- | A 'String' is a list of characters. String constants in Haskell are values +-- of type 'String'. +-- type String = [Char] +{-| The character type 'Char' is an enumeration whose values represent +Unicode characters. A character literal in Haskell has type 'Char'. + +To convert a 'Char' to or from an 'Int', use 'Prelude.toEnum' and +'Prelude.fromEnum' from the 'Enum' class respectively (equivalently +'ord' and 'chr' also do the trick). +-} data Char = C# Char# -- We don't use deriving for Eq and Ord, because for Ord the derived @@ -449,9 +516,14 @@ String equality is used when desugaring pattern-matches against strings. \begin{code} eqString :: String -> String -> Bool -eqString = (==) +eqString [] [] = True +eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 +eqString cs1 cs2 = False + +{-# RULES "eqString" (==) = eqString #-} \end{code} + %********************************************************* %* * \subsection{Type @Int@} @@ -460,15 +532,24 @@ eqString = (==) \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 'minBound' and 'maxBound' from the 'Bounded' +-- class. zeroInt, oneInt, twoInt, maxInt, minInt :: 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 @@ -506,6 +587,22 @@ compareInt# x# y# id :: a -> a id x = x +-- lazy function; this is just the same as id, but its unfolding +-- and strictness are over-ridden by the definition in MkId.lhs +-- That way, it does not get inlined, and the strictness analyser +-- sees it as lazy. Then the worker/wrapper phase inlines it. +-- Result: happiness +lazy :: a -> a +lazy x = x + +-- Assertion function. This simply ignores its boolean argument. +-- The compiler may rewrite it to (assertError line) +-- 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 + -- constant function const :: a -> b -> a const x _ = x @@ -564,8 +661,10 @@ instance CReturnable () -- Why, exactly? \begin{code} data Unit = Unit -data a :+: b = Inl a | Inr b -data a :*: b = a :*: b +#ifndef __HADDOCK__ +data (:+:) a b = Inl a | Inr b +data (:*:) a b = a :*: b +#endif \end{code} @@ -576,11 +675,18 @@ data a :*: b = a :*: b %********************************************************* \begin{code} -divInt#, modInt# :: Int# -> Int# -> Int# +divInt# :: Int# -> Int# -> Int# x# `divInt#` y# - | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y# - | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` 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: +-- | (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#) = ((x# +# 1#) `quotInt#` y#) -# 1# | otherwise = x# `quotInt#` y# + +modInt# :: Int# -> Int# -> Int# x# `modInt#` y# | (x# ># 0#) && (y# <# 0#) || (x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0# @@ -657,10 +763,61 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool "x# <=# x#" forall x#. x# <=# x# = True #-} -#if WORD_SIZE_IN_BYTES == 4 {-# RULES -"intToInt32#" forall x#. intToInt32# x# = x# -"wordToWord32#" forall x#. wordToWord32# x# = x# +"plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x# +"plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x# +"minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x# +"minusFloat x x" forall x#. minusFloat# x# x# = 0.0# +"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0# +"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0# +"timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x# +"timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x# +"divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x# + #-} + +{-# RULES +"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# + #-} + +-- 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 +-- either zero or -1 appropriately. +-- +-- Note that these wrappers still produce undefined results when the +-- second argument (the shift amount) is negative. + +shiftL#, shiftRL# :: Word# -> Int# -> Word# + +a `shiftL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0# + | otherwise = a `uncheckedShiftL#` b + +a `shiftRL#` b | b >=# WORD_SIZE_IN_BITS# = int2Word# 0# + | otherwise = a `uncheckedShiftRL#` b + +iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int# + +a `iShiftL#` b | b >=# WORD_SIZE_IN_BITS# = 0# + | otherwise = a `uncheckedIShiftL#` b + +a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0# + | otherwise = a `uncheckedIShiftRA#` b + +a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0# + | otherwise = a `uncheckedIShiftRL#` b + +#if WORD_SIZE_IN_BITS == 32 +{-# RULES +"narrow32Int#" forall x#. narrow32Int# x# = x# +"narrow32Word#" forall x#. narrow32Word# x# = x# #-} #endif @@ -682,10 +839,8 @@ unpacking the strings of error messages. \begin{code} unpackCString# :: Addr# -> [Char] -unpackCString# a = unpackCStringList# a - -unpackCStringList# :: Addr# -> [Char] -unpackCStringList# addr +{-# NOINLINE [1] unpackCString# #-} +unpackCString# addr = unpack 0# where unpack nh @@ -705,6 +860,9 @@ unpackAppendCString# addr rest 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 @@ -722,19 +880,19 @@ unpackCStringUtf8# addr | ch `eqChar#` '\0'# = [] | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#) | ch `leChar#` '\xDF'# = - C# (chr# ((ord# ch -# 0xC0#) `iShiftL#` 6# +# - (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) : + C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) : unpack (nh +# 2#) | ch `leChar#` '\xEF'# = - C# (chr# ((ord# ch -# 0xE0#) `iShiftL#` 12# +# - (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 6# +# - (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) : + C# (chr# (((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12#) +# + ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) : unpack (nh +# 3#) | otherwise = - C# (chr# ((ord# ch -# 0xF0#) `iShiftL#` 18# +# - (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +# - (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#` 6# +# - (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) : + C# (chr# (((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18#) +# + ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +# + ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) : unpack (nh +# 4#) where ch = indexCharOffAddr# addr nh @@ -750,11 +908,11 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#) ch -> unpack (C# ch : acc) (i# -# 1#) {-# RULES -"unpack" forall a . unpackCString# a = build (unpackFoldrCString# a) -"unpack-list" forall a . unpackFoldrCString# a (:) [] = unpackCStringList# a -"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n +"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 GHC.Rules.lhs) for +-- There's a built-in rule (in PrelRules.lhs) for -- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n #-}