{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE TypeFamilies #-}

module Data.DoubleWord.Base
  ( DoubleWord(..)
  ) where

import Data.Bits (Bits(..))
import Data.Int
import Data.Word
import Data.BinaryWord

-- | Defines a particular way to split a binary word in halves.
class BinaryWord w ⇒ DoubleWord w where
  -- | The low half type
  type LoWord w
  -- | The high half type
  type HiWord w
  -- | The low half of the word
  loWord      ∷ w → LoWord w
  -- | The high half of the word
  hiWord      ∷ w → HiWord w
  -- | Construct a word from the low and high halves
  fromHiAndLo ∷ HiWord w → LoWord w → w
  -- | Extend the low half
  extendLo ∷ LoWord w → w
  -- | Sign-extend the low half
  signExtendLo ∷ SignedWord (LoWord w) → w

instance DoubleWord Word16 where
  type LoWord Word16 = Word8
  type HiWord Word16 = Word8
  loWord :: Word16 -> LoWord Word16
loWord Word16
w = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
  {-# INLINE loWord #-}
  hiWord :: Word16 -> HiWord Word16
hiWord Word16
w = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
w Int
8
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Word16 -> LoWord Word16 -> Word16
fromHiAndLo HiWord Word16
hi LoWord Word16
lo = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
HiWord Word16
hi) Int
8 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
LoWord Word16
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Word16 -> Word16
extendLo = LoWord Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Word16) -> Word16
signExtendLo = SignedWord (LoWord Word16) -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}

instance DoubleWord Word32 where
  type LoWord Word32 = Word16
  type HiWord Word32 = Word16
  loWord :: Word32 -> LoWord Word32
loWord Word32
w = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
  {-# INLINE loWord #-}
  hiWord :: Word32 -> HiWord Word32
hiWord Word32
w = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Word32 -> LoWord Word32 -> Word32
fromHiAndLo HiWord Word32
hi LoWord Word32
lo = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
HiWord Word32
hi) Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
LoWord Word32
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Word32 -> Word32
extendLo = LoWord Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Word32) -> Word32
signExtendLo = SignedWord (LoWord Word32) -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}

instance DoubleWord Word64 where
  type LoWord Word64 = Word32
  type HiWord Word64 = Word32
  loWord :: Word64 -> LoWord Word64
loWord Word64
w = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
  {-# INLINE loWord #-}
  hiWord :: Word64 -> HiWord Word64
hiWord Word64
w = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
w Int
32
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Word64 -> LoWord Word64 -> Word64
fromHiAndLo HiWord Word64
hi LoWord Word64
lo = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
HiWord Word64
hi) Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
LoWord Word64
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Word64 -> Word64
extendLo = LoWord Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Word64) -> Word64
signExtendLo = SignedWord (LoWord Word64) -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}

instance DoubleWord Int16 where
  type LoWord Int16 = Word8
  type HiWord Int16 = Int8
  loWord :: Int16 -> LoWord Int16
loWord Int16
w = Int16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
w
  {-# INLINE loWord #-}
  hiWord :: Int16 -> HiWord Int16
hiWord Int16
w = Int16 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int8) -> Int16 -> Int8
forall a b. (a -> b) -> a -> b
$ Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
shiftR Int16
w Int
8
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Int16 -> LoWord Int16 -> Int16
fromHiAndLo HiWord Int16
hi LoWord Int16
lo = Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
shiftL (Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
HiWord Int16
hi) Int
8 Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.|. Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
LoWord Int16
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Int16 -> Int16
extendLo = LoWord Int16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Int16) -> Int16
signExtendLo = SignedWord (LoWord Int16) -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}

instance DoubleWord Int32 where
  type LoWord Int32 = Word16
  type HiWord Int32 = Int16
  loWord :: Int32 -> LoWord Int32
loWord Int32
w = Int32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w
  {-# INLINE loWord #-}
  hiWord :: Int32 -> HiWord Int32
hiWord Int32
w = Int32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int16) -> Int32 -> Int16
forall a b. (a -> b) -> a -> b
$ Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftR Int32
w Int
16
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Int32 -> LoWord Int32 -> Int32
fromHiAndLo HiWord Int32
hi LoWord Int32
lo = Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftL (Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
HiWord Int32
hi) Int
16 Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|. Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
LoWord Int32
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Int32 -> Int32
extendLo = LoWord Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Int32) -> Int32
signExtendLo = SignedWord (LoWord Int32) -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}

instance DoubleWord Int64 where
  type LoWord Int64 = Word32
  type HiWord Int64 = Int32
  loWord :: Int64 -> LoWord Int64
loWord Int64
w = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
w
  {-# INLINE loWord #-}
  hiWord :: Int64 -> HiWord Int64
hiWord Int64
w = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
shiftR Int64
w Int
32
  {-# INLINE hiWord #-}
  fromHiAndLo :: HiWord Int64 -> LoWord Int64 -> Int64
fromHiAndLo HiWord Int64
hi LoWord Int64
lo = Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
shiftL (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
HiWord Int64
hi) Int
32 Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
LoWord Int64
lo
  {-# INLINE fromHiAndLo #-}
  extendLo :: LoWord Int64 -> Int64
extendLo = LoWord Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE extendLo #-}
  signExtendLo :: SignedWord (LoWord Int64) -> Int64
signExtendLo = SignedWord (LoWord Int64) -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signExtendLo #-}