(* 
 * queue.sml - My attempt to write a queue class
 *)

(* Copyright 2003, Trustees of Indiana University
 * Please see the license in the file ../LICENSE
 *)

(* $Id: queue.sml,v 1.2 2003/05/02 20:03:40 jewillco Exp $ *)


signature Queueable  =
sig
    type element;
end;
	  

structure Queue :
  sig
    exception DeleteQueue;
    exception FrontQueue;
    type 'a Queue;
    val delete : 'a Queue -> unit;
    val empty : 'a Queue  -> bool;
    val front : 'a Queue -> 'a;
    val insert : 'a Queue -> 'a -> 'a Queue;
    val create : unit -> 'a Queue;
  end

 = 

struct

  exception DeleteQueue;
  exception FrontQueue
  exception SetCdr

  datatype 'a QList = QNil | QCons of 'a * ('a QList) ref;

  fun set_cdr (QCons(car,rcdr)) item = rcdr := item |
      set_cdr QNil item = raise SetCdr;


  type 'a Queue = (('a QList) ref  * ('a QList) ref);

  fun create():('a Queue) = (ref QNil, ref QNil);

  fun front_ptr (x:'a Queue) = !(#1 x);
  fun rear_ptr (x:'a Queue) = !(#2 x);

  fun set_front_ptr (queue:'a Queue) item =
      case queue of
	  (car,cdr) => car := item;

  fun set_rear_ptr (queue:'a Queue) item =
      case queue of
	  (car,cdr) => cdr := item;


  fun empty (ref QNil, rear) = true |
      empty (x:'a Queue) = false;


  fun insert (queue:'a Queue) (item:'a) =
      let
	  val new_pair = QCons(item,ref QNil)
      in
	  if empty(queue) then
	      (set_front_ptr queue new_pair;
	       set_rear_ptr queue new_pair;
	       queue)
	  else
	      (set_cdr (rear_ptr queue) new_pair;
	       set_rear_ptr queue new_pair;
	       queue)
      end;


  fun front (queue:'a Queue) =
      if empty(queue) then
	  raise FrontQueue
      else
	  case front_ptr(queue) of
	      QCons(car,rcdr) => car
	    | QNil => raise FrontQueue;

  fun delete(queue) =
      if empty(queue) then
	  raise DeleteQueue
      else
	  case front_ptr(queue) of
	      QCons(car,rcdr) => set_front_ptr queue (!rcdr)
	    | QNil => raise DeleteQueue;

end