3 #include "../includes/ieee-flpt.h"
5 --partain: module PreludeList,
6 head, last, tail, init, null, length, (!!),
7 foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
8 iterate, repeat, replicate, cycle,
9 take, drop, splitAt, takeWhile, dropWhile, span, break,
10 lines, words, unlines, unwords, reverse, and, or,
11 any, all, elem, notElem, lookup,
12 sum, product, maximum, minimum, concatMap,
13 zip, zip3, zipWith, zipWith3, unzip, unzip3,
15 --partain:module PreludeText,
17 Read(readsPrec, readList),
18 Show(showsPrec, showList),
19 reads, shows, show, read, lex,
20 showChar, showString, readParen, showParen,
21 --partain:module PreludeIO,
22 FilePath, IOError, fail, userError, catch,
23 putChar, putStr, putStrLn, print,
24 getChar, getLine, getContents, interact,
25 readFile, writeFile, appendFile, readIO, readLn,
29 Either(Left, Right), either,
31 Char, String, Int, Integer, Float, Double, IO, Void,
33 ()(..), -- Trivial type
34 -- Tuple types: (,), (,,), etc.
43 (,,,,,,,,,)(..),
44 (,,,,,,,,,,)(..),
45 (,,,,,,,,,,,)(..),
46 (,,,,,,,,,,,,)(..),
47 (,,,,,,,,,,,,,)(..),
48 (,,,,,,,,,,,,,,)(..),
49 (,,,,,,,,,,,,,,,)(..),
50 (,,,,,,,,,,,,,,,,)(..),
51 (,,,,,,,,,,,,,,,,,)(..),
52 (,,,,,,,,,,,,,,,,,,)(..),
53 (,,,,,,,,,,,,,,,,,,,)(..),
54 (,,,,,,,,,,,,,,,,,,,,)(..),
55 (,,,,,,,,,,,,,,,,,,,,,)(..),
56 (,,,,,,,,,,,,,,,,,,,,,,)(..),
57 (,,,,,,,,,,,,,,,,,,,,,,,)(..),
58 (,,,,,,,,,,,,,,,,,,,,,,,,)(..),
59 (,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
60 (,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
61 (,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
62 (,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
63 (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
64 (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
65 (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
68 Ord(compare, (<), (<=), (>=), (>), max, min),
69 Enum(toEnum, fromEnum, enumFrom, enumFromThen,
70 enumFromTo, enumFromThenTo),
71 Bounded(minBound, maxBound),
72 Eval(..{-seq, strict-}), seq, strict, -- NB: glasgow hack
73 Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt{-partain-}),
75 Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
76 Fractional((/), recip, fromRational),
77 Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
78 asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
79 RealFrac(properFraction, truncate, round, ceiling, floor),
80 RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
81 encodeFloat, exponent, significand, scaleFloat, isNaN,
82 isInfinite, isDenormalized, isIEEE, isNegativeZero),
83 Monad((>>=), (>>), return),
88 mapM, mapM_, guard, accumulate, sequence, filter, concat, applyM,
90 (&&), (||), not, otherwise,
91 subtract, even, odd, gcd, lcm, (^), (^^),
92 fromIntegral, fromRealFrac, atan2,
93 fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
94 asTypeOf, error, undefined ) where
96 import GHCbase -- all the GHC basics
97 import GHCio -- I/O basics
98 import Ratio(Ratio, Rational, (%), numerator, denominator)
101 import Char ( isSpace )
102 import IO ( hPutChar, hPutStr, hGetChar, hGetContents )
105 infix 4 `elem`, `notElem`
110 infixl 7 *, /, `quot`, `rem`, `div`, `mod`
113 infix 4 ==, /=, <, <=, >=, >
119 -- Standard types, classes, instances and related functions
121 -- Equality and Ordered classes
124 (==), (/=) :: a -> a -> Bool
126 x /= y = not (x == y)
128 class (Eq a) => Ord a where
129 compare :: a -> a -> Ordering
130 (<), (<=), (>=), (>):: a -> a -> Bool
131 max, min :: a -> a -> a
133 -- An instance of Ord should define either compare or <=
134 -- Using compare can be more efficient for complex types.
140 x <= y = compare x y /= GT
141 x < y = compare x y == LT
142 x >= y = compare x y /= LT
143 x > y = compare x y == GT
144 max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
145 min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
147 -- Enumeration and Bounded classes
149 class (Ord a) => Enum a where
152 enumFrom :: a -> [a] -- [n..]
153 enumFromThen :: a -> a -> [a] -- [n,n'..]
154 enumFromTo :: a -> a -> [a] -- [n..m]
155 enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
157 enumFromTo n m = takeWhile (<= m) (enumFrom n)
158 enumFromThenTo n n' m
159 = takeWhile (if n' >= n then (<= m) else (>= m))
162 succ, pred :: Enum a => a -> a
163 succ = toEnum . (+1) . fromEnum
164 pred = toEnum . (subtract 1) . fromEnum
166 class Bounded a where
167 minBound, maxBound :: a
171 class (Eq a, Show a, Eval a) => Num a where
172 (+), (-), (*) :: a -> a -> a
174 abs, signum :: a -> a
175 fromInteger :: Integer -> a
176 fromInt :: Int -> a -- partain: Glasgow extension
179 fromInt i = fromInteger (int2Integer i)
181 int2Integer (I# i#) = int2Integer# i#
182 -- Go via the standard class-op if the
183 -- non-standard one ain't provided
185 class (Num a, Ord a) => Real a where
186 toRational :: a -> Rational
188 class (Real a, Enum a) => Integral a where
189 quot, rem, div, mod :: a -> a -> a
190 quotRem, divMod :: a -> a -> (a,a)
191 toInteger :: a -> Integer
193 n `quot` d = q where (q,r) = quotRem n d
194 n `rem` d = r where (q,r) = quotRem n d
195 n `div` d = q where (q,r) = divMod n d
196 n `mod` d = r where (q,r) = divMod n d
197 divMod n d = if signum r == - signum d then (q-1, r+d) else qr
198 where qr@(q,r) = quotRem n d
200 class (Num a) => Fractional a where
203 fromRational :: Rational -> a
207 class (Fractional a) => Floating a where
209 exp, log, sqrt :: a -> a
210 (**), logBase :: a -> a -> a
211 sin, cos, tan :: a -> a
212 asin, acos, atan :: a -> a
213 sinh, cosh, tanh :: a -> a
214 asinh, acosh, atanh :: a -> a
216 x ** y = exp (log x * y)
217 logBase x y = log y / log x
219 tan x = sin x / cos x
220 tanh x = sinh x / cosh x
222 class (Real a, Fractional a) => RealFrac a where
223 properFraction :: (Integral b) => a -> (b,a)
224 truncate, round :: (Integral b) => a -> b
225 ceiling, floor :: (Integral b) => a -> b
227 truncate x = m where (m,_) = properFraction x
229 round x = let (n,r) = properFraction x
230 m = if r < 0 then n - 1 else n + 1
231 in case signum (abs r - 0.5) of
233 0 -> if even n then n else m
236 ceiling x = if r > 0 then n + 1 else n
237 where (n,r) = properFraction x
239 floor x = if r < 0 then n - 1 else n
240 where (n,r) = properFraction x
242 class (RealFrac a, Floating a) => RealFloat a where
243 floatRadix :: a -> Integer
244 floatDigits :: a -> Int
245 floatRange :: a -> (Int,Int)
246 decodeFloat :: a -> (Integer,Int)
247 encodeFloat :: Integer -> Int -> a
249 significand :: a -> a
250 scaleFloat :: Int -> a -> a
251 isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
254 exponent x = if m == 0 then 0 else n + floatDigits x
255 where (m,n) = decodeFloat x
257 significand x = encodeFloat m (- floatDigits x)
258 where (m,_) = decodeFloat x
260 scaleFloat k x = encodeFloat m (n+k)
261 where (m,n) = decodeFloat x
265 {-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
266 subtract :: (Num a) => a -> a -> a
269 even, odd :: (Integral a) => a -> Bool
270 even n = n `rem` 2 == 0
273 {-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
274 gcd :: (Integral a) => a -> a -> a
275 gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
276 gcd x y = gcd' (abs x) (abs y)
278 gcd' x y = gcd' y (x `rem` y)
280 {-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
281 lcm :: (Integral a) => a -> a -> a
284 lcm x y = abs ((x `quot` (gcd x y)) * y)
286 (^) :: (Num a, Integral b) => a -> b -> a
288 x ^ n | n > 0 = f x (n-1) x
290 f x n y = g x n where
291 g x n | even n = g (x*x) (n `quot` 2)
292 | otherwise = f x (n-1) (x*y)
293 _ ^ _ = error "Prelude.^: negative exponent"
295 (^^) :: (Fractional a, Integral b) => a -> b -> a
296 x ^^ n = if n >= 0 then x^n else recip (x^(-n))
298 fromIntegral :: (Integral a, Num b) => a -> b
299 fromIntegral = fromInteger . toInteger
301 fromRealFrac :: (RealFrac a, Fractional b) => a -> b
302 fromRealFrac = fromRational . toRational
304 atan2 :: (RealFloat a) => a -> a -> a
305 atan2 y x = case (signum y, signum x) of
310 ( _, 1) -> atan (y/x)
311 ( _,-1) -> atan (y/x) + pi
312 ( 0, 0) -> error "Prelude.atan2: atan2 of origin"
317 class Functor f where
318 map :: (a -> b) -> f a -> f b
321 (>>=) :: m a -> (a -> m b) -> m b
322 (>>) :: m a -> m b -> m b
325 m >> k = m >>= \_ -> k
327 class (Monad m) => MonadZero m where
330 class (MonadZero m) => MonadPlus m where
331 (++) :: m a -> m a -> m a
333 accumulate :: Monad m => [m a] -> m [a]
334 accumulate [] = return []
335 accumulate (m:ms) = do { x <- m; xs <- accumulate ms; return (x:xs) }
336 {- partain: this may be right, but I'm going w/ a more-certainly-right version
337 accumulate = foldr mcons (return [])
338 where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
340 sequence :: Monad m => [m a] -> m ()
341 sequence = foldr (>>) (return ())
343 mapM :: Monad m => (a -> m b) -> [a] -> m [b]
344 mapM f as = accumulate (map f as)
346 mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
347 mapM_ f as = sequence (map f as)
349 guard :: MonadZero m => Bool -> m ()
350 guard p = if p then return () else zero
352 -- This subsumes the list-based filter function.
354 filter :: MonadZero m => (a -> Bool) -> m a -> m a
355 filter p = applyM (\x -> if p x then return x else zero)
357 -- This subsumes the list-based concat function.
359 concat :: MonadPlus m => [m a] -> m a
360 concat = foldr (++) zero
362 applyM :: Monad m => (a -> m b) -> m a -> m b
368 class Eval a {-not Glasgow: where
370 strict :: (a -> b) -> a -> b
371 strict f x = x `seq` f x -}
374 strict :: Eval a => (a -> b) -> a -> b
375 strict f x = x `seq` f x
377 ---------------------------------------------------------------
380 data () = () --easier to do explicitly: deriving (Eq, Ord, Enum, Bounded)
381 -- (avoids weird-named functions, e.g., con2tag_()#
383 instance CReturnable () -- Why, exactly?
389 instance Ord () where
398 instance Enum () where
400 toEnum _ = error "Prelude.Enum.().toEnum: argument not 0"
403 enumFromThen () () = [()]
404 enumFromTo () () = [()]
405 enumFromThenTo () () () = [()]
407 instance Bounded () where
411 instance Show () where
412 showsPrec p () = showString "()"
414 instance Read () where
415 readsPrec p = readParen False
416 (\r -> [((),t) | ("(",s) <- lex r,
419 ---------------------------------------------------------------
422 --data a -> b -- No constructor for functions is exported.
424 instance Show (a -> b) where
425 showsPrec p f = showString "<<function>>"
426 showList = showList__ (showsPrec 0)
428 ---------------------------------------------------------------
431 --partain:data Void -- No constructor for Void is exported. Import/Export
432 -- lists must use Void instead of Void(..) or Void()
434 ---------------------------------------------------------------
437 data Bool = False | True deriving (Eq, Ord, Enum, Read, Show, Bounded)
441 (&&), (||) :: Bool -> Bool -> Bool
454 ---------------------------------------------------------------
457 data Char = C# Char# deriving (Eq, Ord)
458 --partain:data Char = ... 'a' | 'b' ... -- 265 ISO values
459 instance CCallable Char
460 instance CReturnable Char
462 instance Enum Char where
463 toEnum (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
464 | otherwise = error "Prelude.Enum.Char.toEnum:out of range"
465 fromEnum (C# c) = I# (ord# c)
466 enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
467 enumFromThen c c' = map toEnum [fromEnum c,
468 fromEnum c' .. fromEnum lastChar]
469 where lastChar :: Char
470 lastChar | c' < c = minBound
471 | otherwise = maxBound
473 instance Bounded Char where
477 instance Read Char where
478 readsPrec p = readParen False
479 (\r -> [(c,t) | ('\'':s,t)<- lex r,
480 (c,_) <- readLitChar s])
482 readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
484 where readl ('"':s) = [("",s)]
485 readl ('\\':'&':s) = readl s
486 readl s = [(c:cs,u) | (c ,t) <- readLitChar s,
488 instance Show Char where
489 showsPrec p '\'' = showString "'\\''"
490 showsPrec p c = showChar '\'' . showLitChar c . showChar '\''
492 showList cs = showChar '"' . showl cs
493 where showl "" = showChar '"'
494 showl ('"':cs) = showString "\\\"" . showl cs
495 showl (c:cs) = showLitChar c . showl cs
499 ---------------------------------------------------------------
502 data Maybe a = Nothing | Just a deriving (Eq, Ord, Read, Show)
504 maybe :: b -> (a -> b) -> Maybe a -> b
505 maybe n f Nothing = n
506 maybe n f (Just x) = f x
508 instance Functor Maybe where
509 map f Nothing = Nothing
510 map f (Just a) = Just (f a)
512 instance Monad Maybe where
514 Nothing >>= k = Nothing
517 instance MonadZero Maybe where
520 instance MonadPlus Maybe where
524 ---------------------------------------------------------------
527 data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show)
529 either :: (a -> c) -> (b -> c) -> Either a b -> c
530 either f g (Left x) = f x
531 either f g (Right y) = g y
533 ---------------------------------------------------------------
534 -- IO type: moved to GHCbase
536 --partain: data IO a = -- abstract
538 ---------------------------------------------------------------
541 data Ordering = LT | EQ | GT deriving (Eq, Ord, Enum, Read, Show, Bounded)
543 ---------------------------------------------------------------
544 -- Standard numeric types. The data declarations for these types
545 -- cannot be expressed directly in (standard) Haskell since the
546 -- constructor lists would be far too large.
548 ---------------------------------------------------------------
549 data Int = I# Int# deriving (Eq,Ord)
550 --partain:data Int = minBound ... -1 | 0 | 1 ... maxBound
552 instance CCallable Int
553 instance CReturnable Int
555 instance Bounded Int where
556 minBound = -2147483647 -- **********************
557 maxBound = 2147483647 -- **********************
559 instance Num Int where
560 (+) x y = plusInt x y
561 (-) x y = minusInt x y
562 negate x = negateInt x
563 (*) x y = timesInt x y
564 abs n = if n `geInt` 0 then n else (negateInt n)
566 signum n | n `ltInt` 0 = negateInt 1
570 fromInteger (J# a# s# d#)
571 = case (integer2Int# a# s# d#) of { i# -> I# i# }
575 instance Real Int where
576 toRational x = toInteger x % 1
578 instance Integral Int where
579 a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
580 -- OK, so I made it a little stricter. Shoot me. (WDP 94/10)
582 -- following chks for zero divisor are non-standard (WDP)
583 a `quot` b = if b /= 0
585 else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
586 a `rem` b = if b /= 0
588 else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
590 x `div` y = if x > 0 && y < 0 then quotInt (x-y-1) y
591 else if x < 0 && y > 0 then quotInt (x-y+1) y
593 x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
594 if r/=0 then r+y else 0
599 divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
600 -- Stricter. Sorry if you don't like it. (WDP 94/10)
602 --OLD: even x = eqInt (x `mod` 2) 0
603 --OLD: odd x = neInt (x `mod` 2) 0
605 toInteger (I# n#) = int2Integer# n# -- give back a full-blown Integer
608 instance Enum Int where
611 #ifndef USE_FOLDR_BUILD
612 enumFrom x = x : enumFrom (x `plusInt` 1)
613 enumFromTo n m = takeWhile (<= m) (enumFrom n)
615 {-# INLINE enumFrom #-}
616 {-# INLINE enumFromTo #-}
617 enumFrom x = _build (\ c _ ->
618 let g x = x `c` g (x `plusInt` 1) in g x)
619 enumFromTo x y = _build (\ c n ->
620 let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
622 enumFromThen m n = en' m (n `minusInt` m)
623 where en' m n = m : en' (m `plusInt` n) n
624 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
627 instance Read Int where
628 readsPrec p x = readSigned readDec x
629 readList = readList__ (readsPrec 0)
631 instance Show Int where
632 showsPrec x = showSigned showInt x
633 showList = showList__ (showsPrec 0)
635 ---------------------------------------------------------------
636 data Integer = J# Int# Int# ByteArray#
637 --partain:data Integer = ... -1 | 0 | 1 ...
639 instance Eq Integer where
640 (J# a1 s1 d1) == (J# a2 s2 d2)
641 = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
643 (J# a1 s1 d1) /= (J# a2 s2 d2)
644 = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
646 instance Ord Integer where
647 (J# a1 s1 d1) <= (J# a2 s2 d2)
648 = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
650 (J# a1 s1 d1) < (J# a2 s2 d2)
651 = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
653 (J# a1 s1 d1) >= (J# a2 s2 d2)
654 = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
656 (J# a1 s1 d1) > (J# a2 s2 d2)
657 = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
659 x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
660 = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
662 x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
663 = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
665 compare (J# a1 s1 d1) (J# a2 s2 d2)
666 = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
667 if res# <# 0# then LT else
668 if res# ># 0# then GT else EQ
671 instance Num Integer where
672 (+) (J# a1 s1 d1) (J# a2 s2 d2)
673 = plusInteger# a1 s1 d1 a2 s2 d2
675 (-) (J# a1 s1 d1) (J# a2 s2 d2)
676 = minusInteger# a1 s1 d1 a2 s2 d2
678 negate (J# a s d) = negateInteger# a s d
680 (*) (J# a1 s1 d1) (J# a2 s2 d2)
681 = timesInteger# a1 s1 d1 a2 s2 d2
683 -- ORIG: abs n = if n >= 0 then n else -n
686 = case 0 of { J# a2 s2 d2 ->
687 if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
689 else negateInteger# a1 s1 d1
692 signum n@(J# a1 s1 d1)
693 = case 0 of { J# a2 s2 d2 ->
695 cmp = cmpInteger# a1 s1 d1 a2 s2 d2
698 else if cmp ==# 0# then 0
704 fromInt (I# n#) = int2Integer# n# -- gives back a full-blown Integer
706 instance Real Integer where
709 instance Integral Integer where
710 quotRem (J# a1 s1 d1) (J# a2 s2 d2)
711 = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
712 Return2GMPs a3 s3 d3 a4 s4 d4
713 -> (J# a3 s3 d3, J# a4 s4 d4)
715 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
717 divMod (J# a1 s1 d1) (J# a2 s2 d2)
718 = case (divModInteger# a1 s1 d1 a2 s2 d2) of
719 Return2GMPs a3 s3 d3 a4 s4 d4
720 -> (J# a3 s3 d3, J# a4 s4 d4)
723 -- toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
725 -- the rest are identical to the report default methods;
726 -- you get slightly better code if you let the compiler
727 -- see them right here:
728 n `quot` d = q where (q,r) = quotRem n d
729 n `rem` d = r where (q,r) = quotRem n d
730 n `div` d = q where (q,r) = divMod n d
731 n `mod` d = r where (q,r) = divMod n d
733 divMod n d = case (quotRem n d) of { qr@(q,r) ->
734 if signum r == - signum d then (q - 1, r+d) else qr }
735 -- Case-ified by WDP 94/10
737 instance Enum Integer where
738 enumFrom n = n : enumFrom (n + 1)
739 enumFromThen m n = en' m (n - m)
740 where en' m n = m : en' (m + n) n
741 enumFromTo n m = takeWhile (<= m) (enumFrom n)
742 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
745 instance Read Integer where
746 readsPrec p x = readSigned readDec x
747 readList = readList__ (readsPrec 0)
749 instance Show Integer where
750 showsPrec x = showSigned showInt x
751 showList = showList__ (showsPrec 0)
753 ---------------------------------------------------------------
754 data Float = F# Float# deriving (Eq, Ord)
755 instance CCallable Float
756 instance CReturnable Float
758 ---------------------------------------------------------------
760 instance Num Float where
761 (+) x y = plusFloat x y
762 (-) x y = minusFloat x y
763 negate x = negateFloat x
764 (*) x y = timesFloat x y
766 | otherwise = negateFloat x
767 signum x | x == 0.0 = 0
770 fromInteger n = encodeFloat n 0
771 fromInt i = int2Float i
773 instance Real Float where
774 toRational x = (m%1)*(b%1)^^n
775 where (m,n) = decodeFloat x
778 instance Fractional Float where
779 (/) x y = divideFloat x y
780 fromRational x = fromRational__ x
783 instance Floating Float where
784 pi = 3.141592653589793238
797 (**) x y = powerFloat x y
798 logBase x y = log y / log x
800 asinh x = log (x + sqrt (1.0+x*x))
801 acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
802 atanh x = log ((x+1.0) / sqrt (1.0-x*x))
804 instance RealFrac Float where
806 {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
807 {-# SPECIALIZE truncate :: Float -> Int #-}
808 {-# SPECIALIZE round :: Float -> Int #-}
809 {-# SPECIALIZE ceiling :: Float -> Int #-}
810 {-# SPECIALIZE floor :: Float -> Int #-}
812 {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
813 {-# SPECIALIZE truncate :: Float -> Integer #-}
814 {-# SPECIALIZE round :: Float -> Integer #-}
815 {-# SPECIALIZE ceiling :: Float -> Integer #-}
816 {-# SPECIALIZE floor :: Float -> Integer #-}
819 = case (decodeFloat x) of { (m,n) ->
820 let b = floatRadix x in
822 (fromInteger m * fromInteger b ^ n, 0.0)
824 case (quotRem m (b^(-n))) of { (w,r) ->
825 (fromInteger w, encodeFloat r n)
829 truncate x = case properFraction x of
832 round x = case properFraction x of
834 m = if r < 0.0 then n - 1 else n + 1
835 half_down = abs r - 0.5
837 case (compare half_down 0.0) of
839 EQ -> if even n then n else m
842 ceiling x = case properFraction x of
843 (n,r) -> if r > 0.0 then n + 1 else n
845 floor x = case properFraction x of
846 (n,r) -> if r < 0.0 then n - 1 else n
848 instance RealFloat Float where
849 floatRadix _ = FLT_RADIX -- from float.h
850 floatDigits _ = FLT_MANT_DIG -- ditto
851 floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
854 = case decodeFloat# f# of
855 ReturnIntAndGMP exp# a# s# d# ->
856 (J# a# s# d#, I# exp#)
858 encodeFloat (J# a# s# d#) (I# e#)
859 = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
861 exponent x = case decodeFloat x of
862 (m,n) -> if m == 0 then 0 else n + floatDigits x
864 significand x = case decodeFloat x of
865 (m,_) -> encodeFloat m (- (floatDigits x))
867 scaleFloat k x = case decodeFloat x of
868 (m,n) -> encodeFloat m (n+k)
870 instance Read Float where
871 readsPrec p x = readSigned readFloat x
872 readList = readList__ (readsPrec 0)
874 instance Show Float where
875 showsPrec x = showSigned showFloat x
876 showList = showList__ (showsPrec 0)
878 ---------------------------------------------------------------
879 data Double = D# Double# deriving (Eq, Ord)
880 instance CCallable Double
881 instance CReturnable Double
883 ---------------------------------------------------------------
885 instance Num Double where
886 (+) x y = plusDouble x y
887 (-) x y = minusDouble x y
888 negate x = negateDouble x
889 (*) x y = timesDouble x y
891 | otherwise = negateDouble x
892 signum x | x == 0.0 = 0
895 fromInteger n = encodeFloat n 0
896 fromInt (I# n#) = case (int2Double# n#) of { d# -> D# d# }
898 instance Real Double where
899 toRational x = (m%1)*(b%1)^^n
900 where (m,n) = decodeFloat x
903 instance Fractional Double where
904 (/) x y = divideDouble x y
905 fromRational x = fromRational__ x
908 instance Floating Double where
909 pi = 3.141592653589793238
912 sqrt x = sqrtDouble x
916 asin x = asinDouble x
917 acos x = acosDouble x
918 atan x = atanDouble x
919 sinh x = sinhDouble x
920 cosh x = coshDouble x
921 tanh x = tanhDouble x
922 (**) x y = powerDouble x y
923 logBase x y = log y / log x
925 asinh x = log (x + sqrt (1.0+x*x))
926 acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
927 atanh x = log ((x+1.0) / sqrt (1.0-x*x))
929 instance RealFrac Double where
931 {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
932 {-# SPECIALIZE truncate :: Double -> Int #-}
933 {-# SPECIALIZE round :: Double -> Int #-}
934 {-# SPECIALIZE ceiling :: Double -> Int #-}
935 {-# SPECIALIZE floor :: Double -> Int #-}
937 {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
938 {-# SPECIALIZE truncate :: Double -> Integer #-}
939 {-# SPECIALIZE round :: Double -> Integer #-}
940 {-# SPECIALIZE ceiling :: Double -> Integer #-}
941 {-# SPECIALIZE floor :: Double -> Integer #-}
943 #if defined(__UNBOXED_INSTANCES__)
944 {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
945 {-# SPECIALIZE truncate :: Double -> Int# #-}
946 {-# SPECIALIZE round :: Double -> Int# #-}
947 {-# SPECIALIZE ceiling :: Double -> Int# #-}
948 {-# SPECIALIZE floor :: Double -> Int# #-}
952 = case (decodeFloat x) of { (m,n) ->
953 let b = floatRadix x in
955 (fromInteger m * fromInteger b ^ n, 0.0)
957 case (quotRem m (b^(-n))) of { (w,r) ->
958 (fromInteger w, encodeFloat r n)
962 truncate x = case properFraction x of
965 round x = case properFraction x of
967 m = if r < 0.0 then n - 1 else n + 1
968 half_down = abs r - 0.5
970 case (compare half_down 0.0) of
972 EQ -> if even n then n else m
975 ceiling x = case properFraction x of
976 (n,r) -> if r > 0.0 then n + 1 else n
978 floor x = case properFraction x of
979 (n,r) -> if r < 0.0 then n - 1 else n
981 instance RealFloat Double where
982 floatRadix _ = FLT_RADIX -- from float.h
983 floatDigits _ = DBL_MANT_DIG -- ditto
984 floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
987 = case decodeDouble# d# of
988 ReturnIntAndGMP exp# a# s# d# ->
989 (J# a# s# d#, I# exp#)
991 encodeFloat (J# a# s# d#) (I# e#)
992 = case encodeDouble# a# s# d# e# of { dbl# -> D# dbl# }
994 exponent x = case decodeFloat x of
995 (m,n) -> if m == 0 then 0 else n + floatDigits x
997 significand x = case decodeFloat x of
998 (m,_) -> encodeFloat m (- (floatDigits x))
1000 scaleFloat k x = case decodeFloat x of
1001 (m,n) -> encodeFloat m (n+k)
1003 instance Read Double where
1004 readsPrec p x = readSigned readFloat x
1005 readList = readList__ (readsPrec 0)
1007 instance Show Double where
1008 showsPrec x = showSigned showFloat x
1009 showList = showList__ (showsPrec 0)
1011 ---------------------------------------------------------------
1012 -- The Enum instances for Floats and Doubles are slightly unusual.
1013 -- The `toEnum' function truncates numbers to Int. The definitions
1014 -- of enumFrom and enumFromThen allow floats to be used in arithmetic
1015 -- series: [0,0.1 .. 1.0]. However, roundoff errors make these somewhat
1016 -- dubious. This example may have either 10 or 11 elements, depending on
1017 -- how 0.1 is represented.
1019 instance Enum Float where
1020 toEnum = fromIntegral
1021 fromEnum = fromInteger . truncate -- may overflow
1022 enumFrom = numericEnumFrom
1023 enumFromThen = numericEnumFromThen
1025 instance Enum Double where
1026 toEnum = fromIntegral
1027 fromEnum = fromInteger . truncate -- may overflow
1028 enumFrom = numericEnumFrom
1029 enumFromThen = numericEnumFromThen
1031 numericEnumFrom :: (Real a) => a -> [a]
1032 numericEnumFromThen :: (Real a) => a -> a -> [a]
1033 numericEnumFrom = iterate (+1)
1034 numericEnumFromThen n m = iterate (+(m-n)) n
1036 ---------------------------------------------------------------
1039 data [] a = [] | a : [a] -- do explicitly: deriving (Eq, Ord)
1040 -- to avoid weird names like con2tag_[]#
1042 instance CCallable [Char]
1043 instance CReturnable [Char]
1045 instance (Eq a) => Eq [a] where
1047 (x:xs) == (y:ys) = x == y && xs == ys
1050 xs /= ys = if (xs == ys) then False else True
1052 instance (Ord a) => Ord [a] where
1053 a < b = case compare a b of { LT -> True; EQ -> False; GT -> False }
1054 a <= b = case compare a b of { LT -> True; EQ -> True; GT -> False }
1055 a >= b = case compare a b of { LT -> False; EQ -> True; GT -> True }
1056 a > b = case compare a b of { LT -> False; EQ -> False; GT -> True }
1058 max a b = case compare a b of { LT -> b; EQ -> a; GT -> a }
1059 min a b = case compare a b of { LT -> a; EQ -> a; GT -> b }
1062 compare (x:xs) [] = GT
1063 compare [] (y:ys) = LT
1064 compare (x:xs) (y:ys) = case compare x y of
1069 instance Functor [] where
1071 map f (x:xs) = f x : map f xs
1073 instance Monad [] where
1074 m >>= k = concat (map k m)
1077 instance MonadZero [] where
1080 instance MonadPlus [] where
1081 xs ++ ys = foldr (:) ys xs
1083 instance (Show a) => Show [a] where
1084 showsPrec p = showList
1085 showList = showList__ (showsPrec 0)
1087 instance (Read a) => Read [a] where
1088 readsPrec p = readList
1089 readList = readList__ (readsPrec 0)
1091 ---------------------------------------------------------------
1094 data (,) a b = (,) a b deriving (Eq, Ord, Bounded)
1095 data (,,) a b c = (,,) a b c deriving (Eq, Ord, Bounded)
1096 data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord, Bounded)
1097 data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord, Bounded)
1098 data (,,,,,) a b c d e f = (,,,,,) a b c d e f
1099 data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
1100 data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
1101 data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
1102 data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
1103 data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
1104 data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
1105 data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
1106 data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
1107 data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
1108 data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
1109 data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
1110 = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
1111 data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
1112 = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
1113 data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
1114 = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
1115 data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
1116 = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
1117 data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
1118 = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
1119 data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
1120 = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
1121 data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
1122 = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
1123 data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
1124 = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
1125 data (,,,,,,,,,,,,,,,,,,,,,,,,) 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
1126 = (,,,,,,,,,,,,,,,,,,,,,,,,) 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
1127 data (,,,,,,,,,,,,,,,,,,,,,,,,,) 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
1128 = (,,,,,,,,,,,,,,,,,,,,,,,,,) 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
1129 data (,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1130 = (,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1131 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1132 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1133 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1134 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1135 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1136 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1137 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1138 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1139 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1140 = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) 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_
1142 instance (Read a, Read b) => Read (a,b) where
1143 readsPrec p = readParen False
1144 (\r -> [((x,y), w) | ("(",s) <- lex r,
1148 (")",w) <- lex v ] )
1149 readList = readList__ (readsPrec 0)
1151 instance (Read a, Read b, Read c) => Read (a, b, c) where
1152 readsPrec p = readParen False
1153 (\a -> [((x,y,z), h) | ("(",b) <- lex a,
1154 (x,c) <- readsPrec 0 b,
1156 (y,e) <- readsPrec 0 d,
1158 (z,g) <- readsPrec 0 f,
1159 (")",h) <- lex g ] )
1160 readList = readList__ (readsPrec 0)
1162 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
1163 readsPrec p = readParen False
1164 (\a -> [((w,x,y,z), j) | ("(",b) <- lex a,
1165 (w,c) <- readsPrec 0 b,
1167 (x,e) <- readsPrec 0 d,
1169 (y,g) <- readsPrec 0 f,
1171 (z,i) <- readsPrec 0 h,
1172 (")",j) <- lex i ] )
1173 readList = readList__ (readsPrec 0)
1175 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
1176 readsPrec p = readParen False
1177 (\a -> [((w,x,y,z,v), l) | ("(",b) <- lex a,
1178 (w,c) <- readsPrec 0 b,
1180 (x,e) <- readsPrec 0 d,
1182 (y,g) <- readsPrec 0 f,
1184 (z,i) <- readsPrec 0 h,
1186 (v,k) <- readsPrec 0 j,
1187 (")",l) <- lex k ] )
1188 readList = readList__ (readsPrec 0)
1190 instance (Show a, Show b) => Show (a,b) where
1191 showsPrec p (x,y) = showChar '(' . shows x . showString ", " .
1192 shows y . showChar ')'
1193 showList = showList__ (showsPrec 0)
1195 instance (Show a, Show b, Show c) => Show (a, b, c) where
1196 showsPrec p (x,y,z) = showChar '(' . showsPrec 0 x . showString ", " .
1197 showsPrec 0 y . showString ", " .
1198 showsPrec 0 z . showChar ')'
1199 showList = showList__ (showsPrec 0)
1201 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
1202 showsPrec p (w,x,y,z) = showChar '(' . showsPrec 0 w . showString ", " .
1203 showsPrec 0 x . showString ", " .
1204 showsPrec 0 y . showString ", " .
1205 showsPrec 0 z . showChar ')'
1207 showList = showList__ (showsPrec 0)
1209 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
1210 showsPrec p (v,w,x,y,z) = showChar '(' . showsPrec 0 v . showString ", " .
1211 showsPrec 0 w . showString ", " .
1212 showsPrec 0 x . showString ", " .
1213 showsPrec 0 y . showString ", " .
1214 showsPrec 0 z . showChar ')'
1215 showList = showList__ (showsPrec 0)
1217 ---------------------------------------------------------------------
1218 -- component projections for pairs:
1219 -- (NB: not provided for triples, quadruples, etc.)
1226 -- curry converts an uncurried function to a curried function;
1227 -- uncurry converts a curried function to a function on pairs.
1228 curry :: ((a, b) -> c) -> a -> b -> c
1229 curry f x y = f (x, y)
1231 uncurry :: (a -> b -> c) -> ((a, b) -> c)
1232 uncurry f p = f (fst p) (snd p)
1236 -- Standard value bindings
1238 -- identity function
1242 -- constant function
1243 const :: a -> b -> a
1246 -- function composition
1248 {-# GENERATE_SPECS (.) a b c #-}
1249 (.) :: (b -> c) -> (a -> b) -> a -> c
1250 f . g = \ x -> f (g x)
1252 -- flip f takes its (first) two arguments in the reverse order of f.
1253 flip :: (a -> b -> c) -> b -> a -> c
1256 -- right-associating infix application operator (useful in continuation-
1258 ($) :: (a -> b) -> a -> b
1261 -- until p f yields the result of applying f until p holds.
1262 until :: (a -> Bool) -> (a -> a) -> a -> a
1263 until p f x | p x = x
1264 | otherwise = until p f (f x)
1266 -- asTypeOf is a type-restricted version of const. It is usually used
1267 -- as an infix operator, and its typing forces its first argument
1268 -- (which is usually overloaded) to have the same type as the second.
1269 asTypeOf :: a -> a -> a
1272 -- error stops execution and displays an error message
1274 error :: String -> a
1275 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
1277 -- It is expected that compilers will recognize this and insert error
1278 -- messages which are more appropriate to the context in which undefined
1282 undefined = error "Prelude.undefined"
1284 -- ============================================================
1285 -- Standard list functions
1286 -- ============================================================
1288 {- module PreludeList -}
1290 -- head and tail extract the first element and remaining elements,
1291 -- respectively, of a list, which must be non-empty. last and init
1292 -- are the dual functions working from the end of a finite list,
1293 -- rather than the beginning.
1297 head [] = error "PreludeList.head: empty list"
1301 last (_:xs) = last xs
1302 last [] = error "PreludeList.last: empty list"
1306 tail [] = error "PreludeList.tail: empty list"
1310 init (x:xs) = x : init xs
1311 init [] = error "PreludeList.init: empty list"
1317 -- length returns the length of a finite list as an Int; it is an instance
1318 -- of the more general genericLength, the result type of which may be
1319 -- any kind of number.
1320 length :: [a] -> Int
1322 length (_:l) = 1 + length l
1324 -- List index (subscript) operator, 0-origin
1325 (!!) :: [a] -> Int -> a
1327 (_:xs) !! n | n > 0 = xs !! (n-1)
1328 (_:_) !! _ = error "PreludeList.!!: negative index"
1329 [] !! _ = error "PreludeList.!!: index too large"
1331 -- foldl, applied to a binary operator, a starting value (typically the
1332 -- left-identity of the operator), and a list, reduces the list using
1333 -- the binary operator, from left to right:
1334 -- foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
1335 -- foldl1 is a variant that has no starting value argument, and thus must
1336 -- be applied to non-empty lists. scanl is similar to foldl, but returns
1337 -- a list of successive reduced values from the left:
1338 -- scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
1339 -- Note that last (scanl f z xs) == foldl f z xs.
1340 -- scanl1 is similar, again without the starting element:
1341 -- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1343 foldl :: (a -> b -> a) -> a -> [b] -> a
1345 foldl f z (x:xs) = foldl f (f z x) xs
1347 foldl1 :: (a -> a -> a) -> [a] -> a
1348 foldl1 f (x:xs) = foldl f x xs
1349 foldl1 _ [] = error "PreludeList.foldl1: empty list"
1351 scanl :: (a -> b -> a) -> a -> [b] -> [a]
1352 scanl f q xs = q : (case xs of
1354 x:xs -> scanl f (f q x) xs)
1356 scanl1 :: (a -> a -> a) -> [a] -> [a]
1357 scanl1 f (x:xs) = scanl f x xs
1358 scanl1 _ [] = error "PreludeList.scanl1: empty list"
1360 -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
1363 foldr :: (a -> b -> b) -> b -> [a] -> b
1365 foldr f z (x:xs) = f x (foldr f z xs)
1367 foldr1 :: (a -> a -> a) -> [a] -> a
1369 foldr1 f (x:xs) = f x (foldr1 f xs)
1370 foldr1 _ [] = error "PreludeList.foldr1: empty list"
1372 scanr :: (a -> b -> b) -> b -> [a] -> [b]
1373 scanr f q0 [] = [q0]
1374 scanr f q0 (x:xs) = f x q : qs
1375 where qs@(q:_) = scanr f q0 xs
1377 scanr1 :: (a -> a -> a) -> [a] -> [a]
1379 scanr1 f (x:xs) = f x q : qs
1380 where qs@(q:_) = scanr1 f xs
1381 scanr1 _ [] = error "PreludeList.scanr1: empty list"
1383 -- iterate f x returns an infinite list of repeated applications of f to x:
1384 -- iterate f x == [x, f x, f (f x), ...]
1385 iterate :: (a -> a) -> a -> [a]
1386 iterate f x = x : iterate f (f x)
1388 -- repeat x is an infinite list, with x the value of every element.
1390 repeat x = xs where xs = x:xs
1392 -- replicate n x is a list of length n with x the value of every element
1393 replicate :: Int -> a -> [a]
1394 replicate n x = take n (repeat x)
1396 -- cycle ties a finite list into a circular one, or equivalently,
1397 -- the infinite repetition of the original list. It is the identity
1398 -- on infinite lists.
1401 cycle xs = xs' where xs' = xs ++ xs'
1403 -- take n, applied to a list xs, returns the prefix of xs of length n,
1404 -- or xs itself if n > length xs. drop n xs returns the suffix of xs
1405 -- after the first n elements, or [] if n > length xs. splitAt n xs
1406 -- is equivalent to (take n xs, drop n xs).
1408 take :: Int -> [a] -> [a]
1411 take n (x:xs) | n > 0 = x : take (n-1) xs
1412 take _ _ = error "PreludeList.take: negative argument"
1414 drop :: Int -> [a] -> [a]
1417 drop n (_:xs) | n > 0 = drop (n-1) xs
1418 drop _ _ = error "PreludeList.drop: negative argument"
1420 splitAt :: Int -> [a] -> ([a],[a])
1421 splitAt 0 xs = ([],xs)
1422 splitAt _ [] = ([],[])
1423 splitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
1424 splitAt _ _ = error "PreludeList.splitAt: negative argument"
1426 -- takeWhile, applied to a predicate p and a list xs, returns the longest
1427 -- prefix (possibly empty) of xs of elements that satisfy p. dropWhile p xs
1428 -- returns the remaining suffix. Span p xs is equivalent to
1429 -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
1431 takeWhile :: (a -> Bool) -> [a] -> [a]
1434 | p x = x : takeWhile p xs
1437 dropWhile :: (a -> Bool) -> [a] -> [a]
1439 dropWhile p xs@(x:xs')
1440 | p x = dropWhile p xs'
1443 span, break :: (a -> Bool) -> [a] -> ([a],[a])
1446 | p x = let (ys,zs) = span p xs' in (x:ys,zs)
1447 | otherwise = ([],xs)
1448 break p = span (not . p)
1450 -- lines breaks a string up into a list of strings at newline characters.
1451 -- The resulting strings do not contain newlines. Similary, words
1452 -- breaks a string up into a list of words, which were delimited by
1453 -- white space. unlines and unwords are the inverse operations.
1454 -- unlines joins lines with terminating newlines, and unwords joins
1455 -- words with separating spaces.
1457 lines :: String -> [String]
1459 lines s = let (l, s') = break (== '\n') s
1462 (_:s'') -> lines s''
1464 words :: String -> [String]
1465 words s = case dropWhile {-partain:Char.-}isSpace s of
1469 break {-partain:Char.-}isSpace s'
1471 unlines :: [String] -> String
1472 unlines = concatMap (++ "\n")
1474 unwords :: [String] -> String
1476 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
1478 -- reverse xs returns the elements of xs in reverse order. xs must be finite.
1479 reverse :: [a] -> [a]
1480 reverse = foldl (flip (:)) []
1482 -- and returns the conjunction of a Boolean list. For the result to be
1483 -- True, the list must be finite; False, however, results from a False
1484 -- value at a finite index of a finite or infinite list. or is the
1485 -- disjunctive dual of and.
1486 and, or :: [Bool] -> Bool
1487 and = foldr (&&) True
1488 or = foldr (||) False
1490 -- Applied to a predicate and a list, any determines if any element
1491 -- of the list satisfies the predicate. Similarly, for all.
1492 any, all :: (a -> Bool) -> [a] -> Bool
1496 -- elem is the list membership predicate, usually written in infix form,
1497 -- e.g., x `elem` xs. notElem is the negation.
1498 elem, notElem :: (Eq a) => a -> [a] -> Bool
1500 notElem x = all (not . (/= x))
1502 -- lookup key assocs looks up a key in an association list.
1503 lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
1504 lookup key [] = Nothing
1505 lookup key ((x,y):xys)
1507 | otherwise = lookup key xys
1509 -- sum and product compute the sum or product of a finite list of numbers.
1510 sum, product :: (Num a) => [a] -> a
1512 product = foldl (*) 1
1514 -- maximum and minimum return the maximum or minimum value from a list,
1515 -- which must be non-empty, finite, and of an ordered type.
1516 maximum, minimum :: (Ord a) => [a] -> a
1517 maximum [] = error "PreludeList.maximum: empty list"
1518 maximum xs = foldl1 max xs
1520 minimum [] = error "PreludeList.minimum: empty list"
1521 minimum xs = foldl1 min xs
1523 concatMap :: (a -> [b]) -> [a] -> [b]
1524 concatMap f = concat . map f
1526 -- zip takes two lists and returns a list of corresponding pairs. If one
1527 -- input list is short, excess elements of the longer list are discarded.
1528 -- zip3 takes three lists and returns a list of triples. Zips for larger
1529 -- tuples are in the List library
1531 zip :: [a] -> [b] -> [(a,b)]
1534 zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
1535 zip3 = zipWith3 (,,)
1537 -- The zipWith family generalises the zip family by zipping with the
1538 -- function given as the first argument, instead of a tupling function.
1539 -- For example, zipWith (+) is applied to two lists to produce the list
1540 -- of corresponding sums.
1542 zipWith :: (a->b->c) -> [a]->[b]->[c]
1543 zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
1546 zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
1547 zipWith3 z (a:as) (b:bs) (c:cs)
1548 = z a b c : zipWith3 z as bs cs
1549 zipWith3 _ _ _ _ = []
1552 -- unzip transforms a list of pairs into a pair of lists.
1554 unzip :: [(a,b)] -> ([a],[b])
1555 unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
1557 unzip3 :: [(a,b,c)] -> ([a],[b],[c])
1558 unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
1561 {- module PreludeText -}
1563 type ReadS a = String -> [(a,String)]
1564 type ShowS = String -> String
1567 readsPrec :: Int -> ReadS a
1568 readList :: ReadS [a]
1570 readList = readParen False (\r -> [pr | ("[",s) <- lex r,
1572 where readl s = [([],t) | ("]",t) <- lex s] ++
1573 [(x:xs,u) | (x,t) <- reads s,
1575 readl' s = [([],t) | ("]",t) <- lex s] ++
1576 [(x:xs,v) | (",",t) <- lex s,
1581 showsPrec :: Int -> a -> ShowS
1582 showList :: [a] -> ShowS
1584 showList [] = showString "[]"
1586 = showChar '[' . shows x . showl xs
1587 where showl [] = showChar ']'
1588 showl (x:xs) = showString ", " . shows x . showl xs
1590 reads :: (Read a) => ReadS a
1593 shows :: (Show a) => a -> ShowS
1596 read :: (Read a) => String -> a
1597 read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
1599 [] -> error "PreludeText.read: no parse"
1600 _ -> error "PreludeText.read: ambiguous parse"
1602 show :: (Show a) => a -> String
1605 showChar :: Char -> ShowS
1608 showString :: String -> ShowS
1611 showParen :: Bool -> ShowS -> ShowS
1612 showParen b p = if b then showChar '(' . p . showChar ')' else p
1614 readParen :: Bool -> ReadS a -> ReadS a
1615 readParen b g = if b then mandatory else optional
1616 where optional r = g r ++ mandatory r
1617 mandatory r = [(x,u) | ("(",s) <- lex r,
1618 (x,t) <- optional s,
1621 -- lex: moved to GHCbase
1623 {- module PreludeIO -}
1625 -- in GHCio: type FilePath = String
1627 fail :: IOError -> IO a
1628 fail err = IO $ ST $ \ s -> (Left err, s)
1630 userError :: String -> IOError
1631 userError str = UserError str
1633 catch :: IO a -> (IOError -> IO a) -> IO a
1634 catch (IO (ST m)) k = IO $ ST $ \ s ->
1635 case (m s) of { (r, new_s) ->
1637 Right _ -> (r, new_s)
1638 Left err -> case (k err) of { IO (ST k_err) ->
1641 putChar :: Char -> IO ()
1642 putChar c = hPutChar stdout c
1644 putStr :: String -> IO ()
1645 putStr s = hPutStr stdout s
1647 putStrLn :: String -> IO ()
1648 putStrLn s = do putStr s
1651 print :: Show a => a -> IO ()
1652 print x = putStrLn (show x)
1655 getChar = hGetChar stdin
1657 getLine :: IO String
1658 getLine = do c <- getChar
1659 if c == '\n' then return "" else
1663 getContents :: IO String
1664 getContents = hGetContents stdin
1666 interact :: (String -> String) -> IO ()
1667 interact f = do s <- getContents
1670 readFile :: FilePath -> IO String
1671 readFile name = openFile name ReadMode >>= hGetContents
1673 writeFile :: FilePath -> String -> IO ()
1675 = openFile name WriteMode >>= \hdl -> hPutStr hdl str >> hClose hdl
1677 appendFile :: FilePath -> String -> IO ()
1679 = openFile name AppendMode >>= \hdl -> hPutStr hdl str >> hClose hdl
1681 readIO :: Read a => String -> IO a
1682 -- raises an exception instead of an error
1683 readIO s = case [x | (x,t) <- reads s, ("","") <- lex t] of
1685 [] -> fail (userError "PreludeIO.readIO: no parse")
1686 _ -> fail (userError
1687 "PreludeIO.readIO: ambiguous parse")
1689 readLn :: Read a => IO a
1690 readLn = do l <- getLine