(* Source code from                               *)
(*   Chris Okasaki                                *)
(*   "Functional Data Structures"                 *)
(*   Second International Summer School on        *)
(*     Advanced Functional Programming Techniques *)
(*   August, 1996                                 *)

signature QUEUE =
sig
  type 'a Queue

  exception EMPTY

  val empty   : 'a Queue
  val isEmpty : 'a Queue -> bool

  val snoc    : 'a Queue * 'a -> 'a Queue
  val head    : 'a Queue -> 'a       (* raises EMPTY if queue is empty *)
  val tail    : 'a Queue -> 'a Queue (* raises EMPTY if queue is empty *)

  (* additional operation not in paper *)
  val size    : 'a Queue -> int
end


structure Queue0 : QUEUE =
struct
  datatype 'a Queue = Queue of 'a list * 'a list
      (* Invariant: null f implies null r *)

  exception EMPTY

  val empty = Queue ([], [])
  fun isEmpty (Queue (f, r)) = null f

  fun queue ([], r) = Queue (rev r, [])
    | queue (f, r) = Queue (f, r)

  fun snoc (Queue (f, r), x) = queue (f, x :: r)
  fun head (Queue ([], _)) = raise EMPTY
    | head (Queue (x :: f, r)) = x
  fun tail (Queue ([], _)) = raise EMPTY
    | tail (Queue (x :: f, r)) = queue (f, r)

  fun size (Queue (f, r)) = length f + length r
end


structure Queue1 : QUEUE = 
struct
  datatype 'a Queue = Queue of 'a S.Stream * int * 'a S.Stream * int
      (* Invariant: |f| >= |r| *)

  exception EMPTY

  val empty = Queue (S.empty, 0, S.empty, 0)
  fun isEmpty (Queue (f, lenf, r, lenr)) = (lenf = 0)

  fun queue (f, lenf, r, lenr) =
        if lenr <= lenf then Queue (f, lenf, r, lenr)
        else Queue (S.++ (f, S.reverse r), lenf+lenr, S.empty, 0)

  fun snoc (Queue (f, lenf, r, lenr), x) = queue (f,lenf,S.cons (x,r),lenr+1)
  fun head (Queue (f, lenf, r, lenr)) =
        if lenf > 0 then S.head f else raise EMPTY
  fun tail (Queue (f, lenf, r, lenr)) =
        if lenf > 0 then queue (S.tail f, lenf-1, r, lenr) else raise EMPTY

  fun size (Queue (f, lenf, r, lenr)) = lenf + lenr
end


structure Queue2 : QUEUE =
struct
  datatype 'a Queue = 
      Queue of 'a list * 'a list susp S.Stream * int * 'a list * int

  exception EMPTY

  val empty = Queue ([], S.empty, 0, [], 0)
  fun isEmpty (Queue (f, m, lenfm, r, lenr)) = null f

  fun msnoc (m, s) = S.++ (m, S.cons (s, S.empty))
  fun queue ([], m, lenfm, r, lenr) =
        if S.isEmpty m then Queue (r, S.empty, lenr, [], 0)  (* |r| <= 1 *)
        else queue' (force (S.head m), S.tail m, lenfm, r, lenr)
    | queue q = queue' q
  and queue' (q as (f, m, lenfm, r, lenr)) =
        if lenr <= lenfm then Queue q
        else Queue (f, msnoc (m, delay (fn () => rev r)), lenfm+lenr, [], 0)

  fun snoc (Queue (f, m, lenfm, r, lenr), x) = queue (f,m,lenfm,x::r,lenr+1)
  fun head (Queue ([], _, _, _, _)) = raise EMPTY 
    | head (Queue (x :: f, m, lenfm, r, lenr)) = x
  fun tail (Queue ([], _, _, _, _)) = raise EMPTY 
    | tail (Queue (x :: f, m, lenfm, r, lenr)) = queue (f, m, lenfm-1, r, lenr)

  fun size (Queue (f, m, lenfm, r, lenr)) = lenfm + lenr
end


functor TestQ (Q : QUEUE) : sig val ok : bool end =
struct
  open Q

  fun snoc' (x, q) = snoc (q, x)
  val make = foldl snoc' empty

  fun list q = if isEmpty q then [] else head q :: list (tail q)

  val xs = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]

  exception BUG

  val ok = if list (make xs) = xs then true else raise BUG
end