-- the representation of some basic types:
Int(..),Addr(..),Word(..),Float(..),Double(..),Integer(..),Char(..),
+ -- Fusion
+ build, augment,
+
-- misc bits
trace,
import PreludeBuiltin
ord_0 = ord '0'
#else
-import PrelBase (ord_0, showList__)
+import PrelNum ( ord_0 )
+import PrelShow( showList__ )
import GlaExts
#endif
\end{code}
) where
import GlaExts
-import PrelBase ( showList__ ) -- ToDo: better
+import PrelShow ( showList__ ) -- ToDo: better
import PrelPack
( new_ps_array
, freeze_ps_array
#if defined(__GLASGOW_HASKELL__)
import GlaExts
import PrelArr (Array(..), ByteArray(..))
-import PrelBase hiding (itos)
+import PrelBase
#endif
data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double
nOfThem = replicate -- deprecated.
lengthExceeds :: [a] -> Int -> Bool
-
+-- (lengthExceeds xs n) is True if length xs > n
[] `lengthExceeds` n = 0 > n
(x:xs) `lengthExceeds` n = (1 > n) || (xs `lengthExceeds` (n - 1))
else GT_
cmpString [] ys = LT_
cmpString xs [] = GT_
-
-#ifdef COMPILING_GHC
-cmpString _ _ = panic# "cmpString"
-#else
-cmpString _ _ = error "cmpString"
-#endif
\end{code}
\begin{code}
)
import Addr
import CCall
-import PrelBase
+import PrelBase hiding( append )
import ByteArray
import PosixErr
import Ix
import PrelList
+import PrelShow
import PrelArr -- Most of the hard work is done here
import PrelBase
) where
import PrelBase
+import PrelShow
+import PrelEnum
+import PrelNum
import PrelRead (readLitChar, lexLitChar, digitToInt)
-import {-# SOURCE #-} PrelErr ( error )
-
+import PrelErr ( error )
\end{code}
import PrelRead ( readParen, Read(..), reads, lex,
readIO
)
---import PrelNum ( toInteger )
-import PrelBounded () -- Bounded Int instance.
-import PrelEither ( Either(..) )
+import PrelShow
+import PrelMaybe ( Either(..) )
import PrelAddr ( Addr(..), nullAddr )
import PrelArr ( ByteArray )
import PrelPack ( unpackNBytesAccST )
import {-# SOURCE #-} PrelErr ( error )
import PrelTup
import PrelBase
+import PrelList( null )
+import PrelEnum
+import PrelShow
+import PrelNum
\end{code}
%*********************************************************
\begin{code}
class (Ord a) => Ix a where
range :: (a,a) -> [a]
- index :: (a,a) -> a -> Int
+ index, unsafeIndex :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
-\end{code}
+ -- Must specify one of index, unsafeIndex
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = error "Error in array index"
+ unsafeIndex b i = index b i
+\end{code}
%*********************************************************
%* *
%*********************************************************
\begin{code}
+-- abstract these errors from the relevant index functions so that
+-- the guts of the function will be small enough to inline.
+
+{-# NOINLINE indexError #-}
+indexError :: Show a => (a,a) -> a -> String -> b
+indexError rng i tp
+ = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+ showParen True (showsPrec 0 i) .
+ showString " out of range " $
+ showParen True (showsPrec 0 rng) "")
+
+----------------------------------------------------------------------
instance Ix Char where
range (m,n)
| m <= n = [m..n]
| otherwise = []
- index b@(m,_) i
- | inRange b i = fromEnum i - fromEnum m
- | otherwise = indexError i b "Char"
+
+ unsafeIndex (m,n) i = fromEnum i - fromEnum m
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Char"
+
inRange (m,n) i = m <= i && i <= n
+----------------------------------------------------------------------
instance Ix Int where
range (m,n)
| m <= n = [m..n]
| otherwise = []
- index b@(m,_) i
- | inRange b i = i - m
- | otherwise = indexError i b "Int"
+
+ unsafeIndex (m,n) i = i - m
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Int"
+
inRange (m,n) i = m <= i && i <= n
--- abstract these errors from the relevant index functions so that
--- the guts of the function will be small enough to inline.
-{-# NOINLINE indexError #-}
-indexError :: Show a => a -> (a,a) -> String -> b
-indexError i rng tp
- = error (showString "Ix{" . showString tp . showString "}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 rng) "")
+----------------------------------------------------------------------
+instance Ix Integer where
+ range (m,n)
+ | m <= n = [m..n]
+ | otherwise = []
+
+ unsafeIndex (m,n) i = fromInteger (i - m)
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Integer"
+
+ inRange (m,n) i = m <= i && i <= n
--- Integer instance is in PrelNum
----------------------------------------------------------------------
instance Ix Bool where -- as derived
range (l,u)
| l <= u = map toEnum [fromEnum l .. fromEnum u]
| otherwise = []
- index (l,_) i = fromEnum i - fromEnum l
+
+ unsafeIndex (l,_) i = fromEnum i - fromEnum l
+
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Bool"
+
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
range (l,u)
| l <= u = map toEnum [fromEnum l .. fromEnum u]
| otherwise = []
- index (l,_) i = fromEnum i - fromEnum l
+ unsafeIndex (l,_) i = fromEnum i - fromEnum l
+ index b i | inRange b i = unsafeIndex b i
+ | otherwise = indexError b i "Ordering"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix () where
{-# INLINE range #-}
range ((), ()) = [()]
- {-# INLINE index #-}
- index ((), ()) () = 0
+ {-# INLINE unsafeIndex #-}
+ unsafeIndex ((), ()) () = 0
{-# INLINE inRange #-}
inRange ((), ()) () = True
+ {-# INLINE index #-}
+ index b i = unsafeIndex b i
+
----------------------------------------------------------------------
instance (Ix a, Ix b) => Ix (a, b) where -- as derived
+ {-# SPECIALISE instance Ix (Int,Int) #-}
+
{- INLINE range #-}
range ((l1,l2),(u1,u2)) =
[ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
- {- INLINE index #-}
- index ((l1,l2),(u1,u2)) (i1,i2) =
- index (l1,u1) i1 * rangeSize (l2,u2) + index (l2,u2) i2
+ {- INLINE unsafeIndex #-}
+ unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
+ unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
{- INLINE inRange #-}
inRange ((l1,l2),(u1,u2)) (i1,i2) =
inRange (l1,u1) i1 && inRange (l2,u2) i2
+ -- Default method for index
+
+----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
+ {-# SPECIALISE instance Ix (Int,Int,Int) #-}
+
range ((l1,l2,l3),(u1,u2,u3)) =
[(i1,i2,i3) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3)]
- index ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
- index (l3,u3) i3 + rangeSize (l3,u3) * (
- index (l2,u2) i2 + rangeSize (l2,u2) * (
- index (l1,u1) i1))
+ unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1))
inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3
+ -- Default method for index
+
+----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
[(i1,i2,i3,i4) | i1 <- range (l1,u1),
i3 <- range (l3,u3),
i4 <- range (l4,u4)]
- index ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
- index (l4,u4) i4 + rangeSize (l4,u4) * (
- index (l3,u3) i3 + rangeSize (l3,u3) * (
- index (l2,u2) i2 + rangeSize (l2,u2) * (
- index (l1,u1) i1)))
+ unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1)))
inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4
+ -- Default method for index
+
instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
[(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
i4 <- range (l4,u4),
i5 <- range (l5,u5)]
- index ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
- index (l5,u5) i5 + rangeSize (l5,u5) * (
- index (l4,u4) i4 + rangeSize (l4,u4) * (
- index (l3,u3) i3 + rangeSize (l3,u3) * (
- index (l2,u2) i2 + rangeSize (l2,u2) * (
- index (l1,u1) i1))))
+ unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
+ unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
+ unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+ unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+ unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+ unsafeIndex (l1,u1) i1))))
inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
inRange (l5,u5) i5
+
+ -- Default method for index
\end{code}
%********************************************************
%********************************************************
The @rangeSize@ operator returns the number of elements
-in the range for an @Ix@ pair:
+in the range for an @Ix@ pair.
\begin{code}
+{-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
+{-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
+unsafeRangeSize :: (Ix a) => (a,a) -> Int
+unsafeRangeSize b@(l,h) = unsafeIndex b h + 1
+
{-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
+{-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
rangeSize :: (Ix a) => (a,a) -> Int
-rangeSize b@(l,h)
- | l > h || isnull (range b) = 0
- | otherwise = index b h + 1
- where
- isnull [] = True
- isnull _ = False
-
+rangeSize b@(l,h) | inRange b h = unsafeIndex b h + 1
+ | otherwise = 0
+
+-- Note that the following is NOT right
+-- rangeSize (l,h) | l <= h = index b h + 1
+-- | otherwise = 0
+--
+-- Because it might be the case that l<h, but the range
+-- is nevertheless empty. Consider
+-- ((1,2),(2,1))
+-- Here l<h, but the second index ranges from 2..1 and
+-- hence is empty
\end{code}
) where
import Prelude
+import PrelShow ( lines, words, unlines, unwords )
import Maybe ( listToMaybe )
import PrelBase ( Int(..), map, (++) )
import PrelGHC ( (+#) )
---------------------------------------------------------------------------
__interface Main 1 where
-__export ! Main main ;
+__export Main main ;
1 main :: __forall [a] => PrelIOBase.IO a; -- wish this could be __o. KSW 1999-04.
+
import PrelBase
import PrelMaybe
+import PrelShow
import PrelArr
import PrelNum
import PrelNumExtra
import PrelGHC
import PrelBase
+import PrelShow
import PrelCCall
\end{code}
case (indexArray# arr# n#) of
(# v #) -> v
-#ifdef USE_FOLDR_BUILD
{-# INLINE array #-}
-#endif
-array ixs ivs =
- runST ( ST $ \ s ->
- case (newArray ixs arrEleBottom) of { ST new_array_thing ->
- case (new_array_thing s) of { (# s#, arr@(MutableArray _ arr#) #) ->
- let
- fill_in s1# [] = s1#
- fill_in s1# ((i,v) : is) =
- case (index ixs i) of { I# n# ->
- case writeArray# arr# n# v s1# of { s2# ->
- fill_in s2# is }}
- in
-
- case (fill_in s# ivs) of { s1# ->
- case (freezeArray arr) of { ST freeze_array_thing ->
- freeze_array_thing s1# }}}})
+array ixs ivs
+ = case rangeSize ixs of { I# n ->
+ runST ( ST $ \ s1 ->
+ case newArray# n arrEleBottom s1 of { (# s2, marr #) ->
+ foldr (fill ixs marr) (done ixs marr) ivs s2
+ })}
+
+fill :: Ix ix => (ix,ix) -> MutableArray# s elt
+ -> (ix,elt) -> STRep s a -> STRep s a
+{-# INLINE fill #-}
+fill ixs marr (i,v) next = \s1 -> case index ixs i of { I# n ->
+ case writeArray# marr n v s1 of { s2 ->
+ next s2 }}
+
+done :: Ix ix => (ix,ix) -> MutableArray# s elt
+ -> STRep s (Array ix elt)
+{-# INLINE done #-}
+done ixs marr = \s1 -> case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
+ (# s2, Array ixs arr #) }
arrEleBottom :: a
arrEleBottom = error "(Array.!): undefined array element"
-fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
-fill_it_in arr lst
- = foldr fill_one_in (return ()) lst
- where -- **** STRICT **** (but that's OK...)
- fill_one_in (i, v) rst
- = writeArray arr i v >> rst
-----------------------------------------------------------------------
-- these also go better with magic: (//), accum, accumArray
freezeArray arr
)
+fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
+fill_it_in arr lst
+ = foldr fill_one_in (return ()) lst
+ where -- **** STRICT **** (but that's OK...)
+ fill_one_in (i, v) rst
+ = writeArray arr i v >> rst
+
zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
-- zap_with_f: reads an elem out first, then uses "f" on that and the new value
import PrelGHC
infixr 9 .
-infixl 9 !!
-infixl 7 *
-infixl 6 +, -
infixr 5 ++, :
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
| x <= y = LT
| 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 (S# i#)
- -- 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
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
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}
+
+A few list functions that appear here because they are used here.
+The rest of the prelude list functions are in PrelList.
-instance (Show a) => Show [a] where
- showsPrec _ = showList
- showList ls = showList__ (showsPrec 0) ls
+----------------------------------------------
+-- 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)
+
+build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# INLINE 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.
+build g = g (:) []
+
+augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
+{-# INLINE 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)
+
+mapFB c f xs = c (f xs)
+
+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
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}
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}
+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)
-\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"]
+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#
+maxInt = I# (-2147483648#) -- GHC <= 2.09 had this at -2147483647
+minInt = 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 (S# i#) = I# i#
- fromInteger (J# s# d#)
- = case (integer2Int# 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}
(J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
\end{code}
+
%*********************************************************
%* *
\subsection{The function type}
%*********************************************************
%* *
-\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)
+++ /dev/null
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[PrelBounded]{Module @PrelBounded@}
-
-Instances of Bounded for various datatypes.
-
-\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module PrelBounded where
-
-import PrelBase
-
-instance Bounded () where
- minBound = ()
- maxBound = ()
-
-instance Bounded Char where
- minBound = '\0'
- maxBound = '\255'
-
-\end{code}
-- But since ThreadId# is unlifted, the Weak type must use open
-- type variables.
---forkIO has now been hoisted out into the concurrent library.
+--forkIO has now been hoisted out into the Concurrent library.
killThread :: ThreadId -> IO ()
killThread (ThreadId id) = IO $ \ s ->
#else
par _ y = y
#endif
-
\end{code}
%************************************************************************
+++ /dev/null
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
-%
-\section[PrelEither]{Module @PrelEither@}
-
-The @Either@ Type.
-
-\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module PrelEither where
-
-import PrelBase
-
-data Either a b = Left a | Right b deriving (Eq, Ord, Show {- Read -} )
-
-either :: (a -> c) -> (b -> c) -> Either a b -> c
-either f _ (Left x) = f x
-either _ g (Right y) = g y
-\end{code}
--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[PrelBounded]{Module @PrelBounded@}
+
+Instances of Bounded for various datatypes.
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module PrelEnum(
+ Bounded(..), Enum(..),
+ enumFromBounded, enumFromThenBounded,
+
+ -- Instances for Bounded and Eum: (), Char, Int
+
+ ) where
+
+import {-# SOURCE #-} PrelErr ( error )
+import PrelBase
+import PrelTup () -- To make sure we look for the .hi file
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Class declarations}
+%* *
+%*********************************************************
+
+\begin{code}
+class Bounded a where
+ minBound, maxBound :: a
+
+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 . (`plusInt` oneInt) . fromEnum
+ pred = toEnum . (`minusInt` oneInt) . fromEnum
+ enumFromTo n m = map toEnum [fromEnum n .. fromEnum m]
+ enumFromThenTo n1 n2 m = map toEnum [fromEnum n1, fromEnum n2 .. fromEnum m]
+
+-- Default methods for bounded enumerations
+enumFromBounded :: (Enum a, Bounded a) => a -> [a]
+enumFromBounded n = enumFromTo n maxBound
+
+enumFromThenBounded :: (Enum a, Bounded a) => a -> a -> [a]
+enumFromThenBounded n1 n2 = enumFromThenTo n1 n2 maxBound
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Tuples}
+%* *
+%*********************************************************
+
+\begin{code}
+instance Bounded () where
+ minBound = ()
+ maxBound = ()
+
+instance Enum () where
+ succ x = error "Prelude.Enum.().succ: bad argment"
+ pred x = error "Prelude.Enum.().pred: bad argument"
+
+ toEnum x | x == zeroInt = ()
+ | otherwise = error "Prelude.Enum.().toEnum: bad argument"
+
+ fromEnum () = zeroInt
+ enumFrom () = [()]
+ enumFromThen () () = [()]
+ enumFromTo () () = [()]
+ enumFromThenTo () () () = [()]
+\end{code}
+
+\begin{code}
+instance (Bounded a, Bounded b) => Bounded (a,b) where
+ minBound = (minBound, minBound)
+ maxBound = (maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where
+ minBound = (minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where
+ minBound = (minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound)
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Type @Bool@}
+%* *
+%*********************************************************
+
+\begin{code}
+instance Bounded Bool where
+ minBound = False
+ maxBound = True
+
+instance Enum Bool where
+ succ False = True
+ succ True = error "Prelude.Enum.Bool.succ: bad argment"
+
+ pred True = False
+ pred False = error "Prelude.Enum.Bool.pred: bad argment"
+
+ toEnum n | n == zeroInt = False
+ | n == oneInt = True
+ | otherwise = error "Prelude.Enum.Bool.toEnum: bad argment"
+
+ fromEnum False = zeroInt
+ fromEnum True = oneInt
+
+ -- Use defaults for the rest
+ enumFrom = enumFromBounded
+ enumFromThen = enumFromThenBounded
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Type @Ordering@}
+%* *
+%*********************************************************
+
+\begin{code}
+instance Bounded Ordering where
+ minBound = LT
+ maxBound = GT
+
+instance Enum Ordering where
+ succ LT = EQ
+ succ EQ = GT
+ succ GT = error "Prelude.Enum.Ordering.succ: bad argment"
+
+ pred GT = EQ
+ pred EQ = LT
+ pred LT = error "Prelude.Enum.Ordering.pred: bad argment"
+
+ toEnum n | n == zeroInt = LT
+ | n == oneInt = EQ
+ | n == twoInt = GT
+ toEnum n = error "Prelude.Enum.Ordering.toEnum: bad argment"
+
+ fromEnum LT = zeroInt
+ fromEnum EQ = oneInt
+ fromEnum GT = twoInt
+
+ -- Use defaults for the rest
+ enumFrom = enumFromBounded
+ enumFromThen = enumFromThenBounded
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Type @Char@}
+%* *
+%*********************************************************
+
+\begin{code}
+instance Bounded Char where
+ minBound = '\0'
+ maxBound = '\255'
+
+instance Enum Char where
+ succ c@(C# c#)
+ | not (ord# c# ==# 255#) = C# (chr# (ord# c# +# 1#))
+ | otherwise = error ("Prelude.Enum.Char.succ: bad argument")
+ pred c@(C# c#)
+ | not (ord# c# ==# 0#) = C# (chr# (ord# c# -# 1#))
+ | otherwise = error ("Prelude.Enum.Char.pred: bad argument")
+
+ toEnum = chr
+ fromEnum = ord
+
+ {-# INLINE enumFrom #-}
+ enumFrom (C# x) = build (\ c n -> eftCharFB c n (ord# x) 255#)
+ -- Blarg: technically I guess enumFrom isn't strict!
+
+ {-# INLINE enumFromTo #-}
+ enumFromTo (C# x) (C# y) = build (\ c n -> eftCharFB c n (ord# x) (ord# y))
+
+ {-# INLINE enumFromThen #-}
+ enumFromThen (C# x1) (C# x2) = build (\ c n -> efdtCharFB c n (ord# x1) (ord# x2) 255#)
+
+ {-# INLINE enumFromThenTo #-}
+ enumFromThenTo (C# x1) (C# x2) (C# y) = build (\ c n -> efdtCharFB c n (ord# x1) (ord# x2) (ord# y))
+
+-- We can do better than for Ints because we don't
+-- have hassles about arithmetic overflow at maxBound
+{-# INLINE eftCharFB #-}
+eftCharFB c n x y = go x
+ where
+ go x | x ># y = n
+ | otherwise = C# (chr# x) `c` go (x +# 1#)
+
+eftCharList x y | x ># y = []
+ | otherwise = C# (chr# x) : eftCharList (x +# 1#) y
+
+
+-- For enumFromThenTo we give up on inlining
+efdtCharFB c n x1 x2 y
+ | delta >=# 0# = go_up x1
+ | otherwise = go_dn x1
+ where
+ delta = x2 -# x1
+ go_up x | x ># y = n
+ | otherwise = C# (chr# x) `c` go_up (x +# delta)
+ go_dn x | x <# y = n
+ | otherwise = C# (chr# x) `c` go_dn (x +# delta)
+
+efdtCharList x1 x2 y
+ | delta >=# 0# = go_up x1
+ | otherwise = go_dn x1
+ where
+ delta = x2 -# x1
+ go_up x | x ># y = []
+ | otherwise = C# (chr# x) : go_up (x +# delta)
+ go_dn x | x <# y = []
+ | otherwise = C# (chr# x) : go_dn (x +# delta)
+
+
+{-# RULES
+"eftCharList" eftCharFB (:) [] = eftCharList
+"efdtCharList" efdtCharFB (:) [] = efdtCharList
+ #-}
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Type @Int@}
+%* *
+%*********************************************************
+
+\begin{code}
+instance Bounded Int where
+ minBound = minInt
+ maxBound = maxInt
+
+instance Enum Int where
+ succ x
+ | x == maxBound = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+ | otherwise = x `plusInt` oneInt
+ pred x
+ | x == minBound = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+ | otherwise = x `minusInt` oneInt
+
+ toEnum x = x
+ fromEnum x = x
+
+ {-# INLINE enumFrom #-}
+ enumFrom (I# x) = build (\ c n -> eftIntFB c n x 2147483647#)
+ -- Blarg: technically I guess enumFrom isn't strict!
+
+ {-# INLINE enumFromTo #-}
+ enumFromTo (I# x) (I# y) = build (\ c n -> eftIntFB c n x y)
+
+ {-# INLINE enumFromThen #-}
+ enumFromThen (I# x1) (I# x2) = build (\ c n -> efdtIntFB c n x1 x2 2147483647#)
+
+ {-# INLINE enumFromThenTo #-}
+ enumFromThenTo (I# x1) (I# x2) (I# y) = build (\ c n -> efdtIntFB c n x1 x2 y)
+
+{-# INLINE eftIntFB #-}
+eftIntFB c n x y | x ># y = n
+ | otherwise = go x
+ where
+ go x = I# x `c` if x ==# y then n else go (x +# 1#)
+ -- Watch out for y=maxBound; hence ==, not >
+ -- Be very careful not to have more than one "c"
+ -- so that when eftInfFB is inlined we can inline
+ -- whatver is bound to "c"
+
+eftIntList x y | x ># y = []
+ | otherwise = go x
+ where
+ go x = I# x : if x ==# y then [] else go (x +# 1#)
+
+
+-- For enumFromThenTo we give up on inlining; so we don't worry
+-- about duplicating occurrences of "c"
+efdtIntFB c n x1 x2 y
+ | delta >=# 0# = if x1 ># y then n else go_up x1
+ | otherwise = if x1 <# y then n else go_dn x1
+ where
+ delta = x2 -# x1
+ go_up x | y -# x <# delta = I# x `c` n
+ | otherwise = I# x `c` go_up (x +# delta)
+ go_dn x | y -# x ># delta = I# x `c` n
+ | otherwise = I# x `c` go_dn (x +# delta)
+
+efdtIntList x1 x2 y
+ | delta >=# 0# = if x1 ># y then [] else go_up x1
+ | otherwise = if x1 <# y then [] else go_dn x1
+ where
+ delta = x2 -# x1
+ go_up x | y -# x <# delta = [I# x]
+ | otherwise = I# x : go_up (x +# delta)
+ go_dn x | y -# x ># delta = [I# x]
+ | otherwise = I# x : go_dn (x +# delta)
+
+
+{-# RULES
+"eftIntList" eftIntFB (:) [] = eftIntList
+"efdtIntList" efdtIntFB (:) [] = efdtIntList
+ #-}
+\end{code}
+
---------------------------------------------------------------------------
__interface PrelErr 2 0 where
-__export ! PrelErr error parError;
+__export PrelErr error parError;
import PrelBase
import PrelList ( span )
import PrelException
-
\end{code}
%*********************************************************
---------------------------------------------------------------------------
__interface PrelException 1 0 where
-__export ! PrelException ioError catch;
+__export PrelException ioError catch;
1 ioError :: __forall [a] => PrelIOBase.IOError -> PrelIOBase.IO a ;
1 catch :: __forall [a] => PrelIOBase.IO a -> (PrelIOBase.IOError -> PrelIOBase.IO a) -> PrelIOBase.IO a ; -- wish there could be more __o's here. KSW 1999-04.
% -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.6 1999/05/10 16:52:10 sof Exp $
+% $Id: PrelException.lhs,v 1.7 1999/05/18 14:59:16 simonpj Exp $
%
% (c) The GRAP/AQUA Project, Glasgow University, 1998
%
module PrelException where
import PrelBase
+import PrelShow
import PrelIOBase
import PrelST ( STret(..) )
import PrelDynamic
handler other = k other
\end{code}
+
Why is this stuff here? To avoid recursive module dependencies of
course.
import PrelIOBase
import PrelException
import PrelMaybe ( Maybe(..) )
-import PrelBounded () -- get at Bounded Int instance.
+import PrelEnum
+import PrelNum
+import PrelShow
+import PrelAddr ( Addr, nullAddr )
import PrelNum ( toInteger, toBig )
import PrelPack ( packString )
import PrelWeak ( addForeignFinalizer )
% -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.9 1999/04/27 17:41:19 sof Exp $
+% $Id: PrelIOBase.lhs,v 1.10 1999/05/18 14:59:18 simonpj Exp $
%
% (c) The AQUA Project, Glasgow University, 1994-1998
%
import PrelMaybe ( Maybe(..) )
import PrelAddr ( Addr(..), nullAddr )
import PrelPack ( unpackCString )
+import PrelShow
#if !defined(__CONCURRENT_HASKELL__)
import PrelArr ( MutableVar, readVar )
foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
iterate, repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break,
- lines, words, unlines, unwords, reverse, and, or,
+ reverse, and, or,
any, all, elem, notElem, lookup,
- sum, product, maximum, minimum, concatMap,
+ maximum, minimum, concatMap,
zip, zip3, zipWith, zipWith3, unzip, unzip3,
-- non-standard, but hidden when creating the Prelude
import PrelMaybe
import PrelBase
+infixl 9 !!
infix 4 `elem`, `notElem`
\end{code}
-- of the more general genericLength, the result type of which may be
-- any kind of number.
length :: [a] -> Int
-#ifdef USE_REPORT_PRELUDE
-length [] = 0
-length (_:l) = 1 + length l
-#else
length l = len l 0#
where
len :: [a] -> Int# -> Int
len [] a# = I# a#
len (_:xs) a# = len xs (a# +# 1#)
-#endif
-- filter, applied to a predicate and a list, returns the list of those
-- elements that satisfy the predicate; i.e.,
-- filter p xs = [ x | x <- xs, p x]
filter :: (a -> Bool) -> [a] -> [a]
-filter _pred [] = []
-filter pred (x:xs)
- | pred x = x : filter pred xs
- | otherwise = filter pred xs
+{-# INLINE filter #-}
+filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+
+filterFB c p x r | p x = x `c` r
+ | otherwise = r
+{-# RULES
+"filterFB" forall c,p,q. filterFB (filterFB c p) q = filterFB c (\x -> p x && q x)
+"filterList" forall p. foldr (filterFB (:) p) [] = filterList p
+ #-}
+
+filterList :: (a -> Bool) -> [a] -> [a]
+filterList _pred [] = []
+filterList pred (x:xs)
+ | pred x = x : filterList pred xs
+ | otherwise = filterList pred xs
-- foldl, applied to a binary operator, a starting value (typically the
-- left-identity of the operator), and a list, reduces the list using
cycle [] = error "Prelude.cycle: empty list"
cycle xs = xs' where xs' = xs ++ 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
+
-- take n, applied to a list xs, returns the prefix of xs of length n,
-- or xs itself if n > length xs. drop n xs returns the suffix of xs
-- after the first n elements, or [] if n > length xs. splitAt n xs
drop n (_:xs) | n > 0 = drop (n-1) xs
drop _ _ = errorNegativeIdx "drop"
+
splitAt :: Int -> [a] -> ([a],[a])
splitAt 0 xs = ([],xs)
splitAt _ [] = ([],[])
and (x:xs) = x && and xs
or [] = False
or (x:xs) = x || or xs
+
+{-# RULES
+"and/build" forall g::forall b.(Bool->b->b)->b->b .
+ and (build g) = g (&&) True
+"or/build" forall g::forall b.(Bool->b->b)->b->b .
+ or (build g) = g (||) False
+ #-}
#endif
-- Applied to a predicate and a list, any determines if any element
all _ [] = True
all p (x:xs) = p x && all p xs
+{-# RULES
+"any/build" forall p, g::forall b.(a->b->b)->b->b .
+ any p (build g) = g ((&&) . p) True
+"all/build" forall p, g::forall b.(a->b->b)->b->b .
+ all p (build g) = g ((||) . p) False
+ #-}
#endif
-- elem is the list membership predicate, usually written in infix form,
| key == x = Just y
| otherwise = lookup key xys
--- sum and product compute the sum or product of a finite list of numbers.
-{-# SPECIALISE sum :: [Int] -> Int #-}
-{-# SPECIALISE product :: [Int] -> Int #-}
-sum, product :: (Num a) => [a] -> a
-#ifdef USE_REPORT_PRELUDE
-sum = foldl (+) 0
-product = foldl (*) 1
-#else
-sum l = sum' l 0
- where
- sum' [] a = a
- sum' (x:xs) a = sum' xs (a+x)
-product l = prod l 1
- where
- prod [] a = a
- prod (x:xs) a = prod xs (a*x)
-#endif
-- maximum and minimum return the maximum or minimum value from a list,
-- which must be non-empty, finite, and of an ordered type.
concatMap f = foldr ((++) . f) []
concat :: [[a]] -> [a]
-concat [] = []
-concat ([]:xss) = concat xss
-concat ((y:ys):xss) = y: (ys ++ concat xss)
+{-# INLINE concat #-}
+concat = foldr (++) []
+\end{code}
+
+
+\begin{code}
+-- 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.
+--
+xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n"
+ | otherwise = sub xs 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
\end{code}
%* *
%*********************************************************
+\begin{code}
+foldr2 k z [] ys = z
+foldr2 k z xs [] = z
+foldr2 k z (x:xs) (y:ys) = k x y (foldr2 k z xs ys)
+
+foldr2_left k z x r [] = z
+foldr2_left k z x r (y:ys) = k x y (r ys)
+
+foldr2_right k z y r [] = z
+foldr2_right k z y r (x:xs) = k x y (r xs)
+
+-- foldr2 k z xs ys = foldr (foldr2_left k z) z xs ys
+-- foldr2 k z xs ys = foldr (foldr2_right k z) z ys xs
+{-# RULES
+"foldr2/left" forall k,z,ys,g::forall b.(a->b->b)->b->b .
+ foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys
+
+"foldr2/right" forall k,z,xs,g::forall b.(a->b->b)->b->b .
+ foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs
+ #-}
+\end{code}
+
zip takes two lists and returns a list of corresponding pairs. If one
input list is short, excess elements of the longer list are discarded.
zip3 takes three lists and returns a list of triples. Zips for larger
tuples are in the List library
\begin{code}
-zip :: [a] -> [b] -> [(a,b)]
--- Specification
--- zip = zipWith (,)
-zip (a:as) (b:bs) = (a,b) : zip as bs
-zip _ _ = []
+----------------------------------------------
+zip :: [a] -> [b] -> [(a,b)]
+{-# INLINE zip #-}
+zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+
+zipFB c x y r = (x,y) `c` r
-zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
+
+zipList :: [a] -> [b] -> [(a,b)]
+zipList (a:as) (b:bs) = (a,b) : zipList as bs
+zipList _ _ = []
+
+{-# RULES
+"zipList" foldr2 (zipFB (:)) [] = zipList
+ #-}
+\end{code}
+
+\begin{code}
+----------------------------------------------
+zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
-- Specification
-- zip3 = zipWith3 (,,)
zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs
zip3 _ _ _ = []
+\end{code}
+
-- The zipWith family generalises the zip family by zipping with the
-- function given as the first argument, instead of a tupling function.
-- For example, zipWith (+) is applied to two lists to produce the list
-- of corresponding sums.
-zipWith :: (a->b->c) -> [a]->[b]->[c]
-zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
-zipWith _ _ _ = []
+\begin{code}
+----------------------------------------------
+zipWith :: (a->b->c) -> [a]->[b]->[c]
+{-# INLINE zipWith #-}
+zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
+
+zipWithFB c f x y r = (x `f` y) `c` r
+
+zipWithList :: (a->b->c) -> [a] -> [b] -> [c]
+zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs
+zipWithList f _ _ = []
+
+{-# RULES
+"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList f
+ #-}
+\end{code}
+
+\begin{code}
zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith3 z (a:as) (b:bs) (c:cs)
= z a b c : zipWith3 z as bs cs
zipWith3 _ _ _ _ = []
-
-- unzip transforms a list of pairs into a pair of lists.
+unzip :: [(a,b)] -> ([a],[b])
+unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
-unzip :: [(a,b)] -> ([a],[b])
-unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
-
-unzip3 :: [(a,b,c)] -> ([a],[b],[c])
-unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
- ([],[],[])
+unzip3 :: [(a,b,c)] -> ([a],[b],[c])
+unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
+ ([],[],[])
\end{code}
+
%*********************************************************
%* *
-\subsection{Functions on strings}
+\subsection{Error code}
%* *
%*********************************************************
-lines breaks a string up into a list of strings at newline characters.
-The resulting strings do not contain newlines. Similary, words
-breaks a string up into a list of words, which were delimited by
-white space. unlines and unwords are the inverse operations.
-unlines joins lines with terminating newlines, and unwords joins
-words with separating spaces.
-
-\begin{code}
-lines :: String -> [String]
-lines "" = []
-lines s = let (l, s') = break (== '\n') s
- in l : case s' of
- [] -> []
- (_:s'') -> lines s''
-
-words :: String -> [String]
-words s = case dropWhile {-partain:Char.-}isSpace s of
- "" -> []
- s' -> w : words s''
- where (w, s'') =
- break {-partain:Char.-}isSpace s'
-
-unlines :: [String] -> String
-#ifdef USE_REPORT_PRELUDE
-unlines = concatMap (++ "\n")
-#else
--- HBC version (stolen)
--- here's a more efficient version
-unlines [] = []
-unlines (l:ls) = l ++ '\n' : unlines ls
-#endif
-
-unwords :: [String] -> String
-#ifdef USE_REPORT_PRELUDE
-unwords [] = ""
-unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
-#else
--- HBC version (stolen)
--- here's a more efficient version
-unwords [] = ""
-unwords [w] = w
-unwords (w:ws) = w ++ ' ' : unwords ws
-#endif
-
-\end{code}
-
Common up near identical calls to `error' to reduce the number
constant strings created when compiled:
-- make sure this type signature stays!
mainIO = catchException Main.main (topHandler True)
\end{code}
-
module PrelMaybe where
import PrelBase
+\end{code}
+
-data Maybe a = Nothing | Just a deriving (Eq, Ord, Show {- Read -})
+%*********************************************************
+%* *
+\subsection{Standard numeric classes}
+%* *
+%*********************************************************
+
+\begin{code}
+data Maybe a = Nothing | Just a deriving (Eq, Ord)
maybe :: b -> (a -> b) -> Maybe a -> b
maybe n _ Nothing = n
return = Just
fail _ = Nothing
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Standard numeric classes}
+%* *
+%*********************************************************
+
+\begin{code}
+data Either a b = Left a | Right b deriving (Eq, Ord )
+either :: (a -> c) -> (b -> c) -> Either a b -> c
+either f _ (Left x) = f x
+either _ g (Right y) = g y
\end{code}
module PrelNum where
-import PrelBase
-import Ix
import {-# SOURCE #-} PrelErr
+import PrelBase
+import PrelList
+import PrelEnum
+import PrelShow
infixr 8 ^, ^^, **
infixl 7 %, /, `quot`, `rem`, `div`, `mod`
+infixl 7 *
+infixl 6 +, -
+
\end{code}
%*********************************************************
%*********************************************************
\begin{code}
+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 (S# i#)
+ -- Go via the standard class-op if the
+ -- non-standard one ain't provided
+
class (Num a, Ord a) => Real a where
toRational :: a -> Rational
%*********************************************************
\begin{code}
+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 (S# i#) = I# i#
+ fromInteger (J# s# d#)
+ = case (integer2Int# s# d#) of { i# -> I# i# }
+
+ fromInt n = n
+
instance Real Int where
toRational x = toInteger x % 1
showList = showList__ (showsPrec 0)
-instance Ix Integer where
- range (m,n)
- | m <= n = [m..n]
- | otherwise = []
-
- index b@(m,_) i
- | inRange b i = fromInteger (i - m)
- | otherwise = indexIntegerError i b
- inRange (m,n) i = m <= i && i <= n
-
--- Sigh, really want to use helper function in Ix, but
--- module deps. are too painful.
-{-# NOINLINE indexIntegerError #-}
-indexIntegerError :: Integer -> (Integer,Integer) -> a
-indexIntegerError i rng
- = error (showString "Ix{Integer}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 rng) "")
-
showSignedInteger :: Int -> Integer -> ShowS
showSignedInteger p n r
| n < 0 && p > 6 = '(':jtos n (')':r)
| otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
where
(q,r) = n `quotRem` 10
+
+ord_0 :: Num a => a
+ord_0 = fromInt (ord '0')
\end{code}
%*********************************************************
%*********************************************************
\begin{code}
+
+{-# SPECIALISE subtract :: Int -> Int -> Int #-}
+subtract :: (Num a) => a -> a -> a
+subtract x y = y - x
+
even, odd :: (Integral a) => a -> Bool
even n = n `rem` 2 == 0
odd = not . even
Rational -> Int -> Rational #-}
(^^) :: (Fractional a, Integral b) => a -> b -> a
x ^^ n = if n >= 0 then x^n else recip (x^(negate n))
-
\end{code}
import PrelBase
import PrelGHC
+import PrelEnum
+import PrelShow
import PrelNum
-import {-# SOURCE #-} PrelErr ( error )
+import PrelErr ( error )
import PrelList
import PrelMaybe
import Maybe ( fromMaybe )
{-# SPECIALIZE ceiling :: Double -> Integer #-}
{-# SPECIALIZE floor :: Double -> Integer #-}
-#if defined(__UNBOXED_INSTANCES__)
- {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
- {-# SPECIALIZE truncate :: Double -> Int# #-}
- {-# SPECIALIZE round :: Double -> Int# #-}
- {-# SPECIALIZE ceiling :: Double -> Int# #-}
- {-# SPECIALIZE floor :: Double -> Int# #-}
-#endif
-
properFraction x
= case (decodeFloat x) of { (m,n) ->
let b = floatRadix x in
---------------------------------------------------------------------------
__interface PrelPack 1 where
-__export ! PrelPack packCStringzh unpackCStringzh unpackNByteszh unpackAppendCStringzh unpackFoldrCStringzh ;
+__export PrelPack packCStringzh unpackCStringzh unpackNByteszh unpackAppendCStringzh unpackFoldrCStringzh ;
1 packCStringzh :: [PrelBase.Char] -> PrelGHC.ByteArrayzh ;
1 unpackCStringzh :: PrelGHC.Addrzh -> [PrelBase.Char] ;
import {-# SOURCE #-} PrelErr ( error )
import PrelList ( length )
import PrelST
+import PrelNum
import PrelArr
import PrelAddr
module PrelRead where
-import {-# SOURCE #-} PrelErr ( error )
+import PrelErr ( error )
+import PrelEnum ( Enum(..) )
import PrelNum
import PrelNumExtra
import PrelList
import PrelTup
import PrelMaybe
-import PrelEither
+import PrelShow -- isAlpha etc
import PrelBase
import Monad
module PrelST where
import Monad
+import PrelShow
import PrelBase
import PrelGHC
+import PrelNum () -- So that we get the .hi file for system imports
\end{code}
%*********************************************************
too many people got bitten by space leaks when it was lazy.
\begin{code}
-newtype ST s a = ST (State# s -> (# State# s, a #))
+newtype ST s a = ST (STRep s a)
+type STRep s a = State# s -> (# State# s, a #)
instance Functor (ST s) where
fmap f (ST m) = ST $ \ s ->
All calls to @f@ will share a {\em single} array! End SLPJ 95/04.
\begin{code}
-{-# NOINLINE runST #-}
+{-# INLINE runST #-}
+-- The INLINE prevents runSTRep getting inlined in *this* module
+-- so that it is still visible when runST is inlined in an importing
+-- module. Regrettably delicate. runST is behaving like a wrapper.
runST :: (forall s. ST s a) -> a
-runST st =
- case st of
- ST m -> case m realWorld# of
- (# _, r #) -> r
+runST st = runSTRep (case st of { ST st_rep -> st_rep })
+
+-- I'm letting runSTRep be inlined *after* full laziness
+-- SLPJ Apr 99
+runSTRep :: (forall s. STRep s a) -> a
+runSTRep st_rep = case st_rep realWorld# of
+ (# _, r #) -> r
\end{code}
--- /dev/null
+%
+% (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
+%
+\section{Module @PrelShow@}
+
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module PrelShow
+ (
+ Show(..), ShowS,
+
+ -- Instances for Show: (), [], Bool, Ordering, Int, Char
+
+ -- Show support code
+ shows, showChar, showString, showParen, showList__, showSpace,
+ showLitChar, protectEsc,
+ intToDigit, showSignedInt,
+
+ -- Character operations
+ isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
+ isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
+ toUpper, toLower,
+ asciiTab,
+
+ -- String operations
+ lines, unlines, words, unwords
+ )
+ where
+
+import {-# SOURCE #-} PrelErr ( error )
+import PrelBase
+import PrelMaybe
+import PrelList ( (!!), break, dropWhile )
+\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
+
+ showsPrec _ x s = show x ++ s
+ show x = shows x ""
+ showList ls = showList__ shows ls
+
+showList__ :: (a -> ShowS) -> [a] -> ShowS
+showList__ _ [] s = "[]" ++ s
+showList__ showx (x:xs) s = '[' : showx x (showl xs)
+ where
+ showl [] = ']' : s
+ showl (y:ys) = ',' : showx y (showl ys)
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Simple Instances}
+%* *
+%*********************************************************
+
+\begin{code}
+
+instance Show () where
+ showsPrec _ () = showString "()"
+
+instance Show a => Show [a] where
+ showsPrec _ = showList
+
+instance Show Bool where
+ showsPrec _ True = showString "True"
+ showsPrec _ False = showString "False"
+
+instance Show Ordering where
+ showsPrec _ LT = showString "LT"
+ showsPrec _ EQ = showString "EQ"
+ showsPrec _ GT = showString "EQ"
+
+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
+
+instance Show Int where
+ showsPrec p n = showSignedInt p n
+
+instance Show a => Show (Maybe a) where
+ showsPrec p Nothing = showString "Nothing"
+ showsPrec p (Just x) = showString "Just " . shows x
+ -- Not sure I have the priorities right here
+
+instance (Show a, Show b) => Show (Either a b) where
+ showsPrec p (Left a) = showString "Left " . shows a
+ showsPrec p (Right b) = showString "Right " . shows b
+ -- Not sure I have the priorities right here
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Show instances for the first few tuples
+%* *
+%*********************************************************
+
+\begin{code}
+instance (Show a, Show b) => Show (a,b) where
+ showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
+ shows y . showChar ')'
+
+instance (Show a, Show b, Show c) => Show (a, b, c) where
+ showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')'
+
+instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
+ showsPrec _ (w,x,y,z) = showChar '(' . shows w . showChar ',' .
+ shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')'
+
+instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
+ showsPrec _ (v,w,x,y,z) = showChar '(' . shows v . showChar ',' .
+ shows w . showChar ',' .
+ shows x . showChar ',' .
+ shows y . showChar ',' .
+ shows z . showChar ')'
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Support code for @Show@}
+%* *
+%*********************************************************
+
+\begin{code}
+shows :: (Show a) => a -> ShowS
+shows = showsPrec zeroInt
+
+showChar :: Char -> ShowS
+showChar = (:)
+
+showString :: String -> ShowS
+showString = (++)
+
+showParen :: Bool -> ShowS -> ShowS
+showParen b p = if b then showChar '(' . p . showChar ')' else p
+
+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)
+ | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
+ | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
+ | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
+
+\end{code}
+
+Code specific for Ints.
+
+\begin{code}
+showSignedInt :: Int -> Int -> ShowS
+showSignedInt (I# 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
+ -- x >= 0
+ 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{Character stuff}
+%* *
+%*********************************************************
+
+\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'
+ = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
+ | otherwise
+ = c
+
+
+
+toLower c@(C# c#)
+ | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
+ | isAscii c = c
+ | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord '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"]
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Functions on strings}
+%* *
+%*********************************************************
+
+lines breaks a string up into a list of strings at newline characters.
+The resulting strings do not contain newlines. Similary, words
+breaks a string up into a list of words, which were delimited by
+white space. unlines and unwords are the inverse operations.
+unlines joins lines with terminating newlines, and unwords joins
+words with separating spaces.
+
+\begin{code}
+lines :: String -> [String]
+lines "" = []
+lines s = let (l, s') = break (== '\n') s
+ in l : case s' of
+ [] -> []
+ (_:s'') -> lines s''
+
+words :: String -> [String]
+words s = case dropWhile {-partain:Char.-}isSpace s of
+ "" -> []
+ s' -> w : words s''
+ where (w, s'') =
+ break {-partain:Char.-}isSpace s'
+
+unlines :: [String] -> String
+#ifdef USE_REPORT_PRELUDE
+unlines = concatMap (++ "\n")
+#else
+-- HBC version (stolen)
+-- here's a more efficient version
+unlines [] = []
+unlines (l:ls) = l ++ '\n' : unlines ls
+#endif
+
+unwords :: [String] -> String
+#ifdef USE_REPORT_PRELUDE
+unwords [] = ""
+unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
+#else
+-- HBC version (stolen)
+-- here's a more efficient version
+unwords [] = ""
+unwords [w] = w
+unwords (w:ws) = w ++ ' ' : unwords ws
+#endif
+
+\end{code}
%*********************************************************
\begin{code}
-data (,) a b = (,) a b deriving (Eq, Ord, Bounded)
-data (,,) a b c = (,,) a b c deriving (Eq, Ord, Bounded)
-data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord, Bounded)
-data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord, Bounded)
+data (,) a b = (,) a b deriving (Eq, Ord)
+data (,,) a b c = (,,) a b c deriving (Eq, Ord)
+data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord)
+data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord)
data (,,,,,) a b c d e f = (,,,,,) a b c d e f
data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
\end{code}
-@Show@ instances for just the first few.
-
-\begin{code}
-instance (Show a, Show b) => Show (a,b) where
- showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
- shows y . showChar ')'
- showList = showList__ (showsPrec 0)
-
-instance (Show a, Show b, Show c) => Show (a, b, c) where
- showsPrec _ (x,y,z) = showChar '(' . showsPrec 0 x . showChar ',' .
- showsPrec 0 y . showChar ',' .
- showsPrec 0 z . showChar ')'
- showList = showList__ (showsPrec 0)
-
-instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
- showsPrec _ (w,x,y,z) = showChar '(' . showsPrec 0 w . showChar ',' .
- showsPrec 0 x . showChar ',' .
- showsPrec 0 y . showChar ',' .
- showsPrec 0 z . showChar ')'
-
- showList = showList__ (showsPrec 0)
-
-instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
- showsPrec _ (v,w,x,y,z) = showChar '(' . showsPrec 0 v . showChar ',' .
- showsPrec 0 w . showChar ',' .
- showsPrec 0 x . showChar ',' .
- showsPrec 0 y . showChar ',' .
- showsPrec 0 z . showChar ')'
- showList = showList__ (showsPrec 0)
-\end{code}
-
%*********************************************************
%* *
module Prelude (
- -- Everything from these modules
- module PrelList,
+ -- Everything corresponding to the Report's PreludeList
+ module PrelList,
+ lines, words, unlines, unwords,
+ sum, product,
-- Everything corresponding to the Report's PreludeText
ReadS, ShowS,
import PrelBase
import PrelList hiding ( takeUInt_append )
import PrelRead
+import PrelEnum
import PrelNum
import PrelNumExtra
import PrelTup
import PrelMaybe
-import PrelEither
-import PrelBounded
+import PrelShow
import PrelConc
import Monad
import Maybe
\end{code}
+List sum and product are defined here because PrelList is too far
+down the compilation chain to "see" the Num class.
+\begin{code}
+-- sum and product compute the sum or product of a finite list of numbers.
+{-# SPECIALISE sum :: [Int] -> Int #-}
+{-# SPECIALISE product :: [Int] -> Int #-}
+sum, product :: (Num a) => [a] -> a
+#ifdef USE_REPORT_PRELUDE
+sum = foldl (+) 0
+product = foldl (*) 1
+#else
+sum l = sum' l 0
+ where
+ sum' [] a = a
+ sum' (x:xs) a = sum' xs (a+x)
+product l = prod l 1
+ where
+ prod [] a = a
+ prod (x:xs) a = prod xs (a*x)
+#endif
+\end{code}
import CPUTime (getCPUTime)
import PrelST
import PrelRead
+import PrelShow
import PrelIOBase
import PrelNumExtra ( float2Double, double2Float )
import PrelBase
import PreludeBuiltin
#else
import PrelBase
+import PrelShow
import PrelIOBase
import PrelHandle
import PrelArr
projects / ghc-hetmet.git / commitdiff