ghc/lib/hbc/Word.hs

   1 -- mimic "hbc_library" module, Word.
   2 -- [seriously non-std Haskell here]
   3 --
   4 module Word (
   5         Bits(..),               -- class
   6         Byte, Short, Word,      -- data types: abstract
   7         byteToInt, shortToInt, wordToInt,
   8         wordToShorts, wordToBytes, bytesToString
   9     ) where
  10
  11 infixl 8 `bitLsh`, `bitRsh`
  12 infixl 7 `bitAnd`
  13 infixl 6 `bitXor`
  14 infixl 5 `bitOr`
  15
  16 class Bits a where
  17         bitAnd, bitOr, bitXor :: a -> a -> a
  18         bitCompl :: a -> a
  19         bitRsh, bitLsh :: a -> Int -> a
  20         bitSwap :: a -> a
  21         bit0 :: a
  22         bitSize :: a -> Int
  23
  24 ------------------------------------------------------------------
  25 data Word = Word Word# deriving (Eq, Ord)
  26
  27 instance Bits Word where
  28         bitAnd (Word x) (Word y) = case and# x y of z -> Word z
  29         bitOr  (Word x) (Word y) = case or#  x y of z -> Word z
  30         bitXor (Word x) (Word y) = error "later..." -- Word (XOR x y)
  31         bitCompl (Word x)        = case not# x of x' -> Word x'
  32         bitLsh (Word x) (I# y)   = case shiftL#  x y of z -> Word z
  33         bitRsh (Word x) (I# y)   = case shiftRL# x y of z -> Word z
  34         bitSwap (Word x)         = --Word (OR (LSH x 16) (AND (RSH x 16) 65535))
  35                                    case shiftL#  x 16# of { a# ->
  36                                    case shiftRL# x 16# of { b# ->
  37                                    case and# b# (i2w 65535#) of { c# ->
  38                                    case or#  a# c# of  { r# ->
  39                                    Word r# }}}}
  40         bit0                     = Word (i2w 1#)
  41         bitSize (Word _)         = 32
  42
  43 w2i x = word2Int# x
  44 i2w x = int2Word# x
  45
  46 instance Num Word where
  47         Word x + Word y = case plusInt#  (w2i x) (w2i y) of z -> Word (i2w z)
  48         Word x - Word y = case minusInt# (w2i x) (w2i y) of z -> Word (i2w z)
  49         Word x * Word y = case timesInt# (w2i x) (w2i y) of z -> Word (i2w z)
  50         negate (Word x) = case negateInt# (w2i x)  of z -> Word (i2w z)
  51         fromInteger (J# a# s# d#)
  52           = case integer2Int# a# s# d# of { z# ->
  53             Word (i2w z#) }
  54         fromInt (I# x) = Word (i2w x)
  55
  56 instance Text Word where
  57         showsPrec _ (Word w) =
  58                 let i = toInteger (I# (w2i w)) + (if geWord# w (i2w 0#) then 0 else  2*(toInteger maxInt + 1))
  59                 in  showString (conv 8 i)
  60
  61 conv :: Int -> Integer -> String
  62 conv 0 _ = ""
  63 conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!r] where (q, r) = quotRem i 16
  64
  65 ------------------------------------------------------------------
  66 data Short = Short Word# deriving (Eq, Ord)
  67
  68 sHORTMASK x = and# x (i2w 65535#)
  69
  70 instance Bits Short where
  71     bitAnd (Short x) (Short y) = case and# x y of z -> Short z
  72     bitOr  (Short x) (Short y) = case or#  x y of z -> Short z
  73     bitXor (Short x) (Short y) = error "later..." -- Short (XOR x y)
  74     bitCompl (Short x)         = case not# x of x' -> Short (sHORTMASK x')
  75     bitLsh (Short x) (I# y)    = case shiftL#  x y of z -> Short (sHORTMASK z)
  76     bitRsh (Short x) (I# y)    = case shiftRL# x y of z -> Short z
  77     bitSwap (Short x)          = --Short (SHORTMASK(OR (LSH x 8) (AND (RSH x 8) 255)))
  78                                  case shiftL#  x 8# of { a# ->
  79                                  case shiftRL# x 8# of { b# ->
  80                                  case and# b# (i2w 255#) of { c# ->
  81                                  case or#  a# c# of  { r# ->
  82                                  Short (sHORTMASK r#) }}}}
  83     bit0                       = Short (i2w 1#)
  84     bitSize (Short _)          = 16
  85
  86 instance Num Short where
  87     Short x + Short y = case plusInt#  (w2i x) (w2i y) of z -> Short (sHORTMASK (i2w z))
  88     Short x - Short y = case minusInt# (w2i x) (w2i y) of z -> Short (sHORTMASK (i2w z))
  89     Short x * Short y = case timesInt# (w2i x) (w2i y) of z -> Short (sHORTMASK (i2w z))
  90     negate (Short x) = case negateInt# (w2i x)  of z -> Short (sHORTMASK (i2w z))
  91     fromInteger (J# a# s# d#)
  92       = case integer2Int# a# s# d# of { z# ->
  93         Short (sHORTMASK (i2w z#)) }
  94     fromInt (I# x) = Short (sHORTMASK (i2w x))
  95
  96 instance Text Short where
  97         showsPrec _ (Short w) =
  98                 let i = toInteger (I# (w2i w))
  99                 in  showString (conv 4 i)
 100 --      showsType _ = showString "Short"
 101
 102 ------------------------------------------------------------------
 103 data Byte = Byte Word# deriving (Eq, Ord)
 104
 105 bYTEMASK x = and# x (i2w 255#)
 106
 107 instance Bits Byte where
 108     bitAnd (Byte x) (Byte y) = case and# x y of z -> Byte z
 109     bitOr  (Byte x) (Byte y) = case or#  x y of z -> Byte z
 110     bitXor (Byte x) (Byte y) = error "later..." -- Byte (XOR x y)
 111     bitCompl (Byte x)         = case not# x of x' -> Byte (bYTEMASK x')
 112     bitLsh (Byte x) (I# y)    = case shiftL#  x y of z -> Byte (bYTEMASK z)
 113     bitRsh (Byte x) (I# y)    = case shiftRL# x y of z -> Byte z
 114     bitSwap (Byte x)          = --Byte (BYTEMASK(OR (LSH x 4) (AND (RSH x 8) 15)))
 115                                  case shiftL#  x 4# of { a# ->
 116                                  case shiftRL# x 8# of { b# ->
 117                                  case and# b# (i2w 15#) of { c# ->
 118                                  case or#  a# c# of  { r# ->
 119                                  Byte (bYTEMASK r#) }}}}
 120     bit0                       = Byte (i2w 1#)
 121     bitSize (Byte _)           = 8
 122
 123 instance Num Byte where
 124     Byte x + Byte y = case plusInt#  (w2i x) (w2i y) of z -> Byte (bYTEMASK (i2w z))
 125     Byte x - Byte y = case minusInt# (w2i x) (w2i y) of z -> Byte (bYTEMASK (i2w z))
 126     Byte x * Byte y = case timesInt# (w2i x) (w2i y) of z -> Byte (bYTEMASK (i2w z))
 127     negate (Byte x) = case negateInt# (w2i x)  of z -> Byte (bYTEMASK (i2w z))
 128     fromInteger (J# a# s# d#)
 129       = case integer2Int# a# s# d# of { z# ->
 130         Byte (bYTEMASK (i2w z#)) }
 131     fromInt (I# x) = Byte (bYTEMASK (i2w x))
 132
 133 instance Text Byte where
 134         showsPrec _ (Byte w) =
 135                 let i = toInteger (I# (w2i w))
 136                 in  showString (conv 2 i)
 137 --      showsType _ = showString "Byte"
 138
 139 ------------------------------------------------------------------
 140 wordToShorts (Word w) = [Short (sHORTMASK(shiftRL# w 16#)), Short (sHORTMASK(w))]
 141 wordToBytes  (Word w) = [Byte  (bYTEMASK(shiftRL#  w 24#)), Byte  (bYTEMASK(shiftRL#  w 16#)), Byte (bYTEMASK(shiftRL#  w 8#)), Byte (bYTEMASK(w))]
 142
 143 bytesToString :: [Byte] -> String
 144 bytesToString bs = map (\ (Byte b) -> chr (I# (w2i b))) bs
 145
 146 stringToBytes :: String -> [Byte]
 147 stringToBytes cs = map (\c -> Byte (case ord c of {I# i -> bYTEMASK (i2w i)})) cs
 148
 149 wordToInt :: Word -> Int
 150 wordToInt (Word w) = I# (w2i w)
 151
 152 shortToInt :: Short -> Int
 153 shortToInt (Short w) = I# (w2i w)
 154
 155 byteToInt :: Byte -> Int
 156 byteToInt (Byte w) = I# (w2i w)