lib/cml/util/fun-queue.sml

   1 (* fun-queue.sml
   2  * 2004 Matthew Fluet (mfluet@acm.org)
   3  *  Ported to MLton threads.
   4  *)
   5
   6 structure FunQueue : FUN_QUEUE =
   7    struct
   8       datatype 'a t = T of {front: 'a list, back: 'a list}
   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             (case filterPrefix (front, p) of
  28                 [] => T {front = filterPrefix (List.rev(back), p),
  29                          back = []}
  30               | front' =>  T {front = front',
  31                               back = back})
  32          fun clean (T {front, back}, p) =
  33             (case filter (front, p) of
  34                 [] => T {front = filterRev (back, p),
  35                          back = []}
  36               | front' =>  T {front = front',
  37                               back = filter (back, p)})
  38          fun cleanAndDeque (T {front, back}, p) =
  39             (case filter (front, p) of
  40                 [] => (case filterRev(back, p) of
  41                           [] => (NONE,
  42                                  T {front = [],
  43                                     back = []})
  44                         | x::front' => (SOME x,
  45                                         T {front = front',
  46                                            back = []}))
  47               | [x] => (SOME x,
  48                         T {front = filterRev (back, p),
  49                            back = []})
  50               | x::front' => (SOME x,
  51                               T {front = front',
  52                                  back = filter (back, p)}))
  53       end
  54
  55       fun deque (T {front, back}) =
  56          (case front of
  57              [] => (case back of
  58                        [] => NONE
  59                      | l => let val l = List.rev l
  60                             in
  61                                case l of
  62                                   [] => raise Fail "FunQueue.deque:impossible"
  63                                 | x::front' =>
  64                                      SOME (x,
  65                                            T {front = front',
  66                                               back = []})
  67                             end)
  68            | x::front' => SOME (x, T {front = front', back = back}))
  69
  70       fun empty (T {front, back}) =
  71          (case front of
  72              [] => (case back of
  73                        [] => true
  74                      | _ => false)
  75            | _ => false)
  76
  77       fun enque (T {front, back, ...}, x) =
  78          T {front = front, back = x::back}
  79
  80       fun enqueAndClean (q, y, p) =
  81          clean (enque (q, y), p)
  82
  83       fun new () = T {front = [], back = []}
  84
  85       fun peek (T {front, back}) =
  86          (case front of
  87              [] => (case back of
  88                        [] => NONE
  89                      | l => let val l = List.rev l
  90                             in
  91                                case l of
  92                                   [] => raise Fail "FunQueue.peek:impossible"
  93                                 | x::_ => SOME x
  94                             end)
  95            | x::_ => SOME x)
  96    end