Source file queue.ml

(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*         Francois Pottier, projet Cristal, INRIA Rocquencourt           *)
(*                  Jeremie Dimino, Jane Street Europe                    *)
(*                                                                        *)
(*   Copyright 2002 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

exception Empty

type 'a cell =
  | Nil
  | Cons of { content: 'a; mutable next: 'a cell }

type 'a t = {
  mutable length: int;
  mutable first: 'a cell;
  mutable last: 'a cell
}

let create () = {
  length = 0;
  first = Nil;
  last = Nil
}

let clear q =
  q.length <- 0;
  q.first <- Nil;
  q.last <- Nil

let add x q =
  let cell = Cons {
    content = x;
    next = Nil
  } in
  match q.last with
  | Nil ->
    q.length <- 1;
    q.first <- cell;
    q.last <- cell
  | Cons last ->
    q.length <- q.length + 1;
    last.next <- cell;
    q.last <- cell

let push =
  add

let peek q =
  match q.first with
  | Nil -> raise Empty
  | Cons { content } -> content

let peek_opt q =
  match q.first with
  | Nil -> None
  | Cons { content } -> Some content

let top =
  peek

let take q =
  match q.first with
  | Nil -> raise Empty
  | Cons { content; next = Nil } ->
    clear q;
    content
  | Cons { content; next } ->
    q.length <- q.length - 1;
    q.first <- next;
    content

let take_opt q =
  match q.first with
  | Nil -> None
  | Cons { content; next = Nil } ->
    clear q;
    Some content
  | Cons { content; next } ->
    q.length <- q.length - 1;
    q.first <- next;
    Some content

let pop =
  take

let copy =
  let rec copy q_res prev cell =
    match cell with
    | Nil -> q_res.last <- prev; q_res
    | Cons { content; next } ->
      let res = Cons { content; next = Nil } in
      begin match prev with
      | Nil -> q_res.first <- res
      | Cons p -> p.next <- res
      end;
      copy q_res res next
  in
  fun q -> copy { length = q.length; first = Nil; last = Nil } Nil q.first

let is_empty q =
  q.length = 0

let length q =
  q.length

let iter =
  let rec iter f cell =
    match cell with
    | Nil -> ()
    | Cons { content; next } ->
      f content;
      iter f next
  in
  fun f q -> iter f q.first

let fold =
  let rec fold f accu cell =
    match cell with
    | Nil -> accu
    | Cons { content; next } ->
      let accu = f accu content in
      fold f accu next
  in
  fun f accu q -> fold f accu q.first

let transfer q1 q2 =
  if q1.length > 0 then
    match q2.last with
    | Nil ->
      q2.length <- q1.length;
      q2.first <- q1.first;
      q2.last <- q1.last;
      clear q1
    | Cons last ->
      q2.length <- q2.length + q1.length;
      last.next <- q1.first;
      q2.last <- q1.last;
      clear q1

(** {1 Iterators} *)

let to_seq q =
  let rec aux c () = match c with
    | Nil -> Seq.Nil
    | Cons { content=x; next; } -> Seq.Cons (x, aux next)
  in
  aux q.first

let add_seq q i = Seq.iter (fun x -> push x q) i

let of_seq g =
  let q = create() in
  add_seq q g;
  q