{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2015, © Eric Mertens 2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- 'Bits' is an arbitrary length natural number type
--------------------------------------------------------------------
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
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (Foldable, toList)
#else
import Data.Foldable (toList)
#endif
import Data.List (unfoldr, foldl')
#if __GLASGOW_HASKELL__ < 710
import Data.Traversable (traverse)
#endif
import Data.Typeable (Typeable)
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
(Int -> Bit1 -> ShowS)
-> (Bit1 -> String) -> ([Bit1] -> ShowS) -> Show Bit1
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,Typeable,(forall x. Bit1 -> Rep Bit1 x)
-> (forall x. Rep Bit1 x -> Bit1) -> Generic Bit1
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'
data Bit2 = Bit2 !Bit !Bit deriving (Int -> Bit2 -> ShowS
[Bit2] -> ShowS
Bit2 -> String
(Int -> Bit2 -> ShowS)
-> (Bit2 -> String) -> ([Bit2] -> ShowS) -> Show Bit2
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,Typeable,(forall x. Bit2 -> Rep Bit2 x)
-> (forall x. Rep Bit2 x -> Bit2) -> Generic Bit2
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'
data Bit3 = Bit3 !Bit !Bit !Bit deriving (Int -> Bit3 -> ShowS
[Bit3] -> ShowS
Bit3 -> String
(Int -> Bit3 -> ShowS)
-> (Bit3 -> String) -> ([Bit3] -> ShowS) -> Show Bit3
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,Typeable,(forall x. Bit3 -> Rep Bit3 x)
-> (forall x. Rep Bit3 x -> Bit3) -> Generic Bit3
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'
data Bit4 = Bit4 !Bit !Bit !Bit !Bit deriving (Int -> Bit4 -> ShowS
[Bit4] -> ShowS
Bit4 -> String
(Int -> Bit4 -> ShowS)
-> (Bit4 -> String) -> ([Bit4] -> ShowS) -> Show Bit4
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,Typeable,(forall x. Bit4 -> Rep Bit4 x)
-> (forall x. Rep Bit4 x -> Bit4) -> Generic Bit4
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'
data Bit5 = Bit5 !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit5 -> ShowS
[Bit5] -> ShowS
Bit5 -> String
(Int -> Bit5 -> ShowS)
-> (Bit5 -> String) -> ([Bit5] -> ShowS) -> Show Bit5
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,Typeable,(forall x. Bit5 -> Rep Bit5 x)
-> (forall x. Rep Bit5 x -> Bit5) -> Generic Bit5
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'
data Bit6 = Bit6 !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit6 -> ShowS
[Bit6] -> ShowS
Bit6 -> String
(Int -> Bit6 -> ShowS)
-> (Bit6 -> String) -> ([Bit6] -> ShowS) -> Show Bit6
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,Typeable,(forall x. Bit6 -> Rep Bit6 x)
-> (forall x. Rep Bit6 x -> Bit6) -> Generic Bit6
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'
data Bit7 = Bit7 !Bit !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit7 -> ShowS
[Bit7] -> ShowS
Bit7 -> String
(Int -> Bit7 -> ShowS)
-> (Bit7 -> String) -> ([Bit7] -> ShowS) -> Show Bit7
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,Typeable,(forall x. Bit7 -> Rep Bit7 x)
-> (forall x. Rep Bit7 x -> Bit7) -> Generic Bit7
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'
data Bit8 = Bit8 !Bit !Bit !Bit !Bit !Bit !Bit !Bit !Bit deriving (Int -> Bit8 -> ShowS
[Bit8] -> ShowS
Bit8 -> String
(Int -> Bit8 -> ShowS)
-> (Bit8 -> String) -> ([Bit8] -> ShowS) -> Show Bit8
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,Typeable,(forall x. Bit8 -> Rep Bit8 x)
-> (forall x. Rep Bit8 x -> Bit8) -> Generic Bit8
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 :: Solution -> Bit1 -> f (Decoded Bit1)
decode Solution
s (Bit1 Bit
a) = Bool -> Word8
boolsToNum1 (Bool -> Word8) -> f Bool -> f Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> Bit -> f (Decoded Bit)
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:[Bit]
_) = Word8 -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf Word8
Decoded Bit1
i

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

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

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

instance Codec Bit5 where
  type Decoded Bit5 = Word8
  decode :: 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 (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a f (Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b f (Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c f (Bool -> Bool -> Word8) -> f Bool -> f (Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d f (Bool -> Word8) -> f Bool -> f Word8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
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:[Bit]
_) = Word8 -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf Word8
Decoded Bit5
i

instance Codec Bit6 where
  type Decoded Bit6 = Word8
  decode :: 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 (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b f (Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c f (Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d f (Bool -> Bool -> Word8) -> f Bool -> f (Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e f (Bool -> Word8) -> f Bool -> f Word8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
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:[Bit]
_) = Word8 -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf Word8
Decoded Bit6
i

instance Codec Bit7 where
  type Decoded Bit7 = Word8
  decode :: 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 (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool
-> f (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a f (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c f (Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d f (Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e f (Bool -> Bool -> Word8) -> f Bool -> f (Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
f f (Bool -> Word8) -> f Bool -> f Word8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
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:[Bit]
_) = Word8 -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf Word8
Decoded Bit7
i

instance Codec Bit8 where
  type Decoded Bit8 = Word8
  decode :: 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 (Bool
 -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool
-> f (Bool
      -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
a f (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool
-> f (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
b f (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
c f (Bool -> Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
d f (Bool -> Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
e f (Bool -> Bool -> Bool -> Word8)
-> f Bool -> f (Bool -> Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
f f (Bool -> Bool -> Word8) -> f Bool -> f (Bool -> Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bit
g f (Bool -> Word8) -> f Bool -> f Word8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> Bit -> f (Decoded Bit)
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:[Bit]
_) = Word8 -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf Word8
Decoded Bit8
i

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

boolsToNum2 :: Bool -> Bool -> Word8
boolsToNum2 :: Bool -> Bool -> Word8
boolsToNum2 Bool
a Bool
b = [Bool] -> Word8
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 = [Bool] -> Word8
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 = [Bool] -> Word8
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 = [Bool] -> Word8
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 = [Bool] -> Word8
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 = [Bool] -> Word8
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 = [Bool] -> Word8
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 -> [Bit]
bitsOf :: a -> [Bit]
bitsOf a
n = Bool -> Bit
forall b. Boolean b => Bool -> b
bool (a -> Bool
forall a. (Eq a, Num a) => a -> Bool
numToBool (a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1)) Bit -> [Bit] -> [Bit]
forall a. a -> [a] -> [a]
: a -> [Bit]
forall a. (Num a, Bits a) => a -> [Bit]
bitsOf (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
{-# INLINE bitsOf #-}

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

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

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

instance Num Bit1 where
  Bit1 Bit
a + :: Bit1 -> Bit1 -> Bit1
+ Bit1 Bit
b = Bit -> Bit1
Bit1 (Bit -> Bit -> Bit
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 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
b)
  Bit1 Bit
a - :: Bit1 -> Bit1 -> Bit1
- Bit1 Bit
b = Bit -> Bit1
Bit1 (Bit -> Bit -> Bit
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 (Bit -> Bit1) -> (Integer -> Bit) -> Integer -> Bit1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bit
forall b. Boolean b => Bool -> b
bool (Bool -> Bit) -> (Integer -> Bool) -> Integer -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
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
c1Bit -> Bit -> Bit
forall 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 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
`xor` Bit
b, Bit
a Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
b)

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 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
b2) Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
`xor` (Bit
a2 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
b1)) (Bit
a1 Bit -> Bit -> Bit
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 (Bit -> Bit
forall b. Boolean b => b -> b
not Bit
a) (Bit -> Bit
forall b. Boolean b => b -> b
not Bit
b) Bit2 -> Bit2 -> Bit2
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 Bit
forall b. Boolean b => b
false (Bit
a Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
|| Bit
b)
  fromInteger :: Integer -> Bit2
fromInteger Integer
k = Bit -> Bit -> Bit2
Bit2 (Bool -> Bit
forall b. Boolean b => Bool -> b
bool (Integer
k Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)) (Bool -> Bit
forall b. Boolean b => Bool -> b
bool (Integer
k Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0))

-- suitable for comparisons and arithmetic. Bits are stored
-- in little-endian order to enable phantom 'false' values
-- to be truncated.
newtype Bits = Bits { Bits -> [Bit]
_getBits :: [Bit] } 
  deriving Typeable

instance Show Bits where
  showsPrec :: Int -> Bits -> ShowS
showsPrec Int
d (Bits [Bit]
xs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Bits " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Bit] -> ShowS
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 = [Bit] -> Bit
forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
and ((Bit -> Bit -> Bit) -> [Bit] -> [Bit] -> [Bit]
forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits Bit -> Bit -> Bit
forall t. Equatable t => t -> t -> Bit
(===) [Bit]
xs [Bit]
ys)
  Bits [Bit]
xs /== :: Bits -> Bits -> Bit
/== Bits [Bit]
ys = [Bit] -> Bit
forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
or  ((Bit -> Bit -> Bit) -> [Bit] -> [Bit] -> [Bit]
forall a. (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [a]
zipWithBits Bit -> Bit -> Bit
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 :: (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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Bit -> Bit -> a) -> [Bit] -> [Bit] -> [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     []     = (Bit -> a) -> [Bit] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bit -> Bit -> a
`f` Bit
forall b. Boolean b => b
false) [Bit]
xs
zipWithBits Bit -> Bit -> a
f []     [Bit]
ys     = (Bit -> a) -> [Bit] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bit
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 Bit
forall b. Boolean b => b
false [Bit]
xs [Bit]
ys
  Bits [Bit]
xs <=? :: Bits -> Bits -> Bit
<=? Bits [Bit]
ys = Bit -> [Bit] -> [Bit] -> Bit
orderHelper Bit
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 = (Bit -> (Bit, Bit) -> Bit) -> Bit -> [(Bit, Bit)] -> Bit
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Bit -> (Bit, Bit) -> Bit
forall t. Orderable t => Bit -> (t, t) -> Bit
aux Bit
c0 ((Bit -> Bit -> (Bit, Bit)) -> [Bit] -> [Bit] -> [(Bit, Bit)]
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 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& t
x t -> t -> Bit
forall t. Equatable t => t -> t -> Bit
=== t
y Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
|| t
x t -> t -> Bit
forall t. Orderable t => t -> t -> Bit
<? t
y

instance Codec Bits where
  type Decoded Bits = Integer

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

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

unbits :: HasBits a => a -> [Bit]
unbits :: a -> [Bit]
unbits a
a = case a -> Bits
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 :: Bit -> a -> b -> Bits
addBits Bit
c a
xs0 b
ys0 = [Bit] -> Bits
Bits (Bit -> [Bit] -> [Bit] -> [Bit]
add2 Bit
c (a -> [Bit]
forall a. HasBits a => a -> [Bit]
unbits a
xs0) (b -> [Bit]
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 Bit -> [Bit] -> [Bit]
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 Bit -> [Bit] -> [Bit]
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 :: t a -> Bits
sumBits = [Bits] -> Bits
sumBits' ([Bits] -> Bits) -> (t a -> [Bits]) -> t a -> Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bits) -> [a] -> [Bits]
forall a b. (a -> b) -> [a] -> [b]
map a -> Bits
forall a. HasBits a => a -> Bits
bits ([a] -> [Bits]) -> (t a -> [a]) -> t a -> [Bits]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
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 = [Bits] -> Bits
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) = Bit -> Bits -> Bits -> Bits
forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits Bit
forall b. Boolean b => b
false Bits
x1 Bits
x2 Bits -> [Bits] -> [Bits]
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 :: t Bit -> Bits
sumBit t Bit
t =
  case State [Bit] Bits -> [Bit] -> (Bits, [Bit])
forall s a. State s a -> s -> (a, s)
runState ([Bits] -> State [Bit] Bits
merge ((Bit -> Bits) -> [Bit] -> [Bits]
forall a b. (a -> b) -> [a] -> [b]
map Bit -> Bits
forall a. HasBits a => a -> Bits
bits [Bit]
h2)) [Bit]
h1 of
    (Bits
s,[]) -> Bits
s
    (Bits, [Bit])
_      -> String -> Bits
forall a. HasCallStack => String -> a
error String
"Bits.betterSumBits: OOPS! Bad algorithm!"

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

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

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

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

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

-- | Predicate for even-valued 'Bits's.
isEven :: HasBits b => b -> Bit
isEven :: b -> Bit
isEven = Bit -> Bit
forall b. Boolean b => b -> b
not (Bit -> Bit) -> (b -> Bit) -> b -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bit
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 = Bits -> Bits
forall a. a -> a
id

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

instance Num Bits where
  + :: Bits -> Bits -> Bits
(+) = Bit -> Bits -> Bits -> Bits
forall a b. (HasBits a, HasBits b) => Bit -> a -> b -> Bits
addBits Bit
forall b. Boolean b => b
false
  * :: Bits -> Bits -> Bits
(*) = Bits -> Bits -> Bits
mulBits
  (-) = Bits -> Bits -> Bits
forall a b. (HasBits a, HasBits b) => a -> b -> Bits
subBits
  fromInteger :: Integer -> Bits
fromInteger = Integer -> Bits
forall a. Codec a => Decoded a -> a
encode
  signum :: Bits -> Bits
signum (Bits [Bit]
xs) = [Bit] -> Bits
Bits [[Bit] -> Bit
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 Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
`xor` Bit
y Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
`xor` Bit
c, Bit
x Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
y Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
c Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
|| Bit -> Bit
forall b. Boolean b => b -> b
not Bit
x Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
y Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
|| Bit -> Bit
forall b. Boolean b => b -> b
not Bit
x Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& Bit
c)

subBits :: (HasBits a, HasBits b) => a -> b -> Bits
subBits :: a -> b -> Bits
subBits a
xs0 b
ys0 = [Bit] -> Bits
Bits ((Bit -> Bit) -> [Bit] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (Bit -> Bit
forall b. Boolean b => b -> b
not Bit
cN Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&&) [Bit]
ss) where
  (Bit
cN, [Bit]
ss) = Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
forall b. Boolean b => b
false (a -> [Bit]
forall a. HasBits a => a -> [Bit]
unbits a
xs0) (b -> [Bit]
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 [Bit
forall b. Boolean b => b
false] [Bit]
ys
  aux Bit
c [Bit]
xs [] = Bit -> [Bit] -> [Bit] -> (Bit, [Bit])
aux Bit
c [Bit]
xs      [Bit
forall b. Boolean b => b
false]
  aux Bit
c (Bit
x:[Bit]
xs) (Bit
y:[Bit]
ys) = ([Bit] -> [Bit]) -> (Bit, [Bit]) -> (Bit, [Bit])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bit
z Bit -> [Bit] -> [Bit]
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