talircd/lib/data/dllist.ml

(* This file was originally part of lwt-dllist, which is licensed
   under MIT: https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)

type 'a t = {
  mutable prev : 'a t;
  mutable next : 'a t;
}

type 'a node = {
  mutable node_prev : 'a t;
  mutable node_next : 'a t;
  mutable node_active : bool;
  node_data : 'a;
}
(* XXX: technically [.node_next]/[.node_prev] *are* mutated in [remove] but they are [Obj.magic]'d
   into ['a t] first.*)
[@@warning "-69"]

external seq_of_node : 'a node -> 'a t = "%identity"
external node_of_seq : 'a t -> 'a node = "%identity"

let create () =
  let rec seq = { prev = seq; next = seq } in
  seq

let is_empty seq = seq.next == seq

let reset seq =
  begin
    seq.next <- seq;
    seq.prev <- seq;
  end

let remove node =
  if node.node_active then begin
    node.node_active <- false;
    let seq = seq_of_node node in
    seq.prev.next <- seq.next;
    seq.next.prev <- seq.prev
  end

let add_l data seq =
  let node = { node_prev = seq; node_next = seq.next; node_data = data; node_active = true } in
  seq.next.prev <- seq_of_node node;
  seq.next <- seq_of_node node;
  node

let add_r data seq =
  let node = { node_prev = seq.prev; node_next = seq; node_data = data; node_active = true } in
  seq.prev.next <- seq_of_node node;
  seq.prev <- seq_of_node node;
  node

let take_l seq =
  if is_empty seq then raise Not_found;
  begin
    let node = node_of_seq seq.next in
    remove node;
    node.node_data
  end

let take_r seq =
  if is_empty seq then raise Not_found;
  begin
    let node = node_of_seq seq.prev in
    remove node;
    node.node_data
  end

let fold_r f seq acc =
  let rec loop curr acc =
    if curr == seq then
      acc
    else
      let node = node_of_seq curr in
      if node.node_active then
        loop node.node_prev (f node.node_data acc)
      else
        loop node.node_prev acc
  in
  loop seq.prev acc

let iter_l f seq =
  let rec loop curr =
    if curr != seq then
      let node = node_of_seq curr in
      if node.node_active then f node.node_data;
      loop node.node_next
  in
  loop seq.next

let find f seq =
  let rec loop curr =
    if curr == seq then
      raise Not_found
    else
      let node = node_of_seq curr in
      if node.node_active && f node.node_data then
        node.node_data
      else
        loop node.node_next
  in
  loop seq.next

let exists f seq =
  let rec loop curr =
    if curr == seq then
      false
    else
      let node = node_of_seq curr in
      if node.node_active && f node.node_data then
        true
      else
        loop node.node_next
  in
  loop seq.next