{-# 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
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
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
Ord, Typeable, Typeable @(*) Bin
Bin -> DataType
Bin -> Constr
(forall b. Data b => b -> b) -> Bin -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Bin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bin -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bin -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall a. Num a => a -> a -> a
* BinP
b)

    abs :: Bin -> Bin
abs = 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
_ = forall a. HasCallStack => String -> a
error String
"negate @Bin"

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

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

    quotRem :: Bin -> Bin -> (Bin, Bin)
quotRem 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 (forall a. Enum a => a -> a
succ BinP
n)

    pred :: Bin -> Bin
pred Bin
BZ     = 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 forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
        Ordering
LT -> forall a e. Exception e => e -> a
throw ArithException
Underflow
        Ordering
EQ -> Bin
BZ
        Ordering
GT -> BinP -> Bin
BP (forall a. Enum a => Int -> a
toEnum  Int
n)

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

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

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

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

instance QC.CoArbitrary Bin where
    coarbitrary :: forall b. Bin -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary 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     = forall a. Maybe a
Nothing
        sp (BP BinP
n) = forall a. a -> Maybe a
Just BinP
n

instance QC.Function Bin where
    function :: forall b. (Bin -> b) -> Bin :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap Bin -> Maybe BinP
sp (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     = forall a. Maybe a
Nothing
        sp (BP BinP
n) = 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 forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BP "
    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 forall a. Bits a => a -> a -> a
.|. BinP
b)

    bit :: Int -> Bin
bit = BinP -> Bin
BP forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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     = 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 (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 forall a. Ord a => a -> a -> Bool
<= Int
0 = Bin
b
        | Bool
otherwise = forall a. Bits a => a -> Int -> a
shiftR (Bin -> Bin
shiftR1 Bin
b) (forall a. Enum a => a -> a
pred Int
n)

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

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

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

    -- xor -- tricky
    complement :: Bin -> Bin
complement  Bin
_  = forall a. HasCallStack => String -> a
error String
"compelement @Bin is undefined"
    bitSizeMaybe :: Bin -> Maybe Int
bitSizeMaybe Bin
_ = forall a. Maybe a
Nothing
    bitSize :: Bin -> Int
bitSize Bin
_      = 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 (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 (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 (forall a. Bits a => Int -> a
bit (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 (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 (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 :: forall a. 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) = 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 = forall a. a -> (a -> a) -> Nat -> a
N.cata Bin
BZ 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