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