{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe               #-}

#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE StandaloneDeriving #-}
#endif
-- | Binary natural numbers, 'Bin'.
--
-- This module is designed to be imported qualified.
--
module Data.Bin (
    -- * Binary natural numbers
    Bin(..),
    toNatural,
    fromNatural,
    toNat,
    fromNat,
    cata,
    -- * Positive natural numbers
    BinP (..),
    -- * Showing
    explicitShow,
    explicitShowsPrec,
    -- * Extras
    predP,
    mult2,
    mult2Plus1,
    -- ** Data.Bits
    andP,
    xorP,
    complementBitP,
    clearBitP,
    -- * Aliases
    bin0, bin1, bin2, bin3, bin4, bin5, bin6, bin7, bin8, bin9,
    ) where

import Control.DeepSeq (NFData (..))
import Data.BinP       (BinP (..))
import Data.Bits       (Bits (..))
import Data.Data       (Data)
import Data.Hashable   (Hashable (..))
import Data.Nat        (Nat (..))
import Data.Typeable   (Typeable)
import GHC.Exception   (ArithException (..), throw)
import Numeric.Natural (Natural)

import qualified Data.BinP       as BP
import qualified Data.Nat        as N
import qualified Test.QuickCheck as QC

-- $setup
-- >>> import qualified Data.Nat as N

-------------------------------------------------------------------------------
-- Bin
-------------------------------------------------------------------------------

-- | Binary natural numbers.
--
-- Numbers are represented in little-endian order,
-- the representation is unique.
--
-- >>> mapM_ (putStrLn .  explicitShow) [0 .. 7]
-- BZ
-- BP BE
-- BP (B0 BE)
-- BP (B1 BE)
-- BP (B0 (B0 BE))
-- BP (B1 (B0 BE))
-- BP (B0 (B1 BE))
-- BP (B1 (B1 BE))
--
data Bin
    = BZ          -- ^ zero
    | BP BP.BinP  -- ^ non-zero
  deriving (Bin -> Bin -> Bool
(Bin -> Bin -> Bool) -> (Bin -> Bin -> Bool) -> Eq Bin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bin -> Bin -> Bool
$c/= :: Bin -> Bin -> Bool
== :: Bin -> Bin -> Bool
$c== :: Bin -> Bin -> Bool
Eq, Eq Bin
Eq Bin
-> (Bin -> Bin -> Ordering)
-> (Bin -> Bin -> Bool)
-> (Bin -> Bin -> Bool)
-> (Bin -> Bin -> Bool)
-> (Bin -> Bin -> Bool)
-> (Bin -> Bin -> Bin)
-> (Bin -> Bin -> Bin)
-> Ord Bin
Bin -> Bin -> Bool
Bin -> Bin -> Ordering
Bin -> Bin -> Bin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bin -> Bin -> Bin
$cmin :: Bin -> Bin -> Bin
max :: Bin -> Bin -> Bin
$cmax :: Bin -> Bin -> Bin
>= :: Bin -> Bin -> Bool
$c>= :: Bin -> Bin -> Bool
> :: Bin -> Bin -> Bool
$c> :: Bin -> Bin -> Bool
<= :: Bin -> Bin -> Bool
$c<= :: Bin -> Bin -> Bool
< :: Bin -> Bin -> Bool
$c< :: Bin -> Bin -> Bool
compare :: Bin -> Bin -> Ordering
$ccompare :: Bin -> Bin -> Ordering
$cp1Ord :: Eq Bin
Ord, Typeable, Typeable @* Bin
DataType
Constr
Typeable @* Bin
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bin -> c Bin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Bin)
-> (Bin -> Constr)
-> (Bin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable @(* -> *) t =>
    (forall d. Data d => c (t d)) -> Maybe (c Bin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable @(* -> * -> *) t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bin))
-> ((forall b. Data b => b -> b) -> Bin -> Bin)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bin -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bin -> m Bin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bin -> m Bin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bin -> m Bin)
-> Data Bin
Bin -> DataType
Bin -> Constr
(forall b. Data b => b -> b) -> Bin -> Bin
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bin -> c Bin
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bin
forall a.
Typeable @* a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable @(* -> *) t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable @(* -> * -> *) t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bin -> u
forall u. (forall d. Data d => d -> u) -> Bin -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bin -> m Bin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bin -> m Bin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bin -> c Bin
forall (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(forall d. Data d => c (t d)) -> Maybe (c Bin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bin)
$cBP :: Constr
$cBZ :: Constr
$tBin :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bin -> m Bin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bin -> m Bin
gmapMp :: (forall d. Data d => d -> m d) -> Bin -> m Bin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bin -> m Bin
gmapM :: (forall d. Data d => d -> m d) -> Bin -> m Bin
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bin -> m Bin
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bin -> u
gmapQ :: (forall d. Data d => d -> u) -> Bin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bin -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bin -> r
gmapT :: (forall b. Data b => b -> b) -> Bin -> Bin
$cgmapT :: (forall b. Data b => b -> b) -> Bin -> Bin
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bin)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bin)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(forall d. Data d => c (t d)) -> Maybe (c Bin)
dataTypeOf :: Bin -> DataType
$cdataTypeOf :: Bin -> DataType
toConstr :: Bin -> Constr
$ctoConstr :: Bin -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bin
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bin -> c Bin
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bin -> c Bin
$cp1Data :: Typeable @* Bin
Data)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

#if __GLASGOW_HASKELL__ < 710
deriving instance Typeable 'BZ
deriving instance Typeable 'BP
#endif

-- | 'Bin' is printed as 'Natural'.
--
-- To see explicit structure, use 'explicitShow' or 'explicitShowsPrec'
--
instance Show Bin where
    showsPrec :: Int -> Bin -> ShowS
showsPrec Int
d = Int -> Natural -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Natural -> ShowS) -> (Bin -> Natural) -> Bin -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Natural
toNatural

-- |
--
-- >>> 0 + 2 :: Bin
-- 2
--
-- >>> 1 + 2 :: Bin
-- 3
--
-- >>> 4 * 8 :: Bin
-- 32
--
-- >>> 7 * 7 :: Bin
-- 49
--
instance Num Bin where
    fromInteger :: Integer -> Bin
fromInteger = Natural -> Bin
fromNatural (Natural -> Bin) -> (Integer -> Natural) -> Integer -> Bin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall a. Num a => Integer -> a
fromInteger

    Bin
BZ       + :: Bin -> Bin -> Bin
+ Bin
b    = Bin
b
    b :: Bin
b@(BP BinP
_) + Bin
BZ   = Bin
b
    BP BinP
a     + BP BinP
b = BinP -> Bin
BP (BinP
a BinP -> BinP -> BinP
forall a. Num a => a -> a -> a
+ BinP
b)

    Bin
BZ   * :: Bin -> Bin -> Bin
* Bin
_    = Bin
BZ
    Bin
_    * Bin
BZ   = Bin
BZ
    BP BinP
a * BP BinP
b = BinP -> Bin
BP (BinP
a BinP -> BinP -> BinP
forall a. Num a => a -> a -> a
* BinP
b)

    abs :: Bin -> Bin
abs = Bin -> Bin
forall a. a -> a
id

    signum :: Bin -> Bin
signum Bin
BZ      = Bin
BZ
    signum (BP BinP
_) = BinP -> Bin
BP BinP
BE

    negate :: Bin -> Bin
negate Bin
_ = String -> Bin
forall a. HasCallStack => String -> a
error String
"negate @Bin"

instance Real Bin where
    toRational :: Bin -> Rational
toRational = Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> (Bin -> Integer) -> Bin -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Integer
forall a. Integral a => a -> Integer
toInteger

instance Integral Bin where
    toInteger :: Bin -> Integer
toInteger = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> (Bin -> Natural) -> Bin -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Natural
toNatural

    quotRem :: Bin -> Bin -> (Bin, Bin)
quotRem Bin
_ Bin
_ = String -> (Bin, Bin)
forall a. HasCallStack => String -> a
error String
"quotRem @Bin is not implemented"


-- | >>> take 10 $ iterate succ BZ
-- [0,1,2,3,4,5,6,7,8,9]
--
-- >>> take 10 [BZ ..]
-- [0,1,2,3,4,5,6,7,8,9]
--
instance Enum Bin where
    succ :: Bin -> Bin
succ Bin
BZ = BinP -> Bin
BP BinP
BE
    succ (BP BinP
n) = BinP -> Bin
BP (BinP -> BinP
forall a. Enum a => a -> a
succ BinP
n)

    pred :: Bin -> Bin
pred Bin
BZ     = ArithException -> Bin
forall a e. Exception e => e -> a
throw ArithException
Underflow
    pred (BP BinP
n) = BinP -> Bin
predP BinP
n

    toEnum :: Int -> Bin
toEnum Int
n = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
        Ordering
LT -> ArithException -> Bin
forall a e. Exception e => e -> a
throw ArithException
Underflow
        Ordering
EQ -> Bin
BZ
        Ordering
GT -> BinP -> Bin
BP (Int -> BinP
forall a. Enum a => Int -> a
toEnum  Int
n)

    fromEnum :: Bin -> Int
fromEnum Bin
BZ     = Int
0
    fromEnum (BP BinP
n) = BinP -> Int
forall a. Enum a => a -> Int
fromEnum BinP
n

instance NFData Bin where
    rnf :: Bin -> ()
rnf Bin
BZ      = ()
    rnf (BP BinP
n) = BinP -> ()
forall a. NFData a => a -> ()
rnf BinP
n

instance Hashable Bin where
    hashWithSalt :: Int -> Bin -> Int
hashWithSalt = Int -> Bin -> Int
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Extras
-------------------------------------------------------------------------------

-- | This is a total function.
--
-- >>> map predP [1..10]
-- [0,1,2,3,4,5,6,7,8,9]
--
predP :: BinP -> Bin
predP :: BinP -> Bin
predP BinP
BE     = Bin
BZ
predP (B1 BinP
n) = BinP -> Bin
BP (BinP -> BinP
B0 BinP
n)
predP (B0 BinP
n) = BinP -> Bin
BP (BinP -> BinP
go BinP
n) where
    go :: BinP -- @00001xyz@
       -> BinP -- @11110xyz@
    go :: BinP -> BinP
go BinP
BE     = BinP
BE
    go (B1 BinP
m) = BinP -> BinP
B1 (BinP -> BinP
B0 BinP
m)
    go (B0 BinP
m) = BinP -> BinP
B1 (BinP -> BinP
go BinP
m)

mult2 :: Bin -> Bin
mult2 :: Bin -> Bin
mult2 Bin
BZ     = Bin
BZ
mult2 (BP BinP
b) = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)

mult2Plus1 :: Bin -> BinP
mult2Plus1 :: Bin -> BinP
mult2Plus1 Bin
BZ     = BinP
BE
mult2Plus1 (BP BinP
b) = BinP -> BinP
B1 BinP
b

-------------------------------------------------------------------------------
-- QuickCheck
-------------------------------------------------------------------------------

instance QC.Arbitrary Bin where
    arbitrary :: Gen Bin
arbitrary = [(Int, Gen Bin)] -> Gen Bin
forall a. [(Int, Gen a)] -> Gen a
QC.frequency [ (Int
1, Bin -> Gen Bin
forall (m :: * -> *) a. Monad m => a -> m a
return Bin
BZ), (Int
20, (BinP -> Bin) -> Gen BinP -> Gen Bin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinP -> Bin
BP Gen BinP
forall a. Arbitrary a => Gen a
QC.arbitrary) ]

    shrink :: Bin -> [Bin]
shrink Bin
BZ     = []
    shrink (BP BinP
b) = Bin
BZ Bin -> [Bin] -> [Bin]
forall a. a -> [a] -> [a]
: (BinP -> Bin) -> [BinP] -> [Bin]
forall a b. (a -> b) -> [a] -> [b]
map BinP -> Bin
BP (BinP -> [BinP]
forall a. Arbitrary a => a -> [a]
QC.shrink BinP
b)

instance QC.CoArbitrary Bin where
    coarbitrary :: Bin -> Gen b -> Gen b
coarbitrary = Maybe BinP -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Maybe BinP -> Gen b -> Gen b)
-> (Bin -> Maybe BinP) -> Bin -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Maybe BinP
sp where
        sp :: Bin -> Maybe BinP
        sp :: Bin -> Maybe BinP
sp Bin
BZ     = Maybe BinP
forall a. Maybe a
Nothing
        sp (BP BinP
n) = BinP -> Maybe BinP
forall a. a -> Maybe a
Just BinP
n

instance QC.Function Bin where
    function :: (Bin -> b) -> Bin :-> b
function = (Bin -> Maybe BinP)
-> (Maybe BinP -> Bin) -> (Bin -> b) -> Bin :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap Bin -> Maybe BinP
sp (Bin -> (BinP -> Bin) -> Maybe BinP -> Bin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bin
BZ BinP -> Bin
BP) where
        sp :: Bin -> Maybe BinP
        sp :: Bin -> Maybe BinP
sp Bin
BZ     = Maybe BinP
forall a. Maybe a
Nothing
        sp (BP BinP
n) = BinP -> Maybe BinP
forall a. a -> Maybe a
Just BinP
n

-------------------------------------------------------------------------------
-- Showing
-------------------------------------------------------------------------------

-- | 'show' displaying a structure of 'Bin'.
--
-- >>> explicitShow 0
-- "BZ"
--
-- >>> explicitShow 2
-- "BP (B0 BE)"
--
explicitShow :: Bin -> String
explicitShow :: Bin -> String
explicitShow Bin
n = Int -> Bin -> ShowS
explicitShowsPrec Int
0 Bin
n String
""

-- | 'showsPrec' displaying a structure of 'Bin'.
explicitShowsPrec :: Int -> Bin -> ShowS
explicitShowsPrec :: Int -> Bin -> ShowS
explicitShowsPrec Int
_ Bin
BZ
    = String -> ShowS
showString String
"BZ"
explicitShowsPrec Int
d (BP BinP
n)
    = 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
"BP "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BinP -> ShowS
BP.explicitShowsPrec Int
11 BinP
n

-------------------------------------------------------------------------------
-- Bits
-------------------------------------------------------------------------------

instance Bits Bin where
    Bin
BZ   .&. :: Bin -> Bin -> Bin
.&. Bin
_    = Bin
BZ
    Bin
_    .&. Bin
BZ   = Bin
BZ
    BP BinP
a .&. BP BinP
b = BinP -> BinP -> Bin
andP BinP
a BinP
b

    Bin
BZ   xor :: Bin -> Bin -> Bin
`xor` Bin
b    = Bin
b
    Bin
a    `xor` Bin
BZ   = Bin
a
    BP BinP
a `xor` BP BinP
b = BinP -> BinP -> Bin
xorP BinP
a BinP
b

    Bin
BZ   .|. :: Bin -> Bin -> Bin
.|. Bin
b    = Bin
b
    Bin
a    .|. Bin
BZ   = Bin
a
    BP BinP
a .|. BP BinP
b = BinP -> Bin
BP (BinP
a BinP -> BinP -> BinP
forall a. Bits a => a -> a -> a
.|. BinP
b)

    bit :: Int -> Bin
bit = BinP -> Bin
BP (BinP -> Bin) -> (Int -> BinP) -> Int -> Bin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BinP
forall a. Bits a => Int -> a
bit

    clearBit :: Bin -> Int -> Bin
clearBit Bin
BZ     Int
_ = Bin
BZ
    clearBit (BP BinP
b) Int
n = BinP -> Int -> Bin
clearBitP BinP
b Int
n

    complementBit :: Bin -> Int -> Bin
complementBit Bin
BZ Int
n     = Int -> Bin
forall a. Bits a => Int -> a
bit Int
n
    complementBit (BP BinP
b) Int
n = BinP -> Int -> Bin
complementBitP BinP
b Int
n

    zeroBits :: Bin
zeroBits = Bin
BZ

    shiftL :: Bin -> Int -> Bin
shiftL Bin
BZ Int
_     = Bin
BZ
    shiftL (BP BinP
b) Int
n = BinP -> Bin
BP (BinP -> Int -> BinP
forall a. Bits a => a -> Int -> a
shiftL BinP
b Int
n)

    shiftR :: Bin -> Int -> Bin
shiftR Bin
BZ Int
_ = Bin
BZ
    shiftR Bin
b Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Bin
b
        | Bool
otherwise = Bin -> Int -> Bin
forall a. Bits a => a -> Int -> a
shiftR (Bin -> Bin
shiftR1 Bin
b) (Int -> Int
forall a. Enum a => a -> a
pred Int
n)

    rotateL :: Bin -> Int -> Bin
rotateL = Bin -> Int -> Bin
forall a. Bits a => a -> Int -> a
shiftL
    rotateR :: Bin -> Int -> Bin
rotateR = Bin -> Int -> Bin
forall a. Bits a => a -> Int -> a
shiftR

    testBit :: Bin -> Int -> Bool
testBit Bin
BZ Int
_     = Bool
False
    testBit (BP BinP
b) Int
i = BinP -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit BinP
b Int
i

    popCount :: Bin -> Int
popCount Bin
BZ     = Int
0
    popCount (BP BinP
n) = BinP -> Int
forall a. Bits a => a -> Int
popCount BinP
n

    -- xor -- tricky
    complement :: Bin -> Bin
complement  Bin
_  = String -> Bin
forall a. HasCallStack => String -> a
error String
"compelement @Bin is undefined"
    bitSizeMaybe :: Bin -> Maybe Int
bitSizeMaybe Bin
_ = Maybe Int
forall a. Maybe a
Nothing
    bitSize :: Bin -> Int
bitSize Bin
_      = String -> Int
forall a. HasCallStack => String -> a
error String
"bitSize @Bin is undefined"
    isSigned :: Bin -> Bool
isSigned Bin
_     = Bool
False

andP :: BinP -> BinP -> Bin
andP :: BinP -> BinP -> Bin
andP BinP
BE     BinP
BE     = BinP -> Bin
BP BinP
BE
andP BinP
BE     (B0 BinP
_) = Bin
BZ
andP BinP
BE     (B1 BinP
_) = BinP -> Bin
BP BinP
BE
andP (B0 BinP
_) BinP
BE     = Bin
BZ
andP (B1 BinP
_) BinP
BE     = BinP -> Bin
BP BinP
BE
andP (B0 BinP
a) (B0 BinP
b) = Bin -> Bin
mult2 (BinP -> BinP -> Bin
andP BinP
a BinP
b)
andP (B0 BinP
a) (B1 BinP
b) = Bin -> Bin
mult2 (BinP -> BinP -> Bin
andP BinP
a BinP
b)
andP (B1 BinP
a) (B0 BinP
b) = Bin -> Bin
mult2 (BinP -> BinP -> Bin
andP BinP
a BinP
b)
andP (B1 BinP
a) (B1 BinP
b) = BinP -> Bin
BP (Bin -> BinP
mult2Plus1 (BinP -> BinP -> Bin
andP BinP
a BinP
b))

xorP :: BinP -> BinP -> Bin
xorP :: BinP -> BinP -> Bin
xorP BinP
BE     BinP
BE     = Bin
BZ
xorP BinP
BE     (B0 BinP
b) = BinP -> Bin
BP (BinP -> BinP
B1 BinP
b)
xorP BinP
BE     (B1 BinP
b) = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)
xorP (B0 BinP
b) BinP
BE     = BinP -> Bin
BP (BinP -> BinP
B1 BinP
b)
xorP (B1 BinP
b) BinP
BE     = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)
xorP (B0 BinP
a) (B0 BinP
b) = Bin -> Bin
mult2 (BinP -> BinP -> Bin
xorP BinP
a BinP
b)
xorP (B0 BinP
a) (B1 BinP
b) = BinP -> Bin
BP (Bin -> BinP
mult2Plus1 (BinP -> BinP -> Bin
xorP BinP
a BinP
b))
xorP (B1 BinP
a) (B0 BinP
b) = BinP -> Bin
BP (Bin -> BinP
mult2Plus1 (BinP -> BinP -> Bin
xorP BinP
a BinP
b))
xorP (B1 BinP
a) (B1 BinP
b) = Bin -> Bin
mult2 (BinP -> BinP -> Bin
xorP BinP
a BinP
b)

clearBitP :: BinP -> Int -> Bin
clearBitP :: BinP -> Int -> Bin
clearBitP BinP
BE     Int
0 = Bin
BZ
clearBitP BinP
BE     Int
_ = BinP -> Bin
BP BinP
BE
clearBitP (B0 BinP
b) Int
0 = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)
clearBitP (B0 BinP
b) Int
n = Bin -> Bin
mult2 (BinP -> Int -> Bin
clearBitP BinP
b (Int -> Int
forall a. Enum a => a -> a
pred Int
n))
clearBitP (B1 BinP
b) Int
0 = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)
clearBitP (B1 BinP
b) Int
n = BinP -> Bin
BP (Bin -> BinP
mult2Plus1 (BinP -> Int -> Bin
clearBitP BinP
b (Int -> Int
forall a. Enum a => a -> a
pred Int
n)))

complementBitP :: BinP -> Int -> Bin
complementBitP :: BinP -> Int -> Bin
complementBitP BinP
BE     Int
0 = Bin
BZ
complementBitP BinP
BE     Int
n = BinP -> Bin
BP (BinP -> BinP
B1 (Int -> BinP
forall a. Bits a => Int -> a
bit (Int -> Int
forall a. Enum a => a -> a
pred Int
n)))
complementBitP (B0 BinP
b) Int
0 = BinP -> Bin
BP (BinP -> BinP
B1 BinP
b)
complementBitP (B0 BinP
b) Int
n = Bin -> Bin
mult2 (BinP -> Int -> Bin
complementBitP BinP
b (Int -> Int
forall a. Enum a => a -> a
pred Int
n))
complementBitP (B1 BinP
b) Int
0 = BinP -> Bin
BP (BinP -> BinP
B0 BinP
b)
complementBitP (B1 BinP
b) Int
n = BinP -> Bin
BP (Bin -> BinP
mult2Plus1 (BinP -> Int -> Bin
complementBitP BinP
b (Int -> Int
forall a. Enum a => a -> a
pred Int
n)))

shiftR1 :: Bin -> Bin
shiftR1 :: Bin -> Bin
shiftR1 Bin
BZ          = Bin
BZ
shiftR1 (BP BinP
BE)     = Bin
BZ
shiftR1 (BP (B0 BinP
b)) = BinP -> Bin
BP BinP
b
shiftR1 (BP (B1 BinP
b)) = BinP -> Bin
BP BinP
b

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

-- | Fold 'Bin'.
cata
    :: a        -- ^ \(0\)
    -> a        -- ^ \(1\)
    -> (a -> a) -- ^ \(2x\)
    -> (a -> a) -- ^ \(2x + 1\)
    -> Bin
    -> a
cata :: a -> a -> (a -> a) -> (a -> a) -> Bin -> a
cata a
z a
_ a -> a
_ a -> a
_ Bin
BZ     = a
z
cata a
_ a
h a -> a
e a -> a
o (BP BinP
b) = a -> (a -> a) -> (a -> a) -> BinP -> a
forall a. a -> (a -> a) -> (a -> a) -> BinP -> a
BP.cata a
h a -> a
e a -> a
o BinP
b

-- | Convert from 'Bin' to 'Nat'.
--
-- >>> toNat 5
-- 5
--
-- >>> N.explicitShow (toNat 5)
-- "S (S (S (S (S Z))))"
--
toNat :: Bin -> Nat
toNat :: Bin -> Nat
toNat Bin
BZ     = Nat
Z
toNat (BP BinP
n) = BinP -> Nat
BP.toNat BinP
n

-- | Convert from 'Nat' to 'Bin'.
--
-- >>> fromNat 5
-- 5
--
-- >>> explicitShow (fromNat 5)
-- "BP (B1 (B0 BE))"
--
fromNat :: Nat -> Bin
fromNat :: Nat -> Bin
fromNat = Bin -> (Bin -> Bin) -> Nat -> Bin
forall a. a -> (a -> a) -> Nat -> a
N.cata Bin
BZ Bin -> Bin
forall a. Enum a => a -> a
succ

-- | Convert 'Bin' to 'Natural'
--
-- >>> toNatural 0
-- 0
--
-- >>> toNatural 2
-- 2
--
-- >>> toNatural $ BP $ B0 $ B1 $ BE
-- 6
--
toNatural :: Bin -> Natural
toNatural :: Bin -> Natural
toNatural Bin
BZ        = Natural
0
toNatural (BP BinP
bnz) = BinP -> Natural
BP.toNatural BinP
bnz

-- | Convert 'Natural' to 'Nat'
--
-- >>> fromNatural 4
-- 4
--
-- >>> explicitShow (fromNatural 4)
-- "BP (B0 (B0 BE))"
--
fromNatural :: Natural -> Bin
fromNatural :: Natural -> Bin
fromNatural Natural
0 = Bin
BZ
fromNatural Natural
n = BinP -> Bin
BP (Natural -> BinP
BP.fromNatural Natural
n)

-------------------------------------------------------------------------------
-- Aliases
-------------------------------------------------------------------------------

bin0, bin1, bin2, bin3, bin4, bin5, bin6, bin7, bin8, bin9 :: Bin
bin0 :: Bin
bin0 = Bin
BZ
bin1 :: Bin
bin1 = BinP -> Bin
BP BinP
BP.binP1
bin2 :: Bin
bin2 = BinP -> Bin
BP BinP
BP.binP2
bin3 :: Bin
bin3 = BinP -> Bin
BP BinP
BP.binP3
bin4 :: Bin
bin4 = BinP -> Bin
BP BinP
BP.binP4
bin5 :: Bin
bin5 = BinP -> Bin
BP BinP
BP.binP5
bin6 :: Bin
bin6 = BinP -> Bin
BP BinP
BP.binP6
bin7 :: Bin
bin7 = BinP -> Bin
BP BinP
BP.binP7
bin8 :: Bin
bin8 = BinP -> Bin
BP BinP
BP.binP8
bin9 :: Bin
bin9 = BinP -> Bin
BP BinP
BP.binP9