ref: 85a1d837030be35f658f0d5c0c9229ab80b6e1e1
parent: c971649c91c6966b1b9c4b32a5368caa3fe60897
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Mar 3 07:58:01 EST 2024
More Word types.
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -1,8 +1,9 @@
-- Copyright 2023,2024 Lennart Augustsson
-- See LICENSE file for full license.
-module Data.Word(Word, Word8) where
+module Data.Word(Word, Word8, Word16, Word32, Word64) where
import Prelude() -- do not import Prelude
import Primitives
+import Control.Error
import Data.Bits
import Data.Bool_Type
import Data.Bounded
@@ -93,8 +94,8 @@
zeroBits = 0
--------------------------------------------------------------------------------
+---- Word8
-
newtype Word8 = W8 Word
unW8 :: Word8 -> Word
unW8 (W8 x) = x
@@ -140,8 +141,6 @@
instance Read Word where
readsPrec = readIntegral
---------------------------------
-
instance Enum Word8 where
succ x = x + 1
pred x = x - 1
@@ -158,8 +157,6 @@
else
takeWhile (>= h) (enumFromThen l m)
---------------------------------
-
instance Eq Word8 where
(==) = cmp8 primWordEQ
(/=) = cmp8 primWordNE
@@ -170,8 +167,6 @@
(>) = cmp8 primWordGT
(>=) = cmp8 primWordGE
---------------------------------
-
instance Bits Word8 where
(.&.) = bin8 primWordAnd
(.|.) = bin8 primWordOr
@@ -182,4 +177,262 @@
bitSizeMaybe _ = Just 8
bitSize _ = 8
bit n = w8 (primWordShl 1 n)
+ zeroBits = 0
+
+--------------------------------------------------------------------------------
+---- Word16
+
+newtype Word16 = W16 Word
+unW16 :: Word16 -> Word
+unW16 (W16 x) = x
+
+w16 :: Word -> Word16
+w16 w = W16 (w .&. 0xffff)
+
+bin16 :: (Word -> Word -> Word) -> (Word16 -> Word16 -> Word16)
+bin16 op (W16 x) (W16 y) = w16 (x `op` y)
+
+bini16 :: (Word -> Int -> Word) -> (Word16 -> Int -> Word16)
+bini16 op (W16 x) y = w16 (x `op` y)
+
+cmp16 :: (Word -> Word -> Bool) -> (Word16 -> Word16 -> Bool)
+cmp16 op (W16 x) (W16 y) = x `op` y
+
+una16 :: (Word -> Word) -> (Word16 -> Word16)
+una16 op (W16 x) = w16 (op x)
+
+instance Num Word16 where
+ (+) = bin16 primWordAdd
+ (-) = bin16 primWordSub
+ (*) = bin16 primWordMul
+ abs x = x
+ signum x = if x == 0 then 0 else 1
+ fromInteger i = w16 (primIntToWord (_integerToInt i))
+
+instance Integral Word16 where
+ quot = bin16 primWordQuot
+ rem = bin16 primWordRem
+ toInteger = _wordToInteger . unW16
+
+instance Bounded Word16 where
+ minBound = W16 0
+ maxBound = W16 0xffff
+
+instance Real Word16 where
+ toRational = _integerToRational . _wordToInteger . unW16
+
+instance Show Word where
+ showsPrec = showIntegral
+
+instance Read Word where
+ readsPrec = readIntegral
+
+instance Enum Word16 where
+ succ x = x + 1
+ pred x = x - 1
+ toEnum = w16 . primIntToWord
+ fromEnum = primWordToInt . unW16
+ 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 Word16 where
+ (==) = cmp16 primWordEQ
+ (/=) = cmp16 primWordNE
+
+instance Ord Word16 where
+ (<) = cmp16 primWordLT
+ (<=) = cmp16 primWordLE
+ (>) = cmp16 primWordGT
+ (>=) = cmp16 primWordGE
+
+instance Bits Word16 where
+ (.&.) = bin16 primWordAnd
+ (.|.) = bin16 primWordOr
+ xor = bin16 primWordXor
+ complement = una16 primWordInv
+ shiftL = bini16 primWordShl
+ shiftR = bini16 primWordShr
+ bitSizeMaybe _ = Just 16
+ bitSize _ = 16
+ bit n = w16 (primWordShl 1 n)
+ zeroBits = 0
+
+--------------------------------------------------------------------------------
+---- Word32
+
+newtype Word32 = W32 Word
+unW32 :: Word32 -> Word
+unW32 (W32 x) = x
+
+w32 :: Word -> Word32
+w32 w = if _wordSize == 32 then W32 w else W32 (w .&. 0xffffffff)
+
+bin32 :: (Word -> Word -> Word) -> (Word32 -> Word32 -> Word32)
+bin32 op (W32 x) (W32 y) = w32 (x `op` y)
+
+bini32 :: (Word -> Int -> Word) -> (Word32 -> Int -> Word32)
+bini32 op (W32 x) y = w32 (x `op` y)
+
+cmp32 :: (Word -> Word -> Bool) -> (Word32 -> Word32 -> Bool)
+cmp32 op (W32 x) (W32 y) = x `op` y
+
+una32 :: (Word -> Word) -> (Word32 -> Word32)
+una32 op (W32 x) = w32 (op x)
+
+instance Num Word32 where
+ (+) = bin32 primWordAdd
+ (-) = bin32 primWordSub
+ (*) = bin32 primWordMul
+ abs x = x
+ signum x = if x == 0 then 0 else 1
+ fromInteger i = w32 (primIntToWord (_integerToInt i))
+
+instance Integral Word32 where
+ quot = bin32 primWordQuot
+ rem = bin32 primWordRem
+ toInteger = _wordToInteger . unW32
+
+instance Bounded Word32 where
+ minBound = W32 0
+ maxBound = W32 0xffffffff
+
+instance Real Word32 where
+ toRational = _integerToRational . _wordToInteger . unW32
+
+instance Show Word where
+ showsPrec = showIntegral
+
+instance Read Word where
+ readsPrec = readIntegral
+
+instance Enum Word32 where
+ succ x = x + 1
+ pred x = x - 1
+ toEnum = w32 . primIntToWord
+ fromEnum = primWordToInt . unW32
+ 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 Word32 where
+ (==) = cmp32 primWordEQ
+ (/=) = cmp32 primWordNE
+
+instance Ord Word32 where
+ (<) = cmp32 primWordLT
+ (<=) = cmp32 primWordLE
+ (>) = cmp32 primWordGT
+ (>=) = cmp32 primWordGE
+
+instance Bits Word32 where
+ (.&.) = bin32 primWordAnd
+ (.|.) = bin32 primWordOr
+ xor = bin32 primWordXor
+ complement = una32 primWordInv
+ shiftL = bini32 primWordShl
+ shiftR = bini32 primWordShr
+ bitSizeMaybe _ = Just 32
+ bitSize _ = 32
+ bit n = w32 (primWordShl 1 n)
+ zeroBits = 0
+
+--------------------------------------------------------------------------------
+---- Word64
+
+newtype Word64 = W64 Word
+unW64 :: Word64 -> Word
+unW64 (W64 x) = x
+
+w64 :: Word -> Word64
+w64 w = if _wordSize == 64 then W64 w else error "No Word64"
+
+bin64 :: (Word -> Word -> Word) -> (Word64 -> Word64 -> Word64)
+bin64 op (W64 x) (W64 y) = w64 (x `op` y)
+
+bini64 :: (Word -> Int -> Word) -> (Word64 -> Int -> Word64)
+bini64 op (W64 x) y = w64 (x `op` y)
+
+cmp64 :: (Word -> Word -> Bool) -> (Word64 -> Word64 -> Bool)
+cmp64 op (W64 x) (W64 y) = x `op` y
+
+una64 :: (Word -> Word) -> (Word64 -> Word64)
+una64 op (W64 x) = w64 (op x)
+
+instance Num Word64 where
+ (+) = bin64 primWordAdd
+ (-) = bin64 primWordSub
+ (*) = bin64 primWordMul
+ abs x = x
+ signum x = if x == 0 then 0 else 1
+ fromInteger i = w64 (primIntToWord (_integerToInt i))
+
+instance Integral Word64 where
+ quot = bin64 primWordQuot
+ rem = bin64 primWordRem
+ toInteger = _wordToInteger . unW64
+
+instance Bounded Word64 where
+ minBound = W64 0
+ maxBound = W64 0xffffffffffffffff
+
+instance Real Word64 where
+ toRational = _integerToRational . _wordToInteger . unW64
+
+instance Show Word where
+ showsPrec = showIntegral
+
+instance Read Word where
+ readsPrec = readIntegral
+
+instance Enum Word64 where
+ succ x = x + 1
+ pred x = x - 1
+ toEnum = w64 . primIntToWord
+ fromEnum = primWordToInt . unW64
+ 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 Word64 where
+ (==) = cmp64 primWordEQ
+ (/=) = cmp64 primWordNE
+
+instance Ord Word64 where
+ (<) = cmp64 primWordLT
+ (<=) = cmp64 primWordLE
+ (>) = cmp64 primWordGT
+ (>=) = cmp64 primWordGE
+
+instance Bits Word64 where
+ (.&.) = bin64 primWordAnd
+ (.|.) = bin64 primWordOr
+ xor = bin64 primWordXor
+ complement = una64 primWordInv
+ shiftL = bini64 primWordShl
+ shiftR = bini64 primWordShr
+ bitSizeMaybe _ = Just 64
+ bitSize _ = 64
+ bit n = w64 (primWordShl 1 n)
zeroBits = 0
--- a/lib/Foreign/Storable.hs
+++ b/lib/Foreign/Storable.hs
@@ -61,7 +61,6 @@
peek p = c_peek_uint8 p
poke p w = c_poke_uint8 p w
-{-foreign import ccall "peek_uint16" c_peek_uint16 :: Ptr Word16 -> IO Word16
foreign import ccall "poke_uint16" c_poke_uint16 :: Ptr Word16 -> Word16 -> IO ()
@@ -88,7 +87,6 @@
alignment _ = 1
peek p = c_peek_uint64 p
poke p w = c_poke_uint64 p w
--}
{-foreign import ccall "peek_int8" c_peek_int8 :: Ptr Int8 -> IO Int8
--
⑨