(*
 * Example queue implementations
 * For cs7963, Spring 2005
 * Robert Ricci
 * Some of these data structures come from the book:
 *     "Purely Functional Data Structures", by Chris Okasaki
 * Another good resource (paricularly for ocaml's lazy evaluation stuff):
 *     "Developing allications with Objective Caml", published in French by
 *         O'Reilly. English translation available at:
 *     http://caml.inria.fr/oreilly-book/"
 *)

(*
 * Implementing a queue with a simple list
 *)
type 'a queue = 'a list;;
exception EmptyQueue;;

(* head: 'a queue -> 'a *)
let head q = 
    match q with
      [] -> raise EmptyQueue;
    | x::_ -> x
;;
head [1; 2 ;3];; (* Should be: 1 *)

(* dequeue: 'a queue -> 'a queue *)
let dequeue q =
    match q with
      [] -> raise EmptyQueue
    | _::xs -> xs
;;
dequeue [1; 2; 3];; (* Should be [2; 3] *)

(* enqueue: 'a queue -> 'a -> 'a queue *)
let rec enqueue q e =
    match q with
      [] -> e :: []
    | x::xs -> x :: (enqueue xs e)
;;
enqueue [1; 2; 3] 4;; (* Should be: [1; 2; 3; 4] *)

(*
 * Implementing a queue with two lists
 *)
type 'a queue = { front : 'a list; rear : 'a list};;

(* head: 'a queue -> 'a *)
let head q = 
    match q.front with
      [] -> raise EmptyQueue
    | x::_ -> x
;;
head { front = [1]; rear = [3; 2] };; (* Should be: 1 *)

(* Invariant is: front is empty iff the queue is empty. If front goes empty,
 * but rear is non-empty, rotate it up to the front *)
(* enqueue: 'a queue -> 'a -> 'a queue *)
let enqueue q e =
    match q.front with
      [] -> { front = e :: []; rear = [] }
    | _ -> { front = q.front; rear = e :: q.rear}
;;
enqueue { front = [1]; rear = [3; 2] } 4;;
(* Should be: { head = [1]; rear = [4; 3; 2] *)

(* dequeue: 'a queue -> 'a queue *)
let dequeue q = 
    match q.front with
      [] -> raise EmptyQueue
    | x::[] -> { front = List.rev q.rear; rear = [] }
    | x::xs -> { front = xs; rear = q.rear }
;;
dequeue { front = [1]; rear = [3; 2] };;
(* Should be: { front = [2; 3]; rear = [] *)

(*
 * Building up the types for lazy evaluation
 *)
type 'a suspendedExpr = (unit -> 'a);;
type 'a suspension = Suspension of 'a suspendedExpr | Val of 'a;;
type 'a lazyExpr =  { mutable thing : 'a suspension };;

(* suspend: 'a -> 'a lazyExpr *)
let suspend expr = 
    { thing = Suspension(expr) }
;;

let thunk () =
    42
;;

let s = suspend thunk;;
(* Should be: int lazyexpr = { thing = Suspension <fun> } *)

(* force : 'a lazyExpr -> 'a *)
let force susp =
    match susp.thing with 
      Val(x) -> x
    | Suspension(x) -> let value = x() in
      susp.thing <- Val(value); value
;;
force s;;
(* Should be: 42 *)
s;;
(* Should be: thing = Val(42) *)
force s;;
(* Should be: 42 *)

(*
 * Using ocaml's Lazy module to build a stream (lazy list)
 *)
type 'a streamcell = Nil | Cons of 'a * 'a stream
and 'a stream = 'a streamcell Lazy.t;;
exception EmptyStream;;

(* scar: 'a streamcell -> 'a *)
let scar stream =
    match stream with
      Nil -> raise EmptyStream
    | Cons(x,_) -> x
;;
scar (Cons(1, lazy Nil));; (* Should be: 1 *)

(* scdr: 'a streamcell -> 'a streamcell *)
let scdr stream =
    match stream with
      Nil -> raise EmptyStream
    | Cons(_,y) -> Lazy.force y
;;
scdr (Cons(1, lazy Nil));; (* Should be: 1 *)
scar (scdr (Cons(1, lazy (Cons(2, lazy Nil)))));; (* Should be: 2 *)

(* srev_append : 'a streamcell -> 'a streamcell -> 'a streamcell *)
let rec srev_append s1 s2 =
    match s1 with
      Nil -> s2
    | Cons(x,y) -> srev_append (Lazy.force y) (Cons(x,lazy s2))
;;

(* srev: 'a streamcell -> 'a streamcell *)
let rec srev s =
    srev_append s Nil
;;
srev (Cons(1, lazy (Cons(2, lazy Nil))));;
(* Should be: Cons(2,<lazy>) *)
scdr (srev (Cons(1, lazy (Cons(2, lazy Nil)))));;
(* Should be: Cons(1,<lazy>) *)

(* scat: 'a streamcell -> 'a streamcell -> 'a streamcell *)
let rec scat s1 s2 =
    match s1 with
      Nil -> s2
    | Cons(x,y) -> Cons(x,lazy (scat (Lazy.force y) s2))
;;
scat Nil Nil;; (* Should be: Nil *)
scat (Cons(1, lazy Nil)) (Cons(2, lazy Nil));; (* Should be: Cons(1,<lazy>) *)

1/0;;
(* Should raise an exception *)
let badstream = Cons(1, lazy (Cons(1/0, lazy Nil)));;
(* Should be: Cons(1, <lazy> *)
scar badstream;;
(* Should be: 1 *)
scdr badstream;;
(* Should be: ??? *)

(*
 * Building a queue with two streams
 *)
type 'a queue = { front : 'a streamcell; front_len : int;
                  rear : 'a streamcell; rear_len : int };;
(* Note: The rear does not have to be a stream, it could be a list, but we make
 *       it one for symmetry *)

let testq = { front = (Cons(1,lazy (Cons(2, lazy Nil)))); front_len = 2;
              rear = (Cons(4,lazy (Cons(3, lazy Nil)))); rear_len = 2 };;

(* head: 'a queue -> 'a *)
let head q =
    scar q.front
;;
head testq;; (* Should be: 1 *)

(* The invariant is: rear is never longer than front. If this happens,
 * rotate rear on to the end of the front *)
(* check_invariant: 'a queue -> 'a queue *)
let check_invariant q =
    if (q.rear_len <= q.front_len) then q
    else { front = scat q.front (srev q.rear);
           front_len = q.front_len + q.rear_len;
           rear = Nil;
           rear_len = 0 }
;;

(* dequeue: 'a queue -> 'a queue *)
let dequeue q =
    check_invariant { front = scdr q.front;
                      front_len = q.front_len - 1;
                      rear = q.rear;
                      rear_len = q.rear_len }
;;
dequeue testq;;
(* Should be: { front = Cons(2,<lazy>); front_len = 3;
   rear = Nil; rear_len = 0 } *)

(* enqueue: 'a queue -> 'a -> 'a queue *)
let enqueue q e =
    check_invariant { front = q.front;
                      front_len = q.front_len;
                      rear = Cons(e,lazy q.rear);
                      rear_len = q.rear_len + 1 }
;;
enqueue testq 5;;
(* Should be: { front = Cons(1,<lazy>); front_len = 5;
   rear = Nil; rear_len = 0 } *)