diff options
| -rw-r--r-- | stdlib/queue.ml | 188 | ||||
| -rw-r--r-- | stdlib/queue.mli | 22 |
2 files changed, 162 insertions, 48 deletions
diff --git a/stdlib/queue.ml b/stdlib/queue.ml index 58fc637ae..477afcb08 100644 --- a/stdlib/queue.ml +++ b/stdlib/queue.ml @@ -2,9 +2,9 @@ (* *) (* Objective Caml *) (* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* François Pottier, projet Cristal, INRIA Rocquencourt *) (* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) @@ -15,59 +15,151 @@ exception Empty -type 'a queue_cell = - Nil - | Cons of 'a * 'a queue_cell ref +(* O'Caml currently does not allow the components of a sum type to be + mutable. Yet, for optimal space efficiency, we must have cons cells + whose [next] field is mutable. This leads us to define a type of + cyclic lists, so as to eliminate the [Nil] case and the sum + type. *) -type 'a t = - { mutable head: 'a queue_cell; - mutable tail: 'a queue_cell } +type 'a cell = { + content: 'a; + mutable next: 'a cell + } -let create () = - { head = Nil; tail = Nil } +(* A queue is a reference to either nothing or some cell of a cyclic + list. By convention, that cell is to be viewed as the last cell in + the queue. The first cell in the queue is then found in constant + time: it is the next cell in the cyclic list. The queue's length is + also recorded, so as to make [length] a constant-time operation. + + The [tail] field should really be of type ['a cell option], but + then it would be [None] when [length] is 0 and [Some] otherwise, + leading to redundant memory allocation and accesses. We avoid this + overhead by filling [tail] with a dummy value when [length] is 0. + Of course, this requires bending the type system's arm slightly, + because it does not have dependent sums. *) + +type 'a t = { + mutable length: int; + mutable tail: 'a cell + } + +let create () = { + length = 0; + tail = Obj.magic None +} let clear q = - q.head <- Nil; q.tail <- Nil + q.length <- 0; + q.tail <- Obj.magic None 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 + q.length <- q.length + 1; + if q.length = 1 then + let rec cell = { + content = x; + next = cell + } in + q.tail <- cell + else + let tail = q.tail in + let head = tail.next in + let cell = { + content = x; + next = head + } in + tail.next <- cell; + q.tail <- cell + +let push = + add let peek q = - match q.head with - Nil -> - raise Empty - | Cons(x, _) -> - x + if q.length = 0 then + raise Empty + else + q.tail.next.content + +let top = + peek 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 + if q.length = 0 then + raise Empty + else + q.length <- q.length - 1; + let tail = q.tail in + let head = tail.next in + if head == tail then + q.tail <- Obj.magic None + else + tail.next <- head.next; + head.content + +let pop = + take + +let copy q = + if q.length = 0 then + create() + else + let tail = q.tail in + + let rec tail' = { + content = tail.content; + next = tail' + } in + + let rec copy cell = + if cell == tail then tail' + else { + content = cell.content; + next = copy cell.next + } in + + tail'.next <- copy tail.next; + { + length = q.length; + tail = tail' + } + +let length q = + q.length + +let iter f q = + if q.length > 0 then + let tail = q.tail in + let rec iter cell = + f cell.content; + if cell != tail then + iter cell.next in + iter tail.next + +let fold f accu q = + if q.length = 0 then + accu + else + let tail = q.tail in + let rec fold accu cell = + let accu = f accu cell.content in + if cell == tail then + accu + else + fold accu cell.next in + fold accu tail.next + +let transfer q1 q2 = + let length1 = q1.length in + if length1 > 0 then + let tail1 = q1.tail in + clear q1; + if q2.length > 0 then begin + let tail2 = q2.tail in + let head1 = tail1.next in + let head2 = tail2.next in + tail1.next <- head2; + tail2.next <- head1 + end; + q2.length <- q2.length + length1; + q2.tail <- tail1 + diff --git a/stdlib/queue.mli b/stdlib/queue.mli index 89af53d1b..bd9879041 100644 --- a/stdlib/queue.mli +++ b/stdlib/queue.mli @@ -32,17 +32,29 @@ val create : unit -> 'a t val add : 'a -> 'a t -> unit (** [add x q] adds the element [x] at the end of the queue [q]. *) +val push : 'a -> 'a t -> unit +(** [push] is a synonym for [add]. *) + val take : 'a t -> 'a (** [take q] removes and returns the first element in queue [q], or raises [Empty] if the queue is empty. *) +val pop : 'a t -> 'a +(** [pop] is a synonym for [take]. *) + val peek : 'a t -> 'a (** [peek q] returns the first element in queue [q], without removing it from the queue, or raises [Empty] if the queue is empty. *) +val top : 'a t -> 'a +(** [top] is a synonym for [peek]. *) + val clear : 'a t -> unit (** Discard all elements from a queue. *) +val copy : 'a t -> 'a t +(** Return a copy of the given queue. *) + val length : 'a t -> int (** Return the number of elements in a queue. *) @@ -51,3 +63,13 @@ val iter : ('a -> unit) -> 'a t -> unit from the least recently entered to the most recently entered. The queue itself is unchanged. *) +val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b +(** [fold f accu q] is equivalent to [List.fold_left f accu l], + where [l] is the list of [q]'s elements. The queue remains + unchanged. *) + +val transfer : 'a t -> 'a t -> unit +(** [transfer q1 q2] adds all of [q1]'s elements at the end of + the queue [q2], then clears [q1]. It is equivalent to the + sequence [iter (fun x -> add x q2) q1; clear q1], but runs + in constant time. *) |