-- in WinHugs, you'll need to change some options and restart
-- (options are in the little "gear" icon)
-- turn on "Allow GHC extensions" and "overlapping instances"
--(for command-line options, use "hugs +o +O -98")


module Natty where


data Nat = Zero | Succ Nat  deriving (Eq,Show)


class Natty n where
  zero :: n
  suck :: n -> n
  isZero :: n -> Bool
  pret :: n -> n

instance Natty Nat where
  zero = Zero
  suck = Succ
  isZero n = (n == Zero)
  pret Zero = Zero
  pret (Succ n) = n
  
one, two, three, four :: Natty n => n
one = suck zero
two = suck one
three = suck two
four = suck three



type Notches = [()]

instance Natty Notches where
  zero = []
  suck = (():)
  isZero = (==[])
  pret = drop 1

  
newtype Church a = Church (forall a. (a -> a) -> a -> a)

instance Natty (Church a) where
  zero              = Church (\f x -> x)
  suck   (Church n) = Church (\f x -> f (n f x))
  isZero (Church n) = n (const False) True
  pret   (Church n) = Church (\f x -> n (\g h -> h (g f)) (\u -> x) (\u -> u))
  
foo (Church n) = n (+3) 7

instance Show (Church a) where
  show (Church n) = "\\f x -> " ++ n ("(f "++) "x" ++ n (')':) ""


iter f x n = if isZero n then x else f (iter f x (pret n))

plus :: Natty n => n -> n -> n
plus n m = iter suck n m

mult :: Natty n => n -> n -> n
mult n m = iter (plus n) zero m