ghc/lib/prelude/IInt.hs

   1 module PreludeCore ( Int(..), rangeComplaint_Ix_Int#{-see comment later-} ) where
   2
   3 import Cls
   4 import Core
   5 import IInteger         -- instances
   6 import IRatio           ( (%) )
   7 import ITup2
   8 import List             ( (++), foldr )
   9 import Prel             ( otherwise, (&&), (||), chr, ord )
  10 import PS               ( _PackedString, _unpackPS )
  11 import Text
  12
  13 -- definitions of the boxed PrimOps; these will be
  14 -- used in the case of partial applications, etc.
  15
  16 plusInt (I# x) (I# y) = I# (plusInt# x y)
  17 minusInt(I# x) (I# y) = I# (minusInt# x y)
  18 timesInt(I# x) (I# y) = I# (timesInt# x y)
  19 quotInt (I# x) (I# y) = I# (quotInt# x y)
  20 remInt  (I# x) (I# y) = I# (remInt# x y)
  21 negateInt (I# x)      = I# (negateInt# x)
  22 gtInt   (I# x) (I# y) = gtInt# x y
  23 geInt   (I# x) (I# y) = geInt# x y
  24 eqInt   (I# x) (I# y) = eqInt# x y
  25 neInt   (I# x) (I# y) = neInt# x y
  26 ltInt   (I# x) (I# y) = ltInt# x y
  27 leInt   (I# x) (I# y) = leInt# x y
  28
  29 ---------------------------------------------------------------
  30
  31 instance  Eq Int  where
  32     (==) x y = eqInt x y
  33     (/=) x y = neInt x y
  34
  35 instance  Ord Int  where
  36     (<=) x y = leInt x y
  37     (<)  x y = ltInt x y
  38     (>=) x y = geInt x y
  39     (>)  x y = gtInt x y
  40
  41     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
  42     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
  43
  44     _tagCmp (I# a#) (I# b#)
  45       = if      (a# ==# b#) then _EQ
  46         else if (a#  <# b#) then _LT else _GT
  47
  48 instance  Num Int  where
  49     (+)    x y =  plusInt x y
  50     (-)    x y =  minusInt x y
  51     negate x   =  negateInt x
  52     (*)    x y =  timesInt x y
  53     abs    n   = if n `geInt` 0 then n else (negateInt n)
  54
  55     signum n | n `ltInt` 0 = negateInt 1
  56              | n `eqInt` 0 = 0
  57              | otherwise   = 1
  58
  59     fromInteger (J# a# s# d#)
  60       = case (integer2Int# a# s# d#) of { i# -> I# i# }
  61
  62     fromInt n           = n
  63
  64 instance  Real Int  where
  65     toRational x        =  toInteger x % 1
  66
  67 instance  Integral Int  where
  68     a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
  69     -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
  70
  71     -- following chks for zero divisor are non-standard (WDP)
  72     a `quot` b          =  if b /= 0
  73                            then a `quotInt` b
  74                            else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
  75     a `rem` b           =  if b /= 0
  76                            then a `remInt` b
  77                            else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
  78
  79     x `div` y = if x > 0 && y < 0       then quotInt (x-y-1) y
  80                 else if x < 0 && y > 0  then quotInt (x-y+1) y
  81                 else quotInt x y
  82     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
  83                     if r/=0 then r+y else 0
  84                 else
  85                     r
  86               where r = remInt x y
  87
  88     divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
  89     -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
  90
  91     even x = eqInt (x `mod` 2) 0
  92     odd x  = neInt (x `mod` 2) 0
  93
  94     toInteger (I# n#) = int2Integer# n#  -- give back a full-blown Integer
  95     toInt x           = x
  96
  97 rangeComplaint_Ix_Int# i m n -- export it so it will *not* be floated inwards
  98   = error ("Ix.Int.index2{PreludeCore}: Index "
  99            ++ show (I# i) ++ " outside the range "
 100            ++ show (I# m,I# n) ++ ".\n")
 101
 102 instance  Ix Int  where
 103     range (m,n)         =  [m..n]
 104     index b@(I# m, I# n) (I# i)
 105         | inRange b (I# i)  =  I# (i -# m)
 106         | otherwise         =  rangeComplaint_Ix_Int# i m n
 107     inRange (I# m, I# n) (I# i) =  m <=# i && i <=# n
 108
 109 instance  Enum Int  where
 110 {- RAW PRELUDE ************************
 111     enumFrom            =  numericEnumFrom
 112     enumFromThen        =  numericEnumFromThen
 113 -}
 114 #ifndef USE_FOLDR_BUILD
 115     enumFrom x = x : enumFrom (x `plusInt` 1)
 116 #else
 117     {-# INLINE enumFromTo #-}
 118     {-# INLINE enumFrom #-}
 119     enumFromTo x y       = _build (\ c n ->
 120         let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
 121     enumFrom x           = _build (\ c _ ->
 122         let g x = x `c` g (x `plusInt` 1) in g x)
 123 #endif
 124     enumFromThen m n = en' m (n `minusInt` m)
 125             where en' m n = m : en' (m `plusInt` n) n
 126
 127 instance  Text Int  where
 128     readsPrec p x = readSigned readDec x
 129     showsPrec x   = showSigned showInt x
 130
 131 ---------------------------------------------------------------
 132 instance _CCallable   Int
 133 instance _CReturnable Int
 134
 135 #if defined(__UNBOXED_INSTANCES__)
 136 ---------------------------------------------------------------
 137 -- Instances for Int#
 138 ---------------------------------------------------------------
 139
 140 instance  Eq Int#  where
 141     (==) x y = eqInt# x y
 142     (/=) x y = neInt# x y
 143
 144 instance  Ord Int#  where
 145     (<=) x y = leInt# x y
 146     (<)  x y = ltInt# x y
 147     (>=) x y = geInt# x y
 148     (>)  x y = gtInt# x y
 149
 150     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 151     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 152
 153     _tagCmp a b
 154       = if      (a `eqInt#` b) then _EQ
 155         else if (a `ltInt#` b) then _LT else _GT
 156
 157 instance  Num Int#  where
 158     (+)    x y = plusInt# x y
 159     (-)    x y = minusInt# x y
 160     negate x   = negateInt# x
 161     (*)    x y = timesInt# x y
 162     abs    n   = if n `geInt#` 0 then n else (negateInt# n)
 163
 164     signum n | n `ltInt#` 0 = negateInt# 1
 165              | n `eqInt#` 0 = 0
 166              | otherwise    = 1
 167
 168     fromInteger (J# a# s# d#)
 169       = integer2Int# a# s# d#
 170
 171     fromInt (I# i#) = i#
 172
 173 instance  Real Int#  where
 174     toRational x        =  toInteger x % 1
 175
 176 instance  Integral Int#  where
 177     a `quotRem` b       =  (a `quotInt#` b, a `remInt#` b)
 178
 179     -- following chks for zero divisor are non-standard (WDP)
 180     a `quot` b          =  if b /= 0
 181                            then a `quotInt#` b
 182                            else error "Integral.Int#.quot{PreludeCore}: divide by 0\n"
 183     a `rem` b           =  if b /= 0
 184                            then a `remInt#` b
 185                            else error "Integral.Int#.rem{PreludeCore}: divide by 0\n"
 186
 187     x `div` y = if x > 0 && y < 0       then quotInt# (x-y-1) y
 188                 else if x < 0 && y > 0  then quotInt# (x-y+1) y
 189                 else quotInt# x y
 190     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 191                     if r/=0 then r+y else 0
 192                 else
 193                     r
 194               where r = remInt# x y
 195
 196     divMod x y = (x `div` y, x `mod` y)
 197
 198     even x = eqInt# (x `mod` 2) 0
 199     odd x  = neInt# (x `mod` 2) 0
 200
 201     toInteger n# = int2Integer# n#  -- give back a full-blown Integer
 202     toInt n#     = I# n#
 203
 204 instance  Ix Int#  where
 205     range (m,n)         =  [m..n]
 206     index b@(m, n) i
 207         | inRange b i   =  I# (i -# m)
 208         | otherwise     =  rangeComplaint_Ix_Int# i m n
 209     inRange (m, n) i    =  m <=# i && i <=# n
 210
 211 instance  Enum Int#  where
 212     enumFrom x           =  x : enumFrom (x `plusInt#` 1)
 213     enumFromThen m n     =  en' m (n `minusInt#` m)
 214                             where en' m n = m : en' (m `plusInt#` n) n
 215     -- default methods not specialised!
 216     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 217     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 218                                       (enumFromThen n m)
 219
 220 -- ToDo: efficient Text Int# instance
 221 instance  Text Int#  where
 222     readsPrec p s = map (\ (I# i#, s) -> (i#, s)) (readsPrec p s)
 223     showsPrec p x = showsPrec p (I# x)
 224     readList s = map (\ (x, s) -> (map (\ (I# i#) -> i#) x, s)) (readList s)
 225     showList l = showList (map I# l)
 226
 227 instance _CCallable   Int#
 228 instance _CReturnable Int#
 229
 230 #endif {-UNBOXED INSTANCES-}
 231
 232 ---------------------------------------------------------------
 233 -- Instances for Addr Word etc #
 234 ---------------------------------------------------------------
 235
 236 instance _CCallable _Addr
 237 instance _CCallable _Word
 238 instance _CCallable _MallocPtr
 239
 240 instance _CReturnable _Addr
 241 instance _CReturnable _Word
 242 instance _CReturnable ()
 243 instance _CReturnable _MallocPtr
 244
 245 #ifndef __PARALLEL_HASKELL__
 246 instance _CCallable (_StablePtr a)
 247 instance _CReturnable (_StablePtr a)
 248 #endif
 249
 250 ---------------------------------------------------------------
 251 gtAddr  (A# x) (A# y) = gtAddr# x y
 252 geAddr  (A# x) (A# y) = geAddr# x y
 253 eqAddr  (A# x) (A# y) = eqAddr# x y
 254 neAddr  (A# x) (A# y) = neAddr# x y
 255 ltAddr  (A# x) (A# y) = ltAddr# x y
 256 leAddr  (A# x) (A# y) = leAddr# x y
 257
 258 instance  Eq _Addr  where
 259     (==) x y = eqAddr x y
 260     (/=) x y = neAddr x y
 261
 262 instance  Ord _Addr  where
 263     (<=) x y = leAddr x y
 264     (<)  x y = ltAddr x y
 265     (>=) x y = geAddr x y
 266     (>)  x y = gtAddr x y
 267
 268     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 269     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 270
 271     _tagCmp (A# a#) (A# b#)
 272       = if      (eqAddr# a# b#) then _EQ
 273         else if (ltAddr# a# b#) then _LT else _GT
 274
 275 ---------------------------------------------------------------
 276 gtWord  (W# x) (W# y) = gtWord# x y
 277 geWord  (W# x) (W# y) = geWord# x y
 278 eqWord  (W# x) (W# y) = eqWord# x y
 279 neWord  (W# x) (W# y) = neWord# x y
 280 ltWord  (W# x) (W# y) = ltWord# x y
 281 leWord  (W# x) (W# y) = leWord# x y
 282
 283 instance  Eq _Word  where
 284     (==) x y = eqWord x y
 285     (/=) x y = neWord x y
 286
 287 instance  Ord _Word  where
 288     (<=) x y = leWord x y
 289     (<)  x y = ltWord x y
 290     (>=) x y = geWord x y
 291     (>)  x y = gtWord x y
 292
 293     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 294     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 295
 296     _tagCmp (W# a#) (W# b#)
 297       = if      (eqWord# a# b#) then _EQ
 298         else if (ltWord# a# b#) then _LT else _GT