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