capitalex / queue.ml

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