Some fun with Peano numbers

gistfile1.ml

(* Type of natural numbers *)
type nat = Zero
         | Succ of nat ;;

exception Undefined ;;

type comparison = LT
                | EQ
                | GT ;;


(* Conversion between machine integers and our 100% all-natural numbers *)
let rec int_to_nat n =
    if n == 0 then Zero else Succ (int_to_nat (n - 1)) ;;

let rec nat_to_int n = match n with
    Zero -> 0
  | Succ np -> 1 + (nat_to_int np) ;;

let rec add x y = match x with
    Zero -> y
  | Succ xp -> add xp (Succ y) ;;

let rec sub x y = match x with
    Zero -> (match y with
        Zero -> Zero
      | Succ yp -> raise Undefined)
    | Succ xp -> (match y with
        Zero -> x
      | Succ yp -> sub xp yp) ;;

let mul x y =
    let rec mul_inner x y acc = match x with
        Zero -> acc
      | Succ xp -> mul_inner xp y (add y acc)
    in mul_inner x y Zero ;;

let rec cmp x y = match x with
    Zero -> (match y with
        Zero -> EQ
      | Succ yp -> LT)
  | Succ xp -> (match y with
        Zero -> GT
      | Succ yp -> cmp xp yp) ;;

let div_mod x y =
    let rec div_inner x y yp acc = let remainder = sub x yp
      in match cmp (sub x yp) y with
        LT -> (acc, remainder)
      | _  -> div_inner x y (add yp y) (Succ acc)

    in div_inner x y Zero Zero ;;

let div x y = fst (div_mod x y) ;;
let modulo x y = snd (div_mod x y) ;;

(* Finds the greatest common divisor of x and y, with x >= y *)
let rec gcd x y = match y with
    Zero -> x
  | Succ yp -> gcd y (modulo x y) ;;

(* Some helpful constants *)
let one   = Succ Zero ;;
let two   = Succ one ;;
let three = Succ two ;;
let four  = Succ three ;;
let five  = Succ four ;;
let six   = Succ five ;;
let seven = Succ six ;;
let eight = Succ seven ;;
let nine  = Succ eight ;;
let ten   = Succ nine ;;

let assocs = [(Zero,  "0");
              (one,   "1");
              (two,   "2");
              (three, "3");
              (four,  "4");
              (five,  "5");
              (six,   "6");
              (seven, "7");
              (eight, "8");
              (nine,  "9");] ;;

(* Converts a natural to a string by repeated div/mod 10 *)
let rec nat_to_string n = 
    try
        List.assoc n assocs
    with Not_found ->
        (let (d, m) = div_mod n ten
                                in String.concat "" [nat_to_string d;
                                                  List.assoc m assocs]) ;;

(* Loop to generate and print Fibonacci numbers *)
let rec print_fibs a b = print_string (nat_to_string b) ;
                         print_newline () ;
                         print_fibs b (add a b)
in print_fibs Zero one ;;