-- 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