1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
2001-12-07 05:41:02 -08:00
|
|
|
(* under the terms of the GNU Library General Public License, with *)
|
|
|
|
(* the special exception on linking described in file ../LICENSE. *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
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 }
|
|
|
|
|
1996-04-22 04:15:41 -07:00
|
|
|
let create () =
|
1995-05-04 03:15:53 -07:00
|
|
|
{ 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
|