Real Time Queue in OCaml

gistfile1.sh

$ ocamlopt unix.cmxa rtq.ml -o rtq
$ OCAMLRUNPARAM=h=500M,s=500M,v=255 ./rtq

rtq.ml

exception Empty

(* Scheduling Real Time Queue *)
module RealTimeQueue1 = struct
  type 'a stream_cell = Nil | Cons of 'a * 'a stream
  and 'a stream = 'a stream_cell lazy_t

  type 'a t = 'a stream * 'a list * 'a stream

  let empty = lazy Nil, [], lazy Nil
  let is_empty = function
    | lazy Nil, _, _ -> true
    | _              -> false

  let rec rotate = function
    | lazy Nil, y :: _, a -> lazy (Cons (y, a))
    | lazy (Cons (x, xs)), y :: ys, a ->
      lazy (Cons (x, rotate (xs, ys, lazy (Cons (y, a)))))
    | _, _, _ -> failwith "rotate"

  let exec = function
    | f, r, lazy (Cons (x, s)) -> f, r, s
    | f, r, lazy Nil -> 
      let f' = rotate (f, r, lazy Nil) in f', [], f'

  let snoc (f, r, s) x = exec (f, x :: r, s)

  let head = function
    | lazy Nil, _, _ -> raise Empty
    | lazy (Cons (x, _)), _, _ -> x
  let tail = function
    | lazy Nil, _, _ -> raise Empty
    | lazy (Cons (x, f)), r, s -> exec (f, r, s)
end

(* Non-Scheduling Real Time Queue *)
module RealTimeQueue2 = struct
  type 'a stream_cell = Nil | Cons of 'a * 'a stream
  and 'a stream = 'a stream_cell lazy_t

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

  let empty = 0, lazy Nil, 0, []
  let is_empty (lenf, _, _, _) = lenf = 0

  let rec rotate = function
    | lazy Nil, y :: _, a -> lazy (Cons (y, a))
    | lazy (Cons (x, xs)), y :: ys, a ->
      lazy (Cons (x, rotate (xs, ys, lazy (Cons (y, a)))))
    | _, _, _ -> failwith "rotate"

  let check ((lenf, f, lenr, r) as q) =
    if lenr <= lenf
    then q
    else lenf+lenr, rotate (f, r, lazy Nil), 0, []

  let snoc (lenf, f, lenr, r) x = check (lenf, f, lenr+1, x :: r)

  let head = function
    | _, lazy Nil, _, _ -> raise Empty
    | _, lazy (Cons (x, _)), _, _ -> x
  let tail = function
    | _, lazy Nil, _, _ -> raise Empty
    | lenf, lazy (Cons (x, f)), lenr, r -> check (lenf-1, f, lenr, r)
end

module Q = RealTimeQueue1

let () =
  let q = ref Q.empty in
    for i = 1 to 10000 do
      q := Q.snoc !q ()
    done;
    for i = 1 to 1000 do
      let t = Unix.gettimeofday () in
        for j = 1 to 900 do
          q := Q.snoc (Q.tail !q) ()
        done;
        Printf.printf "#%d: %f\n%!" i (Unix.gettimeofday () -. t)
    done

That's an interesting example, from the official document, it says

lazy_t is the built-in type constructor used by the compiler for the lazy keyword. You should not use it directly. Always use Lazy.t instead.

So I think the line 6th should change to Lazy.t:)