ghc/tests/programs/fast2haskell/Word.hs

   1 -- mimic "hbc_library" module, Word.
   2 -- [seriously non-std Haskell here]
   3
   4 module Word2 (
   5         Bits(..),               -- class
   6         Byte, Short, Word,      -- data types: abstract
   7         byteToInt, shortToInt, wordToInt
   8     ) where
   9
  10 import GHC
  11 import PrelBase
  12
  13 infixl 8 `bitLsh`, `bitRsh`
  14 infixl 7 `bitAnd`
  15 infixl 6 `bitXor`
  16 infixl 5 `bitOr`
  17
  18 class Bits a where
  19         bitAnd, bitOr, bitXor :: a -> a -> a
  20         bitCompl :: a -> a
  21         bitRsh, bitLsh :: a -> Int -> a
  22         bitSwap :: a -> a
  23         bit0 :: a
  24         bitSize :: a -> Int
  25
  26 ------------------------------------------------------------------
  27 data Word = Word Word# deriving (Eq, Ord)
  28
  29 instance Bits Word where
  30         bitAnd (Word x) (Word y) = case and# x y of z -> Word z
  31         bitOr  (Word x) (Word y) = case or#  x y of z -> Word z
  32         bitXor (Word x) (Word y) = error "later..." -- Word (XOR x y)
  33         bitCompl (Word x)        = case not# x of x' -> Word x'
  34         bitLsh (Word x) (I# y)   = case shiftL# x y of z -> Word z
  35         bitRsh (Word x) (I# y)   = case shiftRA# x y of z -> Word z
  36         bitSwap (Word x)         = --Word (OR (LSH x 16) (AND (RSH x 16) 65535))
  37                                    case shiftL# x 16# of { a# ->
  38                                    case shiftRA# x 16# of { b# ->
  39                                    case and# b# (i2w 65535#) of { c# ->
  40                                    case or#  a# c# of  { r# ->
  41                                    Word r# }}}}
  42         bit0                     = Word (i2w 1#)
  43         bitSize (Word _)         = 32
  44
  45 w2i x = word2Int# x
  46 i2w x = int2Word# x
  47
  48 instance Num Word where
  49         Word x + Word y = case plusInt#  (w2i x) (w2i y) of z -> Word (i2w z)
  50         Word x - Word y = case minusInt# (w2i x) (w2i y) of z -> Word (i2w z)
  51         Word x * Word y = case timesInt# (w2i x) (w2i y) of z -> Word (i2w z)
  52         negate (Word x) = case negateInt# (w2i x)  of z -> Word (i2w z)
  53         fromInteger (J# a# s# d#)
  54           = case integer2Int# a# s# d# of { z# ->
  55             Word (i2w z#) }
  56
  57 instance Show Word where
  58         showsPrec _ (Word w) =
  59                 let i = toInteger (I# (w2i w)) + (if geWord# w (i2w 0#) then 0 else  2*(toInteger maxBound + 1))
  60                 in  showString (conv 8 i)
  61
  62 conv :: Int -> Integer -> String
  63 conv 0 _ = ""
  64
  65 -- Was:
  66 --      conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!r] where (q, r) = quotRem (fromInteger i) 16
  67 -- But !!'s type has changed (Haskell 1.3) to take an Int index
  68
  69 conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!fromInteger r]
  70          where
  71            (q, r) = quotRem i 16
  72
  73 ------------------------------------------------------------------
  74 data Short = Short Int# deriving (Eq, Ord)
  75
  76 ------------------------------------------------------------------
  77 data Byte = Byte Int# deriving (Eq, Ord)
  78
  79 ------------------------------------------------------------------
  80 wordToInt :: Word -> Int
  81 wordToInt (Word w) = I# (w2i w)
  82
  83 shortToInt :: Short -> Int
  84 shortToInt (Short w) = I# w
  85
  86 byteToInt :: Byte -> Int
  87 byteToInt (Byte w) = I# w