lib/mlton/queue/circular.fun

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7 (*-------------------------------------------------------------------*)
   8 (*                           CircularQueue                           *)
   9 (*-------------------------------------------------------------------*)
  10
  11 functor CircularQueue(): BOUNDED_EPHEMERAL_QUEUE =
  12 struct
  13
  14 structure A = Array1D
  15 structure I = A.I
  16 open I
  17
  18 datatype 'a t = T of {size: I.t ref,
  19                       elts: 'a option A.t,
  20                       front: I.t ref,
  21                       back: I.t ref}
  22
  23 fun sizeRef(T{size=s, ...}) = s
  24 fun incSize(T{size=s, ...}) = s := add1(!s)
  25 fun decSize(T{size=s, ...}) = s := sub1(!s)
  26 fun size d = !(sizeRef d)
  27 fun elts(T{elts=e, ...}) = e
  28 fun frontRef(T{front=f, ...}) = f
  29 fun backRef(T{back=b, ...}) = b
  30
  31 fun maxSize d = A.size(elts d)
  32
  33 fun empty maxSize = T{size = ref zero,
  34                       elts = A.new(maxSize, NONE),
  35                       front = ref zero,
  36                       back = ref zero}
  37
  38 fun isEmpty d = isZero(size d)
  39
  40 fun isFull d = size d = maxSize d
  41
  42 fun inc(q, r) = let val r = r q
  43               in r := add1(!r) mod maxSize q
  44               end
  45
  46 fun incFront q = inc(q, frontRef)
  47 fun incBack q = inc(q, backRef)
  48
  49 exception Enque
  50 fun enque(q as T{size, elts, front, back}, x) =
  51    if isFull q then raise Enque
  52    else (if isEmpty q then (front := zero ; back := zero)
  53          else (incBack q ;
  54                incSize q ;
  55                A.update(elts, !back, SOME x)))
  56
  57 exception Deque
  58 fun deque(q as T{size, elts, front, ...}) =
  59    if isEmpty q then raise Deque
  60    else case A.sub(elts, !front) of
  61            NONE => raise Deque
  62          | SOME x => (incFront q ;
  63                       decSize q ;
  64                       x)
  65
  66 end
  67
  68 structure CircularQueue = CircularQueue()