home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Word.hs < prev   
Encoding:
Text File  |  2000-09-21  |  12.2 KB  |  377 lines
  1. -----------------------------------------------------------------------------
  2. -- Unsigned Integers
  3. -- Suitable for use with Hugs 98 on 32 bit systems.
  4. -----------------------------------------------------------------------------
  5. module Word
  6.     ( Word8
  7.     , Word16
  8.     , Word32
  9.     , Word64
  10.     , word8ToWord32  -- :: Word8  -> Word32
  11.     , word32ToWord8  -- :: Word32 -> Word8
  12.     , word16ToWord32 -- :: Word16 -> Word32
  13.     , word32ToWord16 -- :: Word32 -> Word16
  14.     , word8ToInt     -- :: Word8  -> Int
  15.     , intToWord8     -- :: Int    -> Word8
  16.     , word16ToInt    -- :: Word16 -> Int
  17.     , intToWord16    -- :: Int    -> Word16
  18.     , word32ToInt    -- :: Word32 -> Int
  19.     , intToWord32    -- :: Int    -> Word32
  20.     ) where
  21. import Bits
  22. import Int
  23.  
  24. -----------------------------------------------------------------------------
  25. -- The "official" coercion functions
  26. -----------------------------------------------------------------------------
  27.  
  28. word8ToWord32  :: Word8  -> Word32
  29. word32ToWord8  :: Word32 -> Word8
  30. word16ToWord32 :: Word16 -> Word32
  31. word32ToWord16 :: Word32 -> Word16
  32.  
  33. word8ToInt   :: Word8  -> Int
  34. intToWord8   :: Int    -> Word8
  35. word16ToInt  :: Word16 -> Int
  36. intToWord16  :: Int    -> Word16
  37.  
  38. word8ToInt  = word32ToInt    . word8ToWord32
  39. intToWord8  = word32ToWord8  . intToWord32
  40. word16ToInt = word32ToInt    . word16ToWord32
  41. intToWord16 = word32ToWord16 . intToWord32
  42.  
  43. primitive intToWord32 "intToWord" :: Int    -> Word32
  44. primitive word32ToInt "wordToInt" :: Word32 -> Int
  45.  
  46. -----------------------------------------------------------------------------
  47. -- Word8
  48. -----------------------------------------------------------------------------
  49.  
  50. newtype Word8  = W8 Word32
  51.  
  52. word8ToWord32 (W8 x) = x .&. 0xff
  53. word32ToWord8 = W8
  54.  
  55. instance Eq  Word8     where (==)    = binop (==)
  56. instance Ord Word8     where compare = binop compare
  57.  
  58. instance Num Word8 where
  59.     x + y         = to (binop (+) x y)
  60.     x - y         = to (binop (-) x y)
  61.     negate        = to . negate . from
  62.     x * y         = to (binop (*) x y)
  63.     abs           = absReal
  64.     signum        = signumReal
  65.     fromInteger   = to . primIntegerToWord
  66.     fromInt       = intToWord8
  67.  
  68. instance Bounded Word8 where
  69.     minBound = 0
  70.     maxBound = 0xff
  71.  
  72. instance Real Word8 where
  73.     toRational x = toInteger x % 1
  74.  
  75. instance Integral Word8 where
  76.     x `div` y     = to  (binop div x y)
  77.     x `quot` y    = to  (binop quot x y)
  78.     x `rem` y     = to  (binop rem x y)
  79.     x `mod` y     = to  (binop mod x y)
  80.     x `quotRem` y = to2 (binop quotRem x y)
  81.     divMod        = quotRem
  82.     even          = even      . from
  83.     toInteger     = toInteger . from
  84.     toInt         = word8ToInt
  85.  
  86. instance Ix Word8 where
  87.     range (m,n)          = [m..n]
  88.     index b@(m,n) i
  89.        | inRange b i = word32ToInt (from (i - m))
  90.        | otherwise   = error "index: Index out of range"
  91.     inRange (m,n) i      = m <= i && i <= n
  92.  
  93. instance Enum Word8 where
  94.     toEnum         = to . intToWord32
  95.     fromEnum       = word32ToInt . from
  96.     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
  97.     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
  98.                where last = if d < c then minBound else maxBound
  99.  
  100. instance Read Word8 where
  101.     readsPrec p = readDec
  102.  
  103. instance Show Word8 where
  104.     showsPrec p = showInt  -- a particularily counterintuitive name!
  105.  
  106. instance Bits Word8 where
  107.   x .&. y       = to (binop (.&.) x y)
  108.   x .|. y       = to (binop (.|.) x y)
  109.   x `xor` y     = to (binop xor x y)
  110.   complement    = to . complement . from
  111.   x `shift` i   = to (from x `shift` i)
  112. --  rotate      
  113.   bit           = to . bit
  114.   setBit x i    = to (setBit (from x) i)
  115.   clearBit x i  = to (clearBit (from x) i)
  116.   complementBit x i = to (complementBit (from x) i)
  117.   testBit x i   = testBit (from x) i
  118.   bitSize  _    = 8
  119.   isSigned _    = False
  120.  
  121. -----------------------------------------------------------------------------
  122. -- Word16
  123. -----------------------------------------------------------------------------
  124.  
  125. newtype Word16 = W16 Word32
  126.  
  127. word16ToWord32 (W16 x) = x .&. 0xffff
  128. word32ToWord16 = W16
  129.  
  130. instance Eq  Word16     where (==)    = binop (==)
  131. instance Ord Word16     where compare = binop compare
  132.  
  133. instance Num Word16 where
  134.     x + y         = to (binop (+) x y)
  135.     x - y         = to (binop (-) x y)
  136.     negate        = to . negate . from
  137.     x * y         = to (binop (*) x y)
  138.     abs           = absReal
  139.     signum        = signumReal
  140.     fromInteger   = to . primIntegerToWord
  141.     fromInt       = intToWord16
  142.  
  143. instance Bounded Word16 where
  144.     minBound = 0
  145.     maxBound = 0xffff
  146.  
  147. instance Real Word16 where
  148.   toRational x = toInteger x % 1
  149.  
  150. instance Integral Word16 where
  151.   x `div` y     = to  (binop div x y)
  152.   x `quot` y    = to  (binop quot x y)
  153.   x `rem` y     = to  (binop rem x y)
  154.   x `mod` y     = to  (binop mod x y)
  155.   x `quotRem` y = to2 (binop quotRem x y)
  156.   divMod        = quotRem
  157.   even          = even      . from
  158.   toInteger     = toInteger . from
  159.   toInt         = word16ToInt
  160.  
  161. instance Ix Word16 where
  162.   range (m,n)          = [m..n]
  163.   index b@(m,n) i
  164.          | inRange b i = word32ToInt (from (i - m))
  165.          | otherwise   = error "index: Index out of range"
  166.   inRange (m,n) i      = m <= i && i <= n
  167.  
  168. instance Enum Word16 where
  169.   toEnum         = to . intToWord32
  170.   fromEnum       = word32ToInt . from
  171.   enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
  172.   enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
  173.                where last = if d < c then minBound else maxBound
  174.  
  175. instance Read Word16 where
  176.   readsPrec p = readDec
  177.  
  178. instance Show Word16 where
  179.   showsPrec p = showInt  -- a particularily counterintuitive name!
  180.  
  181. instance Bits Word16 where
  182.   x .&. y       = to (binop (.&.) x y)
  183.   x .|. y       = to (binop (.|.) x y)
  184.   x `xor` y     = to (binop xor x y)
  185.   complement    = to . complement . from
  186.   x `shift` i   = to (from x `shift` i)
  187. --  rotate      
  188.   bit           = to . bit
  189.   setBit x i    = to (setBit (from x) i)
  190.   clearBit x i  = to (clearBit (from x) i)
  191.   complementBit x i = to (complementBit (from x) i)
  192.   testBit x i   = testBit (from x) i
  193.   bitSize  _    = 16
  194.   isSigned _    = False
  195.  
  196. -----------------------------------------------------------------------------
  197. -- Word32
  198. -----------------------------------------------------------------------------
  199.  
  200. data Word32     -- builtin datatype of 32 bit naturals
  201.  
  202. instance Eq  Word32     where (==)    = primEqWord
  203. instance Ord Word32     where compare = primCmpWord
  204.  
  205. instance Num Word32 where
  206.     (+)           = primPlusWord
  207.     (-)           = primMinusWord
  208.     negate        = primNegateWord
  209.     (*)           = primMulWord
  210.     abs           = absReal
  211.     signum        = signumReal
  212.     fromInteger   = primIntegerToWord
  213.     fromInt       = intToWord32
  214.  
  215. instance Bounded Word32 where
  216.     minBound = 0
  217.     maxBound = primMaxWord
  218.  
  219. instance Real Word32 where
  220.     toRational x = toInteger x % 1
  221.  
  222. instance Integral Word32 where
  223.     div       = primDivWord
  224.     quot      = primQuotWord
  225.     rem       = primRemWord
  226.     mod       = primModWord
  227.     quotRem   = primQrmWord
  228.     divMod    = quotRem
  229.     even      = primEvenWord
  230.     toInteger = primWordToInteger
  231.     toInt     = word32ToInt 
  232.  
  233. instance Ix Word32 where
  234.     range (m,n)          = [m..n]
  235.     index b@(m,n) i
  236.        | inRange b i = word32ToInt (i - m)
  237.        | otherwise   = error "index: Index out of range"
  238.     inRange (m,n) i      = m <= i && i <= n
  239.  
  240. instance Enum Word32 where
  241.     toEnum        = intToWord32
  242.     fromEnum      = word32ToInt
  243.  
  244.     --No: suffers from overflow problems: 
  245.     --   [4294967295 .. 1] :: [Word32]
  246.     --   = [4294967295,0,1]
  247.     --enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word32)]
  248.     --enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word32)]
  249.     --                    where last = if d < c then minBound else maxBound
  250.  
  251.     enumFrom       = numericEnumFrom
  252.     enumFromTo     = numericEnumFromTo
  253.     enumFromThen   = numericEnumFromThen
  254.     enumFromThenTo = numericEnumFromThenTo
  255.  
  256. instance Read Word32 where
  257.     readsPrec p = readDec
  258.  
  259. instance Show Word32 where
  260.     showsPrec p = showInt  -- a particularily counterintuitive name!
  261.  
  262. instance Bits Word32 where
  263.   (.&.)         = primAndWord
  264.   (.|.)         = primOrWord
  265.   xor           = primXorWord
  266.   complement    = primComplementWord
  267.   shift         = primShiftWord
  268. --  rotate      
  269.   bit           = primBitWord
  270.   setBit x i    = x .|. bit i
  271.   clearBit x i  = x .&. complement (bit i)
  272.   complementBit x i = x `xor` bit i
  273.   testBit       = primTestWord
  274.   bitSize  _    = 32
  275.   isSigned _    = False
  276.  
  277. -----------------------------------------------------------------------------
  278. -- Word64
  279. -----------------------------------------------------------------------------
  280.  
  281. data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
  282.  
  283. w64ToInteger W64{lo=lo,hi=hi} = toInteger lo + 0x100000000 * toInteger hi 
  284. integerToW64 x = case x `quotRem` 0x100000000 of 
  285.                  (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
  286.  
  287. instance Show Word64 where
  288.   showsPrec p = showInt . w64ToInteger
  289.  
  290. instance Read Word64 where
  291.   readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
  292.  
  293. -----------------------------------------------------------------------------
  294. -- End of exported definitions
  295. --
  296. -- The remainder of this file consists of definitions which are only
  297. -- used in the implementation.
  298. -----------------------------------------------------------------------------
  299.  
  300. -----------------------------------------------------------------------------
  301. -- Enumeration code: copied from Prelude
  302. -----------------------------------------------------------------------------
  303.  
  304. numericEnumFrom        :: Real a => a -> [a]
  305. numericEnumFromThen    :: Real a => a -> a -> [a]
  306. numericEnumFromTo      :: Real a => a -> a -> [a]
  307. numericEnumFromThenTo  :: Real a => a -> a -> a -> [a]
  308. numericEnumFrom n            = n : (numericEnumFrom $! (n+1))
  309. numericEnumFromThen n m      = iterate ((m-n)+) n
  310. numericEnumFromTo n m        = takeWhile (<= m) (numericEnumFrom n)
  311. numericEnumFromThenTo n n' m = takeWhile (if n' >= n then (<= m) else (>= m))
  312.                                          (numericEnumFromThen n n')
  313.  
  314. -----------------------------------------------------------------------------
  315. -- Coercions - used to make the instance declarations more uniform
  316. -----------------------------------------------------------------------------
  317.  
  318. class Coerce a where
  319.   to   :: Word32 -> a
  320.   from :: a -> Word32
  321.  
  322. instance Coerce Word8 where
  323.   from = word8ToWord32
  324.   to   = word32ToWord8
  325.  
  326. instance Coerce Word16 where
  327.   from = word16ToWord32
  328.   to   = word32ToWord16
  329.  
  330. binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
  331. binop op x y = from x `op` from y
  332.  
  333. to2 :: Coerce word => (Word32, Word32) -> (word, word)
  334. to2 (x,y) = (to x, to y)
  335.  
  336. -----------------------------------------------------------------------------
  337. -- primitives
  338. -----------------------------------------------------------------------------
  339.  
  340. primitive primEqWord        :: Word32 -> Word32 -> Bool
  341. primitive primCmpWord       :: Word32 -> Word32 -> Ordering
  342. primitive primPlusWord,
  343.       primMinusWord,
  344.       primMulWord        :: Word32 -> Word32 -> Word32
  345. primitive primNegateWord    :: Word32 -> Word32
  346. primitive primIntegerToWord :: Integer -> Word32
  347. primitive primMaxWord       :: Word32
  348. primitive primDivWord,
  349.       primQuotWord,
  350.       primRemWord,
  351.       primModWord       :: Word32 -> Word32 -> Word32
  352. primitive primQrmWord       :: Word32 -> Word32 -> (Word32,Word32)
  353. primitive primEvenWord      :: Word32 -> Bool
  354. primitive primWordToInteger :: Word32 -> Integer
  355. primitive primAndWord       :: Word32 -> Word32 -> Word32
  356. primitive primOrWord        :: Word32 -> Word32 -> Word32
  357. primitive primXorWord       :: Word32 -> Word32 -> Word32
  358. primitive primComplementWord:: Word32 -> Word32
  359. primitive primShiftWord     :: Word32 -> Int -> Word32
  360. primitive primBitWord       :: Int -> Word32
  361. primitive primTestWord      :: Word32 -> Int -> Bool
  362.  
  363. -----------------------------------------------------------------------------
  364. -- Code copied from the Prelude
  365. -----------------------------------------------------------------------------
  366.  
  367. absReal x    | x >= 0    = x
  368.          | otherwise = -x
  369.  
  370. signumReal x | x == 0    =  0
  371.          | x > 0     =  1
  372.          | otherwise = -1
  373.  
  374. -----------------------------------------------------------------------------
  375. -- End
  376. -----------------------------------------------------------------------------
  377.