-- Copyright 2023,2024 Lennart Augustsson
-- See LICENSE file for full license.
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
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 Numeric
import Text.Read
import Text.Show

instance Num Word where
  (+)  = primWordAdd
  (-)  = primWordSub
  (*)  = primWordMul
  abs x = x
  signum x = if x == 0 then 0 else 1
  fromInteger x = primIntToWord (_integerToInt x)

instance Integral Word where
  quot = primWordQuot
  rem  = primWordRem
  toInteger = _wordToInteger

instance Bounded Word where
  minBound = 0::Word
  maxBound = primWordInv (0::Word)

instance Real Word where
  toRational i = _integerToRational (_wordToInteger i)

instance Show Word where
  showsPrec = showIntegral

instance Read Word where
  readsPrec = readIntegral

--------------------------------

instance Enum Word where
  succ x = x + 1
  pred x = x - 1
  toEnum = primIntToWord
  fromEnum = primWordToInt
  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 Word where
  (==) = primWordEQ
  (/=) = primWordNE

instance Ord Word where
  (<)  = primWordLT
  (<=) = primWordLE
  (>)  = primWordGT
  (>=) = primWordGE

--------------------------------

instance Bits Word where
  (.&.) = primWordAnd
  (.|.) = primWordOr
  xor   = primWordXor
  complement = primWordInv
  shiftL = primWordShl
  shiftR = primWordShr
  bitSizeMaybe _ = Just _wordSize
  bitSize _ = _wordSize
  bit n = primWordShl 1 n
  zeroBits = 0

--------------------------------------------------------------------------------
----    Word8

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 Show Word8 where
  showsPrec = showIntegral

instance Read Word8 where
  readsPrec = readIntegral

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

--------------------------------------------------------------------------------
----    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 Word16 where
  showsPrec = showIntegral

instance Read Word16 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 Word32 where
  showsPrec = showIntegral

instance Read Word32 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 Word64 where
  showsPrec = showIntegral

instance Read Word64 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