(* Lecture 27: Scheme *)
(* See home page on scheme at http://www-swiss.ai.mit.edu/scheme-home.html *)

(* Church numerals in ML *)
(* Note that the only place we use recursion is in the conversion *)
(* from integers to Church numerals (only given for convenience)! *)

type 'a nat = 'a -> ('a -> 'a) -> 'a;

val zero : 'a nat =
    fn x:'a => fn f:'a->'a => x;
val succ : 'a nat -> 'a nat =
    fn n:'a nat => fn x:'a => fn f:'a->'a => f (n x f);

val toInt : int nat -> int =
    fn (n:int nat) => n 0 (fn x => x + 1);

(* fromInt i  where i >= 0 *)
(* val fromInt : int -> 'a nat *)
fun fromInt (0) = zero
  | fromInt (i) = succ (fromInt (i-1));

val n5 : 'a nat = fn x => fn f => f(f(f(f(f(x)))));
val n5' : int nat = succ (succ (succ (succ (succ zero))));
val i5 = toInt n5;
val i5' = toInt n5';

val plus : 'a nat -> 'a nat -> 'a nat =
    fn n:'a nat => fn m:'a nat =>
    fn x:'a => fn f:'a -> 'a => n (m x f) f;

val times : 'a nat -> 'a nat -> 'a nat =
    fn n:'a nat => fn m:'a nat =>
    fn x:'a => fn f:'a -> 'a => n x (fn y => m y f);

val n25 : int nat = times n5 n5;
val i25 = toInt n25;

(* exponential cannot be programmed in the same way as above *)
(* the first argument needs to iterate over naturals *)

val exp : ('a nat) nat -> 'a nat -> 'a nat =
    fn n:('a nat) nat => fn m:'a nat =>
    n (succ zero) (fn x:'a nat => times x m);

val n3125 : int nat = exp n5 n5;
val i3125 = toInt n3125;

(* we code pairs in the pure calculus, just to see that we *)
(* can define predecessor in the language with only functions *)
type 'a pair = ('a -> 'a -> 'a) -> 'a;
val pair : 'a -> 'a -> 'a pair =
    fn x:'a => fn y:'a => fn f:'a -> 'a -> 'a => f x y;
val fst : 'a pair -> 'a =
    fn p:'a pair => p (fn x:'a => fn y:'a => x);
val snd : 'a pair -> 'a =
    fn p:'a pair => p (fn x:'a => fn y:'a => y);   

val pred : (('a nat) pair) nat -> 'a nat =
    fn n:(('a nat) pair) nat =>
    fst (n (pair zero zero)
	   (fn p:('a nat) pair => pair (snd p) (succ (snd p))));

val n3124 : int nat = pred (exp n5 n5);
val i3124 = toInt n3124;