{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HaskellWorks.Data.Network.Ip.Word128 where

import Data.Maybe
import Data.Word
import Prelude    hiding (words)

import qualified Data.Bits as B

type Word128 = (Word32, Word32, Word32, Word32)

instance Enum Word128 where
  fromEnum :: Word128 -> Int
fromEnum  = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (Word128 -> Integer) -> Word128 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word128 -> Integer
word128ToInteger
  toEnum :: Int -> Word128
toEnum Int
i  = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
  succ :: Word128 -> Word128
succ (Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff) = (Word32
0, Word32
0, Word32
0, Word32
0)
  succ (Word32
a,          Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff) = (Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
a, Word32
0, Word32
0, Word32
0)
  succ (Word32
a,                   Word32
b, Word32
0xffffffff, Word32
0xffffffff) = (Word32
a, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
b, Word32
0, Word32
0)
  succ (Word32
a,                   Word32
b,          Word32
c, Word32
0xffffffff) = (Word32
a, Word32
b, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
c, Word32
0)
  succ (Word32
a,                   Word32
b,          Word32
c,          Word32
d) = (Word32
a, Word32
b, Word32
c, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
d)
  pred :: Word128 -> Word128
pred (Word32
0, Word32
0, Word32
0, Word32
0) = (Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff)
  pred (Word32
a, Word32
0, Word32
0, Word32
0) = (    Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
a, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff)
  pred (Word32
a, Word32
b, Word32
0, Word32
0) = (         Word32
a,     Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
b, Word32
0xffffffff, Word32
0xffffffff)
  pred (Word32
a, Word32
b, Word32
c, Word32
0) = (         Word32
a,          Word32
b,     Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
c, Word32
0xffffffff)
  pred (Word32
a, Word32
b, Word32
c, Word32
d) = (         Word32
a,          Word32
b,          Word32
c,     Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
d)

integerToWord128 :: Integer -> Word128
integerToWord128 :: Integer -> Word128
integerToWord128 Integer
i = let a :: Word32
a  = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
96 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..&. Integer
0xffffffff)
                         b :: Word32
b  = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
64 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..&. Integer
0xffffffff)
                         c :: Word32
c  = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
32 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..&. Integer
0xffffffff)
                         d :: Word32
d  = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
00 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..&. Integer
0xffffffff)
                     in (Word32
a, Word32
b, Word32
c, Word32
d)

word128ToInteger :: Word128 -> Integer
word128ToInteger :: Word128 -> Integer
word128ToInteger (Word32
a, Word32
b, Word32
c, Word32
d) = let a' :: Integer
a' = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shift` Int
96
                                    b' :: Integer
b' = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shift` Int
64
                                    c' :: Integer
c' = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shift` Int
32
                                    d' :: Integer
d' = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shift` Int
0
                                in Integer
a' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..|. Integer
b' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..|. Integer
c' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
B..|. Integer
d' :: Integer

instance Num Word128 where
  + :: Word128 -> Word128 -> Word128
(+) Word128
l Word128
r     = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word128 -> Integer
word128ToInteger Word128
r
  (-) Word128
l Word128
r     = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word128 -> Integer
word128ToInteger Word128
r
  * :: Word128 -> Word128 -> Word128
(*) Word128
l Word128
r     = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word128 -> Integer
word128ToInteger Word128
r
  abs :: Word128 -> Word128
abs Word128
a       = Word128
a
  signum :: Word128 -> Word128
signum (Word32
0, Word32
0, Word32
0, Word32
0) = Word128
forall a. Bounded a => a
minBound
  signum Word128
_            = Word128
1
  fromInteger :: Integer -> Word128
fromInteger = Integer -> Word128
integerToWord128

instance B.Bits Word128 where
  .&. :: Word128 -> Word128 -> Word128
(.&.) (Word32
a, Word32
b, Word32
c, Word32
d) (Word32
e, Word32
f, Word32
g, Word32
h) = (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..&. Word32
e, Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..&. Word32
f, Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..&. Word32
g, Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..&. Word32
h)
  .|. :: Word128 -> Word128 -> Word128
(.|.) (Word32
a, Word32
b, Word32
c, Word32
d) (Word32
e, Word32
f, Word32
g, Word32
h) = (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..|. Word32
e, Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..|. Word32
f, Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..|. Word32
g, Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B..|. Word32
h)
  xor :: Word128 -> Word128 -> Word128
xor (Word32
a, Word32
b, Word32
c, Word32
d) (Word32
e, Word32
f, Word32
g, Word32
h)   = (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
e, Word32
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
f, Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
g, Word32
d Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
h)
  complement :: Word128 -> Word128
complement (Word32
a, Word32
b, Word32
c, Word32
d)         = (Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
a, Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
b, Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
c, Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
d)
  shift :: Word128 -> Int -> Word128
shift Word128
w Int
n                       = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shift` Int
n
  shiftL :: Word128 -> Int -> Word128
shiftL Word128
w Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Word128
forall a. Bounded a => a
minBound  -- This is the special case to make it behaviour as the same as Word32
    | Bool
otherwise = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
n
  shiftR :: Word128 -> Int -> Word128
shiftR Word128
w Int
n                      = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.shiftR` Int
n
  rotate :: Word128 -> Int -> Word128
rotate Word128
w Int
n                      = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.rotate` Int
n
  rotateL :: Word128 -> Int -> Word128
rotateL Word128
w Int
n                     = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.rotateL` Int
n
  rotateR :: Word128 -> Int -> Word128
rotateR Word128
w Int
n                     = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`B.rotateR` Int
n
  bitSize :: Word128 -> Int
bitSize Word128
_                       = Int
128
  bitSizeMaybe :: Word128 -> Maybe Int
bitSizeMaybe Word128
_                  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
128
  isSigned :: Word128 -> Bool
isSigned Word128
_                      = Bool
False
  testBit :: Word128 -> Int -> Bool
testBit Word128
w                       = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit (Word128 -> Integer
word128ToInteger Word128
w)
  bit :: Int -> Word128
bit Int
n                           = Integer -> Word128
integerToWord128 (Integer -> Word128) -> Integer -> Word128
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Bits a => Int -> a
B.bit Int
n
  popCount :: Word128 -> Int
popCount Word128
w                      = Integer -> Int
forall a. Bits a => a -> Int
B.popCount (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Word128 -> Integer
word128ToInteger Word128
w

instance B.FiniteBits Word128 where
  finiteBitSize :: Word128 -> Int
finiteBitSize Word128
_ = Int
128