(**
  functional queue

  @author Satoshi Ogasawara, IT Planning Inc.
  @version $Id: fqueue.ml,v 1.1 2007/05/21 05:54:01 ogasawara Exp $
*)

module FStream = struct
  type 'a stream = Nil | Cons of 'a * 'a stream Lazy.t

  let (!$) = Lazy.force
      
  let rec (++) s1 s2 = 
    match s1 with
      Nil -> s2
    | Cons (hd, tl) -> Cons (hd, lazy (!$tl ++ s2))
	  
  let rec take n s = 
    match n, s with
      0, _ -> Nil
    | _, Nil -> Nil
    | _, Cons (hd, tl) -> Cons (hd, lazy (take (n - 1) !$tl))
	  
  let drop n s =
    let rec drop' n s = match n, s with
      0, _ -> s
    | _, Nil -> Nil
    | _, Cons (_, tl) -> drop' (n - 1) !$tl in drop' n s
      
  let reverse s =
    let rec reverse' acc = function
	Nil -> acc
      | Cons (hd, tl) -> reverse' (Cons (hd, lazy acc)) !$tl 
    in
    reverse' Nil s
      
end

open FStream

exception Empty

type 'a t = int * 'a stream * int * 'a stream

(** 空のキューを生成します *)
let empty () = 0, Nil, 0, Nil

(** キューが空ならtrue,それ以外はfalseを返します *)
let is_empty (lenf, _, _, _) = lenf = 0

let check (lenf, f, lenr, r as q) =
  if lenr <= lenf then q
  else (lenf + lenr, f ++ reverse r, 0, Nil)

(** push q x はキューqにxを追加します *)
let push (lenf, f, lenr, r) x = check (lenf, f, lenr + 1, Cons (x, lazy r))

(** キューの最初の要素を取得します. キューが空の場合はEmpty例外が発生します. *)
let head = function
    _, Nil, _, _ -> raise Empty
  | _, Cons (x, _), _, _ -> x

(** キューの最初の要素を除いた残りのキューを返します. キューが空の場合は、 Empty例外が発生します *) 
let tail = function
    _, Nil, _, _ -> raise Empty
  | lenf, Cons (_, f'), lenr, r -> check (lenf - 1, !$f', lenr, r)