New representation for queues, avoiding Obj.magic

(Jérémie Dimino)

- use inline-records to avoid using Obj.magic while keeping
  indirections to the minumum
- change the representation from a cyclic list to a simply-linked
  list. The drawback is one more word per queue, but it makes the
  implementation clearer

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16545 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 79 insertions, 114 deletions

diff --git a/stdlib/queue.ml b/stdlib/queue.ml
index fb920d8c9c..134bdacc1f 100644
--- a/stdlib/queue.ml
+++ b/stdlib/queue.ml
@@ -3,6 +3,7 @@
 (*                                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    *)
@@ -13,113 +14,80 @@
 
 exception Empty
 
-(* OCaml 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 cell = {
-    content: 'a;
-    mutable next: 'a cell
-  }
-
-(* 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 cell =
+  | Nil
+  | Cons of { content: 'a; mutable next: 'a cell }
 
 type 'a t = {
-    mutable length: int;
-    mutable tail: 'a cell
-  }
+  mutable length: int;
+  mutable first: 'a cell;
+  mutable last: 'a cell
+}
 
 let create () = {
   length = 0;
-  tail = Obj.magic None
+  first = Nil;
+  last = Nil
 }
 
 let clear q =
   q.length <- 0;
-  q.tail <- Obj.magic None
+  q.first <- Nil;
+  q.last <- Nil
 
 let add x q =
-  if q.length = 0 then
-    let rec cell = {
-      content = x;
-      next = cell
-    } in
+  let cell = Cons {
+    content = x;
+    next = Nil
+  } in
+  match q.last with
+  | Nil ->
     q.length <- 1;
-    q.tail <- cell
-  else
-    let tail = q.tail in
-    let head = tail.next in
-    let cell = {
-      content = x;
-      next = head
-    } in
+    q.first <- cell;
+    q.last <- cell
+  | Cons last ->
     q.length <- q.length + 1;
-    tail.next <- cell;
-    q.tail <- cell
+    last.next <- cell;
+    q.last <- cell
 
 let push =
   add
 
 let peek q =
-  if q.length = 0 then
-    raise Empty
-  else
-    q.tail.next.content
+  match q.first with
+  | Nil -> raise Empty
+  | Cons { content } -> content
 
 let top =
   peek
 
 let take q =
-  if q.length = 0 then raise Empty;
-  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
+  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 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 prev cell =
-      if cell != tail
-      then let res = {
-        content = cell.content;
-        next = tail'
-      } in prev.next <- res;
-      copy res cell.next in
-
-    copy tail' tail.next;
-    {
-      length = q.length;
-      tail = tail'
-    }
+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
@@ -127,39 +95,36 @@ let is_empty q =
 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 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 =
-  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
+  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