home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / ppqueue.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.1 KB  |  80 lines
  1. signature PPQUEUE =
  2. sig
  3.    type 'a  queue
  4.    exception QUEUE_FULL
  5.    exception QUEUE_EMPTY
  6.    datatype  Qend = Qback | Qfront
  7.    val is_empty : 'a queue -> bool
  8.    val mk_queue : int -> '2a -> '2a queue
  9.    val clear_queue : 'a queue -> unit
  10.    val queue_at : Qend -> 'a queue -> 'a
  11.    val en_queue : Qend -> 'a -> 'a queue -> unit
  12.    val de_queue : Qend -> 'a queue -> unit
  13. end
  14.  
  15. structure PPQueue: PPQUEUE =
  16. struct
  17.  
  18.   open Array
  19.   infix 9 sub
  20.  
  21.   datatype Qend = Qfront | Qback
  22.  
  23.   exception QUEUE_FULL
  24.   exception QUEUE_EMPTY
  25.   exception REQUESTED_QUEUE_SIZE_TOO_SMALL
  26.  
  27.   fun ++ i n = (i + 1) mod n
  28.   fun -- i n = (i - 1) mod n
  29.  
  30.   abstype 'a queue = QUEUE of {elems: 'a array, (* the contents *)
  31.                    front: int ref,
  32.                    back: int ref,
  33.                    size: int}  (* fixed size of element array *)
  34.   with
  35.  
  36.     fun is_empty (QUEUE{front=ref ~1, back=ref ~1,...}) = true
  37.       | is_empty _ = false
  38.  
  39.     fun mk_queue n init_val = 
  40.     if (n < 2)
  41.     then raise REQUESTED_QUEUE_SIZE_TOO_SMALL
  42.     else QUEUE{elems=array(n, init_val), front=ref ~1, back=ref ~1, size=n}
  43.  
  44.     fun clear_queue (QUEUE{front,back,...}) = (front := ~1; back := ~1)
  45.  
  46.     fun queue_at Qfront (QUEUE{elems,front,...}) = elems sub !front
  47.       | queue_at Qback (QUEUE{elems,back,...}) = elems sub !back
  48.  
  49.     fun en_queue Qfront item (Q as QUEUE{elems,front,back,size}) =
  50.       if (is_empty Q)
  51.       then (front := 0; back := 0;
  52.         update(elems,0,item))
  53.       else let val i = --(!front) size
  54.            in  if (i = !back)
  55.            then raise QUEUE_FULL
  56.            else (update(elems,i,item); front := i)
  57.            end
  58.       | en_queue Qback item (Q as QUEUE{elems,front,back,size}) = 
  59.       if (is_empty Q)
  60.       then (front := 0; back := 0;
  61.         update(elems,0,item))
  62.       else let val i = ++(!back) size
  63.            in  if (i = !front)
  64.            then raise QUEUE_FULL
  65.            else (update(elems,i,item); back := i)
  66.            end
  67.  
  68.     fun de_queue Qfront (Q as QUEUE{front,back,size,...}) = 
  69.       if (!front = !back) (* unitary queue *)
  70.       then clear_queue Q
  71.       else front := ++(!front) size
  72.       | de_queue Qback (Q as QUEUE{front,back,size,...}) =
  73.       if (!front = !back)
  74.       then clear_queue Q
  75.       else back := --(!back) size
  76.  
  77.   end (* abstype *)
  78.  
  79. end (* structure PPQueue *)
  80.