ghc/interpreter/library/Int.hs

   1 -----------------------------------------------------------------------------
   2 -- Signed Integers
   3 -- Suitable for use with Hugs 1.4 on 32 bit systems.
   4 -----------------------------------------------------------------------------
   5
   6 module Int
   7         ( Int8
   8         , Int16
   9         , Int32
  10         --, Int64
  11         , int8ToInt  -- :: Int8  -> Int
  12         , intToInt8  -- :: Int   -> Int8
  13         , int16ToInt -- :: Int16 -> Int
  14         , intToInt16 -- :: Int   -> Int16
  15         , int32ToInt -- :: Int32 -> Int
  16         , intToInt32 -- :: Int   -> Int32
  17         -- plus Eq, Ord, Num, Bounded, Real, Integral, Ix, Enum, Read,
  18         --  Show and Bits instances for each of Int8, Int16 and Int32
  19         ) where
  20
  21 import PreludeBuiltin
  22 import Bits
  23
  24 -----------------------------------------------------------------------------
  25 -- The "official" coercion functions
  26 -----------------------------------------------------------------------------
  27
  28 int8ToInt  :: Int8  -> Int
  29 intToInt8  :: Int   -> Int8
  30 int16ToInt :: Int16 -> Int
  31 intToInt16 :: Int   -> Int16
  32 int32ToInt :: Int32 -> Int
  33 intToInt32 :: Int   -> Int32
  34
  35 -- And some non-exported ones
  36
  37 int8ToInt16  :: Int8  -> Int16
  38 int8ToInt32  :: Int8  -> Int32
  39 int16ToInt8  :: Int16 -> Int8
  40 int16ToInt32 :: Int16 -> Int32
  41 int32ToInt8  :: Int32 -> Int8
  42 int32ToInt16 :: Int32 -> Int16
  43
  44 int8ToInt16  = I16 . int8ToInt
  45 int8ToInt32  = I32 . int8ToInt
  46 int16ToInt8  = I8  . int16ToInt
  47 int16ToInt32 = I32 . int16ToInt
  48 int32ToInt8  = I8  . int32ToInt
  49 int32ToInt16 = I16 . int32ToInt
  50
  51 -----------------------------------------------------------------------------
  52 -- Int8
  53 -----------------------------------------------------------------------------
  54
  55 newtype Int8  = I8 Int
  56
  57 int8ToInt (I8 x) = if x' <= 0x7f then x' else x' - 0x100
  58  where x' = x `primAndInt` 0xff
  59 intToInt8 = I8
  60
  61 instance Eq  Int8     where (==)    = binop (==)
  62 instance Ord Int8     where compare = binop compare
  63
  64 instance Num Int8 where
  65     x + y         = to (binop (+) x y)
  66     x - y         = to (binop (-) x y)
  67     negate        = to . negate . from
  68     x * y         = to (binop (*) x y)
  69     abs           = absReal
  70     signum        = signumReal
  71     fromInteger   = to . fromInteger
  72     fromInt       = to
  73
  74 instance Bounded Int8 where
  75     minBound = 0x80
  76     maxBound = 0x7f
  77
  78 instance Real Int8 where
  79     toRational x = toInteger x % 1
  80
  81 instance Integral Int8 where
  82     x `div` y     = to  (binop div x y)
  83     x `quot` y    = to  (binop quot x y)
  84     x `rem` y     = to  (binop rem x y)
  85     x `mod` y     = to  (binop mod x y)
  86     x `quotRem` y = to2 (binop quotRem x y)
  87     toInteger     = toInteger . from
  88     toInt         = toInt     . from
  89
  90 instance Ix Int8 where
  91     range (m,n)          = [m..n]
  92     index b@(m,n) i
  93               | inRange b i = from (i - m)
  94               | otherwise   = error "index: Index out of range"
  95     inRange (m,n) i      = m <= i && i <= n
  96
  97 instance Enum Int8 where
  98     toEnum         = to
  99     fromEnum       = from
 100     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int8)]
 101     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int8)]
 102                           where last = if d < c then minBound else maxBound
 103
 104 instance Read Int8 where
 105     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
 106
 107 instance Show Int8 where
 108     showsPrec p = showsPrec p . from
 109
 110 binop8 :: (Int32 -> Int32 -> a) -> (Int8 -> Int8 -> a)
 111 binop8 op x y = int8ToInt32 x `op` int8ToInt32 y
 112
 113 instance Bits Int8 where
 114   x .&. y       = int32ToInt8 (binop8 (.&.) x y)
 115   x .|. y       = int32ToInt8 (binop8 (.|.) x y)
 116   x `xor` y     = int32ToInt8 (binop8 xor x y)
 117   complement    = int32ToInt8 . complement . int8ToInt32
 118   x `shift` i   = int32ToInt8 (int8ToInt32 x `shift` i)
 119 --  rotate
 120   bit           = int32ToInt8 . bit
 121   setBit x i    = int32ToInt8 (setBit (int8ToInt32 x) i)
 122   clearBit x i  = int32ToInt8 (clearBit (int8ToInt32 x) i)
 123   complementBit x i = int32ToInt8 (complementBit (int8ToInt32 x) i)
 124   testBit x i   = testBit (int8ToInt32 x) i
 125   bitSize  _    = 8
 126   isSigned _    = True
 127
 128 -----------------------------------------------------------------------------
 129 -- Int16
 130 -----------------------------------------------------------------------------
 131
 132 newtype Int16  = I16 Int
 133
 134 int16ToInt (I16 x) = if x' <= 0x7fff then x' else x' - 0x10000
 135  where x' = x `primAndInt` 0xffff
 136 intToInt16 = I16
 137
 138 instance Eq  Int16     where (==)    = binop (==)
 139 instance Ord Int16     where compare = binop compare
 140
 141 instance Num Int16 where
 142     x + y         = to (binop (+) x y)
 143     x - y         = to (binop (-) x y)
 144     negate        = to . negate . from
 145     x * y         = to (binop (*) x y)
 146     abs           = absReal
 147     signum        = signumReal
 148     fromInteger   = to . fromInteger
 149     fromInt       = to
 150
 151 instance Bounded Int16 where
 152     minBound = 0x8000
 153     maxBound = 0x7fff
 154
 155 instance Real Int16 where
 156     toRational x = toInteger x % 1
 157
 158 instance Integral Int16 where
 159     x `div` y     = to  (binop div x y)
 160     x `quot` y    = to  (binop quot x y)
 161     x `rem` y     = to  (binop rem x y)
 162     x `mod` y     = to  (binop mod x y)
 163     x `quotRem` y = to2 (binop quotRem x y)
 164     toInteger     = toInteger . from
 165     toInt         = toInt     . from
 166
 167 instance Ix Int16 where
 168     range (m,n)          = [m..n]
 169     index b@(m,n) i
 170               | inRange b i = from (i - m)
 171               | otherwise   = error "index: Index out of range"
 172     inRange (m,n) i      = m <= i && i <= n
 173
 174 instance Enum Int16 where
 175     toEnum         = to
 176     fromEnum       = from
 177     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int16)]
 178     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int16)]
 179                           where last = if d < c then minBound else maxBound
 180
 181 instance Read Int16 where
 182     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
 183
 184 instance Show Int16 where
 185     showsPrec p = showsPrec p . from
 186
 187 binop16 :: (Int32 -> Int32 -> a) -> (Int16 -> Int16 -> a)
 188 binop16 op x y = int16ToInt32 x `op` int16ToInt32 y
 189
 190 instance Bits Int16 where
 191   x .&. y       = int32ToInt16 (binop16 (.&.) x y)
 192   x .|. y       = int32ToInt16 (binop16 (.|.) x y)
 193   x `xor` y     = int32ToInt16 (binop16 xor x y)
 194   complement    = int32ToInt16 . complement . int16ToInt32
 195   x `shift` i   = int32ToInt16 (int16ToInt32 x `shift` i)
 196 --  rotate
 197   bit           = int32ToInt16 . bit
 198   setBit x i    = int32ToInt16 (setBit (int16ToInt32 x) i)
 199   clearBit x i  = int32ToInt16 (clearBit (int16ToInt32 x) i)
 200   complementBit x i = int32ToInt16 (complementBit (int16ToInt32 x) i)
 201   testBit x i   = testBit (int16ToInt32 x) i
 202   bitSize  _    = 16
 203   isSigned _    = True
 204
 205 -----------------------------------------------------------------------------
 206 -- Int32
 207 -----------------------------------------------------------------------------
 208
 209 newtype Int32  = I32 Int
 210
 211 int32ToInt (I32 x) = x
 212 intToInt32 = I32
 213
 214 instance Eq  Int32     where (==)    = binop (==)
 215 instance Ord Int32     where compare = binop compare
 216
 217 instance Num Int32 where
 218     x + y         = to (binop (+) x y)
 219     x - y         = to (binop (-) x y)
 220     negate        = to . negate . from
 221     x * y         = to (binop (*) x y)
 222     abs           = absReal
 223     signum        = signumReal
 224     fromInteger   = to . fromInteger
 225     fromInt       = to
 226
 227 instance Bounded Int32 where
 228     minBound = to minBound
 229     maxBound = to maxBound
 230
 231 instance Real Int32 where
 232     toRational x = toInteger x % 1
 233
 234 instance Integral Int32 where
 235     x `div` y     = to  (binop div x y)
 236     x `quot` y    = to  (binop quot x y)
 237     x `rem` y     = to  (binop rem x y)
 238     x `mod` y     = to  (binop mod x y)
 239     x `quotRem` y = to2 (binop quotRem x y)
 240     toInteger     = toInteger . from
 241     toInt         = toInt     . from
 242
 243 instance Ix Int32 where
 244     range (m,n)          = [m..n]
 245     index b@(m,n) i
 246               | inRange b i = from (i - m)
 247               | otherwise   = error "index: Index out of range"
 248     inRange (m,n) i      = m <= i && i <= n
 249
 250 instance Enum Int32 where
 251     toEnum         = to
 252     fromEnum       = from
 253     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int32)]
 254     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int32)]
 255                           where last = if d < c then minBound else maxBound
 256
 257 instance Read Int32 where
 258     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
 259
 260 instance Show Int32 where
 261     showsPrec p = showsPrec p . from
 262
 263 instance Bits Int32 where
 264   (.&.)         = lift2 primAndInt
 265   (.|.)         = lift2 primOrInt
 266   xor           = lift2 primXorInt
 267   complement    = lift1 primNotInt
 268   shift x n
 269     | n >= 0    = to (primShiftLInt  (from x) (primIntToWord n))
 270     | otherwise = to (primShiftRLInt (from x) (primIntToWord (-n)))
 271 --  rotate
 272   bit           = shift 1
 273   setBit        x i = x .|. bit i
 274   clearBit      x i = x .&. complement (bit i)
 275   complementBit x i = x `xor` bit i
 276   testBit       x i = x .&. bit i /= 0
 277   bitSize  _    = 32
 278   isSigned _    = True
 279
 280 -----------------------------------------------------------------------------
 281 -- End of exported definitions
 282 --
 283 -- The remainder of this file consists of definitions which are only
 284 -- used in the implementation.
 285 -----------------------------------------------------------------------------
 286
 287 -----------------------------------------------------------------------------
 288 -- Coercions - used to make the instance declarations more uniform
 289 -----------------------------------------------------------------------------
 290
 291 class Coerce a where
 292   to   :: Int -> a
 293   from :: a -> Int
 294
 295 instance Coerce Int32 where
 296   from = int32ToInt
 297   to   = intToInt32
 298
 299 instance Coerce Int8 where
 300   from = int8ToInt
 301   to   = intToInt8
 302
 303 instance Coerce Int16 where
 304   from = int16ToInt
 305   to   = intToInt16
 306
 307 binop :: Coerce int => (Int -> Int -> a) -> (int -> int -> a)
 308 binop op x y = from x `op` from y
 309
 310 to2 :: Coerce int => (Int, Int) -> (int, int)
 311 to2 (x,y) = (to x, to y)
 312
 313 lift1 :: Coerce int => (Int -> Int) -> (int -> int)
 314 lift1 f x = to (f (from x))
 315
 316 lift2 :: Coerce int => (Int -> Int -> Int) -> (int -> int -> int)
 317 lift2 f x y = to (f (from x) (from y))
 318
 319 -----------------------------------------------------------------------------
 320 -- Code copied from the Prelude
 321 -----------------------------------------------------------------------------
 322
 323 absReal x    | x >= 0    = x
 324              | otherwise = -x
 325
 326 signumReal x | x == 0    =  0
 327              | x > 0     =  1
 328              | otherwise = -1
 329
 330 -----------------------------------------------------------------------------
 331 -- End
 332 -----------------------------------------------------------------------------