module Combinatorics.Battleship.Count.Counter (
   C,
   Composed,
   zero,
   one,
   add,
   sum,
   toInteger,
   propAdd,
   ) where

import Control.Monad (liftM2, )

import qualified Data.List as List
import Data.Bits (shiftL, )
import Data.Word (Word8, Word32, Word64, )

import Foreign.Storable
          (Storable, sizeOf, alignment,
           poke, peek, pokeByteOff, peekByteOff, )

import qualified Test.QuickCheck as QC

import Prelude hiding (sum, toInteger, )


class C a where
   zero, one :: a
   add :: a -> a -> a

class (C a, Ord a) => Integ a where
   toInteger :: a -> Integer
   rangeSize :: a -> Integer

instance C Word8 where
   zero :: Word8
zero = Word8
0; one :: Word8
one = Word8
1
   add :: Word8 -> Word8 -> Word8
add = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+)

instance Integ Word8 where
   toInteger :: Word8 -> Integer
toInteger = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   rangeSize :: Word8 -> Integer
rangeSize Word8
_ = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
1 Int
8

instance C Word32 where
   zero :: Word32
zero = Word32
0; one :: Word32
one = Word32
1
   add :: Word32 -> Word32 -> Word32
add = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+)

instance Integ Word32 where
   toInteger :: Word32 -> Integer
toInteger = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   rangeSize :: Word32 -> Integer
rangeSize Word32
_ = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
1 Int
32

instance C Word64 where
   zero :: Word64
zero = Word64
0; one :: Word64
one = Word64
1
   add :: Word64 -> Word64 -> Word64
add = Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+)

instance Integ Word64 where
   toInteger :: Word64 -> Integer
toInteger = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   rangeSize :: Word64 -> Integer
rangeSize Word64
_ = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
1 Int
64

sum :: (C a) => [a] -> a
sum :: [a] -> a
sum = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' a -> a -> a
forall a. C a => a -> a -> a
add a
forall a. C a => a
zero

data Composed hi lo = Composed !hi !lo
   deriving (Composed hi lo -> Composed hi lo -> Bool
(Composed hi lo -> Composed hi lo -> Bool)
-> (Composed hi lo -> Composed hi lo -> Bool)
-> Eq (Composed hi lo)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall hi lo.
(Eq hi, Eq lo) =>
Composed hi lo -> Composed hi lo -> Bool
/= :: Composed hi lo -> Composed hi lo -> Bool
$c/= :: forall hi lo.
(Eq hi, Eq lo) =>
Composed hi lo -> Composed hi lo -> Bool
== :: Composed hi lo -> Composed hi lo -> Bool
$c== :: forall hi lo.
(Eq hi, Eq lo) =>
Composed hi lo -> Composed hi lo -> Bool
Eq, Eq (Composed hi lo)
Eq (Composed hi lo)
-> (Composed hi lo -> Composed hi lo -> Ordering)
-> (Composed hi lo -> Composed hi lo -> Bool)
-> (Composed hi lo -> Composed hi lo -> Bool)
-> (Composed hi lo -> Composed hi lo -> Bool)
-> (Composed hi lo -> Composed hi lo -> Bool)
-> (Composed hi lo -> Composed hi lo -> Composed hi lo)
-> (Composed hi lo -> Composed hi lo -> Composed hi lo)
-> Ord (Composed hi lo)
Composed hi lo -> Composed hi lo -> Bool
Composed hi lo -> Composed hi lo -> Ordering
Composed hi lo -> Composed hi lo -> Composed hi lo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall hi lo. (Ord hi, Ord lo) => Eq (Composed hi lo)
forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Bool
forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Ordering
forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Composed hi lo
min :: Composed hi lo -> Composed hi lo -> Composed hi lo
$cmin :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Composed hi lo
max :: Composed hi lo -> Composed hi lo -> Composed hi lo
$cmax :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Composed hi lo
>= :: Composed hi lo -> Composed hi lo -> Bool
$c>= :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Bool
> :: Composed hi lo -> Composed hi lo -> Bool
$c> :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Bool
<= :: Composed hi lo -> Composed hi lo -> Bool
$c<= :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Bool
< :: Composed hi lo -> Composed hi lo -> Bool
$c< :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Bool
compare :: Composed hi lo -> Composed hi lo -> Ordering
$ccompare :: forall hi lo.
(Ord hi, Ord lo) =>
Composed hi lo -> Composed hi lo -> Ordering
$cp1Ord :: forall hi lo. (Ord hi, Ord lo) => Eq (Composed hi lo)
Ord)

instance (C hi, C lo, Ord lo) => C (Composed hi lo) where
   zero :: Composed hi lo
zero = hi -> lo -> Composed hi lo
forall hi lo. hi -> lo -> Composed hi lo
Composed hi
forall a. C a => a
zero lo
forall a. C a => a
zero
   one :: Composed hi lo
one = hi -> lo -> Composed hi lo
forall hi lo. hi -> lo -> Composed hi lo
Composed hi
forall a. C a => a
zero lo
forall a. C a => a
one
   add :: Composed hi lo -> Composed hi lo -> Composed hi lo
add (Composed hi
xh lo
xl) (Composed hi
yh lo
yl) =
      let zh :: hi
zh = hi -> hi -> hi
forall a. C a => a -> a -> a
add hi
xh hi
yh; zl :: lo
zl = lo -> lo -> lo
forall a. C a => a -> a -> a
add lo
xl lo
yl
      in  hi -> lo -> Composed hi lo
forall hi lo. hi -> lo -> Composed hi lo
Composed (if lo
zl lo -> lo -> Bool
forall a. Ord a => a -> a -> Bool
< lo
xl then hi -> hi -> hi
forall a. C a => a -> a -> a
add hi
zh hi
forall a. C a => a
one else hi
zh) lo
zl

instance (Integ hi, Integ lo) => Integ (Composed hi lo) where
   rangeSize :: Composed hi lo -> Integer
rangeSize ~(Composed hi
hi lo
lo) = hi -> Integer
forall a. Integ a => a -> Integer
rangeSize hi
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* lo -> Integer
forall a. Integ a => a -> Integer
rangeSize lo
lo
   toInteger :: Composed hi lo -> Integer
toInteger (Composed hi
hi lo
lo) =
      hi -> Integer
forall a. Integ a => a -> Integer
toInteger hi
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* lo -> Integer
forall a. Integ a => a -> Integer
rangeSize lo
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ lo -> Integer
forall a. Integ a => a -> Integer
toInteger lo
lo

instance (Integ hi, Integ lo) => Show (Composed hi lo) where
   show :: Composed hi lo -> String
show = Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> (Composed hi lo -> Integer) -> Composed hi lo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composed hi lo -> Integer
forall a. Integ a => a -> Integer
toInteger

-- | This instance expects that there is no need for padding for alignment
instance (Storable a, Storable b) => Storable (Composed a b) where
   sizeOf :: Composed a b -> Int
sizeOf ~(Composed a
a b
b) = a -> Int
forall a. Storable a => a -> Int
sizeOf a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. Storable a => a -> Int
sizeOf b
b
   alignment :: Composed a b -> Int
alignment ~(Composed a
a b
b) = a -> Int
forall a. Storable a => a -> Int
alignment a
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`lcm` b -> Int
forall a. Storable a => a -> Int
alignment b
b
   poke :: Ptr (Composed a b) -> Composed a b -> IO ()
poke Ptr (Composed a b)
ptr (Composed a
a b
b) = do
      Ptr (Composed a b) -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Composed a b)
ptr Int
0 a
a
      Ptr (Composed a b) -> Int -> b -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (Composed a b)
ptr (a -> Int
forall a. Storable a => a -> Int
sizeOf a
a) b
b
   peek :: Ptr (Composed a b) -> IO (Composed a b)
peek Ptr (Composed a b)
ptr = do
      a
a <- Ptr (Composed a b) -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Composed a b)
ptr Int
0
      b
b <- Ptr (Composed a b) -> Int -> IO b
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Composed a b)
ptr (a -> Int
forall a. Storable a => a -> Int
sizeOf a
a)
      Composed a b -> IO (Composed a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Composed a b -> IO (Composed a b))
-> Composed a b -> IO (Composed a b)
forall a b. (a -> b) -> a -> b
$ a -> b -> Composed a b
forall hi lo. hi -> lo -> Composed hi lo
Composed a
a b
b


instance (QC.Arbitrary a, QC.Arbitrary b) => QC.Arbitrary (Composed a b) where
   arbitrary :: Gen (Composed a b)
arbitrary = (a -> b -> Composed a b) -> Gen a -> Gen b -> Gen (Composed a b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> Composed a b
forall hi lo. hi -> lo -> Composed hi lo
Composed Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary Gen b
forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: Composed a b -> [Composed a b]
shrink (Composed a
hi b
lo) = ((a, b) -> Composed a b) -> [(a, b)] -> [Composed a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> Composed a b) -> (a, b) -> Composed a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Composed a b
forall hi lo. hi -> lo -> Composed hi lo
Composed) ([(a, b)] -> [Composed a b]) -> [(a, b)] -> [Composed a b]
forall a b. (a -> b) -> a -> b
$ (a, b) -> [(a, b)]
forall a. Arbitrary a => a -> [a]
QC.shrink (a
hi,b
lo)

propAdd ::
   Composed (Composed Word64 Word32) (Composed Word32 Word32) ->
   Composed (Composed Word64 Word32) (Composed Word32 Word32) ->
   Bool
propAdd :: Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Bool
propAdd Composed (Composed Word64 Word32) (Composed Word32 Word32)
a Composed (Composed Word64 Word32) (Composed Word32 Word32)
b =
   Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Integer
forall a. Integ a => a -> Integer
toInteger (Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Composed (Composed Word64 Word32) (Composed Word32 Word32)
forall a. C a => a -> a -> a
add Composed (Composed Word64 Word32) (Composed Word32 Word32)
a Composed (Composed Word64 Word32) (Composed Word32 Word32)
b) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Integer
forall a. Integ a => a -> Integer
toInteger Composed (Composed Word64 Word32) (Composed Word32 Word32)
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Integer
forall a. Integ a => a -> Integer
toInteger Composed (Composed Word64 Word32) (Composed Word32 Word32)
b) (Composed (Composed Word64 Word32) (Composed Word32 Word32)
-> Integer
forall a. Integ a => a -> Integer
rangeSize Composed (Composed Word64 Word32) (Composed Word32 Word32)
a)