fifo.ml

module type QUEUE = sig
  type item

  type t

  val make_empty :
    unit -> t

  val enqueue :
    t -> item -> unit

  val dequeue :
    t -> item option
end

module Fifo_queue (K : sig type t end) : QUEUE with type item = K.t = struct
  type item = K.t

  type t = {
    mutable head : item list;
    mutable tail : item list;
  }

  let make_empty () = { head = []; tail = []; }

  let enqueue t x =
    t.tail <- x :: t.tail

  let rec dequeue t =
    match t.head with
    | x :: r -> t.head <- r; Some x
    | [] ->
      begin match t.tail with
        | [] -> None
        | _ ->
          t.head <- List.rev t.tail;
          t.tail <- [];
          dequeue t
      end
end

type 'a t =
  | Fifo : 'b * (module QUEUE with type item = 'a and type t = 'b) -> 'a t

let make_empty (type a) () =
  let module M = Fifo_queue(struct type t = a end) in
  Fifo (M.make_empty (), (module M : QUEUE with type item = a and type t = M.t))
  
let enqueue (type a) ((Fifo (t, (module M))) : a t) (x : a) = M.enqueue t x