lib/cml/util/imp-queue.sml

   1 (* imp-queue.sml
   2  * 2004 Matthew Fluet (mfluet@acm.org)
   3  *  Ported to MLton threads.
   4  *)
   5
   6 structure ImpQueue : IMP_QUEUE =
   7    struct
   8       datatype 'a t = T of {front: 'a list ref, back: 'a list ref}
   9
  10       local
  11          fun filterPrefix (xs, p) =
  12             case xs of
  13                [] => []
  14              | y::ys => if p y
  15                           then filterPrefix (ys, p)
  16                           else xs
  17          fun filter (xs, p) = List.filter (not o p) xs
  18          fun filterRevAcc ((xs, zs), p) =
  19             case xs of
  20                [] => zs
  21              | y::ys => if p y
  22                           then filterRevAcc ((ys, zs), p)
  23                           else filterRevAcc ((ys, y::zs), p)
  24          fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
  25       in
  26          fun cleanPrefix (T {front, back}, p) =
  27             (Assert.assertAtomic' ("ImpQueue.cleanPrefix", NONE)
  28              ; case filterPrefix (!front, p) of
  29                   [] => (front := filterPrefix (List.rev(!back), p)
  30                          ; back := [])
  31                 | front' =>  front := front')
  32          fun clean (T {front, back}, p) =
  33             (Assert.assertAtomic' ("ImpQueue.clean", NONE)
  34              ; case filter (!front, p) of
  35                   [] => (front := filterRev (!back, p)
  36                          ; back := [])
  37                 | front' =>  (front := front'
  38                               ; back := filter (!back, p)))
  39          fun cleanAndDeque (T {front, back}, p) =
  40             (Assert.assertAtomic' ("ImpQueue.cleanAndDeque", NONE)
  41              ; case filter (!front, p) of
  42                   [] => (case filterRev(!back, p) of
  43                             [] => (front := []
  44                                    ; back := []
  45                                    ; NONE)
  46                           | x::front' => (front := front'
  47                                           ; back := []
  48                                           ; SOME x))
  49                 | [x] => (front := filterRev (!back, p)
  50                           ; back := []
  51                           ; SOME x)
  52                 | x::front' => (front := front'
  53                                 ; back := filter (!back, p)
  54                                 ; SOME x))
  55       end
  56
  57       fun deque (T {front, back}) =
  58          (Assert.assertAtomic' ("ImpQueue.deque", NONE)
  59           ; case !front of
  60                [] => (case !back of
  61                          [] => NONE
  62                        | l => let val l = List.rev l
  63                               in case l of
  64                                     [] => raise Fail "ImpQueue.deque:impossible"
  65                                   | x :: front' =>
  66                                        (front := front'
  67                                         ; back := []
  68                                         ; SOME x)
  69                               end)
  70              | x::front' => (front := front'; SOME x))
  71
  72       fun empty (T {front, back}) =
  73          (Assert.assertAtomic' ("ImpQueue.empty", NONE)
  74           ; case !front of
  75                [] => (case !back of
  76                          [] => true
  77                        | _ => false)
  78              | _ => false)
  79
  80       fun enque (T {back, ...}, x) =
  81          (Assert.assertAtomic' ("ImpQueue.enque", NONE)
  82           ; back := x::(!back))
  83
  84       fun enqueAndClean (q, y, p) =
  85          (enque (q, y); clean (q, p))
  86
  87       fun new () = T {front = ref [], back = ref []}
  88
  89       fun peek (T {front, back}) =
  90          (Assert.assertAtomic' ("ImpQueue.peek", NONE)
  91           ; case !front of
  92                [] => (case !back of
  93                          [] => NONE
  94                        | l => let val l = List.rev l
  95                               in case l of
  96                                     [] => raise Fail "ImpQueue.peek:impossible"
  97                                   | x::front' =>
  98                                        (front := x::front'
  99                                         ; back := []
 100                                         ; SOME x)
 101                               end)
 102              | x::_ => SOME x)
 103
 104       fun reset (T {front, back}) =
 105          (Assert.assertAtomic' ("ImpQueue.reset", NONE)
 106           ; front := []
 107           ; back := [])
 108
 109 (*
 110       val clean = fn arg => TimeIt.timeit "ImpQueue.clean" clean arg
 111       val cleanAndDeque = fn arg => TimeIt.timeit "ImpQueue.cleanAndDeque" cleanAndDeque arg
 112       val cleanPrefix = fn arg => TimeIt.timeit "ImpQueue.cleanPrefix" cleanPrefix arg
 113       val deque = fn arg => TimeIt.timeit "ImpQueue.deque" deque arg
 114       val empty = fn arg => TimeIt.timeit "ImpQueue.empty" empty arg
 115       val enque = fn arg => TimeIt.timeit "ImpQueue.enque" enque arg
 116       val enqueAndClean = fn arg => TimeIt.timeit "ImpQueue.enqueAndClean" enqueAndClean arg
 117       val new = fn arg => TimeIt.timeit "ImpQueue.new" new arg
 118       val peek = fn arg => TimeIt.timeit "ImpQueue.peek" peek arg
 119       val reset = fn arg => TimeIt.timeit "ImpQueue.reset" reset arg
 120 *)
 121    end