Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/comp-lib/ppqueue.sml
ViewVC logotype

View of /sml/trunk/src/comp-lib/ppqueue.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 246 - (download) (annotate)
Sat Apr 17 18:47:12 1999 UTC (20 years, 8 months ago) by monnier
File size: 2272 byte(s)
This commit was generated by cvs2svn to compensate for changes in r245,
which included commits to RCS files with non-trunk default branches.
(* ppqueue.sml
 *
 * COPYRIGHT (c) 1996 Bell Laboratories.
 *
 *)

signature PPQUEUE =
sig
   type 'a  queue
   exception QUEUE_FULL
   exception QUEUE_EMPTY
   datatype  Qend = Qback | Qfront
   val is_empty : 'a queue -> bool
   val mk_queue : int -> 'a -> 'a queue
   val clear_queue : 'a queue -> unit
   val queue_at : Qend -> 'a queue -> 'a
   val en_queue : Qend -> 'a -> 'a queue -> unit
   val de_queue : Qend -> 'a queue -> unit
end

structure PPQueue: PPQUEUE =
struct

  open Array
  infix 9 sub

  datatype Qend = Qfront | Qback

  exception QUEUE_FULL
  exception QUEUE_EMPTY
  exception REQUESTED_QUEUE_SIZE_TOO_SMALL

  fun ++ i n = (i + 1) mod n
  fun -- i n = (i - 1) mod n

  abstype 'a queue = QUEUE of {elems: 'a array, (* the contents *)
			       front: int ref,
			       back: int ref,
			       size: int}  (* fixed size of element array *)
  with

    fun is_empty (QUEUE{front=ref ~1, back=ref ~1,...}) = true
      | is_empty _ = false

    fun mk_queue n init_val = 
	if (n < 2)
	then raise REQUESTED_QUEUE_SIZE_TOO_SMALL
	else QUEUE{elems=array(n, init_val), front=ref ~1, back=ref ~1, size=n}

    fun clear_queue (QUEUE{front,back,...}) = (front := ~1; back := ~1)

    fun queue_at Qfront (QUEUE{elems,front,...}) = elems sub !front
      | queue_at Qback (QUEUE{elems,back,...}) = elems sub !back

    fun en_queue Qfront item (Q as QUEUE{elems,front,back,size}) =
	  if (is_empty Q)
	  then (front := 0; back := 0;
		update(elems,0,item))
	  else let val i = --(!front) size
	       in  if (i = !back)
		   then raise QUEUE_FULL
		   else (update(elems,i,item); front := i)
	       end
      | en_queue Qback item (Q as QUEUE{elems,front,back,size}) = 
	  if (is_empty Q)
	  then (front := 0; back := 0;
		update(elems,0,item))
	  else let val i = ++(!back) size
	       in  if (i = !front)
		   then raise QUEUE_FULL
		   else (update(elems,i,item); back := i)
	       end

    fun de_queue Qfront (Q as QUEUE{front,back,size,...}) = 
	  if (!front = !back) (* unitary queue *)
	  then clear_queue Q
	  else front := ++(!front) size
      | de_queue Qback (Q as QUEUE{front,back,size,...}) =
	  if (!front = !back)
	  then clear_queue Q
	  else back := --(!back) size

  end (* abstype *)

end (* structure PPQueue *)

(*
 * $Log$
 *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0