(* $Header: /home/pauillac/formel1/fpottier/cvs/modulo/fQueue.ml,v 1.1 2002/04/08 14:34:59 fpottier Exp $ *)

exception Empty

(* O'Caml currently does not allow the components of a sum type to be
   mutable. Yet, for optimal space efficiency, we must have cons cells whose
   [next] field is mutable. This leads us to define a type of cyclic lists, so
   as to eliminate the [Nil] case and the sum type. *)

type 'a cell = {
    content: 'a;
    mutable next: 'a cell
  } 

(* A queue is a reference to either nothing or some cell of a cyclic list. By
   convention, that cell is to be viewed as the last cell in the queue. The
   first cell in the queue is then found in constant time: it is the next cell
   in the cyclic list. *)

type 'a t =
    'a cell option ref

(* Standard operations. *)

let create () =
  ref None

let clear q =
  q := None

let add x q =
  match !q with
  | None ->
      let rec cell = {
	content = x;
	next = cell
      }	in
      q := Some cell
  | Some last ->
      let first = last.next in
      let cell = {
	content = x;
	next = first
      }	in
      last.next <- cell;
      q := Some cell

let peek q =
  match !q with
  | None ->
      raise Empty
  | Some last ->
      last.next.content

let take q =
  match !q with
  | None ->
      raise Empty
  | Some last ->
      let first = last.next in
      if first == last then
	q := None
      else
	last.next <- first.next;
      first.content

let length q =
  match !q with
  | None ->
      0
  | Some last ->
      let rec length accu cell =
	if cell == last then accu
	else length (accu + 1) cell.next in
      length 1 last.next

let iter f q =
  match !q with
  | None ->
      ()
  | Some last ->
      let rec iter cell =
	f cell.content;
	if cell != last then
	  iter cell.next in
      iter last.next

(* Extra operations. *)

let transfer q1 q2 =
  match !q1 with
  | None ->
      ()
  | (Some last1) as some_last1 ->
      q1 := None;
      match !q2 with
      |	None ->
	  q2 := some_last1
      |	Some last2 ->
	  let first1 = last1.next in
	  let first2 = last2.next in
	  last1.next <- first2;
	  last2.next <- first1;
	  q2 := some_last1