summaryrefslogtreecommitdiff
path: root/stdlib/queue.ml
blob: 84bb67aa47b5b30b55b7614364b4a68014f10ed9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

exception Empty

type 'a queue_cell =
    Nil
  | Cons of 'a * 'a queue_cell ref

type 'a t =
  { mutable head: 'a queue_cell;
    mutable tail: 'a queue_cell }

let create () =
  { head = Nil; tail = Nil }

let clear q =
  q.head <- Nil; q.tail <- Nil

let add x q =
  match q.tail with
    Nil ->                              (* if tail = Nil then head = Nil *)
      let c = Cons(x, ref Nil) in
      q.head <- c; q.tail <- c
  | Cons(_, newtailref) ->
      let c = Cons(x, ref Nil) in
      newtailref := c;
      q.tail <- c

let peek q =
  match q.head with
    Nil ->
      raise Empty
  | Cons(x, _) ->
      x

let take q =
  match q.head with
    Nil ->
      raise Empty
  | Cons(x, rest) ->
      q.head <- !rest;
      begin match !rest with
        Nil -> q.tail <- Nil
      |  _  -> ()
      end;
      x

let rec length_aux = function
    Nil -> 0
  | Cons(_, rest) -> succ (length_aux !rest)

let length q = length_aux q.head

let rec iter_aux f = function
    Nil ->
      ()
  | Cons(x, rest) ->
      f x; iter_aux f !rest

let iter f q = iter_aux f q.head