Arrow style natural numbers

natural.hs

import Prelude hiding (succ, pred, and, or, not, const, flip, curry)
import Control.Arrow

-- Arrow style natural numbers by itchyny


toint = ($ ((1+), 0))
tobool = ($ (True, False))
fromint 0 = zero
fromint n = succ (fromint (n - 1))

-- Do not use except for
--    fst
--    snd
--    (,)
--    app
--    id
--    (>>>)
--    (&&&)
--    (***)
--
-- and following is allowed
--    (<<<) == flip (>>>)
--    curry == ((<<<) >>> ((,) >>>))
--    flip == uncurry >>> ((snd &&& fst) >>>) >>> curry
--    const == ((,) >>> (>>> fst))
--
-- don't use
--    uncurry == (*** id) >>> (>>> app)
--            == \f -> (f *** id) >>> app
--    (.) f g == g >>> f
--    first f == f *** id
--    second g == id *** g
--    ($) == curry app
--    etc.
--
--
-- f >>> (>>> g) == (g.).f
--               == \x -> (g.) (f x)
--               == \x -> g . f x
-- \a -> (g >>> f a) == \a -> ((g >>>) (f a))
--                   == \a -> (f >>> (g >>>)) a
--                   == f >>> (g >>>)

curry = ((<<<) >>> ((,) >>>))
flip = uncurry >>> ((snd &&& fst) >>>) >>> curry
const = ((,) >>> (>>> fst))

-- zero = \(f, x) -> x
zero = snd

-- succ = \n (f, x) -> f (n (f, x))
succ = curry ((snd >>> fst) &&& app >>> app)

-- plus = \m n (f, x) -> m (f, (n (f, x)))
plus = (((snd >>> fst) &&& app) >>>) >>> curry

-- mult = \m n -> m ((plus n), zero)
mult = ((plus >>> (flip (,) zero)) >>>)

-- pred = \n (f, x) -> n ((\g h -> h (g f)), (\u -> x)) (\u -> u)
pred = flip flip id >>> (flip (>>> flip (curry app)) *** const >>>)

-- iszero = \n -> n (\x -> false) true
iszero = flip (curry app) ((const false), true)

-- true = \(x, y) -> x
true = fst

-- false = \(x, y) -> y
false = snd

-- and = \p q -> p (q, false)
and = (flip (,) false >>>)

-- or = \p q -> p (true, q)
or = ((,) true >>>)

-- not = \p -> p (false, true)
not = flip (curry app) ((,) false true)

-- fact = loop (\(n, f) -> (f n, g f))
-- g = (\(f, n) -> (iszero n) ((succ zero), mult n (f (pred n))))
-- g = \n -> (iszero n) ((succ zero), mult n (g (pred n)))

main = do
  -- print $ fact 10
  -- print $ fact (fromint 10)
  -- print $ toint $ fact (succ (succ (succ zero)))
  let one = succ zero
      two = succ one
      three = succ two
      four = succ three
      five = succ four
      six = succ five
  print $ toint zero
  print $ toint one
  print $ toint two
  print $ toint three
  print $ toint $ plus five three
  print $ toint $ mult four six
  print $ toint $ pred six
  print $ toint $ pred (plus six six)
  print $ tobool $ iszero zero
  print $ tobool $ iszero $ succ zero
  print $ "Bool"
  print $ tobool true
  print $ tobool false
  print $ "and"
  print $ tobool $ and true true
  print $ tobool $ and true false
  print $ tobool $ and false true
  print $ tobool $ and false false
  print $ "or"
  print $ tobool $ or true true
  print $ tobool $ or true false
  print $ tobool $ or false true
  print $ tobool $ or false false
  print $ "not"
  print $ tobool $ not true
  print $ tobool $ not false