1 -- mimic "hbc_library" module, Word.
2 -- [seriously non-std Haskell here]
6 Byte, Short, Word, -- data types: abstract
7 byteToInt, shortToInt, wordToInt,
8 wordToShorts, wordToBytes, bytesToString
11 infixl 8 `bitLsh`, `bitRsh`
17 bitAnd, bitOr, bitXor :: a -> a -> a
19 bitRsh, bitLsh :: a -> Int -> a
24 ------------------------------------------------------------------
25 data Word = Word Word# deriving (Eq, Ord)
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# ->
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# ->
54 fromInt (I# x) = Word (i2w x)
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)
61 conv :: Int -> Integer -> String
63 conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!r] where (q, r) = quotRem i 16
65 ------------------------------------------------------------------
66 data Short = Short Word# deriving (Eq, Ord)
68 sHORTMASK x = and# x (i2w 65535#)
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#) }}}}
84 bitSize (Short _) = 16
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))
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"
102 ------------------------------------------------------------------
103 data Byte = Byte Word# deriving (Eq, Ord)
105 bYTEMASK x = and# x (i2w 255#)
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#) }}}}
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))
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"
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))]
143 bytesToString :: [Byte] -> String
144 bytesToString bs = map (\ (Byte b) -> chr (I# (w2i b))) bs
146 stringToBytes :: String -> [Byte]
147 stringToBytes cs = map (\c -> Byte (case ord c of {I# i -> bYTEMASK (i2w i)})) cs
149 wordToInt :: Word -> Int
150 wordToInt (Word w) = I# (w2i w)
152 shortToInt :: Short -> Int
153 shortToInt (Short w) = I# (w2i w)
155 byteToInt :: Byte -> Int
156 byteToInt (Byte w) = I# (w2i w)