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