home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Int.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  10.8 KB  |  352 lines
  1. -----------------------------------------------------------------------------
  2. -- Signed Integers
  3. -- Suitable for use with Hugs 98 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.     , toInt
  18.     , fromInt
  19.     -- plus Eq, Ord, Num, Bounded, Real, Integral, Ix, Enum, Read,
  20.     --  Show and Bits instances for each of Int8, Int16 and Int32
  21.     ) where
  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 `primAnd` 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.     even          = even      . from
  88.     toInteger     = toInteger . from
  89.     toInt         = toInt     . from
  90.  
  91. instance Ix Int8 where
  92.     range (m,n)          = [m..n]
  93.     index b@(m,n) i
  94.           | inRange b i = from (i - m)
  95.           | otherwise   = error "index: Index out of range"
  96.     inRange (m,n) i      = m <= i && i <= n
  97.  
  98. instance Enum Int8 where
  99.     toEnum         = to 
  100.     fromEnum       = from
  101.     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int8)]
  102.     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int8)]
  103.               where last = if d < c then minBound else maxBound
  104.  
  105. instance Read Int8 where
  106.     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
  107.  
  108. instance Show Int8 where
  109.     showsPrec p = showsPrec p . from
  110.  
  111. binop8 :: (Int32 -> Int32 -> a) -> (Int8 -> Int8 -> a)
  112. binop8 op x y = int8ToInt32 x `op` int8ToInt32 y
  113.  
  114. instance Bits Int8 where
  115.   x .&. y       = int32ToInt8 (binop8 (.&.) x y)
  116.   x .|. y       = int32ToInt8 (binop8 (.|.) x y)
  117.   x `xor` y     = int32ToInt8 (binop8 xor x y)
  118.   complement    = int32ToInt8 . complement . int8ToInt32
  119.   x `shift` i   = int32ToInt8 (int8ToInt32 x `shift` i)
  120. --  rotate      
  121.   bit           = int32ToInt8 . bit
  122.   setBit x i    = int32ToInt8 (setBit (int8ToInt32 x) i)
  123.   clearBit x i  = int32ToInt8 (clearBit (int8ToInt32 x) i)
  124.   complementBit x i = int32ToInt8 (complementBit (int8ToInt32 x) i)
  125.   testBit x i   = testBit (int8ToInt32 x) i
  126.   bitSize  _    = 8
  127.   isSigned _    = True
  128.  
  129. -----------------------------------------------------------------------------
  130. -- Int16
  131. -----------------------------------------------------------------------------
  132.  
  133. newtype Int16  = I16 Int
  134.  
  135. int16ToInt (I16 x) = if x' <= 0x7fff then x' else x' - 0x10000
  136.  where x' = x `primAnd` 0xffff
  137. intToInt16 = I16
  138.  
  139. instance Eq  Int16     where (==)    = binop (==)
  140. instance Ord Int16     where compare = binop compare
  141.  
  142. instance Num Int16 where
  143.     x + y         = to (binop (+) x y)
  144.     x - y         = to (binop (-) x y)
  145.     negate        = to . negate . from
  146.     x * y         = to (binop (*) x y)
  147.     abs           = absReal
  148.     signum        = signumReal
  149.     fromInteger   = to . fromInteger
  150.     fromInt       = to
  151.  
  152. instance Bounded Int16 where
  153.     minBound = 0x8000
  154.     maxBound = 0x7fff 
  155.  
  156. instance Real Int16 where
  157.     toRational x = toInteger x % 1
  158.  
  159. instance Integral Int16 where
  160.     x `div` y     = to  (binop div x y)
  161.     x `quot` y    = to  (binop quot x y)
  162.     x `rem` y     = to  (binop rem x y)
  163.     x `mod` y     = to  (binop mod x y)
  164.     x `quotRem` y = to2 (binop quotRem x y)
  165.     even          = even      . from
  166.     toInteger     = toInteger . from
  167.     toInt         = toInt     . from
  168.  
  169. instance Ix Int16 where
  170.     range (m,n)          = [m..n]
  171.     index b@(m,n) i
  172.           | inRange b i = from (i - m)
  173.           | otherwise   = error "index: Index out of range"
  174.     inRange (m,n) i      = m <= i && i <= n
  175.  
  176. instance Enum Int16 where
  177.     toEnum         = to 
  178.     fromEnum       = from
  179.     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int16)]
  180.     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int16)]
  181.               where last = if d < c then minBound else maxBound
  182.  
  183. instance Read Int16 where
  184.     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
  185.  
  186. instance Show Int16 where
  187.     showsPrec p = showsPrec p . from
  188.  
  189. binop16 :: (Int32 -> Int32 -> a) -> (Int16 -> Int16 -> a)
  190. binop16 op x y = int16ToInt32 x `op` int16ToInt32 y
  191.  
  192. instance Bits Int16 where
  193.   x .&. y       = int32ToInt16 (binop16 (.&.) x y)
  194.   x .|. y       = int32ToInt16 (binop16 (.|.) x y)
  195.   x `xor` y     = int32ToInt16 (binop16 xor x y)
  196.   complement    = int32ToInt16 . complement . int16ToInt32
  197.   x `shift` i   = int32ToInt16 (int16ToInt32 x `shift` i)
  198. --  rotate      
  199.   bit           = int32ToInt16 . bit
  200.   setBit x i    = int32ToInt16 (setBit (int16ToInt32 x) i)
  201.   clearBit x i  = int32ToInt16 (clearBit (int16ToInt32 x) i)
  202.   complementBit x i = int32ToInt16 (complementBit (int16ToInt32 x) i)
  203.   testBit x i   = testBit (int16ToInt32 x) i
  204.   bitSize  _    = 16
  205.   isSigned _    = True
  206.  
  207. -----------------------------------------------------------------------------
  208. -- Int32
  209. -----------------------------------------------------------------------------
  210.  
  211. newtype Int32  = I32 Int
  212.  
  213. int32ToInt (I32 x) = x
  214. intToInt32 = I32
  215.  
  216. instance Eq  Int32     where (==)    = binop (==)
  217. instance Ord Int32     where compare = binop compare
  218.  
  219. instance Num Int32 where
  220.     x + y         = to (binop (+) x y)
  221.     x - y         = to (binop (-) x y)
  222.     negate        = to . negate . from
  223.     x * y         = to (binop (*) x y)
  224.     abs           = absReal
  225.     signum        = signumReal
  226.     fromInteger   = to . fromInteger
  227.     fromInt       = to
  228.  
  229. instance Bounded Int32 where
  230.     minBound = to minBound
  231.     maxBound = to maxBound
  232.  
  233. instance Real Int32 where
  234.     toRational x = toInteger x % 1
  235.  
  236. instance Integral Int32 where
  237.     x `div` y     = to  (binop div x y)
  238.     x `quot` y    = to  (binop quot x y)
  239.     x `rem` y     = to  (binop rem x y)
  240.     x `mod` y     = to  (binop mod x y)
  241.     x `quotRem` y = to2 (binop quotRem x y)
  242.     even          = even      . from
  243.     toInteger     = toInteger . from
  244.     toInt         = toInt     . from
  245.  
  246. instance Ix Int32 where
  247.     range (m,n)          = [m..n]
  248.     index b@(m,n) i
  249.           | inRange b i = from (i - m)
  250.           | otherwise   = error "index: Index out of range"
  251.     inRange (m,n) i      = m <= i && i <= n
  252.  
  253. instance Enum Int32 where
  254.     toEnum         = to 
  255.     fromEnum       = from
  256.     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int32)]
  257.     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int32)]
  258.               where last = if d < c then minBound else maxBound
  259.  
  260. instance Read Int32 where
  261.     readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
  262.  
  263. instance Show Int32 where
  264.     showsPrec p = showsPrec p . from
  265.  
  266. instance Bits Int32 where
  267.   (.&.)           = primAndInt
  268.   (.|.)           = primOrInt
  269.   xor             = primXorInt
  270.   complement      = primComplementInt
  271.   shift           = primShiftInt
  272. --  rotate           
  273.   bit             = primBitInt
  274.   setBit x i    = x .|. bit i
  275.   clearBit x i  = x .&. complement (bit i)
  276.   complementBit x i = x `xor` bit i
  277.   testBit       = primTestInt
  278.   bitSize  _    = 32
  279.   isSigned _    = True
  280.  
  281. -----------------------------------------------------------------------------
  282. -- Int64
  283. --
  284. -- This is not ideal, but does have the advantage that you can 
  285. -- now typecheck generated code that include Int64 statements.
  286. --
  287. -----------------------------------------------------------------------------
  288.  
  289. type Int64 = Integer
  290.  
  291. -----------------------------------------------------------------------------
  292. -- End of exported definitions
  293. --
  294. -- The remainder of this file consists of definitions which are only
  295. -- used in the implementation.
  296. -----------------------------------------------------------------------------
  297.  
  298. -----------------------------------------------------------------------------
  299. -- Coercions - used to make the instance declarations more uniform
  300. -----------------------------------------------------------------------------
  301.  
  302. class Coerce a where
  303.   to   :: Int -> a
  304.   from :: a -> Int
  305.  
  306. instance Coerce Int32 where
  307.   from = int32ToInt
  308.   to   = intToInt32
  309.  
  310. instance Coerce Int8 where
  311.   from = int8ToInt
  312.   to   = intToInt8
  313.  
  314. instance Coerce Int16 where
  315.   from = int16ToInt
  316.   to   = intToInt16
  317.  
  318. binop :: Coerce int => (Int -> Int -> a) -> (int -> int -> a)
  319. binop op x y = from x `op` from y
  320.  
  321. to2 :: Coerce int => (Int, Int) -> (int, int)
  322. to2 (x,y) = (to x, to y)
  323.  
  324. -----------------------------------------------------------------------------
  325. -- Extra primitives
  326. -----------------------------------------------------------------------------
  327.  
  328. primitive primAnd "primAndInt" :: Int -> Int -> Int
  329.  
  330. primitive primAndInt        :: Int32 -> Int32 -> Int32
  331. primitive primOrInt         :: Int32 -> Int32 -> Int32
  332. primitive primXorInt        :: Int32 -> Int32 -> Int32
  333. primitive primComplementInt :: Int32 -> Int32
  334. primitive primShiftInt      :: Int32 -> Int -> Int32
  335. primitive primBitInt        :: Int -> Int32
  336. primitive primTestInt       :: Int32 -> Int -> Bool
  337.  
  338. -----------------------------------------------------------------------------
  339. -- Code copied from the Prelude
  340. -----------------------------------------------------------------------------
  341.  
  342. absReal x    | x >= 0    = x
  343.          | otherwise = -x
  344.  
  345. signumReal x | x == 0    =  0
  346.          | x > 0     =  1
  347.          | otherwise = -1
  348.  
  349. -----------------------------------------------------------------------------
  350. -- End
  351. -----------------------------------------------------------------------------
  352.