Do not match on record types with mutable fields in function arguments.

This tends to confuse the OCaml compiler, for good reasons. Indeed, if
there are mutable fields, the generated code cannot wait for the function
to be fully applied. It needs to recover the value of the mutable fields
as early as possible, and thus to create a closure.

Example:

    let foo {bar} x = ...

is compiled as

    let foo y = match y with {bar} -> fun x -> ...

1 files changed, 21 insertions, 15 deletions

diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index e17c3a2f88..2aaca85582 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -27,21 +27,23 @@ end = struct
   let create () = ref ([],sort_timestamp)
   let is_empty t = fst !t = []
   let exists p t = List.exists (fun (_,x) -> p x) (fst !t)
-  let pop ?(picky=(fun _ -> true)) ({ contents = (l, rel) } as t) =
+  let pop ?(picky=(fun _ -> true)) t =
+    let (l, rel) = !t in
     let rec aux acc = function
       | [] -> raise Queue.Empty
       | (_,x) :: xs when picky x -> t := (List.rev acc @ xs, rel); x
       | (_,x) as hd :: xs -> aux (hd :: acc) xs in
     aux [] l
-  let push ({ contents = (xs, rel) } as t) x =
+  let push t x =
+    let (xs, rel) = !t in
     incr age;
     (* re-roting the whole list is not the most efficient way... *)
     t := (List.sort rel (xs @ [!age,x]), rel)
-  let clear ({ contents = (l, rel) } as t) = t := ([], rel)
-  let set_rel rel ({ contents = (xs, _) } as t) =
+  let clear t = t := ([], snd !t)
+  let set_rel rel t =
     let rel (_,x) (_,y) = rel x y in
-    t := (List.sort rel xs, rel)
-  let length ({ contents = (l, _) }) = List.length l
+    t := (List.sort rel (fst !t), rel)
+  let length t = List.length (fst !t)
 end
 
 type 'a t = {
@@ -64,9 +66,8 @@ let create () = {
   release = false;
 }
 
-let pop ?(picky=(fun _ -> true)) ?(destroy=ref false)
-  ({ queue = q; lock = m; cond = c; cond_waiting = cn } as tq)
-=
+let pop ?(picky=(fun _ -> true)) ?(destroy=ref false) tq =
+  let { queue = q; lock = m; cond = c; cond_waiting = cn } = tq in
   Mutex.lock m;
   if tq.release then (Mutex.unlock m; raise BeingDestroyed);
   while not (PriorityQueue.exists picky q || !destroy) do
@@ -83,12 +84,14 @@ let pop ?(picky=(fun _ -> true)) ?(destroy=ref false)
   Mutex.unlock m;
   x
 
-let broadcast { lock = m; cond = c } =
+let broadcast tq =
+  let { lock = m; cond = c } = tq in
   Mutex.lock m;
   Condition.broadcast c;
   Mutex.unlock m
 
-let push { queue = q; lock = m; cond = c; release } x =
+let push tq x =
+  let { queue = q; lock = m; cond = c; release } = tq in
   if release then CErrors.anomaly(Pp.str
     "TQueue.push while being destroyed! Only 1 producer/destroyer allowed.");
   Mutex.lock m;
@@ -96,18 +99,21 @@ let push { queue = q; lock = m; cond = c; release } x =
   Condition.broadcast c;
   Mutex.unlock m
 
-let length { queue = q; lock = m } =
+let length tq =
+  let { queue = q; lock = m } = tq in
   Mutex.lock m;
   let n = PriorityQueue.length q in
   Mutex.unlock m;
   n
 
-let clear { queue = q; lock = m; cond = c } =
+let clear tq =
+  let { queue = q; lock = m; cond = c } = tq in
   Mutex.lock m;
   PriorityQueue.clear q;
   Mutex.unlock m
 
-let clear_saving { queue = q; lock = m; cond = c } f =
+let clear_saving tq f =
+  let { queue = q; lock = m; cond = c } = tq in
   Mutex.lock m;
   let saved = ref [] in
   while not (PriorityQueue.is_empty q) do
@@ -119,7 +125,7 @@ let clear_saving { queue = q; lock = m; cond = c } f =
   Mutex.unlock m;
   List.rev !saved
 
-let is_empty { queue = q } = PriorityQueue.is_empty q
+let is_empty tq = PriorityQueue.is_empty tq.queue
 
 let destroy tq =
   tq.release <- true;