Merge pull request #4 from sadiqj/dunify

First pass at getting this to build under dune

Author: kayceesrk

.gitignore

@@ -5,4 +5,5 @@ tmp
 \#*#
 *.install
 *.native
-*.byte
+*.byte
+**/.merlin

_tags

@@ -0,0 +1 @@
+(lang dune 1.8)

dune-project

@@ -1,18 +1,19 @@
-opam-version: "1.2"
+opam-version: "2.0"
+name: "kcas"
 maintainer: "KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"
 authors: ["KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"]
 homepage: "https://github.com/kayceesrk/kcas"
+description: "Multi-word compare-and-swap library"
 doc: "https://kayceesrk.github.io/kcas/doc"
 license: "ISC"
-dev-repo: "https://github.com/kayceesrk/kcas.git"
+dev-repo: "git+https://github.com/kayceesrk/kcas.git"
 bug-reports: "https://github.com/kayceesrk/kcas/issues"
 tags: []
-available: [ ocaml-version >= "4.01.0"]
 depends: [
   "ocamlfind" {build}
   "ocamlbuild" {build}
-  "topkg" {build} ]
+  "dune" {build} ]
 depopts: []
 build: [
-  "ocaml" "pkg/pkg.ml" "build"
-          "--pinned" pinned ]
+  ["dune" "build" "src/kcas.mllib"] 
+]

opam renamed to kcas.opam

@@ -0,0 +1,4 @@
+(library
+ (name kcas)
+ (libraries unix)
+ (modes native))

pkg/META

@@ -4,8 +4,6 @@ Copyright (c) 2017, Nicolas ASSOUAD <nicolas.assouad@ens.fr>
 ########
 *)
 
-open Printf;;
-
 module type Backoff = Kcas_backoff.S;;
 module Backoff = Kcas_backoff.M;;
 
@@ -62,7 +60,7 @@ let mk_casn st c_l = {
   id_casn = Oo.id (object end);
 };;
 
-let rec st_eq s s' =
+let st_eq s s' =
   match s, s' with
   |WORD(x), WORD(x') -> x == x'
   |RDCSS_DESC(r), RDCSS_DESC(r') -> r.id_rdcss == r'.id_rdcss
@@ -148,7 +146,7 @@ let rec get a =
 let kCAS c_l =
   match c_l with
   |[] -> true
-  |[CAS(r, o, n) as c] -> ignore @@ get r; commit c
+  |[CAS(r, _, _) as c] -> ignore @@ get r; commit c
   |_ -> casn_proceed (mk_casn (ref UNDECIDED) c_l)
 ;;
 

pkg/pkg.ml

@@ -4,11 +4,11 @@ Copyright (c) 2017, Nicolas ASSOUAD <nicolas.assouad@ens.fr>
 ########
 *)
 
-type 'a ref;;
 (** Type of shared memory reference *)
+type 'a ref;;
 
-type t;;
 (** Type of compare and swap value *)
+type t;;
 
 (** The type of CAS result. *)
 type 'a cas_result =
@@ -17,71 +17,71 @@ type 'a cas_result =
   | Success of 'a
 ;;
 
-val ref : 'a -> 'a ref;;
 (** [ref x] returns a reference on a shared memory ceils containing the value [x] *)
+val ref : 'a -> 'a ref;;
 
 val equal : 'a ref -> 'b ref -> bool;;
 
 val is_on_ref : t -> 'a ref -> bool;;
 
-val mk_cas : 'a ref -> 'a -> 'a -> t;;
 (** [mk_cas a o n] returns a new CAS value, which when performed, updates
     the reference [a] to [n] if the current content of [a] is [o] *)
+val mk_cas : 'a ref -> 'a -> 'a -> t;;
 
-val set : 'a ref -> 'a -> unit;;
 (** [set r n] updates the reference [r] to value [n] directly. Not Safe to use with
     shared memory ! *)
+val set : 'a ref -> 'a -> unit;;
 
-val cas : 'a ref -> 'a -> 'a -> bool;;
 (** [cas r e u] updates the reference [r] to value [u] if the current content
     of [r] is [e]. *)
+val cas : 'a ref -> 'a -> 'a -> bool;;
 
-val commit : t -> bool;;
 (** [commit c] performs the CAS [c] and returns [true] if the CAS is successful. *)
+val commit : t -> bool;;
 
-val kCAS : t list -> bool;;
 (** [kCAS l] performs a lock-free multi-word CAS and returns [true] if the
     multi-word CAS is successful. *)
+val kCAS : t list -> bool;;
 
-val get : 'a ref -> 'a;;
 (** [get a] reads the value contained in the memory ceil [a]. *)
+val get : 'a ref -> 'a;;
 
-val try_map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 (** [try_map r f] invokes [f c], where [c] is the result of [get r]. If the
     result of [f c] is [None], then [Aborted] is returned. If the result of [f c]
     is [Some v], then attempt to CAS update [r] from [c] to [v]. If the CAS
     succeeds, then [Success c] is returned. If the CAS fails, then [Failed] is
     returned. *)
+val try_map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 
-val map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 (** Like {!try_map} but retries on CAS failure. Hence, [map r f] never returns
     [Failed]. *)
+val map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 
-val incr : int ref -> unit;;
 (** [incr r] atomically increments [r] *)
+val incr : int ref -> unit;;
 
-val decr : int ref -> unit;;
 (** [decr r] atomically decrements [r] *)
+val decr : int ref -> unit;;
 
 (** {2 Backoff}
     Suspend domains with exponential backoff. *)
 module type Backoff = sig
-  type t;;
   (** The type of backoff value *)
+  type t;;
 
-  val create : ?max:int -> unit -> t;;
   (** [create ~max:maxv ()] returns a backoff value, which when waited upon,
       suspends the calling domain for [x] milliseconds, where [x] is the
       current value of the backoff. The backoff value [x] is doubled after
       every wait upto a maximum of [maxv] milliseconds. The default maximum is
       32 milliseconds. The initial backoff is 1 millisecond. *)
-
-  val once : t -> unit;;
+  val create : ?max:int -> unit -> t;;
+ 
   (** [once b] suspends the current domain for [x] milliseconds, where [x] is
       the current value of the backoff. *)
-
-  val reset : t -> unit;;
+  val once : t -> unit;;
+  
   (** Resets the backoff clock to 1 millisecond. *)
+  val reset : t -> unit;;
 end
 
 module Backoff : Backoff;;
@@ -92,39 +92,36 @@ module Backoff : Backoff;;
     internal representation of a single word CAS reference is more efficient
     than that of a multi-word CAS reference. *)
 module type W1 = sig
-
-  type 'a ref;;
   (** The type of shared memory reference. *)
+  type 'a ref;;
 
-  val ref : 'a -> 'a ref;;
   (** Create a new reference. *)
+  val ref : 'a -> 'a ref;;
 
-  val get : 'a ref -> 'a;;
   (** Get the value of the reference. *)
+  val get : 'a ref -> 'a;;
 
   val set : 'a ref -> 'a -> unit;;
 
-  val cas : 'a ref -> 'a -> 'a -> bool;;
   (** [cas r e u] updates the reference [r] to value [u] if the current content
       of [r] is [e]. *)
-
-  val try_map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
+  val cas : 'a ref -> 'a -> 'a -> bool;;
+ 
   (** [try_map r f] invokes [f c], where [c] is the result of [get r]. If the
       result of [f c] is [None], then [Aborted] is returned. If the result of [f c]
       is [Some v], then attempt to CAS update [r] from [c] to [v]. If the CAS
       succeeds, then [Success c] is returned. If the CAS fails, then [Failed] is
       returned. *)
+  val try_map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 
-  val map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
   (** Like {!try_map} but retries on CAS failure. Hence, [map r f] never returns
       [Failed]. *)
+  val map : 'a ref -> ('a -> 'a option) -> 'a cas_result;;
 
-  val incr : int ref -> unit;;
   (** [incr r] atomically increments [r] *)
+  val incr : int ref -> unit;;
 
   val decr : int ref -> unit;;
-  (** [decr r] atomically decrements [r] *)
-
 end
 
 module W1 : W1;;

src/dune

@@ -1,19 +1,14 @@
 
 open Printf;;
 
-let print_usage_and_exit () =
-  print_endline @@ "Usage: " ^ Sys.argv.(0) ^ " <k> <num_iter>";
-  exit(0)
-;;
-
 let (k_kCAS, num_iter) =
   if Array.length Sys.argv < 3 then
-    print_usage_and_exit ()
+    (2, 1000)
   else try
     let a = int_of_string (Sys.argv.(1)) in
     let b = int_of_string (Sys.argv.(2)) in
     (a,b)
-  with Failure _ -> print_usage_and_exit ()
+  with Failure _ -> failwith "Unable to parse arguments"
 ;;
 
 let make_kCAS k =
@@ -63,7 +58,7 @@ let benchmark () =
 
 let main () =
   let n = 10 in
-  let (m,sd) = Benchmark.benchmark benchmark n in
+  let (m,_) = Benchmark.benchmark benchmark n in
   print_endline (sprintf "%f" m)
 ;;
 

src/kcas.ml

@@ -0,0 +1,11 @@
+(test
+ (name test)
+ (libraries kcas)
+ (modules test)
+ (modes native))
+
+(test
+ (name benchmark)
+ (libraries kcas)
+ (modules benchmark)
+ (modes native))

src/kcas.mli

@@ -41,7 +41,7 @@ let v_y = 1;;
 let thread1 (a1, a2) =
   let c1 = [mk_cas a1 v_x v_y ; mk_cas a2 v_x v_y] in
   let c2 = [mk_cas a1 v_y v_x ; mk_cas a2 v_y v_x] in
-  for i = 1 to nb_iter do
+  for _ = 1 to nb_iter do
     let out1 = kCAS c1 in
     let out2 = kCAS c2 in
     if out1 <> true || out2 <> true then begin
@@ -56,7 +56,7 @@ let thread1 (a1, a2) =
 let thread2 (a1, a2) =
   let c1 = [mk_cas a1 v_y v_x ; mk_cas a2 v_x v_y] in
   let c2 = [mk_cas a1 v_x v_y ; mk_cas a2 v_y v_x] in
-  for i = 1 to nb_iter do
+  for _ = 1 to nb_iter do
     let out1 = kCAS c1 in
     let out2 = kCAS c2 in
     if out1 <> false || out2 <> false then begin
@@ -69,7 +69,7 @@ let thread2 (a1, a2) =
 let thread3 (a1, a2) =
   let c1 = [mk_cas a1 v_x v_y ; mk_cas a2 v_y v_x] in
   let c2 = [mk_cas a1 v_y v_x ; mk_cas a2 v_x v_y] in
-  for i = 1 to nb_iter do
+  for _ = 1 to nb_iter do
     let out1 = kCAS c1 in
     let out2 = kCAS c2 in
     if out1 <> false || out2 <> false then begin
@@ -89,7 +89,7 @@ let thread4 (a1, a2) =
 ;;
 
 let thread5 (a1, a2) =
-  for i = 0 to nb_iter do
+  for _ = 0 to nb_iter do
     let a = get a1 in
     let b = get a2 in
     if a > b then
@@ -101,9 +101,9 @@ let test_casn () =
   let a1 = ref v_x in
   let a2 = ref v_x in
 
-  Domain.spawn (fun () -> thread1 (a1, a2));
-  Domain.spawn (fun () -> thread2 (a1, a2));
-  Domain.spawn (fun () -> thread3 (a1, a2));
+  Domain.spawn (fun () -> thread1 (a1, a2)) |> ignore;
+  Domain.spawn (fun () -> thread2 (a1, a2)) |> ignore;
+  Domain.spawn (fun () -> thread3 (a1, a2)) |> ignore;
 
   Unix.sleep wait_time;
   print_endline (sprintf "a1 = %d et a2 = %d" (get a1) (get a2));
@@ -114,8 +114,8 @@ let test_read_casn () =
   let a1 = ref 0 in
   let a2 = ref 0 in
 
-  Domain.spawn (fun () -> thread4 (a1, a2));
-  Domain.spawn (fun () -> thread5 (a1, a2));
+  Domain.spawn (fun () -> thread4 (a1, a2)) |> ignore;
+  Domain.spawn (fun () -> thread5 (a1, a2)) |> ignore;
 
   Unix.sleep wait_time;
   !th4_success && !th5_success