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 #if defined(__UNBOXED_INSTANCES__)
  48         , minInt#, maxInt#
  49         , minChar#, maxChar#
  50         , toChar#, fromChar#
  51         , isAscii#, isControl#, isPrint#, isSpace#
  52         , isUpper#, isLower#, isAlpha#, isDigit#, isAlphanum#
  53         , toUpper#, toLower#
  54 #endif
  55     ) where
  56
  57 import UTypes           ( Bin ) -- so we don't get any data constructors!
  58
  59 import Cls
  60 import Core
  61 import TyComplex
  62 import IChar
  63 import IComplex
  64 import IDouble
  65 import IFloat
  66 import IInt
  67 import IInteger
  68 import IList
  69 import IRatio
  70 import List             ( (++) )
  71 import PS               ( _PackedString, _unpackPS )
  72 import Text
  73
  74 --infixr 9  .
  75 --infixr 8  ^, ^^
  76 --infixr 3  &&
  77 --infixr 2  ||
  78 --infixr 0  $
  79
  80 ---------------------------------------------------------------
  81 -- Binary functions
  82 ---------------------------------------------------------------
  83
  84 nullBin                 :: Bin
  85 isNullBin               :: Bin -> Bool
  86 appendBin               :: Bin -> Bin -> Bin
  87
  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 #if defined(__UNBOXED_INSTANCES__)
 159 ---------------------------------------------------------------
 160 -- Int# functions
 161 ---------------------------------------------------------------
 162
 163 -- ToDo: Preferable to overload minInt and maxInt
 164 --       minInt, maxInt :: Num a => a
 165 --       Solution: place in class Num (as pi is in Floating)
 166
 167 minInt#, maxInt#        :: Int#
 168 minInt#                 =  -2147483647#
 169 maxInt#                 =  2147483647#
 170
 171 ---------------------------------------------------------------
 172 -- Char# functions -- ToDo: class Chr ???
 173 ---------------------------------------------------------------
 174
 175 toChar#         :: Char  -> Char#
 176 toChar# (C# c#) = c#
 177
 178 fromChar#       :: Char# -> Char
 179 fromChar# c#    = C# c#
 180
 181 -- ord# and chr# are builtin
 182
 183 minChar#, maxChar#      :: Char#
 184 minChar#                = '\0'#
 185 maxChar#                = '\255'#
 186
 187 isAscii#, isControl#, isPrint#, isSpace#                :: Char# -> Bool
 188 isUpper#, isLower#, isAlpha#, isDigit#, isAlphanum#     :: Char# -> Bool
 189
 190 isAscii# c              =  ord# c < 128#
 191 isControl# c            =  c < ' '# || c == '\DEL'#
 192 isPrint# c              =  c >= ' '# && c <= '~'#
 193 isSpace# c              =  c == ' '# || c == '\t'# || c == '\n'# ||
 194                            c == '\r'# || c == '\f'# || c == '\v'#
 195 isUpper# c              =  c >= 'A'# && c <= 'Z'#
 196 isLower# c              =  c >= 'a'# && c <= 'z'#
 197 isAlpha# c              =  isUpper# c || isLower# c
 198 isDigit# c              =  c >= '0'# && c <= '9'#
 199 isAlphanum# c           =  isAlpha# c || isDigit# c
 200
 201
 202 toUpper#, toLower#      :: Char# -> Char#
 203 toUpper# c | isLower# c = chr# ((ord# c - ord# 'a'#) + ord# 'A'#)
 204            | otherwise  = c
 205
 206 toLower# c | isUpper# c = chr# ((ord# c - ord# 'A'#) + ord# 'a'#)
 207            | otherwise  = c
 208
 209 #endif {-UNBOXED INSTANCES-}
 210
 211 ---------------------------------------------------------------
 212 -- Numeric functions
 213 ---------------------------------------------------------------
 214
 215 --{-# GENERATE_SPECS subtract a{Int#,Double#} #-}
 216 {-# GENERATE_SPECS subtract a{~,Int,Double} #-}
 217 subtract        :: (Num a) => a -> a -> a
 218 #ifdef USE_REPORT_PRELUDE
 219 subtract        =  flip (-)
 220 #else
 221 subtract x y    =  y - x
 222 #endif /* ! USE_REPORT_PRELUDE */
 223
 224 --{-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
 225 {-# GENERATE_SPECS gcd a{~,Int,Integer} #-}
 226 gcd             :: (Integral a) => a -> a -> a
 227 gcd 0 0         =  error "gcd{Prelude}: gcd 0 0 is undefined\n"
 228 gcd x y         =  gcd' (abs x) (abs y)
 229                    where gcd' x 0  =  x
 230                          gcd' x y  =  gcd' y (x `rem` y)
 231
 232 --{-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
 233 {-# GENERATE_SPECS lcm a{~,Int,Integer} #-}
 234 lcm             :: (Integral a) => a -> a -> a
 235 lcm _ 0         =  0
 236 lcm 0 _         =  0
 237 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 238
 239 --{-# GENERATE_SPECS (^) a{~,Int#,Double#,Int,Integer,Double,Complex(Double#),Complex(Double)} b{~,Int#,Int} #-}
 240 {-# GENERATE_SPECS (^) a{~,Int,Integer,Double,Rational,Complex(Double)} b{~,Int} #-}
 241 (^)             :: (Num a, Integral b) => a -> b -> a
 242 x ^ 0           =  1
 243 x ^ (n+1)       =  f x n x
 244                    where f _ 0 y = y
 245                          f x n y = g x n  where
 246                                    g x n | odd n = f x (n-1) (x*y)
 247                                          | otherwise  = g (x*x) (n `div` 2)
 248 _ ^ _           = error "(^){Prelude}: negative exponent\n"
 249
 250 --{-# GENERATE_SPECS (^^) a{~,Double#,Double,Complex(Double#),Complex(Double)} b{~,Int#,Int} #-}
 251 {-# GENERATE_SPECS (^^) a{~,Double,Rational} b{~,Int} #-}
 252 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 253 x ^^ n          =  if n >= 0 then x^n else recip (x^(-n))
 254
 255 --{-# GENERATE_SPECS atan2 a{Double#,Double} #-}
 256 {-# GENERATE_SPECS atan2 a{~,Double} #-}
 257 atan2           :: (RealFloat a) => a -> a -> a
 258 #if USE_REPORT_PRELUDE
 259 atan2 y x       =  case (signum y, signum x) of
 260                         ( 0, 1) ->  0
 261                         ( 1, 0) ->  pi/2
 262                         ( 0,-1) ->  pi
 263                         (-1, 0) -> -pi/2
 264                         ( _, 1) ->  atan (y/x)
 265                         ( _,-1) ->  atan (y/x) + pi
 266                         ( 0, 0) ->  error "atan2{Prelude}: atan2 of origin\n"
 267 #else {- steal Lennart's version -}
 268 atan2 y x =
 269         if y == 0 then
 270                  if x > 0 then 0
 271             else if x < 0 then pi
 272             else {- x == 0 -}  error "Prelude.atan2: atan2 of origin"
 273         else if x == 0 then
 274             if y > 0 then pi/2
 275             else {- y < 0 -} -pi/2
 276         else if x > 0 then
 277             atan (y/x)          -- 1st and 4th quadrant
 278         else {- x < 0 -}
 279             if y > 0 then
 280                 atan (y/x) + pi -- 2nd quadrant
 281             else {- y < 0 -}
 282                 atan (y/x) - pi -- 3rd quadrant
 283 #endif
 284
 285 ---------------------------------------------------------------
 286 -- Some standard functions:
 287 ---------------------------------------------------------------
 288
 289 -- component projections for pairs:
 290 --{-# GENERATE_SPECS fst a b #-}
 291 fst                     :: (a,b) -> a
 292 fst (x,y)               =  x
 293
 294 --{-# GENERATE_SPECS snd a b #-}
 295 snd                     :: (a,b) -> b
 296 snd (x,y)               =  y
 297
 298 -- identity function
 299 --{-# GENERATE_SPECS id a #-}
 300 id                      :: a -> a
 301 id x                    =  x
 302
 303 -- constant function
 304 --{-# GENERATE_SPECS const a b #-}
 305 const                   :: a -> b -> a
 306 const x _               =  x
 307
 308 -- function composition
 309 {-# INLINE (.) #-}
 310 --{-# GENERATE_SPECS (.) a b c #-}
 311 (.)                     :: (b -> c) -> (a -> b) -> a -> c
 312 (f . g) x               =  f (g x)
 313
 314 -- flip f  takes its (first) two arguments in the reverse order of f.
 315 --{-# GENERATE_SPECS flip a b c #-}
 316 flip                    :: (a -> b -> c) -> b -> a -> c
 317 flip f x y              =  f y x
 318
 319 -- right-associating infix application operator (useful in continuation-
 320 -- passing style)
 321 --{-# GENERATE_SPECS ($) a b #-}
 322 ($)                     :: (a -> b) -> a -> b
 323 f $ x                   =  f x
 324
 325 -- until p f  yields the result of applying f until p holds.
 326 --{-# GENERATE_SPECS until a #-}
 327 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 328 until p f x | p x       =  x
 329             | otherwise =  until p f (f x)
 330
 331 -- asTypeOf is a type-restricted version of const.  It is usually used
 332 -- as an infix operator, and its typing forces its first argument
 333 -- (which is usually overloaded) to have the same type as the second.
 334 --{-# GENERATE_SPECS asTypeOf a #-}
 335 asTypeOf                :: a -> a -> a
 336 asTypeOf                =  const
 337
 338 ---------------------------------------------------------------
 339 -- fromIntegral and fromRealFrac with explicit specialisations
 340 ---------------------------------------------------------------
 341
 342 {- LATER:
 343 {-# SPECIALIZE fromIntegral ::
 344     Int#        -> Int#         = id,
 345     Int#        -> Double#      = int2Double#,
 346     Int#        -> Int          = i2I#,
 347     Int#        -> Integer      = int2Integer#,
 348     Int#        -> Double       = i2D#,
 349     Int         -> Int#         = i2i,
 350     Int         -> Double#      = i2d,
 351     Int         -> Int          = id,
 352     Int         -> Integer      = i2Integer,
 353     Int         -> Double       = i2D,
 354     Integer     -> Int#         = integer2i,
 355     Integer     -> Double#      = integer2d,
 356     Integer     -> Int          = integer2I,
 357     Integer     -> Integer      = id,
 358     Integer     -> Double       = integer2D     #-}
 359 -}
 360
 361 {-# SPECIALIZE fromIntegral ::
 362     Int         -> Int          = id,
 363     Int         -> Integer      = i2Integer,
 364     Int         -> Double       = i2D,
 365     Integer     -> Int          = integer2I,
 366     Integer     -> Integer      = id,
 367     Integer     -> Double       = integer2D     #-}
 368
 369 i2I# i# = I# i#
 370 i2D# i# = D# (int2Double# i#)
 371
 372 i2i (I# i#) = i#
 373 i2d (I# i#) = int2Double# i#
 374 i2D (I# i#) = D# (int2Double# i#)
 375 i2Integer (I# i#) = int2Integer# i#
 376
 377 integer2i (J# a# s# d#) = integer2Int# a# s# d#
 378 integer2d (J# a# s# d#) = encodeDouble# a# s# d# 0#
 379 integer2I (J# a# s# d#) = I# (integer2Int# a# s# d#)
 380 integer2F (J# a# s# d#) = F# (encodeFloat# a# s# d# 0#)
 381 integer2D (J# a# s# d#) = D# (encodeDouble# a# s# d# 0#)
 382
 383 fromIntegral    :: (Integral a, Num b) => a -> b
 384 fromIntegral    =  fromInteger . toInteger
 385
 386 {- LATER:
 387 {-# SPECIALIZE fromRealFrac ::
 388     Double#     -> Double#      = id,
 389     Double#     -> Double       = d2D#,
 390     Double      -> Double#      = d2d,
 391     Double      -> Double       = id #-}
 392 -}
 393
 394 {-# SPECIALIZE fromRealFrac ::
 395     Float       -> Float        = id,
 396     Float       -> Double       = f2D,
 397     Double      -> Float        = d2F,
 398     Double      -> Double       = id #-}
 399
 400 d2F# d# = F# (double2Float# d#)
 401 d2D# d# = D# d#
 402
 403 f2d (F# f#) = float2Double# f#
 404 f2D (F# f#) = D# (float2Double# f#)
 405
 406 d2d (D# d#) = d#
 407 d2F (D# d#) = F# (double2Float# d#)
 408
 409 fromRealFrac    :: (RealFrac a, Fractional b) => a -> b
 410 fromRealFrac    =  fromRational . toRational