(* Chris Okasaki
   School of Computer Science
   Carnegie Mellon University
   Pittsburgh, PA 15213
   cokasaki@cs.cmu.edu *)

functor HoodMelvilleQueue () : QUEUE =
    (* Alternative implementation of queues with O(1) worst-case  *)
    (* performance.  Provided for comparison.                     *)
    (*                                                            *)
    (* Taken from                                                 *)
    (*   Hood and Melville                                        *)
    (*   "Real-time queue operations in pure Lisp"                *)
    (*   IPL 13(2) (Nov 1981), 50-53                              *)
    (*                                                            *)
    (* Warning!  Does not support insertf!                        *)
struct

    datatype 'a Queue =
	Simple of
	  {front    : 'a list,
	   rear     : 'a list,
	   diff     : int}       (* diff = length front - length rear *)

      | Copy1 of  (* in process of reversing f and r *)
	  {oldfront : 'a list,
	   rear     : 'a list,
	   f        : 'a list,
           r        : 'a list,
           frev     : 'a list,
           rrev     : 'a list,   (* the partial new front *)
	   diff     : int,       (* diff = length rrev - length rear *)
	   copy     : int}       (* copy = # of valid elements in frev *)

      | Copy2 of  (* in process of reversing frev onto newfront *)
	  {oldfront : 'a list,
	   rear     : 'a list,
           frev     : 'a list,
	   newfront : 'a list,
	   diff     : int,       (* diff = length newfront - length rear *)
	   copy     : int}       (* copy = # of valid elements in frev *)
		   

    (* begin process of moving elements from rear to front *)
    fun rotate (front,rear) = (* length rear = length front + 1 *)
	  Copy1 {oldfront = front, rear = [],
		 f = front,r = rear,frev = [],rrev = [],
		 diff = 0,copy = 0}

    (* do one step in process of moving elements from rear to front *)
    fun tick (Copy1 {oldfront,rear,f=x::f,r=y::r,frev,rrev,diff,copy}) =
	  Copy1 {oldfront = oldfront,rear = rear,
		 f = f,r = r,frev = x::frev,rrev = y::rrev,
		 diff = diff + 1,copy = copy + 1}
      | tick (Copy1 {oldfront,rear,f=[],r=[y],frev,rrev,diff,copy}) =
	  Copy2 {oldfront = oldfront,rear = rear,
		 frev = frev,newfront = y::rrev,
		 diff = diff + 1,copy = copy}
      | tick (Copy2 {oldfront,rear,newfront,diff,copy = 0,frev}) =
	  Simple {front = newfront,rear = rear,diff = diff}
      | tick (Copy2 {oldfront,rear,newfront,diff,copy = 1,frev = x::_}) =
	  Simple {front = x::newfront,rear = rear,diff = diff + 1}
      | tick (Copy2 {oldfront,rear,newfront,diff,copy,frev = x::frev}) =
	  Copy2 {oldfront = oldfront,rear = rear,
		 newfront = x::newfront,frev = frev,
		 diff = diff + 1,copy = copy - 1}
      | tick simpleq = simpleq

    fun tick2 q = tick (tick q)


    exception Empty

    val empty = Simple {front=[],rear=[],diff=0}

    fun isempty (Simple {front=[],...}) = true
      | isempty _ = false

    fun size (Simple {rear,diff,...}) =
	  2 * length rear + diff
      | size (Copy1 {rear,diff,copy,f,r,...}) =
          2 * length rear + diff + copy + length f + length r
      | size (Copy2 {rear,diff,copy,...}) =
	  2 * length rear + diff + copy

    fun insert (x, Simple {front,rear,diff = 0}) =
	  tick2 (rotate (front,x::rear))
      | insert (x, Simple {front,rear,diff}) =
	  Simple {front=front,rear=x::rear,diff=diff-1}
      | insert (x, Copy1 {oldfront,rear,f,r,frev,rrev,diff,copy}) =
	  tick2 (Copy1 {oldfront=oldfront,rear=x::rear,
			f=f,r=r,frev=frev,rrev=rrev,
			diff = diff-1,copy=copy})
      | insert (x, Copy2 {oldfront,rear,frev,newfront,diff,copy}) =
	  tick2 (Copy2 {oldfront=oldfront,rear=x::rear,
			frev=frev,newfront=newfront,
			diff = diff-1,copy=copy})

    fun remove (Simple {front=[],...}) = raise Empty
      | remove (Simple {front=x::front,rear,diff=0}) =
	  (x,tick2 (rotate (front,rear)))
      | remove (Simple {front=x::front,rear,diff}) =
	  (x,Simple {front=front,rear=rear,diff=diff-1})
      | remove (Copy1 {oldfront=x::oldfront,rear,f,r,frev,rrev,diff,copy})=
	  (x,tick2 (Copy1 {oldfront=oldfront,rear=rear,
			   f=f,r=r,frev=frev,rrev=rrev,
			   diff=diff,copy=copy-1}))
      | remove (Copy2 {oldfront=x::oldfront,rear,frev,newfront,diff,copy})=
	  (x,tick2 (Copy2 {oldfront=oldfront,rear=rear,
			   frev=frev,newfront=newfront,
			   diff=diff,copy=copy-1}))

    exception InsertfNotSupported
    fun insertf (_,_) = raise InsertfNotSupported

end