lib/mlton/queue/incremental.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 (*                         IncrementalQueue                          *)
   9 (*-------------------------------------------------------------------*)
  10
  11 (* Error. on Okasaki93 *)
  12
  13 (* reverses tail before it is needed
  14  and walks down list incrementally *)
  15
  16 functor IncrementalQueue(AR: APPEND_REVERSE)
  17   : BASIC_PERSISTENT_QUEUE =
  18 struct
  19
  20 structure L = AR.L
  21 open L.I
  22
  23 datatype 'a t = T of 'a AR.t * 'a AR.t * 'a L.t
  24
  25 fun tail l =
  26    case AR.destruct l of
  27       NONE => l
  28     | SOME(_, l) => l
  29
  30 fun queue(l, l', r) =
  31    if AR.length l >= L.length r then T(l, l', r)
  32    else let val l = AR.appendReverse(l, r)
  33         in T(l, l, L.empty())
  34         end
  35
  36 fun empty() = let val l = AR.empty()
  37               in T(l, l, L.empty())
  38               end
  39
  40 fun isEmpty(T(l, _, _)) = AR.isEmpty l
  41
  42 fun destruct(T(l, l', r)) =
  43    case AR.destruct l of
  44       NONE => NONE
  45     | SOME(x, l) => SOME(x, queue(l, l', r))
  46
  47 fun enque(T(l, l', r), x) = queue(l, l', L.cons(x, r))
  48
  49 end