ghc/lib/prelude/Prel.hs

   1 -- Standard value bindings
   2
   3 module Prelude (
   4         -- NB: not the "real" Prelude.hi export list
   5         ($),
   6         (&&),
   7         (.),
   8         (^),
   9         (^^),
  10         appendBin,
  11         asTypeOf,
  12         atan2,
  13         chr,
  14         const,
  15         flip,
  16         fromIntegral,
  17         fromRealFrac,
  18         fst,
  19         gcd,
  20         id,
  21         isAlpha,
  22         isAlphanum,
  23         isAscii,
  24         isControl,
  25         isDigit,
  26         isLower,
  27         isNullBin,
  28         isPrint,
  29         isSpace,
  30         isUpper,
  31         lcm,
  32         maxChar,
  33         maxInt,
  34         minChar,
  35         minInt,
  36         not,
  37         nullBin,
  38         ord,
  39         otherwise,
  40         snd,
  41         subtract,
  42         toLower,
  43         toUpper,
  44         until,
  45         (||),
  46
  47         minInt#, maxInt#,
  48         toInt#, fromInt#,
  49         minChar#, maxChar#,
  50         toChar#, fromChar#,
  51         isAscii#, isControl#, isPrint#, isSpace#,
  52         isUpper#, isLower#, isAlpha#, isDigit#, isAlphanum#,
  53         toUpper#, toLower#
  54
  55     ) where
  56
  57 import UTypes           ( Bin ) -- so we don't get any data constructors!
  58
  59 import Cls
  60 import Core
  61 import TyArray
  62 import TyComplex
  63 import IChar
  64 import IComplex
  65 import IDouble
  66 import IFloat
  67 import IInt
  68 import IInteger
  69 import IList
  70 import IRatio
  71 import List             ( (++) )
  72 import PS               ( _PackedString, _unpackPS )
  73 import Text
  74
  75 --infixr 9  .
  76 --infixr 8  ^, ^^
  77 --infixr 3  &&
  78 --infixr 2  ||
  79 --infixr 0  $
  80
  81 ---------------------------------------------------------------
  82 -- Binary functions
  83 ---------------------------------------------------------------
  84
  85 nullBin                 :: Bin
  86 isNullBin               :: Bin -> Bool
  87 appendBin               :: Bin -> Bin -> Bin
  88
  89 nullBin                 = error "nullBin{Prelude}\n"
  90 isNullBin               = error "isNullBin{Prelude}\n"
  91 appendBin               = error "appendBin{Prelude}\n"
  92
  93 ---------------------------------------------------------------
  94 -- Boolean functions
  95 ---------------------------------------------------------------
  96
  97 {-# INLINE (&&) #-}
  98 {-# INLINE (||) #-}
  99 (&&), (||)              :: Bool -> Bool -> Bool
 100 True  && x              =  x
 101 False && _              =  False
 102 True  || _              =  True
 103 False || x              =  x
 104
 105 {-# INLINE not #-}
 106 not                     :: Bool -> Bool
 107 not True                =  False
 108 not False               =  True
 109
 110 {-# INLINE otherwise #-}
 111 otherwise               :: Bool
 112 otherwise               =  True
 113
 114 ---------------------------------------------------------------
 115 -- Int functions
 116 ---------------------------------------------------------------
 117
 118 minInt, maxInt  :: Int
 119 minInt          =  -2147483647  -- **********************
 120 maxInt          =  2147483647   -- **********************
 121
 122 ---------------------------------------------------------------
 123 -- Char functions
 124 ---------------------------------------------------------------
 125
 126 minChar, maxChar        :: Char
 127 minChar                 = '\0'
 128 maxChar                 = '\255'
 129
 130 ord                     :: Char -> Int
 131 ord c                   =  case c of { C# ch -> I# (ord# ch) }
 132
 133 chr                     :: Int -> Char
 134 chr i                   =  case i of { I# ih -> C# (chr# ih) }
 135
 136 isAscii, isControl, isPrint, isSpace            :: Char -> Bool
 137 isUpper, isLower, isAlpha, isDigit, isAlphanum  :: Char -> Bool
 138
 139 isAscii c               =  ord c < 128
 140 isControl c             =  c < ' ' || c == '\DEL'
 141 isPrint c               =  c >= ' ' && c <= '~'
 142 isSpace c               =  c == ' ' || c == '\t' || c == '\n' ||
 143                            c == '\r' || c == '\f' || c == '\v'
 144 isUpper c               =  c >= 'A' && c <= 'Z'
 145 isLower c               =  c >= 'a' && c <= 'z'
 146 isAlpha c               =  isUpper c || isLower c
 147 isDigit c               =  c >= '0' && c <= '9'
 148 isAlphanum c            =  isAlpha c || isDigit c
 149
 150
 151 toUpper, toLower        :: Char -> Char
 152 toUpper c | isLower c   = chr ((ord c - ord 'a') + ord 'A')
 153           | otherwise   = c
 154
 155 toLower c | isUpper c   = chr ((ord c - ord 'A') + ord 'a')
 156           | otherwise   = c
 157
 158 ---------------------------------------------------------------
 159 -- Int# functions
 160 ---------------------------------------------------------------
 161
 162 toInt#          :: Int  -> Int#
 163 toInt# (I# i#)  = i#
 164
 165 fromInt#        :: Int# -> Int
 166 fromInt# i#     = I# i#
 167
 168 -- ToDo: Preferable to overload minInt and maxInt
 169 --       minInt, maxInt :: Num a => a
 170 --       Solution: place in class Num (as pi is in Floating)
 171
 172 minInt#, maxInt#        :: Int#
 173 minInt#                 =  -2147483647#
 174 maxInt#                 =  2147483647#
 175
 176 ---------------------------------------------------------------
 177 -- Char# functions -- ToDo: class Chr ???
 178 ---------------------------------------------------------------
 179
 180 toChar#         :: Char  -> Char#
 181 toChar# (C# c#) = c#
 182
 183 fromChar#       :: Char# -> Char
 184 fromChar# c#    = C# c#
 185
 186 -- ord# and chr# are builtin
 187
 188 minChar#, maxChar#      :: Char#
 189 minChar#        = '\0'#
 190 maxChar#        = '\255'#
 191
 192 isAscii#, isControl#, isPrint#, isSpace#                :: Char# -> Bool
 193 isUpper#, isLower#, isAlpha#, isDigit#, isAlphanum#     :: Char# -> Bool
 194
 195 isAscii# c      =  ord# c `ltInt#` 128#
 196 isControl# c    =  c `ltChar#` ' '# || c `eqChar#` '\DEL'#
 197 isPrint# c      =  c `geChar#` ' '# && c `leChar#` '~'#
 198 isSpace# c      =  c `eqChar#` ' '# || c `eqChar#` '\t'# || c `eqChar#` '\n'# ||
 199                    c `eqChar#` '\r'# || c `eqChar#` '\f'# || c `eqChar#` '\v'#
 200 isUpper# c      =  c `geChar#` 'A'# && c `leChar#` 'Z'#
 201 isLower# c      =  c `geChar#` 'a'# && c `leChar#` 'z'#
 202 isAlpha# c      =  isUpper# c || isLower# c
 203 isDigit# c      =  c `geChar#` '0'# && c `leChar#` '9'#
 204 isAlphanum# c   =  isAlpha# c || isDigit# c
 205
 206
 207 toUpper#, toLower#      :: Char# -> Char#
 208 toUpper# c | isLower# c = chr# ((ord# c `minusInt#` ord# 'a'#) `plusInt#` ord# 'A'#)
 209            | otherwise  = c
 210 toLower# c | isUpper# c = chr# ((ord# c `minusInt#` ord# 'A'#) `plusInt#` ord# 'a'#)
 211            | otherwise  = c
 212
 213 ---------------------------------------------------------------
 214 -- Numeric functions
 215 ---------------------------------------------------------------
 216
 217 {-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
 218 subtract        :: (Num a) => a -> a -> a
 219 #ifdef USE_REPORT_PRELUDE
 220 subtract        =  flip (-)
 221 #else
 222 subtract x y    =  y - x
 223 #endif /* ! USE_REPORT_PRELUDE */
 224
 225 {-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
 226 gcd             :: (Integral a) => a -> a -> a
 227 gcd x y | x == __i0 && y == __i0
 228         =  error "gcd{Prelude}: gcd 0 0 is undefined\n"
 229         | otherwise
 230         =  gcd' (abs x) (abs y)
 231                    where gcd' x y | y == __i0
 232                                   =  x
 233                                   | otherwise
 234                                   =  gcd' y (x `rem` y)
 235
 236 {-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
 237 lcm             :: (Integral a) => a -> a -> a
 238 lcm x y | y == __i0
 239         = __i0
 240         | x == __i0
 241         = __i0
 242         | otherwise
 243         = abs ((x `quot` (gcd x y)) * y)
 244
 245 {-# SPECIALIZE (^) :: Integer -> Integer -> Integer #-}
 246 {-# GENERATE_SPECS (^) a{~,Int#,Double#,Int,Integer,Double,Rational,Complex(Double#),Complex(Double)} b{~,Int#,Int} #-}
 247 (^)             :: (Num a, Integral b) => a -> b -> a
 248 x ^ n | n == __i0
 249       = __i1
 250       | n > __i0
 251       = f x (n - __i1) x
 252       | otherwise
 253       = error "(^){Prelude}: negative exponent\n"
 254   where
 255     f x n y | n == __i0
 256             = y
 257             | otherwise
 258             = g x n y
 259     g x n y | odd n
 260             = f x (n - __i1) (x*y)
 261             | otherwise
 262             = g (x*x) (n `div` __i2) y
 263
 264 {-# GENERATE_SPECS (^^) a{~,Double#,Double,Rational,Complex(Double#),Complex(Double)} b{~,Int#,Int} #-}
 265 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 266 x ^^ n          =  if n >= 0 then x^n else recip (x^(-n))
 267
 268 {-# GENERATE_SPECS atan2 a{Double#,Double} #-}
 269 atan2           :: (RealFloat a) => a -> a -> a
 270 #if USE_REPORT_PRELUDE
 271 atan2 y x       =  case (signum y, signum x) of
 272                         ( 0, 1) ->  0
 273                         ( 1, 0) ->  pi/2
 274                         ( 0,-1) ->  pi
 275                         (-1, 0) -> -pi/2
 276                         ( _, 1) ->  atan (y/x)
 277                         ( _,-1) ->  atan (y/x) + pi
 278                         ( 0, 0) ->  error "atan2{Prelude}: atan2 of origin\n"
 279 #else {- steal Lennart's version -}
 280 atan2 y x =
 281         if y == 0 then
 282                  if x > 0 then 0
 283             else if x < 0 then pi
 284             else {- x == 0 -}  error "Prelude.atan2: atan2 of origin"
 285         else if x == 0 then
 286             if y > 0 then pi/2
 287             else {- y < 0 -} -pi/2
 288         else if x > 0 then
 289             atan (y/x)          -- 1st and 4th quadrant
 290         else {- x < 0 -}
 291             if y > 0 then
 292                 atan (y/x) + pi -- 2nd quadrant
 293             else {- y < 0 -}
 294                 atan (y/x) - pi -- 3rd quadrant
 295 #endif
 296
 297 ---------------------------------------------------------------
 298 -- Some standard functions:
 299 ---------------------------------------------------------------
 300
 301 -- component projections for pairs:
 302 {-# GENERATE_SPECS fst a b #-}
 303 fst                     :: (a,b) -> a
 304 fst (x,y)               =  x
 305
 306 {-# GENERATE_SPECS snd a b #-}
 307 snd                     :: (a,b) -> b
 308 snd (x,y)               =  y
 309
 310 -- identity function
 311 {-# GENERATE_SPECS id a #-}
 312 id                      :: a -> a
 313 id x                    =  x
 314
 315 -- constant function
 316 {-# GENERATE_SPECS const a b #-}
 317 const                   :: a -> b -> a
 318 const x _               =  x
 319
 320 -- function composition
 321 {-# INLINE (.) #-}
 322 {-# GENERATE_SPECS (.) a b c #-}
 323 (.)                     :: (b -> c) -> (a -> b) -> a -> c
 324 (f . g) x               =  f (g x)
 325
 326 -- flip f  takes its (first) two arguments in the reverse order of f.
 327 {-# GENERATE_SPECS flip a b c #-}
 328 flip                    :: (a -> b -> c) -> b -> a -> c
 329 flip f x y              =  f y x
 330
 331 -- right-associating infix application operator (useful in continuation-
 332 -- passing style)
 333 {-# GENERATE_SPECS ($) a b #-}
 334 ($)                     :: (a -> b) -> a -> b
 335 f $ x                   =  f x
 336
 337 -- until p f  yields the result of applying f until p holds.
 338 {-# GENERATE_SPECS until a #-}
 339 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 340 until p f x | p x       =  x
 341             | otherwise =  until p f (f x)
 342
 343 -- asTypeOf is a type-restricted version of const.  It is usually used
 344 -- as an infix operator, and its typing forces its first argument
 345 -- (which is usually overloaded) to have the same type as the second.
 346 {-# GENERATE_SPECS asTypeOf a #-}
 347 asTypeOf                :: a -> a -> a
 348 asTypeOf                =  const
 349
 350 ---------------------------------------------------------------
 351 -- fromIntegral and fromRealFrac with explicit specialisations
 352 ---------------------------------------------------------------
 353
 354 {-# SPECIALIZE fromIntegral ::
 355     Int         -> Rational,
 356     Integer     -> Rational,
 357     Int         -> Int          = id,
 358     Int         -> Integer      = i2Integer,
 359     Int         -> Float        = i2F,
 360     Int         -> Double       = i2D,
 361     Integer     -> Int          = integer2I,
 362     Integer     -> Integer      = id,
 363     Integer     -> Float        = integer2F,
 364     Integer     -> Double       = integer2D #-}
 365
 366 #if defined(__UNBOXED_INSTANCES__)
 367 {-# SPECIALIZE fromIntegral ::
 368     Int#        -> Rational,
 369     Int#        -> Int#         = id,
 370     Int#        -> Double#      = i2d#,
 371     Int#        -> Int          = i2I#,
 372     Int#        -> Integer      = i2Integer#,
 373     Int#        -> Float        = i2F#,
 374     Int#        -> Double       = i2D#,
 375     Int         -> Int#         = i2i,
 376     Int         -> Double#      = i2d,
 377     Integer     -> Int#         = integer2i,
 378     Integer     -> Double#      = integer2d #-}
 379 #endif
 380
 381 i2d# i# = int2Double# i#
 382 i2I# i# = I# i#
 383 i2Integer# i# = int2Integer# i#
 384 i2F# i# = F# (int2Float# i#)
 385 i2D# i# = D# (int2Double# i#)
 386
 387 i2i (I# i#) = i#
 388 i2d (I# i#) = int2Double# i#
 389 i2Integer (I# i#) = int2Integer# i#
 390 i2F (I# i#) = F# (int2Float# i#)
 391 i2D (I# i#) = D# (int2Double# i#)
 392
 393 integer2i (J# a# s# d#) = integer2Int# a# s# d#
 394 integer2d (J# a# s# d#) = encodeDouble# a# s# d# 0#
 395 integer2I (J# a# s# d#) = I# (integer2Int# a# s# d#)
 396 integer2F (J# a# s# d#) = F# (encodeFloat# a# s# d# 0#)
 397 integer2D (J# a# s# d#) = D# (encodeDouble# a# s# d# 0#)
 398
 399 fromIntegral    :: (Integral a, Num b) => a -> b
 400 fromIntegral    =  fromInteger . toInteger
 401
 402 {-# SPECIALIZE fromRealFrac ::
 403     Double      -> Rational,
 404     Rational    -> Double,
 405     Float       -> Rational,
 406     Rational    -> Float,
 407     Rational    -> Rational     = id,
 408     Double      -> Double       = id,
 409     Double      -> Float        = d2F,
 410     Float       -> Float        = id,
 411     Float       -> Double       = f2D #-}
 412
 413 #if defined(__UNBOXED_INSTANCES__)
 414 {-# SPECIALIZE fromRealFrac ::
 415     Double#     -> Rational,
 416     Rational    -> Double#,
 417     Double#     -> Double#      = id,
 418     Double#     -> Float        = d2F#,
 419     Double#     -> Double       = d2D#,
 420     Double      -> Double#      = d2d,
 421     Float       -> Double#      = f2d #-}
 422 #endif
 423
 424 d2F# d# = F# (double2Float# d#)
 425 d2D# d# = D# d#
 426
 427 f2d (F# f#) = float2Double# f#
 428 f2D (F# f#) = D# (float2Double# f#)
 429
 430 d2d (D# d#) = d#
 431 d2F (D# d#) = F# (double2Float# d#)
 432
 433 fromRealFrac    :: (RealFrac a, Fractional b) => a -> b
 434 fromRealFrac    =  fromRational . toRational