(* Lecture 28: Scheme, Review of Semester *)

(* References and circular lists *)

(*
; l must be non-empty
; returns no useful value
(define append!
 (lambda (l k)
  (cond ((and (pair? l) (null? (cdr l)))
         (set-cdr! l k))
        (#t (append! (cdr l) k)))))

(define reverse!
 (lambda (l)
  (letrec ((rev (lambda (prev k)
                 (if (null? k)
		     prev
		     (let ((next (cdr l)))
			(set-cdr! l prev)
			(rev l next))))))
    (rev '() l))))
*)

datatype 'a mlist = Nil | Cons of 'a * ('a mlist) ref;

fun reverse cl =
    let fun rev (prev, Nil) = prev
	  | rev (prev, this as Cons(x,r as ref(next))) =
              (r := prev ; rev (this, next))
    in
      rev (Nil, cl)
    end;

val l123 = Cons(1,ref(Cons(2,ref(Cons(3,ref(Nil))))));
val l321 = reverse l123;
l123;
(* val l123 : int mlist = Cons (1, ref(Nil)) *)

(* repeat l for l <> nil *)
fun repeat (x::l) =
    let
        val tail = ref(Nil)
        val result = Cons(x,tail)
        fun rp (nil) = result
	  | rp (y::k) = Cons(y,ref(rp k))
    in
      ( tail := rp(l) ; result )
    end;

(* Embedding "Scheme" into ML *)
(* Universal type U *)

datatype U =
    Integer of int
  | Symbol of string
  | Bool of bool
  | Nil
  | Cons of U * U
  | Fun of U -> U;

exception RuntimeError;

fun plus (Cons(Integer(n1),Integer(n2))) = Integer(n1+n2)
  | plus _ = raise RuntimeError;

fun car (Cons(s1,s2)) = s1
  | car _ = raise RuntimeError;

fun cdr (Cons(s1,s2)) = s2
  | cdr _ = raise RuntimeError;

fun nullp (Nil) = Bool(true)
  | nullp _ = Bool(false);

fun apply (Fun(f),s) = f(s)
  | apply _ = raise RuntimeError;

(* val Y : (U -> U) -> U *)
fun Y (f) = Fun (fn x => apply (f (Y f), x))

(*
(define length
 (lambda (l)
  (if (null? l)
      0
      (+ (length (cdr l)) 1))))

(define two 
 (length (cons 1 (cons 2 ())))
*)

(* Alternative 1, using "fun" *)
(*
(* val length' : U -> U *)
fun length' (s) =
    (case (nullp s)
       of (Bool(true)) => Integer(0)
        | (Bool(false)) => plus (Cons (length' (cdr s), Integer(1)))
	| _ => raise RuntimeError);

(* val length : U *)
val length = Fun (length');
*)

(* Alternative 2, using "Y" combinator *)
(* val length : U *)
val length : U =
    Y (fn length => Fun (fn s =>
       (case (nullp s)
	  of (Bool(true)) => Integer(0)
           | (Bool(false)) => plus (Cons (apply (length, cdr(s)), Integer(1)))
	   | _ => raise RuntimeError)))

val two : U = apply (length, Cons (Integer(1), Cons (Integer(2), Nil)));

(* Typing self-application *)
(* val selfAppl = fn f => f f  is not well-typed in ML, but... *)
val selfAppl : U = Fun (fn f:U => apply (f, f));

val identity : U = Fun (fn x:U => x);
val identity' : U = apply (selfAppl, Fun (fn x => x));

val three : U = apply (identity', Integer(3));