ref: b456108b4fbfb9fb9c8de1c86910e64a45d0d290
parent: 8ce96e5c25c1e3556b80e5d4d68816ee524ca476
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sun Dec 17 07:20:23 EST 2023
Add Word8 for byte manipulation.
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -68,10 +68,6 @@
(>) = primWordGT
(>=) = primWordGE
-instance Enum Word where
- toEnum = primIntToWord
- fromEnum = primWordToInt
-
--------------------------------
instance Bits Word where
--- /dev/null
+++ b/lib/Data/Word8.hs
@@ -1,0 +1,109 @@
+-- Copyright 2023 Lennart Augustsson
+-- See LICENSE file for full license.
+module Data.Word8(module Data.Word8) where
+import Primitives
+import Data.Bits
+import Data.Bool_Type
+import Data.Bounded
+import Data.Char
+import Data.Enum
+import Data.Eq
+import Data.Function
+import Data.Int() -- instances only
+import Data.Integer
+import Data.Integral
+import Data.List
+import Data.Maybe_Type
+import Data.Num
+import Data.Ord
+import Data.Real
+import Data.Word
+import Text.Show
+
+newtype Word8 = W8 Word
+unW8 :: Word8 -> Word
+unW8 (W8 x) = x
+
+w8 :: Word -> Word8
+w8 w = W8 (w .&. 0xff)
+
+bin8 :: (Word -> Word -> Word) -> (Word8 -> Word8 -> Word8)
+bin8 op (W8 x) (W8 y) = w8 (x `op` y)
+
+bini8 :: (Word -> Int -> Word) -> (Word8 -> Int -> Word8)
+bini8 op (W8 x) y = w8 (x `op` y)
+
+cmp8 :: (Word -> Word -> Bool) -> (Word8 -> Word8 -> Bool)
+cmp8 op (W8 x) (W8 y) = x `op` y
+
+una8 :: (Word -> Word) -> (Word8 -> Word8)
+una8 op (W8 x) = w8 (op x)
+
+instance Num Word8 where
+ (+) = bin8 primWordAdd
+ (-) = bin8 primWordSub
+ (*) = bin8 primWordMul
+ abs x = x
+ signum x = if x == 0 then 0 else 1
+ fromInteger i = w8 (primIntToWord (_integerToInt i))
+
+instance Integral Word8 where
+ quot = bin8 primWordQuot
+ rem = bin8 primWordRem
+ toInteger = _wordToInteger . unW8
+
+instance Bounded Word8 where
+ minBound = W8 0
+ maxBound = W8 0xff
+
+instance Real Word8 where
+ toRational = _integerToRational . _wordToInteger . unW8
+
+--------------------------------
+
+instance Enum Word8 where
+ succ x = x + 1
+ pred x = x - 1
+ toEnum = w8 . primIntToWord
+ fromEnum = primWordToInt . unW8
+ enumFrom n = n : enumFrom (n+1)
+ enumFromThen n m = from n
+ where d = m - n
+ from i = i : from (i+d)
+ enumFromTo l h = takeWhile (<= h) (enumFrom l)
+ enumFromThenTo l m h =
+ if m > l then
+ takeWhile (<= h) (enumFromThen l m)
+ else
+ takeWhile (>= h) (enumFromThen l m)
+
+--------------------------------
+
+instance Eq Word8 where
+ (==) = cmp8 primWordEQ
+ (/=) = cmp8 primWordNE
+
+instance Ord Word8 where
+ (<) = cmp8 primWordLT
+ (<=) = cmp8 primWordLE
+ (>) = cmp8 primWordGT
+ (>=) = cmp8 primWordGE
+
+--------------------------------
+
+instance Bits Word8 where
+ (.&.) = bin8 primWordAnd
+ (.|.) = bin8 primWordOr
+ xor = bin8 primWordXor
+ complement = una8 primWordInv
+ shiftL = bini8 primWordShl
+ shiftR = bini8 primWordShr
+ bitSizeMaybe _ = Just 8
+ bitSize _ = 8
+ bit n = w8 (primWordShl 1 n)
+ zeroBits = 0
+
+--------------------------------
+
+instance Show Word8 where
+ show = show . unW8
--- a/lib/Foreign/Storable.hs
+++ b/lib/Foreign/Storable.hs
@@ -2,6 +2,7 @@
import Primitives
import Control.Error(undefined)
import Foreign.Ptr
+import Data.Word8
class Storable a where
sizeOf :: a -> Int
@@ -39,3 +40,12 @@
alignment _ = _wordSize
peek p = c_peekPtr p
poke p w = c_pokePtr p w
+
+foreign import ccall "peekByte" c_peekByte :: Ptr Word8 -> IO Word8
+foreign import ccall "pokeByte" c_pokeByte :: Ptr Word8 -> Word8 -> IO ()
+
+instance Storable Word8 where
+ sizeOf _ = 8
+ alignment _ = 8
+ peek p = c_peekByte p
+ poke p w = c_pokeByte p w
--- a/tests/Storable.hs
+++ b/tests/Storable.hs
@@ -1,6 +1,7 @@
module Storable(main) where
import Prelude
import Data.Word
+import Data.Word8
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Ptr
@@ -22,3 +23,10 @@
poke p2 w1
wp3 <- peekArray0 0 p2
print $ wp3 == [w1,1,2,3,4]
+
+{- Relies on endianess+ let p3 = castPtr p1 :: Ptr Word8
+ b1 <- peek p3
+ b2 <- peek (p3 `plusPtr` 1)
+ print [b1, b2]
+-}
--
⑨