(*
 * $Id: lists.ocaml,v 1.9 2001/01/31 02:12:48 doug Exp $
 * http://www.bagley.org/~doug/shootout/
 * from Benedict Rosenau
 *)

module Deque:
  sig
    type 'a t
    exception Empty

    val make: int -> 'a -> 'a t
    val iota: int -> int t

    val is_empty: 'a t -> bool
    val equal: 'a t -> 'a t -> bool
    val length: 'a t -> int
    val nth: 'a t -> int -> 'a

    val push_front: 'a -> 'a t -> unit
    val push_back: 'a t -> 'a -> unit

    val take_front: 'a t -> 'a
    val take_back: 'a t -> 'a

    val copy: 'a t -> 'a t
    val reverse: 'a t -> 'a t
  end =
struct
  type 'a t = {mutable size: int;
               mutable first: int;
               mutable last: int;
               mutable field: 'a array;
               fill: 'a}

  exception Empty

  let make n dummy =
    let n = max n 0 in
    let nplus = max 1 n in
    {size = nplus;
     first = nplus lsr 1;
     last = (nplus lsr 1) - 1;
     field = Array.make nplus dummy;
     fill = dummy}

  let iota i =
    let i = max 0 i in
    let iplus = max 1 i in
    {size = iplus;
     first = 0;
     last = i - 1;
     field = Array.init iplus (fun n -> n + 1);
     fill = i}

  let length buf = buf.last - buf.first + 1

  let is_empty buf = buf.last < buf.first

  let rec array_eq arr1 off1 arr2 off2 = function
    | 0 -> true
    | n ->
        if arr1.(off1) <> arr2.(off2) then false
        else array_eq arr1 (off1 + 1) arr2 (off2 + 1) (n - 1)

  let equal buf1 buf2 =
    let len = length buf1 in
    if len <> length buf2 then false
    else array_eq buf1.field buf1.first buf2.field buf2.first len

  let nth buf n =
    if n < 0 or n >= length buf then failwith "nth";
    buf.field.(buf.first + n)

  let double_shift buf = 
    let new_size = buf.size lsl 1
    and len = length buf in
    let new_first = (new_size - len) lsr 1 
    and new_field = Array.make new_size buf.fill in
    Array.blit buf.field buf.first new_field new_first len;
    buf.size <- new_size;
    buf.field <- new_field;
    buf.first <- new_first;
    buf.last <- new_first + len - 1

  let push_front elem buf =
    if buf.first = 0 then double_shift buf;
    let new_first = buf.first - 1 in
    buf.field.(new_first) <- elem;
    buf.first <- new_first

  let push_back buf elem =
    if buf.last = buf.size - 1 then double_shift buf;
    let new_last = buf.last + 1 in
    buf.field.(new_last) <- elem;
    buf.last <- new_last

  let take_front buf =
    if is_empty buf then raise Empty;
    let old_first = buf.first in
    buf.first <- old_first + 1;
    buf.field.(old_first)

  let take_back buf =
    if is_empty buf then raise Empty;
    let old_last = buf.last in
    buf.last <- old_last - 1;
    buf.field.(old_last)

  let copy buf =
    let len = length buf in
    let new_buf = make len buf.fill in
    Array.blit buf.field buf.first new_buf.field 0 len;
    new_buf.first <- 0;
    new_buf.last <- len - 1;
    new_buf

  let reverse buf =
    let len = length buf 
    and fst = buf.first
    and fld = buf.field in
    let new_buf = make len buf.fill in
    let new_fld = new_buf.field in
    for i = 0 to len - 1 do
      new_fld.(len - i - 1) <- fld.(fst + i)
    done;
    new_buf.first <- 0;
    new_buf.last <- len - 1;
    new_buf
end


open Deque

let empty () = iota 0

let size = 10000

let test_lists () =
  let d1 = iota size in
  let d2 = copy d1
  and d3 = empty () in

  for i = 1 to length d2 do
    push_back d3 (take_front d2)
  done;
  for i = 1 to length d3 do
    push_back d2 (take_back d3)
  done;
  let d1 = reverse d1 in
  if size <> nth d1 0 then failwith "First test failed";
  if length d1 <> length d2 then failwith "Second test failed";
  if not (equal d1 d2) then failwith "Third test failed";
  length d1

let _ =
  let n =
    try int_of_string Sys.argv.(1)
    with Invalid_argument _ -> 1
  and result = ref 0 in
  for i = 1 to n do
    result := test_lists ()
  done;
  Printf.printf "%d\n" !result