Use polymorphic variant for mode

Author: polytypic

src/kcas/kcas.ml

@@ -136,7 +136,9 @@ let[@inline] resume_awaiters = function
   | [ awaiter ] -> resume_awaiter awaiter
   | awaiters -> List.iter resume_awaiter awaiters
 
-type mode = Lock_free | Obstruction_free
+module Mode = struct
+  type t = [ `Lock_free | `Obstruction_free ]
+end
 
 type 'a state = {
   mutable before : 'a;
@@ -164,7 +166,7 @@ and _ tdt =
               This field must be first, see [root_as_atomic] and
               [tree_as_ref]. *)
       timeout : [ `Set | `Unset ] Timeout.t;
-      mutable mode : mode;
+      mutable mode : Mode.t;
       mutable validate_counter : int;
       mutable post_commit : Action.t;
     }
@@ -231,13 +233,6 @@ let[@inline] is_determined = function
       | R After | R Before -> true
     end
 
-module Mode = struct
-  type t = mode
-
-  let lock_free = Lock_free
-  let obstruction_free = Obstruction_free
-end
-
 let[@inline] isnt_int x = not (Obj.is_int (Obj.repr x))
 
 let[@inline] rec release_after_rec which = function
@@ -545,20 +540,18 @@ let dec x = x - 1
 module Loc = struct
   type 'a t = 'a loc
 
-  let make ?(padded = false) ?(mode = Mode.obstruction_free) after =
+  let make ?(padded = false) ?(mode = `Obstruction_free) after =
     let state = new_state after
-    and id =
-      if mode == Mode.obstruction_free then Id.nat_id () else Id.neg_id ()
-    in
+    and id = if mode == `Obstruction_free then Id.nat_id () else Id.neg_id () in
     make_loc padded state id
 
   let make_contended ?mode after = make ~padded:true ?mode after
 
-  let make_array ?(padded = false) ?(mode = Mode.obstruction_free) n after =
+  let make_array ?(padded = false) ?(mode = `Obstruction_free) n after =
     assert (0 <= n);
     let state = new_state after
     and id =
-      (if mode == Mode.obstruction_free then Id.nat_ids n else Id.neg_ids n)
+      (if mode == `Obstruction_free then Id.nat_ids n else Id.neg_ids n)
       - (n - 1)
     in
     Array.init n @@ fun i -> make_loc padded state (id + i)
@@ -584,7 +577,7 @@ module Loc = struct
     get_as (Timeout.alloc_opt timeoutf) f loc (atomic_get (as_atomic loc))
 
   let[@inline] get_mode loc =
-    if loc.id < 0 then Mode.lock_free else Mode.obstruction_free
+    if loc.id < 0 then `Lock_free else `Obstruction_free
 
   let compare_and_set ?(backoff = Backoff.default) loc before after =
     let state = new_state after in
@@ -660,7 +653,7 @@ module Xt = struct
 
   let[@inline] is_obstruction_free (Xt xt_r : _ t) loc =
     (* Fenceless is safe as we are accessing a private location. *)
-    xt_r.mode == Mode.obstruction_free && 0 <= loc.id
+    xt_r.mode == `Obstruction_free && 0 <= loc.id
 
   let[@inline] update_new loc f xt lt gt =
     (* Fenceless is safe inside transactions as each log update has a fence. *)
@@ -895,9 +888,9 @@ module Xt = struct
                 if a_cmp_followed_by_a_cas < status then begin
                   if finish xt root (verify xt root) then success xt result
                   else begin
-                    (* We switch to [Mode.lock_free] as there was
+                    (* We switch to [`Lock_free] as there was
                        interference. *)
-                    commit_once_alloc backoff Mode.lock_free xt tx
+                    commit_once_alloc backoff `Lock_free xt tx
                   end
                 end
                 else if
@@ -965,7 +958,7 @@ module Xt = struct
     commit backoff xt tx
 
   let[@inline] commit ?timeoutf ?(backoff = Backoff.default)
-      ?(mode = Mode.obstruction_free) { tx } =
+      ?(mode = `Obstruction_free) { tx } =
     let timeout = Timeout.alloc_opt timeoutf
     and rot = U Leaf
     and validate_counter = initial_validate_period

src/kcas/kcas.mli

@@ -140,18 +140,17 @@ end
 
 (** Operating modes of the [k-CAS-n-CMP] algorithm. *)
 module Mode : sig
-  type t
-  (** Type of an operating mode of the [k-CAS-n-CMP] algorithm. *)
-
-  val lock_free : t
-  (** In [lock_free] mode the algorithm makes sure that at least one domain will
+  type t =
+    [ `Lock_free
+      (** In [`Lock_free] mode the algorithm makes sure that at least one domain will
       be able to make progress at the cost of performing read-only operations as
       read-write operations. *)
-
-  val obstruction_free : t
-  (** In [obstruction_free] mode the algorithm proceeds optimistically and
+    | `Obstruction_free
+      (** In [`Obstruction_free] mode the algorithm proceeds optimistically and
       allows read-only operations to fail due to interference from other domains
-      that might have been prevented in the {!lock_free} mode. *)
+      that might have been prevented in the [`Lock_free] mode. *)
+    ]
+  (** Type of an operating mode of the [k-CAS-n-CMP] algorithm. *)
 end
 
 (** {1 Individual locations}
@@ -185,8 +184,8 @@ module Loc : sig
       of using more memory.  It is not recommended to use [~padded:true] for
       short lived shared memory locations.
 
-      The optional [mode] argument defaults to {!Mode.obstruction_free}.  If
-      explicitly specified as {!Mode.lock_free}, the location will always be
+      The optional {{!Mode.t} [mode]} argument defaults to [`Obstruction_free].
+      If explicitly specified as [`Lock_free], the location will always be
       accessed using the lock-free operating mode.  This may improve performance
       in rare cases where a location is updated frequently and obstruction-free
       read-only accesses would almost certainly suffer from interference. *)
@@ -288,8 +287,9 @@ end
     done internally by the library implementation.  Only logically invisible
     writes to shared memory locations are performed during this phase.
 
-    3. In {!Mode.obstruction_free} a third phase verifies all read-only
-    operations.  This is also done internally by the library implementation.
+    3. In [`Obstruction_free] {{!Mode.t} mode} a third phase verifies all
+    read-only operations.  This is also done internally by the library
+    implementation.
 
     Each phase may fail.  In particular, in the first phase, as no changes to
     shared memory have yet been attempted, it is safe, for example, to raise
@@ -537,9 +537,9 @@ module Xt : sig
       {!Retry.Invalid} to explicitly request a retry or any other exception to
       abort the transaction.
 
-      The default for [commit] is {!Mode.obstruction_free}.  However, after
-      enough attempts have failed during the verification step, [commit]
-      switches to {!Mode.lock_free}. *)
+      The default {{!Mode.t} [mode]} for [commit] is [`Obstruction_free].
+      However, after enough attempts have failed during the verification step,
+      [commit] switches to [`Lock_free]. *)
 
   (**/**)
 

src/kcas_data/accumulator.ml

@@ -11,7 +11,7 @@ let make ?n_way n =
     | None -> n_way_default
     | Some n_way -> n_way |> Int.min n_way_max |> Bits.ceil_pow_2
   in
-  let a = Loc.make_array ~padded:true ~mode:Mode.lock_free n_way 0 in
+  let a = Loc.make_array ~padded:true ~mode:`Lock_free n_way 0 in
   Loc.set (Array.unsafe_get a 0) n;
   a
 

test/kcas/loc_modes.ml

@@ -5,9 +5,9 @@ let loop_count = try int_of_string Sys.argv.(1) with _ -> Util.iter_factor
 let mode =
   Some
     (try
-       if Sys.argv.(2) = "obstruction-free" then Mode.obstruction_free
-       else Mode.lock_free
-     with _ -> Mode.lock_free)
+       if Sys.argv.(2) = "obstruction-free" then `Obstruction_free
+       else `Lock_free
+     with _ -> `Lock_free)
 
 (* Number of shared counters being used to try to cause interference *)
 

test/kcas/test.ml

@@ -44,7 +44,7 @@ let run_domains = function
 (* *)
 
 let test_non_linearizable_xt () =
-  [ Mode.obstruction_free; Mode.lock_free ]
+  [ `Obstruction_free; `Lock_free ]
   |> List.iter @@ fun mode ->
      let barrier = Barrier.make 2
      and n_iter = 100 * Util.iter_factor
@@ -63,7 +63,7 @@ let test_non_linearizable_xt () =
      in
 
      let atomically tx =
-       if Random.bool () then Xt.commit ~mode:Mode.obstruction_free tx
+       if Random.bool () then Xt.commit ~mode:`Obstruction_free tx
        else Xt.commit tx
      in
 
@@ -103,7 +103,7 @@ let test_set () =
 (* *)
 
 let test_no_skew_xt () =
-  [ Mode.obstruction_free; Mode.lock_free ]
+  [ `Obstruction_free; `Lock_free ]
   |> List.iter @@ fun mode ->
      let barrier = Barrier.make 3 in
      let test_finished = Atomic.make false in
@@ -168,7 +168,7 @@ let test_no_skew_xt () =
 (* *)
 
 let test_get_seq_xt () =
-  [ Mode.obstruction_free; Mode.lock_free ]
+  [ `Obstruction_free; `Lock_free ]
   |> List.iter @@ fun mode ->
      let barrier = Barrier.make 4 in
      let test_finished = Atomic.make false in
@@ -225,7 +225,7 @@ let test_get_seq_xt () =
 (* *)
 
 let test_stress_xt n nb_loop =
-  [ Mode.obstruction_free; Mode.lock_free ]
+  [ `Obstruction_free; `Lock_free ]
   |> List.iter @@ fun mode ->
      let make_loc n =
        let rec loop n out =
@@ -326,7 +326,7 @@ let test_post_commit () =
     begin
       try
         count := 0;
-        Xt.commit ~mode:Mode.obstruction_free { tx }
+        Xt.commit ~mode:`Obstruction_free { tx }
       with Exit -> ()
     end;
     assert (!count = expect)
@@ -613,11 +613,9 @@ let test_timeout () =
 (* *)
 
 let test_mode () =
-  assert (Loc.get_mode (Loc.make ~mode:Mode.lock_free 0) == Mode.lock_free);
-  assert (
-    Loc.get_mode (Loc.make ~mode:Mode.obstruction_free 0)
-    == Mode.obstruction_free);
-  assert (Loc.get_mode (Loc.make 0) == Mode.obstruction_free)
+  assert (Loc.get_mode (Loc.make ~mode:`Lock_free 0) == `Lock_free);
+  assert (Loc.get_mode (Loc.make ~mode:`Obstruction_free 0) == `Obstruction_free);
+  assert (Loc.get_mode (Loc.make 0) == `Obstruction_free)
 
 (* *)