(* 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