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.index{PreludeCore}: Index "
 101            ++ show (I# i) ++ " outside the range "
 102            ++ show (I# m,I# n) ++ ".\n")
 103
 104 instance  Ix Int  where
 105     {-# INLINE range #-}
 106     range (m,n)         =  [m..n]
 107     {-# INLINE index #-}
 108     index b@(I# m, I# n) (I# i)
 109         | inRange b (I# i)  =  I# (i -# m)
 110         | otherwise         =  _rangeComplaint_Ix_Int i m n
 111     {-# INLINE inRange #-}
 112     inRange (I# m, I# n) (I# i) =  m <=# i && i <=# n
 113
 114 instance  Enum Int  where
 115 #ifndef USE_FOLDR_BUILD
 116     enumFrom x           =  x : enumFrom (x `plusInt` 1)
 117     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 118 #else
 119     {-# INLINE enumFrom #-}
 120     {-# INLINE enumFromTo #-}
 121     enumFrom x           = _build (\ c _ ->
 122         let g x = x `c` g (x `plusInt` 1) in g x)
 123     enumFromTo x y       = _build (\ c n ->
 124         let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
 125 #endif
 126     enumFromThen m n     =  en' m (n `minusInt` m)
 127                             where en' m n = m : en' (m `plusInt` n) n
 128     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 129                                       (enumFromThen n m)
 130
 131 instance  Text Int  where
 132     readsPrec p x = readSigned readDec x
 133     showsPrec x   = showSigned showInt x
 134     readList = _readList (readsPrec 0)
 135     showList = _showList (showsPrec 0)
 136
 137 ---------------------------------------------------------------
 138 instance _CCallable   Int
 139 instance _CReturnable Int
 140
 141 #if defined(__UNBOXED_INSTANCES__)
 142 ---------------------------------------------------------------
 143 -- Instances for Int#
 144 ---------------------------------------------------------------
 145
 146 instance  Eq Int#  where
 147     (==) x y = eqInt# x y
 148     (/=) x y = neInt# x y
 149
 150 instance  Ord Int#  where
 151     (<=) x y = leInt# x y
 152     (<)  x y = ltInt# x y
 153     (>=) x y = geInt# x y
 154     (>)  x y = gtInt# x y
 155
 156     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 157     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 158
 159     _tagCmp a b
 160       = if      (a `eqInt#` b) then _EQ
 161         else if (a `ltInt#` b) then _LT else _GT
 162
 163 instance  Num Int#  where
 164     (+)    x y = plusInt# x y
 165     (-)    x y = minusInt# x y
 166     negate x   = negateInt# x
 167     (*)    x y = timesInt# x y
 168     abs    n   = if n `geInt#` 0 then n else (negateInt# n)
 169
 170     signum n | n `ltInt#` 0 = negateInt# 1
 171              | n `eqInt#` 0 = 0
 172              | otherwise    = 1
 173
 174     fromInteger (J# a# s# d#)
 175       = integer2Int# a# s# d#
 176
 177     fromInt (I# i#) = i#
 178
 179 instance  Real Int#  where
 180     toRational x        =  toInteger x % 1
 181
 182 instance  Integral Int#  where
 183     a `quotRem` b       =  (a `quotInt#` b, a `remInt#` b)
 184
 185     -- following chks for zero divisor are non-standard (WDP)
 186     a `quot` b          =  if b /= 0
 187                            then a `quotInt#` b
 188                            else error "Integral.Int#.quot{PreludeCore}: divide by 0\n"
 189     a `rem` b           =  if b /= 0
 190                            then a `remInt#` b
 191                            else error "Integral.Int#.rem{PreludeCore}: divide by 0\n"
 192
 193     x `div` y = if x > 0 && y < 0       then quotInt# (x-y-1) y
 194                 else if x < 0 && y > 0  then quotInt# (x-y+1) y
 195                 else quotInt# x y
 196     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 197                     if r/=0 then r+y else 0
 198                 else
 199                     r
 200               where r = remInt# x y
 201
 202     divMod x y = (x `div` y, x `mod` y)
 203
 204     even x = eqInt# (x `mod` 2) 0
 205     odd x  = neInt# (x `mod` 2) 0
 206
 207     toInteger n# = int2Integer# n#  -- give back a full-blown Integer
 208     toInt n#     = I# n#
 209
 210 instance  Ix Int#  where
 211     {-# INLINE range #-}
 212     range (m,n)         =  [m..n]
 213     index b@(m, n) i
 214         | inRange b i   =  I# (i -# m)
 215         | otherwise     =  _rangeComplaint_Ix_Int i m n
 216     inRange (m, n) i    =  m <=# i && i <=# n
 217
 218 instance  Enum Int#  where
 219 #ifndef USE_FOLDR_BUILD
 220     enumFrom x = x : enumFrom (x `plusInt#` 1)
 221     enumFromTo n m = takeWhile (<= m) (enumFrom n)
 222 #else
 223     {-# INLINE enumFromTo #-}
 224     {-# INLINE enumFrom #-}
 225     enumFromTo x y       = _build (\ c n ->
 226         let g x = if x <= y then x `c` g (x +# 1) else n in g x)
 227     enumFrom x           = _build (\ c _ ->
 228         let g x = x `c` g (x +# 1) in g x)
 229 #endif
 230     enumFromThen m n     =  en' m (n `minusInt#` m)
 231                             where en' m n = m : en' (m `plusInt#` n) n
 232     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 233                                       (enumFromThen n m)
 234
 235 -- ToDo: efficient Text Int# instance
 236 instance  Text Int#  where
 237     readsPrec p s = map (\ (I# i#, s) -> (i#, s)) (readsPrec p s)
 238     showsPrec p x = showsPrec p (I# x)
 239     readList = _readList (readsPrec 0)
 240     showList = _showList (showsPrec 0)
 241
 242 instance _CCallable   Int#
 243 instance _CReturnable Int#
 244
 245 #endif {-UNBOXED INSTANCES-}
 246
 247 ---------------------------------------------------------------
 248 -- Instances for Addr Word etc #
 249 ---------------------------------------------------------------
 250
 251 instance _CCallable _Addr
 252 instance _CCallable _Word
 253 instance _CCallable (_StablePtr a)
 254 instance _CCallable _MallocPtr
 255
 256 instance _CReturnable _Addr
 257 instance _CReturnable _Word
 258 instance _CReturnable ()
 259 instance _CReturnable (_StablePtr a)
 260 instance _CReturnable _MallocPtr
 261
 262 ---------------------------------------------------------------
 263 gtAddr  (A# x) (A# y) = gtAddr# x y
 264 geAddr  (A# x) (A# y) = geAddr# x y
 265 eqAddr  (A# x) (A# y) = eqAddr# x y
 266 neAddr  (A# x) (A# y) = neAddr# x y
 267 ltAddr  (A# x) (A# y) = ltAddr# x y
 268 leAddr  (A# x) (A# y) = leAddr# x y
 269
 270 instance  Eq _Addr  where
 271     (==) x y = eqAddr x y
 272     (/=) x y = neAddr x y
 273
 274 instance  Ord _Addr  where
 275     (<=) x y = leAddr x y
 276     (<)  x y = ltAddr x y
 277     (>=) x y = geAddr x y
 278     (>)  x y = gtAddr x y
 279
 280     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 281     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 282
 283     _tagCmp (A# a#) (A# b#)
 284       = if      (eqAddr# a# b#) then _EQ
 285         else if (ltAddr# a# b#) then _LT else _GT
 286
 287 ---------------------------------------------------------------
 288 gtWord  (W# x) (W# y) = gtWord# x y
 289 geWord  (W# x) (W# y) = geWord# x y
 290 eqWord  (W# x) (W# y) = eqWord# x y
 291 neWord  (W# x) (W# y) = neWord# x y
 292 ltWord  (W# x) (W# y) = ltWord# x y
 293 leWord  (W# x) (W# y) = leWord# x y
 294
 295 instance  Eq _Word  where
 296     (==) x y = eqWord x y
 297     (/=) x y = neWord x y
 298
 299 instance  Ord _Word  where
 300     (<=) x y = leWord x y
 301     (<)  x y = ltWord x y
 302     (>=) x y = geWord x y
 303     (>)  x y = gtWord x y
 304
 305     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
 306     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
 307
 308     _tagCmp (W# a#) (W# b#)
 309       = if      (eqWord# a# b#) then _EQ
 310         else if (ltWord# a# b#) then _LT else _GT