{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.Bits.AllExcess.AllExcess1 where

import Data.Word
import HaskellWorks.Data.Bits.PopCount.PopCount0
import HaskellWorks.Data.Bits.PopCount.PopCount1

import qualified Data.Bit             as Bit
import qualified Data.Bit.ThreadSafe  as BitTS
import qualified Data.Vector          as DV
import qualified Data.Vector.Storable as DVS
import qualified Data.Vector.Unboxed  as DVU

class AllExcess1 a where
  -- | Number of 1-bits minues the number of 0-bits.
  allExcess1 :: a -> Int

instance AllExcess1 [Bool] where
  allExcess1 :: [Bool] -> Int
allExcess1 = Int -> [Bool] -> Int
forall p. Num p => p -> [Bool] -> p
go Int
0
    where go :: p -> [Bool] -> p
go p
n (Bool
True :[Bool]
ys) = p -> [Bool] -> p
go (p
n p -> p -> p
forall a. Num a => a -> a -> a
+ p
1) [Bool]
ys
          go p
n (Bool
False:[Bool]
ys) = p -> [Bool] -> p
go (p
n p -> p -> p
forall a. Num a => a -> a -> a
- p
1) [Bool]
ys
          go p
n [Bool]
_          = p
n
  {-# INLINE allExcess1 #-}

instance AllExcess1 Word8 where
  allExcess1 :: Word8 -> Int
allExcess1 Word8
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Word8
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Word8
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 Word16 where
  allExcess1 :: Word16 -> Int
allExcess1 Word16
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Word16
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Word16
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 Word32 where
  allExcess1 :: Word32 -> Int
allExcess1 Word32
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Word32
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Word32
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 Word64 where
  allExcess1 :: Count -> Int
allExcess1 Count
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count
forall v. PopCount1 v => v -> Count
popCount1 Count
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count
forall v. PopCount0 v => v -> Count
popCount0 Count
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DV.Vector Word8) where
  allExcess1 :: Vector Word8 -> Int
allExcess1 Vector Word8
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word8
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word8
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DV.Vector Word16) where
  allExcess1 :: Vector Word16 -> Int
allExcess1 Vector Word16
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word16 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word16
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word16 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word16
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DV.Vector Word32) where
  allExcess1 :: Vector Word32 -> Int
allExcess1 Vector Word32
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word32
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word32
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DV.Vector Word64) where
  allExcess1 :: Vector Count -> Int
allExcess1 Vector Count
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Count -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Count
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Count -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Count
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVS.Vector Word8) where
  allExcess1 :: Vector Word8 -> Int
allExcess1 Vector Word8
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word8
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word8
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVS.Vector Word16) where
  allExcess1 :: Vector Word16 -> Int
allExcess1 Vector Word16
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word16 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word16
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word16 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word16
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVS.Vector Word32) where
  allExcess1 :: Vector Word32 -> Int
allExcess1 Vector Word32
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Word32
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Word32
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVS.Vector Word64) where
  allExcess1 :: Vector Count -> Int
allExcess1 Vector Count
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Count -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Count
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Count -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Count
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVU.Vector Bit.Bit) where
  allExcess1 :: Vector Bit -> Int
allExcess1 Vector Bit
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Bit -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Bit
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Bit -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Bit
w)
  {-# INLINE allExcess1 #-}

instance AllExcess1 (DVU.Vector BitTS.Bit) where
  allExcess1 :: Vector Bit -> Int
allExcess1 Vector Bit
w = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Bit -> Count
forall v. PopCount0 v => v -> Count
popCount0 Vector Bit
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Bit -> Count
forall v. PopCount1 v => v -> Count
popCount1 Vector Bit
w)
  {-# INLINE allExcess1 #-}