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

#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE StandaloneDeriving #-}
#endif
-- | Positive binary natural numbers, 'BinP'.
--
-- This module is designed to be imported qualified.
--
module Data.BinP (
    BinP(..),
    -- * Conversions
    cata,
    toNatural,
    fromNatural,
    toNat,
    -- * Showing
    explicitShow,
    explicitShowsPrec,
    -- * Extras
    predMaybe,
    -- * Aliases
    binP1, binP2, binP3, binP4, binP5, binP6, binP7, binP8, binP9,
    ) where

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

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

-- $setup
-- >>> import Data.List (sort)

-------------------------------------------------------------------------------
-- BinP
-------------------------------------------------------------------------------

-- | Non-zero binary natural numbers.
--
-- We could have called this type @Bin1@,
-- but that's used as type alias for promoted @'BP' 'BE'@ in "Data.Type.Bin".
data BinP
    = BE        -- ^ one
    | B0 BinP  -- ^ mult2
    | B1 BinP  -- ^ mult2 plus 1
  deriving (BinP -> BinP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinP -> BinP -> Bool
$c/= :: BinP -> BinP -> Bool
== :: BinP -> BinP -> Bool
$c== :: BinP -> BinP -> Bool
Eq, Typeable, Typeable @(*) BinP
BinP -> DataType
BinP -> Constr
(forall b. Data b => b -> b) -> BinP -> BinP
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) -> BinP -> u
forall u. (forall d. Data d => d -> u) -> BinP -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinP
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinP -> c BinP
forall (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(forall d. Data d => c (t d)) -> Maybe (c BinP)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinP)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinP -> m BinP
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinP -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinP -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BinP -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinP -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinP -> r
gmapT :: (forall b. Data b => b -> b) -> BinP -> BinP
$cgmapT :: (forall b. Data b => b -> b) -> BinP -> BinP
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinP)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable @(* -> * -> *) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinP)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(forall d. Data d => c (t d)) -> Maybe (c BinP)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable @(* -> *) t =>
(forall d. Data d => c (t d)) -> Maybe (c BinP)
dataTypeOf :: BinP -> DataType
$cdataTypeOf :: BinP -> DataType
toConstr :: BinP -> Constr
$ctoConstr :: BinP -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinP
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinP
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinP -> c BinP
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinP -> c BinP
Data)

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

#if __GLASGOW_HASKELL__ < 710
deriving instance Typeable 'BE
deriving instance Typeable 'B0
deriving instance Typeable 'B1
#endif

-- |
--
-- >>> sort [ 1 .. 9 :: BinP ]
-- [1,2,3,4,5,6,7,8,9]
--
-- >>> sort $ reverse [ 1 .. 9 :: BinP ]
-- [1,2,3,4,5,6,7,8,9]
--
-- >>> sort $ [ 1 .. 9 ] ++ [ 1 .. 9 :: BinP ]
-- [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9]
--
instance Ord BinP where
    compare :: BinP -> BinP -> Ordering
compare = Ordering -> BinP -> BinP -> Ordering
go Ordering
EQ where
        go :: Ordering -> BinP -> BinP -> Ordering
go  Ordering
acc BinP
BE     BinP
BE     = Ordering
acc
        go Ordering
_acc BinP
BE     BinP
_      = Ordering
LT
        go Ordering
_acc BinP
_      BinP
BE     = Ordering
GT
        go  Ordering
acc (B0 BinP
a) (B0 BinP
b) = Ordering -> BinP -> BinP -> Ordering
go Ordering
acc BinP
a BinP
b
        go  Ordering
acc (B1 BinP
a) (B1 BinP
b) = Ordering -> BinP -> BinP -> Ordering
go Ordering
acc BinP
a BinP
b
        go Ordering
_acc (B0 BinP
a) (B1 BinP
b) = Ordering -> BinP -> BinP -> Ordering
go Ordering
LT  BinP
a BinP
b
        go Ordering
_acc (B1 BinP
a) (B0 BinP
b) = Ordering -> BinP -> BinP -> Ordering
go Ordering
GT  BinP
a BinP
b

instance Show BinP where
    showsPrec :: Int -> BinP -> ShowS
showsPrec Int
d = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinP -> Natural
toNatural

instance Num BinP where
    fromInteger :: Integer -> BinP
fromInteger = Natural -> BinP
fromNatural forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

    BinP
BE   + :: BinP -> BinP -> BinP
+ BinP
b    = forall a. Enum a => a -> a
succ BinP
b
    BinP
b    + BinP
BE   = forall a. Enum a => a -> a
succ BinP
b
    B0 BinP
a + B0 BinP
b = BinP -> BinP
B0 (BinP
a forall a. Num a => a -> a -> a
+ BinP
b)
    B0 BinP
a + B1 BinP
b = BinP -> BinP
B1 (BinP
a forall a. Num a => a -> a -> a
+ BinP
b)
    B1 BinP
a + B0 BinP
b = BinP -> BinP
B1 (BinP
a forall a. Num a => a -> a -> a
+ BinP
b)
    B1 BinP
a + B1 BinP
b = BinP -> BinP
B0 (forall a. Enum a => a -> a
succ (BinP
a forall a. Num a => a -> a -> a
+ BinP
b))

    BinP
BE * :: BinP -> BinP -> BinP
* BinP
b = BinP
b
    BinP
a  * BinP
BE = BinP
a
    B0 BinP
a * B0 BinP
b = BinP -> BinP
B0 (BinP -> BinP
B0 (BinP
a forall a. Num a => a -> a -> a
* BinP
b))
    B1 BinP
a * B0 BinP
b = BinP -> BinP
B0 (BinP -> BinP
B0 (BinP
a forall a. Num a => a -> a -> a
* BinP
b)) forall a. Num a => a -> a -> a
+ BinP -> BinP
B0 BinP
b
    B0 BinP
a * B1 BinP
b = BinP -> BinP
B0 (BinP -> BinP
B0 (BinP
a forall a. Num a => a -> a -> a
* BinP
b)) forall a. Num a => a -> a -> a
+ BinP -> BinP
B0 BinP
a
    B1 BinP
a * B1 BinP
b = BinP -> BinP
B1 (BinP -> BinP
B0 (BinP
a forall a. Num a => a -> a -> a
* BinP
b)) forall a. Num a => a -> a -> a
+ BinP -> BinP
B0 BinP
a forall a. Num a => a -> a -> a
+ BinP -> BinP
B0 BinP
b

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

    signum :: BinP -> BinP
signum BinP
_ = BinP
BE

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

instance Real BinP where
    toRational :: BinP -> 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 BinP where
    toInteger :: BinP -> Integer
toInteger = forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinP -> Natural
toNatural

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

instance Enum BinP where
    succ :: BinP -> BinP
succ BinP
BE     = BinP -> BinP
B0 BinP
BE
    succ (B0 BinP
n) = BinP -> BinP
B1 BinP
n
    succ (B1 BinP
n) = BinP -> BinP
B0 (forall a. Enum a => a -> a
succ BinP
n)

    pred :: BinP -> BinP
pred BinP
n = case BinP -> Maybe BinP
predMaybe BinP
n of
        Maybe BinP
Nothing -> forall a e. Exception e => e -> a
throw ArithException
Underflow
        Just BinP
m  -> BinP
m

    toEnum :: Int -> BinP
toEnum Int
n = case forall a. Ord a => a -> a -> Ordering
compare Int
n Int
1 of
        Ordering
LT -> forall a e. Exception e => e -> a
throw ArithException
Underflow
        Ordering
EQ -> BinP
BE
        Ordering
GT -> case Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
            (Int
m, Int
0) -> BinP -> BinP
B0 (forall a. Enum a => Int -> a
toEnum Int
m)
            (Int
m, Int
_) -> BinP -> BinP
B1 (forall a. Enum a => Int -> a
toEnum Int
m)

    fromEnum :: BinP -> Int
fromEnum BinP
BE     = Int
1
    fromEnum (B0 BinP
n) = Int
2 forall a. Num a => a -> a -> a
* forall a. Enum a => a -> Int
fromEnum BinP
n
    fromEnum (B1 BinP
n) = forall a. Enum a => a -> a
succ (Int
2 forall a. Num a => a -> a -> a
* forall a. Enum a => a -> Int
fromEnum BinP
n)

instance NFData BinP where
    rnf :: BinP -> ()
rnf BinP
BE     = ()
    rnf (B0 BinP
n) = forall a. NFData a => a -> ()
rnf BinP
n
    rnf (B1 BinP
n) = forall a. NFData a => a -> ()
rnf BinP
n

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

predMaybe :: BinP -> Maybe BinP
predMaybe :: BinP -> Maybe BinP
predMaybe BinP
BE     = forall a. Maybe a
Nothing
predMaybe (B1 BinP
n) = forall a. a -> Maybe a
Just (BinP -> BinP
B0 BinP
n)
predMaybe (B0 BinP
n) = forall a. a -> Maybe a
Just (Maybe BinP -> BinP
mult2Plus1 (BinP -> Maybe BinP
predMaybe BinP
n))
  where
    mult2Plus1 :: Maybe BinP -> BinP
    mult2Plus1 :: Maybe BinP -> BinP
mult2Plus1 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe BinP
BE BinP -> BinP
B1

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

-- | __NOTE__: '.&.', 'xor', 'shiftR' and 'rotateR' are __NOT_ implemented.
-- They may make number zero.
--
instance Bits BinP where
    B0 BinP
a .|. :: BinP -> BinP -> BinP
.|. B0 BinP
b = BinP -> BinP
B0 (BinP
a forall a. Bits a => a -> a -> a
.|. BinP
b)
    B0 BinP
a .|. B1 BinP
b = BinP -> BinP
B1 (BinP
a forall a. Bits a => a -> a -> a
.|. BinP
b)
    B1 BinP
a .|. B0 BinP
b = BinP -> BinP
B1 (BinP
a forall a. Bits a => a -> a -> a
.|. BinP
b)
    B1 BinP
a .|. B1 BinP
b = BinP -> BinP
B1 (BinP
a forall a. Bits a => a -> a -> a
.|. BinP
b)

    BinP
BE   .|. B0 BinP
b = BinP -> BinP
B1 BinP
b
    BinP
BE   .|. B1 BinP
b = BinP -> BinP
B1 BinP
b
    B0 BinP
b .|. BinP
BE   = BinP -> BinP
B1 BinP
b
    B1 BinP
b .|. BinP
BE   = BinP -> BinP
B1 BinP
b

    BinP
BE   .|. BinP
BE   = BinP
BE

    bit :: Int -> BinP
bit Int
n
        | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = BinP
BE
        | Bool
otherwise = BinP -> BinP
B0 (forall a. Bits a => Int -> a
bit (forall a. Enum a => a -> a
pred Int
n))

    shiftL :: BinP -> Int -> BinP
shiftL BinP
b Int
n
        | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0    = BinP
b
        | Bool
otherwise = forall a. Bits a => a -> Int -> a
shiftL (BinP -> BinP
B0 BinP
b) (forall a. Enum a => a -> a
pred Int
n)

    rotateL :: BinP -> Int -> BinP
rotateL = forall a. Bits a => a -> Int -> a
shiftL

    popCount :: BinP -> Int
popCount = forall {t}. Enum t => t -> BinP -> t
go Int
1 where
        go :: t -> BinP -> t
go !t
acc BinP
BE     = t
acc
        go !t
acc (B0 BinP
b) = t -> BinP -> t
go t
acc BinP
b
        go !t
acc (B1 BinP
b) = t -> BinP -> t
go (forall a. Enum a => a -> a
succ t
acc) BinP
b

    testBit :: BinP -> Int -> Bool
testBit BinP
BE     Int
0 = Bool
True
    testBit (B0 BinP
_) Int
0 = Bool
False
    testBit (B1 BinP
_) Int
0 = Bool
True
    testBit BinP
BE     Int
_ = Bool
False
    testBit (B0 BinP
b) Int
n = forall a. Bits a => a -> Int -> Bool
testBit BinP
b (forall a. Enum a => a -> a
pred Int
n)
    testBit (B1 BinP
b) Int
n = forall a. Bits a => a -> Int -> Bool
testBit BinP
b (forall a. Enum a => a -> a
pred Int
n)

    zeroBits :: BinP
zeroBits          = forall a. HasCallStack => String -> a
error String
"zeroBits @BinP is undefined"
    clearBit :: BinP -> Int -> BinP
clearBit BinP
_ Int
_      = forall a. HasCallStack => String -> a
error String
"clearBit @BinP is undefined"
    complementBit :: BinP -> Int -> BinP
complementBit BinP
_ Int
_ = forall a. HasCallStack => String -> a
error String
"complementBit @BinP is undefined"
    xor :: BinP -> BinP -> BinP
xor BinP
_ BinP
_           = forall a. HasCallStack => String -> a
error String
"xor @BinP is undefined"
    .&. :: BinP -> BinP -> BinP
(.&.) BinP
_ BinP
_         = forall a. HasCallStack => String -> a
error String
"(.&.) @BinP is undefined"
    shiftR :: BinP -> Int -> BinP
shiftR BinP
_          = forall a. HasCallStack => String -> a
error String
"shiftR @BinP is undefined"
    rotateR :: BinP -> Int -> BinP
rotateR BinP
_         = forall a. HasCallStack => String -> a
error String
"shiftL @BinP is undefined"
    complement :: BinP -> BinP
complement  BinP
_     = forall a. HasCallStack => String -> a
error String
"compelement @BinP is undefined"
    bitSizeMaybe :: BinP -> Maybe Int
bitSizeMaybe BinP
_    = forall a. Maybe a
Nothing
    bitSize :: BinP -> Int
bitSize BinP
_         = forall a. HasCallStack => String -> a
error String
"bitSize @BinP is undefined"
    isSigned :: BinP -> Bool
isSigned BinP
_        = Bool
True

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

instance QC.Arbitrary BinP where
    arbitrary :: Gen BinP
arbitrary = do
        [Bool]
bs <- forall a. Arbitrary a => Gen a
QC.arbitrary :: QC.Gen [Bool]
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Bool
b -> if Bool
b then BinP -> BinP
B1 else BinP -> BinP
B0) BinP
BE [Bool]
bs)

    shrink :: BinP -> [BinP]
shrink BinP
BE     = []
    shrink (B1 BinP
b) = BinP
b forall a. a -> [a] -> [a]
: BinP -> BinP
B0 BinP
b forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map BinP -> BinP
B1 (forall a. Arbitrary a => a -> [a]
QC.shrink BinP
b)
    shrink (B0 BinP
b) = BinP
b forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map BinP -> BinP
B0 (forall a. Arbitrary a => a -> [a]
QC.shrink BinP
b)

instance QC.CoArbitrary BinP where
    coarbitrary :: forall b. BinP -> 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
. BinP -> Maybe (Either BinP BinP)
sp where
        sp :: BinP -> Maybe (Either BinP BinP)
        sp :: BinP -> Maybe (Either BinP BinP)
sp BinP
BE     = forall a. Maybe a
Nothing
        sp (B0 BinP
b) = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left BinP
b)
        sp (B1 BinP
b) = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right BinP
b)

instance QC.Function BinP where
    function :: forall b. (BinP -> b) -> BinP :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap BinP -> Maybe (Either BinP BinP)
sp (forall b a. b -> (a -> b) -> Maybe a -> b
maybe BinP
BE (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BinP -> BinP
B0 BinP -> BinP
B1)) where
        sp :: BinP -> Maybe (Either BinP BinP)
        sp :: BinP -> Maybe (Either BinP BinP)
sp BinP
BE     = forall a. Maybe a
Nothing
        sp (B0 BinP
b) = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left BinP
b)
        sp (B1 BinP
b) = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right BinP
b)

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

-- | 'show' displaying a structure of 'BinP'.
--
-- >>> explicitShow 11
-- "B1 (B1 (B0 BE))"
explicitShow :: BinP -> String
explicitShow :: BinP -> String
explicitShow BinP
n = Int -> BinP -> ShowS
explicitShowsPrec Int
0 BinP
n String
""

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

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

-- | 'toNatural' for 'BinP'.
toNatural :: BinP -> Natural
toNatural :: BinP -> Natural
toNatural BinP
BE     = Natural
1
toNatural (B0 BinP
n) = Natural
2 forall a. Num a => a -> a -> a
* BinP -> Natural
toNatural BinP
n
toNatural (B1 BinP
n) = Natural
2 forall a. Num a => a -> a -> a
* BinP -> Natural
toNatural BinP
n forall a. Num a => a -> a -> a
+ Natural
1

-- | 'fromNatural' for 'BinP'.
--
-- Throws when given 0.
fromNatural :: Natural -> BinP
fromNatural :: Natural -> BinP
fromNatural Natural
0 = forall a e. Exception e => e -> a
throw ArithException
Underflow
fromNatural Natural
1 = BinP
BE
fromNatural Natural
n = case Natural
n forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
2 of
    (Natural
m, Natural
0) -> BinP -> BinP
B0 (Natural -> BinP
fromNatural Natural
m)
    (Natural
m, Natural
_) -> BinP -> BinP
B1 (Natural -> BinP
fromNatural Natural
m)

-- | Fold 'BinP'.
cata
    :: a        -- ^ \(1\)
    -> (a -> a) -- ^ \(2x\)
    -> (a -> a) -- ^ \(2x + 1\)
    -> BinP
    -> a
cata :: forall a. a -> (a -> a) -> (a -> a) -> BinP -> a
cata a
z a -> a
o a -> a
i = BinP -> a
go where
    go :: BinP -> a
go BinP
BE     = a
z
    go (B0 BinP
b) = a -> a
o (BinP -> a
go BinP
b)
    go (B1 BinP
b) = a -> a
i (BinP -> a
go BinP
b)

-- | Convert from 'BinP' to 'Nat'.
toNat :: BinP -> Nat
toNat :: BinP -> Nat
toNat = forall a. a -> (a -> a) -> (a -> a) -> BinP -> a
cata (Nat -> Nat
S Nat
Z) Nat -> Nat
o Nat -> Nat
i where
    o :: Nat -> Nat
    o :: Nat -> Nat
o = forall a. a -> (a -> a) -> Nat -> a
N.cata Nat
Z (Nat -> Nat
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nat -> Nat
S)

    i :: Nat -> Nat
    i :: Nat -> Nat
i = Nat -> Nat
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nat -> Nat
o

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

binP1, binP2, binP3, binP4, binP5, binP6, binP7, binP8, binP9 :: BinP
binP1 :: BinP
binP1 = BinP
BE
binP2 :: BinP
binP2 = BinP -> BinP
B0 BinP
BE
binP3 :: BinP
binP3 = BinP -> BinP
B1 BinP
BE
binP4 :: BinP
binP4 = BinP -> BinP
B0 BinP
binP2
binP5 :: BinP
binP5 = BinP -> BinP
B1 BinP
binP2
binP6 :: BinP
binP6 = BinP -> BinP
B0 BinP
binP3
binP7 :: BinP
binP7 = BinP -> BinP
B1 BinP
binP3
binP8 :: BinP
binP8 = BinP -> BinP
B0 BinP
binP4
binP9 :: BinP
binP9 = BinP -> BinP
B1 BinP
binP4