ghc/lib/glaExts/Int.lhs

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