{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2015, © Eric Mertens 2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- 'Bit1' .. 'Bit8' represent fixed length bit vectors.
-- The most significant bit comes first.
-- 'Bit1' and 'Bit2' have modular arithmetic
-- (the result has the same width as the arguments, overflow is ignored).
--
-- 'Bits' is an arbitrary length natural number type.
-- The least significant bit comes first.
-- 'Bits' has full arithmetic
-- (the result has large enough width so that there is no overflow).


--------------------------------------------------------------------
module Ersatz.Bits
  (
  -- * Fixed length bit vectors
    Bit1(..), Bit2(..), Bit3(..), Bit4(..), Bit5(..), Bit6(..), Bit7(..), Bit8(..)
  -- * Variable length bit vectors
  , Bits(Bits)
  , HasBits(..)
  , isEven
  , isOdd
  , sumBit
  , sumBits
  -- * Adders
  , fullAdder, halfAdder
  ) where

import Control.Applicative
import Control.Monad.Trans.State (State, runState, get, put)
import Data.Bits ((.&.), (.|.), shiftL, shiftR)
import qualified Data.Bits as Data
import Data.Foldable (toList)
import Data.List (unfoldr, foldl')
import Data.Stream.Infinite (Stream(..))
import Data.Word (Word8)
import Ersatz.Bit
import Ersatz.Codec
import Ersatz.Equatable
import Ersatz.Orderable
import Ersatz.Variable
import GHC.Generics
import Prelude hiding (and, or, not, (&&), (||))

-- | A container of 1 'Bit' that 'encode's from and 'decode's to 'Word8'.
newtype Bit1 = Bit1 Bit deriving (Int -> Bit1 -> ShowS
[Bit1] -> ShowS
Bit1 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit1] -> ShowS
$cshowList :: [Bit1] -> ShowS
show :: Bit1 -> String
$cshow :: Bit1 -> String
showsPrec :: Int -> Bit1 -> ShowS
$cshowsPrec :: Int -> Bit1 -> ShowS
Show,forall x. Rep Bit1 x -> Bit1
forall x. Bit1 -> Rep Bit1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit1 x -> Bit1
$cfrom :: forall x. Bit1 -> Rep Bit1 x
Generic)
-- | A container of 2 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit2 = Bit2 !Bit !Bit deriving (Int -> Bit2 -> ShowS
[Bit2] -> ShowS
Bit2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit2] -> ShowS
$cshowList :: [Bit2] -> ShowS
show :: Bit2 -> String
$cshow :: Bit2 -> String
showsPrec :: Int -> Bit2 -> ShowS
$cshowsPrec :: Int -> Bit2 -> ShowS
Show,forall x. Rep Bit2 x -> Bit2
forall x. Bit2 -> Rep Bit2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit2 x -> Bit2
$cfrom :: forall x. Bit2 -> Rep Bit2 x
Generic)
-- | A container of 3 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit3 = Bit3 !Bit !Bit !Bit deriving (Int -> Bit3 -> ShowS
[Bit3] -> ShowS
Bit3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit3] -> ShowS
$cshowList :: [Bit3] -> ShowS
show :: Bit3 -> String
$cshow :: Bit3 -> String
showsPrec :: Int -> Bit3 -> ShowS
$cshowsPrec :: Int -> Bit3 -> ShowS
Show,forall x. Rep Bit3 x -> Bit3
forall x. Bit3 -> Rep Bit3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit3 x -> Bit3
$cfrom :: forall x. Bit3 -> Rep Bit3 x
Generic)
-- | A container of 4 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit4 = Bit4 !Bit !Bit !Bit !Bit deriving (Int -> Bit4 -> ShowS
[Bit4] -> ShowS
Bit4 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit4] -> ShowS
$cshowList :: [Bit4] -> ShowS
show :: Bit4 -> String
$cshow :: Bit4 -> String
showsPrec :: Int -> Bit4 -> ShowS
$cshowsPrec :: Int -> Bit4 -> ShowS
Show,forall x. Rep Bit4 x -> Bit4
forall x. Bit4 -> Rep Bit4 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit4 x -> Bit4
$cfrom :: forall x. Bit4 -> Rep Bit4 x
Generic)
-- | A container of 5 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit5 = Bit5 !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit5 -> ShowS
[Bit5] -> ShowS
Bit5 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit5] -> ShowS
$cshowList :: [Bit5] -> ShowS
show :: Bit5 -> String
$cshow :: Bit5 -> String
showsPrec :: Int -> Bit5 -> ShowS
$cshowsPrec :: Int -> Bit5 -> ShowS
Show,forall x. Rep Bit5 x -> Bit5
forall x. Bit5 -> Rep Bit5 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit5 x -> Bit5
$cfrom :: forall x. Bit5 -> Rep Bit5 x
Generic)
-- | A container of 6 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit6 = Bit6 !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit6 -> ShowS
[Bit6] -> ShowS
Bit6 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit6] -> ShowS
$cshowList :: [Bit6] -> ShowS
show :: Bit6 -> String
$cshow :: Bit6 -> String
showsPrec :: Int -> Bit6 -> ShowS
$cshowsPrec :: Int -> Bit6 -> ShowS
Show,forall x. Rep Bit6 x -> Bit6
forall x. Bit6 -> Rep Bit6 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit6 x -> Bit6
$cfrom :: forall x. Bit6 -> Rep Bit6 x
Generic)
-- | A container of 7 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit7 = Bit7 !Bit !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit7 -> ShowS
[Bit7] -> ShowS
Bit7 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit7] -> ShowS
$cshowList :: [Bit7] -> ShowS
show :: Bit7 -> String
$cshow :: Bit7 -> String
showsPrec :: Int -> Bit7 -> ShowS
$cshowsPrec :: Int -> Bit7 -> ShowS
Show,forall x. Rep Bit7 x -> Bit7
forall x. Bit7 -> Rep Bit7 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit7 x -> Bit7
$cfrom :: forall x. Bit7 -> Rep Bit7 x
Generic)
-- | A container of 8 'Bit's that 'encode's from and 'decode's to 'Word8'. MSB is first.
data Bit8 = Bit8 !Bit !Bit !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit8 -> ShowS
[Bit8] -> ShowS
Bit8 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit8] -> ShowS
$cshowList :: [Bit8] -> ShowS
show :: Bit8 -> String
$cshow :: Bit8 -> String
showsPrec :: Int -> Bit8 -> ShowS
$cshowsPrec :: Int -> Bit8 -> ShowS
Show,forall x. Rep Bit8 x -> Bit8
forall x. Bit8 -> Rep Bit8 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit8 x -> Bit8
$cfrom :: forall x. Bit8 -> Rep Bit8 x
Generic)

instance Boolean Bit1
instance Boolean Bit2
instance Boolean Bit3
instance Boolean Bit4
instance Boolean Bit5
instance Boolean Bit6
instance Boolean Bit7
instance Boolean Bit8

instance Equatable Bit1
instance Equatable Bit2
instance Equatable Bit3
instance Equatable Bit4
instance Equatable Bit5
instance Equatable Bit6
instance Equatable Bit7
instance Equatable Bit8

instance Orderable Bit1
instance Orderable Bit2
instance Orderable Bit3
instance Orderable Bit4
instance Orderable Bit5
instance Orderable Bit6
instance Orderable Bit7
instance Orderable Bit8

instance Variable Bit1
instance Variable Bit2
instance Variable Bit3
instance Variable Bit4
instance Variable Bit5
instance Variable Bit6
instance Variable Bit7
instance Variable Bit8

instance Codec Bit1 where
  type Decoded Bit1 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit1 -> f (Decoded Bit1)
decode Solution
s (Bit1 Bit
a) = Bool -> Word8
boolsToNum1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a
  encode :: Decoded Bit1 -> Bit1
encode Decoded Bit1
i = Bit -> Bit1
Bit1 Bit
a where (Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit1
i

instance Codec Bit2 where
  type Decoded Bit2 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit2 -> f (Decoded Bit2)
decode Solution
s (Bit2 Bit
a Bit
b) = Bool -> Bool -> Word8
boolsToNum2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b
  encode :: Decoded Bit2 -> Bit2
encode Decoded Bit2
i = Bit -> Bit -> Bit2
Bit2 Bit
a Bit
b where (Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit2
i

instance Codec Bit3 where
  type Decoded Bit3 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit3 -> f (Decoded Bit3)
decode Solution
s (Bit3 Bit
a Bit
b Bit
c) = Bool -> Bool -> Bool -> Word8
boolsToNum3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c
  encode :: Decoded Bit3 -> Bit3
encode Decoded Bit3
i = Bit -> Bit -> Bit -> Bit3
Bit3 Bit
a Bit
b Bit
c where (Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit3
i

instance Codec Bit4 where
  type Decoded Bit4 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit4 -> f (Decoded Bit4)
decode Solution
s (Bit4 Bit
a Bit
b Bit
c Bit
d) = Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d
  encode :: Decoded Bit4 -> Bit4
encode Decoded Bit4
i = Bit -> Bit -> Bit -> Bit -> Bit4
Bit4 Bit
a Bit
b Bit
c Bit
d where (Bit
d:>Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit4
i

instance Codec Bit5 where
  type Decoded Bit5 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit5 -> f (Decoded Bit5)
decode Solution
s (Bit5 Bit
a Bit
b Bit
c Bit
d Bit
e) = Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e
  encode :: Decoded Bit5 -> Bit5
encode Decoded Bit5
i = Bit -> Bit -> Bit -> Bit -> Bit -> Bit5
Bit5 Bit
a Bit
b Bit
c Bit
d Bit
e where (Bit
e:>Bit
d:>Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit5
i

instance Codec Bit6 where
  type Decoded Bit6 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit6 -> f (Decoded Bit6)
decode Solution
s (Bit6 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f) = Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
f
  encode :: Decoded Bit6 -> Bit6
encode Decoded Bit6
i = Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit6
Bit6 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f where (Bit
f:>Bit
e:>Bit
d:>Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit6
i

instance Codec Bit7 where
  type Decoded Bit7 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit7 -> f (Decoded Bit7)
decode Solution
s (Bit7 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f Bit
g) = Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
g
  encode :: Decoded Bit7 -> Bit7
encode Decoded Bit7
i = Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit7
Bit7 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f Bit
g where (Bit
g:>Bit
f:>Bit
e:>Bit
d:>Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit7
i

instance Codec Bit8 where
  type Decoded Bit8 = Word8
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bit8 -> f (Decoded Bit8)
decode Solution
s (Bit8 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f Bit
g Bit
h) = Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
h
  encode :: Decoded Bit8 -> Bit8
encode Decoded Bit8
i = Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit -> Bit8
Bit8 Bit
a Bit
b Bit
c Bit
d Bit
e Bit
f Bit
g Bit
h where (Bit
h:>Bit
g:>Bit
f:>Bit
e:>Bit
d:>Bit
c:>Bit
b:>Bit
a:>Stream Bit
_) = forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf Decoded Bit8
i

boolsToNum1 :: Bool -> Word8
boolsToNum1 :: Bool -> Word8
boolsToNum1 = forall a. Num a => Bool -> a
boolToNum

boolsToNum2 :: Bool -> Bool -> Word8
boolsToNum2 :: Bool -> Bool -> Word8
boolsToNum2 Bool
a Bool
b = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b]

boolsToNum3 :: Bool -> Bool -> Bool -> Word8
boolsToNum3 :: Bool -> Bool -> Bool -> Word8
boolsToNum3 Bool
a Bool
b Bool
c = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c]

boolsToNum4 :: Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum4 :: Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum4 Bool
a Bool
b Bool
c Bool
d = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c,Bool
d]

boolsToNum5 :: Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum5 :: Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum5 Bool
a Bool
b Bool
c Bool
d Bool
e = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c,Bool
d,Bool
e]

boolsToNum6 :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum6 :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum6 Bool
a Bool
b Bool
c Bool
d Bool
e Bool
f = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c,Bool
d,Bool
e,Bool
f]

boolsToNum7 :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum7 :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum7 Bool
a Bool
b Bool
c Bool
d Bool
e Bool
f Bool
g = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c,Bool
d,Bool
e,Bool
f,Bool
g]

boolsToNum8 :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum8 :: Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
boolsToNum8 Bool
a Bool
b Bool
c Bool
d Bool
e Bool
f Bool
g Bool
h = forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum [Bool
a,Bool
b,Bool
c,Bool
d,Bool
e,Bool
f,Bool
g,Bool
h]

bitsOf :: (Num a, Data.Bits a) => a -> Stream Bit
bitsOf :: forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf a
n = forall b. Boolean b => Bool -> b
bool (forall a. (Eq a, Num a) => a -> Bool
numToBool (a
n forall a. Bits a => a -> a -> a
.&. a
1)) forall a. a -> Stream a -> Stream a
:> forall a. (Num a, Bits a) => a -> Stream Bit
bitsOf (a
n forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
{-# INLINE bitsOf #-}

numToBool :: (Eq a, Num a) => a -> Bool
numToBool :: forall a. (Eq a, Num a) => a -> Bool
numToBool a
0 = Bool
False
numToBool a
_ = Bool
True
{-# INLINE numToBool #-}

boolsToNum :: (Num a, Data.Bits a) => [Bool] -> a
boolsToNum :: forall a. (Num a, Bits a) => [Bool] -> a
boolsToNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
n Bool
a -> (a
n forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
.|. forall a. Num a => Bool -> a
boolToNum Bool
a) a
0
{-# INLINE boolsToNum #-}

boolToNum :: Num a => Bool -> a
boolToNum :: forall a. Num a => Bool -> a
boolToNum Bool
False = a
0
boolToNum Bool
True  = a
1
{-# INLINE boolToNum #-}


-- | This instance provides modular arithmetic (overflow is ignored).
instance Num Bit1 where
  Bit1 Bit
a + :: Bit1 -> Bit1 -> Bit1
+ Bit1 Bit
b = Bit -> Bit1
Bit1 (forall b. Boolean b => b -> b -> b
xor Bit
a Bit
b)
  Bit1 Bit
a * :: Bit1 -> Bit1 -> Bit1
* Bit1 Bit
b = Bit -> Bit1
Bit1 (Bit
a forall b. Boolean b => b -> b -> b
&& Bit
b)
  Bit1 Bit
a - :: Bit1 -> Bit1 -> Bit1
- Bit1 Bit
b = Bit -> Bit1
Bit1 (forall b. Boolean b => b -> b -> b
xor Bit
a Bit
b)
  negate :: Bit1 -> Bit1
negate Bit1
a = Bit1
a
  abs :: Bit1 -> Bit1
abs Bit1
a    = Bit1
a
  signum :: Bit1 -> Bit1
signum Bit1
a = Bit1
a
  fromInteger :: Integer -> Bit1
fromInteger = Bit -> Bit1
Bit1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Boolean b => Bool -> b
bool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Bool
odd

-- | Compute the sum and carry bit from adding three bits.
fullAdder :: Bit -> Bit -> Bit -> (Bit, Bit) -- ^ (sum, carry)
fullAdder :: Bit -> Bit -> Bit -> (Bit, Bit)
fullAdder Bit
a Bit
b Bit
c =
  -- ( full_Adder_Sum a b c , full_Adder_Carry a b c )
  let (Bit
s1,Bit
c1) = Bit -> Bit -> (Bit, Bit)
halfAdder Bit
a Bit
b ; (Bit
s2,Bit
c2) = Bit -> Bit -> (Bit, Bit)
halfAdder Bit
s1 Bit
c in (Bit
s2, Bit
c1forall b. Boolean b => b -> b -> b
||Bit
c2)
  -- following does not work (formula generation does not stop), why?
  {-
  ( Run $ exists >>= \ x -> do
      assert (     a ||     b ||     c || not x ) ; assert ( not a || not b || not c || x )
      assert (     a || not b || not c || not x ) ; assert ( not a ||     b ||     c || x )
      assert ( not a ||     b || not c || not x ) ; assert (     a || not b ||     c || x )
      assert ( not a || not b ||     c || not x ) ; assert (     a ||     b || not c || x )
      return x
  , Run $ exists >>= \ x -> do
      assert ( not b || not c || x ) ; assert ( b || c || not x )
      assert ( not a || not c || x ) ; assert ( a || c || not x )
      assert ( not a || not b || x ) ; assert ( a || b || not x )
      return x
  )
  -}

-- | Compute the sum and carry bit from adding two bits.
halfAdder :: Bit -> Bit -> (Bit, Bit) -- ^ (sum, carry)
halfAdder :: Bit -> Bit -> (Bit, Bit)
halfAdder Bit
a Bit
b = (Bit
a forall b. Boolean b => b -> b -> b
`xor` Bit
b, Bit
a forall b. Boolean b => b -> b -> b
&& Bit
b)

-- | This instance provides modular arithmetic (overflow is ignored).
instance Num Bit2 where
  Bit2 Bit
a2 Bit
a1 + :: Bit2 -> Bit2 -> Bit2
+ Bit2 Bit
b2 Bit
b1 = Bit -> Bit -> Bit2
Bit2 Bit
s2 Bit
s1 where
    (Bit
s1,Bit
c2) = Bit -> Bit -> (Bit, Bit)
halfAdder Bit
a1 Bit
b1
    (Bit
s2,Bit
_)  = Bit -> Bit -> Bit -> (Bit, Bit)
fullAdder Bit
a2 Bit
b2 Bit
c2
  Bit2 Bit
a2 Bit
a1 * :: Bit2 -> Bit2 -> Bit2
* Bit2 Bit
b2 Bit
b1 = Bit -> Bit -> Bit2
Bit2 ((Bit
a1 forall b. Boolean b => b -> b -> b
&& Bit
b2) forall b. Boolean b => b -> b -> b
`xor` (Bit
a2 forall b. Boolean b => b -> b -> b
&& Bit
b1)) (Bit
a1 forall b. Boolean b => b -> b -> b
&& Bit
b1)
    -- wallace tree
    --
    --   XX
    --  XX
    -- ----
    --  XXX
    --  X
    -- ----
    -- XXXX
    --
    -- But we only need the first 2 bits
  negate :: Bit2 -> Bit2
negate (Bit2 Bit
a Bit
b) = Bit -> Bit -> Bit2
Bit2 (forall b. Boolean b => b -> b
not Bit
a) (forall b. Boolean b => b -> b
not Bit
b) forall a. Num a => a -> a -> a
+ Bit2
1
  abs :: Bit2 -> Bit2
abs Bit2
a = Bit2
a
  signum :: Bit2 -> Bit2
signum (Bit2 Bit
a Bit
b) = Bit -> Bit -> Bit2
Bit2 forall b. Boolean b => b
false (Bit
a forall b. Boolean b => b -> b -> b
|| Bit
b)
  fromInteger :: Integer -> Bit2
fromInteger Integer
k = Bit -> Bit -> Bit2
Bit2 (forall b. Boolean b => Bool -> b
bool (Integer
k forall a. Bits a => a -> a -> a
.&. Integer
2 forall a. Eq a => a -> a -> Bool
/= Integer
0)) (forall b. Boolean b => Bool -> b
bool (Integer
k forall a. Bits a => a -> a -> a
.&. Integer
1 forall a. Eq a => a -> a -> Bool
/= Integer
0))

-- | A container of 'Bit's that is suitable for comparisons and arithmetic. Bits are stored
-- with least significant bit first to enable phantom 'false' values
-- to be truncated.
newtype Bits = Bits { Bits -> [Bit]
_getBits :: [Bit] }

instance Show Bits where
  showsPrec :: Int -> Bits -> ShowS
showsPrec Int
d (Bits [Bit]
xs) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Bits " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Bit]
xs

instance Equatable Bits where
  Bits [Bit]
xs === :: Bits -> Bits -> Bit
=== Bits [Bit]
ys = forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
and (forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits forall t. Equatable t => t -> t -> Bit
(===) [Bit]
xs [Bit]
ys)
  Bits [Bit]
xs /== :: Bits -> Bits -> Bit
/== Bits [Bit]
ys = forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
or  (forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits forall t. Equatable t => t -> t -> Bit
(/==) [Bit]
xs [Bit]
ys)

-- | Zip the component bits of a 'Bits' extending the
-- shorter argument with 'false' values.
zipWithBits :: (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits :: forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits Bit -> Bit -> a
_ []     []     = []
zipWithBits Bit -> Bit -> a
f (Bit
x:[Bit]
xs) (Bit
y:[Bit]
ys) = Bit -> Bit -> a
f Bit
x Bit
y forall a. a -> [a] -> [a]
: forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits Bit -> Bit -> a
f [Bit]
xs [Bit]
ys
zipWithBits Bit -> Bit -> a
f [Bit]
xs     []     = forall a b. (a -> b) -> [a] -> [b]
map (Bit -> Bit -> a
`f` forall b. Boolean b => b
false) [Bit]
xs
zipWithBits Bit -> Bit -> a
f []     [Bit]
ys     = forall a b. (a -> b) -> [a] -> [b]
map (forall b. Boolean b => b
false Bit -> Bit -> a
`f`) [Bit]
ys

instance Orderable Bits where
  Bits [Bit]
xs <? :: Bits -> Bits -> Bit
<?  Bits [Bit]
ys = Bit -> [Bit] -> [Bit] -> Bit
orderHelper forall b. Boolean b => b
false [Bit]
xs [Bit]
ys
  Bits [Bit]
xs <=? :: Bits -> Bits -> Bit
<=? Bits [Bit]
ys = Bit -> [Bit] -> [Bit] -> Bit
orderHelper forall b. Boolean b => b
true  [Bit]
xs [Bit]
ys

orderHelper :: Bit -> [Bit] -> [Bit] -> Bit
orderHelper :: Bit -> [Bit] -> [Bit] -> Bit
orderHelper Bit
c0 [Bit]
xs [Bit]
ys = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {t}. Orderable t => Bit -> (t, t) -> Bit
aux Bit
c0 (forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits (,) [Bit]
xs [Bit]
ys)
    where
    aux :: Bit -> (t, t) -> Bit
aux Bit
c (t
x,t
y) = Bit
c forall b. Boolean b => b -> b -> b
&& t
x forall t. Equatable t => t -> t -> Bit
=== t
y forall b. Boolean b => b -> b -> b
|| t
x forall t. Orderable t => t -> t -> Bit
<? t
y

instance Codec Bits where
  type Decoded Bits = Integer

  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> Bits -> f (Decoded Bits)
decode Solution
s (Bits [Bit]
xs) =
    do [Bool]
ys <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s) [Bit]
xs
       -- bools to Integers
       let zs :: [Integer]
zs = forall a b. (a -> b) -> [a] -> [b]
map (\Bool
x -> if Bool
x then Integer
1 else Integer
0) [Bool]
ys
       -- Integers to Integer
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Integer
x Integer
acc -> Integer
x forall a. Num a => a -> a -> a
+ Integer
2 forall a. Num a => a -> a -> a
* Integer
acc) Integer
0 [Integer]
zs)

  encode :: Decoded Bits -> Bits
encode = [Bit] -> Bits
Bits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b} {a}. (Integral b, Boolean a) => b -> Maybe (a, b)
step
    where
    step :: b -> Maybe (a, b)
step b
x =
      case forall a. Ord a => a -> a -> Ordering
compare b
x b
0 of
        Ordering
LT -> forall a. HasCallStack => String -> a
error String
"Bits/encode: Negative number"
        Ordering
EQ -> forall a. Maybe a
Nothing
        Ordering
GT -> forall a. a -> Maybe a
Just (if forall a. Integral a => a -> Bool
odd b
x then forall b. Boolean b => b
true else forall b. Boolean b => b
false, b
x forall a. Integral a => a -> a -> a
`div` b
2)

unbits :: HasBits a => a -> [Bit]
unbits :: forall a. HasBits a => a -> [Bit]
unbits a
a = case forall a. HasBits a => a -> Bits
bits a
a of Bits [Bit]
xs -> [Bit]
xs

-- | Add two 'Bits' values given an incoming carry bit.
addBits :: (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits :: forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits Bit
c a
xs0 b
ys0 = [Bit] -> Bits
Bits (Bit -> [Bit] -> [Bit] -> [Bit]
add2 Bit
c (forall a. HasBits a => a -> [Bit]
unbits a
xs0) (forall a. HasBits a => a -> [Bit]
unbits b
ys0)) where
  add2 :: Bit -> [Bit] -> [Bit] -> [Bit]
add2 Bit
cin []     [Bit]
ys    = Bit -> [Bit] -> [Bit]
add1 Bit
cin [Bit]
ys
  add2 Bit
cin [Bit]
xs     []    = Bit -> [Bit] -> [Bit]
add1 Bit
cin [Bit]
xs
  add2 Bit
cin (Bit
x:[Bit]
xs) (Bit
y:[Bit]
ys)= Bit
s forall a. a -> [a] -> [a]
: Bit -> [Bit] -> [Bit] -> [Bit]
add2 Bit
cout [Bit]
xs [Bit]
ys where
    (Bit
s,Bit
cout)            = Bit -> Bit -> Bit -> (Bit, Bit)
fullAdder Bit
x Bit
y Bit
cin

  add1 :: Bit -> [Bit] -> [Bit]
add1 Bit
cin []           = [Bit
cin]
  add1 Bit
cin (Bit
x:[Bit]
xs)       = Bit
s forall a. a -> [a] -> [a]
: Bit -> [Bit] -> [Bit]
add1 Bit
cout [Bit]
xs where
    (Bit
s,Bit
cout)            = Bit -> Bit -> (Bit, Bit)
halfAdder Bit
cin Bit
x

-- | Compute the sum of a source of 'Bits' values.
sumBits :: (Foldable t, HasBits a) => t a -> Bits
sumBits :: forall (t :: * -> *) a. (Foldable t, HasBits a) => t a -> Bits
sumBits = [Bits] -> Bits
sumBits' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. HasBits a => a -> Bits
bits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

sumBits' :: [Bits] -> Bits
sumBits' :: [Bits] -> Bits
sumBits' []  = [Bit] -> Bits
Bits []
sumBits' [Bits
x] = Bits
x
sumBits' [Bits]
xs0 = forall (t :: * -> *) a. (Foldable t, HasBits a) => t a -> Bits
sumBits ([Bits] -> [Bits]
merge [Bits]
xs0) where
  merge :: [Bits] -> [Bits]
merge [Bits
x] = [Bits
x]
  merge []  = []
  merge (Bits
x1:Bits
x2:[Bits]
xs) = forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits forall b. Boolean b => b
false Bits
x1 Bits
x2 forall a. a -> [a] -> [a]
: [Bits] -> [Bits]
merge [Bits]
xs

-- | Optimization of 'sumBits' enabled when summing
-- individual 'Bit's.
sumBit :: Foldable t => t Bit -> Bits
sumBit :: forall (t :: * -> *). Foldable t => t Bit -> Bits
sumBit t Bit
t =
  case forall s a. State s a -> s -> (a, s)
runState ([Bits] -> State [Bit] Bits
merge (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasBits a => a -> Bits
bits [Bit]
h2)) [Bit]
h1 of
    (Bits
s,[]) -> Bits
s
    (Bits, [Bit])
_      -> forall a. HasCallStack => String -> a
error String
"Bits.betterSumBits: OOPS! Bad algorithm!"

  where
  ts :: [Bit]
ts = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Bit
t
  ([Bit]
h1,[Bit]
h2) = forall a. Int -> [a] -> ([a], [a])
splitAt ((forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bit]
tsforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`div` Int
2) [Bit]
ts

  spareBit :: StateT [Bit] Identity Bit
spareBit = do
    [Bit]
xs <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    case [Bit]
xs of
      []   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b. Boolean b => b
false
      Bit
y:[Bit]
ys -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [Bit]
ys forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bit
y

  merge :: [Bits] -> State [Bit] Bits
  merge :: [Bits] -> State [Bit] Bits
merge [Bits
x] = forall (m :: * -> *) a. Monad m => a -> m a
return Bits
x
  merge []  = forall (m :: * -> *) a. Monad m => a -> m a
return ([Bit] -> Bits
Bits [])
  merge [Bits]
xs  = [Bits] -> State [Bit] Bits
merge forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Bits] -> State [Bit] [Bits]
merge' [Bits]
xs

  merge' :: [Bits] -> State [Bit] [Bits]
  merge' :: [Bits] -> State [Bit] [Bits]
merge' []  = forall (m :: * -> *) a. Monad m => a -> m a
return []
  merge' [Bits
x] = forall (m :: * -> *) a. Monad m => a -> m a
return [Bits
x]
  merge' (Bits
x1:Bits
x2:[Bits]
xs) =
    do Bit
cin <- StateT [Bit] Identity Bit
spareBit
       [Bits]
xs' <- [Bits] -> State [Bit] [Bits]
merge' [Bits]
xs
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits Bit
cin Bits
x1 Bits
x2 forall a. a -> [a] -> [a]
: [Bits]
xs')

-- | Predicate for odd-valued 'Bits's.
isOdd :: HasBits b => b -> Bit
isOdd :: forall b. HasBits b => b -> Bit
isOdd b
b = case forall a. HasBits a => a -> [Bit]
unbits b
b of
  []    -> forall b. Boolean b => b
false
  (Bit
x:[Bit]
_) -> Bit
x

-- | Predicate for even-valued 'Bits's.
isEven :: HasBits b => b -> Bit
isEven :: forall b. HasBits b => b -> Bit
isEven = forall b. Boolean b => b -> b
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. HasBits b => b -> Bit
isOdd

-- | 'HasBits' provides the 'bits' method for embedding
-- fixed with numeric encoding types into the arbitrary width
-- 'Bits' type.
class HasBits a where
  bits :: a -> Bits

instance HasBits Bit where
  bits :: Bit -> Bits
bits Bit
x = [Bit] -> Bits
Bits [Bit
x]

instance HasBits Bit1 where
  bits :: Bit1 -> Bits
bits (Bit1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0]

instance HasBits Bit2 where
  bits :: Bit2 -> Bits
bits (Bit2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1]

instance HasBits Bit3 where
  bits :: Bit3 -> Bits
bits (Bit3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2]

instance HasBits Bit4 where
  bits :: Bit4 -> Bits
bits (Bit4 Bit
x3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2,Bit
x3]

instance HasBits Bit5 where
  bits :: Bit5 -> Bits
bits (Bit5 Bit
x4 Bit
x3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2,Bit
x3,Bit
x4]

instance HasBits Bit6 where
  bits :: Bit6 -> Bits
bits (Bit6 Bit
x5 Bit
x4 Bit
x3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2,Bit
x3,Bit
x4,Bit
x5]

instance HasBits Bit7 where
  bits :: Bit7 -> Bits
bits (Bit7 Bit
x6 Bit
x5 Bit
x4 Bit
x3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2,Bit
x3,Bit
x4,Bit
x5,Bit
x6]

instance HasBits Bit8 where
  bits :: Bit8 -> Bits
bits (Bit8 Bit
x7 Bit
x6 Bit
x5 Bit
x4 Bit
x3 Bit
x2 Bit
x1 Bit
x0) = [Bit] -> Bits
Bits [Bit
x0,Bit
x1,Bit
x2,Bit
x3,Bit
x4,Bit
x5,Bit
x6,Bit
x7]

instance HasBits Bits where
  bits :: Bits -> Bits
bits = forall a. a -> a
id

mulBits :: Bits -> Bits -> Bits
mulBits :: Bits -> Bits -> Bits
mulBits (Bits [Bit]
xs) (Bits [Bit]
ys0)
  = forall (t :: * -> *) a. (Foldable t, HasBits a) => t a -> Bits
sumBits
  forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bit -> [Bit] -> Bits
aux [Bit]
xs (forall a. (a -> a) -> a -> [a]
iterate [Bit] -> [Bit]
times2 [Bit]
ys0)
  where
  times2 :: [Bit] -> [Bit]
times2 = (forall b. Boolean b => b
falseforall a. a -> [a] -> [a]
:)
  aux :: Bit -> [Bit] -> Bits
aux Bit
x [Bit]
ys = [Bit] -> Bits
Bits (forall a b. (a -> b) -> [a] -> [b]
map (Bit
x forall b. Boolean b => b -> b -> b
&&) [Bit]
ys)

-- | This instance provides full arithmetic.
-- The result has large enough width so that there is no overflow.
--
-- Subtraction is modified: @a - b@ denotes @max 0 (a - b)@.
--
-- Width of @a + b@ is @1 + max (width a) (width b)@,
-- width of @a * b@ is @(width a) + (width b)@,
-- width of @a - b@ is @max (width a) (width b)@.
--
-- @fromInteger@ will raise 'error' for negative arguments.
instance Num Bits where
  + :: Bits -> Bits -> Bits
(+) = forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits forall b. Boolean b => b
false
  * :: Bits -> Bits -> Bits
(*) = Bits -> Bits -> Bits
mulBits
  (-) = forall a b. (HasBits a, HasBits b) => a -> b -> Bits
subBits
  fromInteger :: Integer -> Bits
fromInteger = forall a. Codec a => Decoded a -> a
encode
  signum :: Bits -> Bits
signum (Bits [Bit]
xs) = [Bit] -> Bits
Bits [forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
or [Bit]
xs]
  abs :: Bits -> Bits
abs Bits
x = Bits
x

fullSubtract :: Bit -> Bit -> Bit -> (Bit,Bit)
fullSubtract :: Bit -> Bit -> Bit -> (Bit, Bit)
fullSubtract Bit
c Bit
x Bit
y =
  (Bit
x forall b. Boolean b => b -> b -> b
`xor` Bit
y forall b. Boolean b => b -> b -> b
`xor` Bit
c, Bit
x forall b. Boolean b => b -> b -> b
&& Bit
y forall b. Boolean b => b -> b -> b
&& Bit
c forall b. Boolean b => b -> b -> b
|| forall b. Boolean b => b -> b
not Bit
x forall b. Boolean b => b -> b -> b
&& Bit
y forall b. Boolean b => b -> b -> b
|| forall b. Boolean b => b -> b
not Bit
x forall b. Boolean b => b -> b -> b
&& Bit
c)

subBits :: (HasBits a, HasBits b) => a -> b -> Bits
subBits :: forall a b. (HasBits a, HasBits b) => a -> b -> Bits
subBits a
xs0 b
ys0 = [Bit] -> Bits
Bits (forall a b. (a -> b) -> [a] -> [b]
map (forall b. Boolean b => b -> b
not Bit
cN forall b. Boolean b => b -> b -> b
&&) [Bit]
ss) where
  (Bit
cN, [Bit]
ss) = Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux forall b. Boolean b => b
false (forall a. HasBits a => a -> [Bit]
unbits a
xs0) (forall a. HasBits a => a -> [Bit]
unbits b
ys0)

  aux :: Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
c [] [] = (Bit
c, [])
  aux Bit
c [] [Bit]
ys = Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
c [forall b. Boolean b => b
false] [Bit]
ys
  aux Bit
c [Bit]
xs [] = Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
c [Bit]
xs      [forall b. Boolean b => b
false]
  aux Bit
c (Bit
x:[Bit]
xs) (Bit
y:[Bit]
ys) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bit
z forall a. a -> [a] -> [a]
:) (Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
cout [Bit]
xs [Bit]
ys) where
    (Bit
z,Bit
cout) = Bit -> Bit -> Bit -> (Bit, Bit)
fullSubtract Bit
c Bit
x Bit
y