{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
#endif
module Data.BinP (
BinP(..),
cata,
toNatural,
fromNatural,
toNat,
explicitShow,
explicitShowsPrec,
predMaybe,
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
data BinP
= BE
| B0 BinP
| B1 BinP
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)
#if __GLASGOW_HASKELL__ < 710
deriving instance Typeable 'BE
deriving instance Typeable 'B0
deriving instance Typeable 'B1
#endif
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
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
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)
explicitShow :: BinP -> String
explicitShow :: BinP -> String
explicitShow BinP
n = Int -> BinP -> ShowS
explicitShowsPrec Int
0 BinP
n String
""
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
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 :: 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)
cata
:: a
-> (a -> a)
-> (a -> a)
-> 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)
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
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