Merge pull request #3 from sadiqj/duneify

Duneification of lockfree

dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.8)
+(name lockfree)

lockfree.opam

@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"
+authors: ["KC Sivaramakrishnan <sk826@cl.cam.ac.uk>"]
+homepage: "https://github.com/ocaml-multicore/lockfree"
+doc: "https://kayceesrk.github.io/lockfree/doc"
+synopsis: "Lock-free data structures for multicore OCaml"
+license: "ISC"
+dev-repo: "https://github.com/ocaml-multicore/lockfree.git"
+bug-reports: "https://github.com/ocaml-multicore/lockfree/issues"
+tags: []
+available: [ ocaml-version >= "4.06.1"]
+depends: [
+  "ocamlfind" {build}
+  "ocamlbuild" {build}
+  "dune" {build} 
+	"kcas" {>= "0.1.3"}
+]
+depopts: []
+build: [
+  "dune" "build" "-p" name ]

src/dune

@@ -0,0 +1,5 @@
+(library
+ (name lockfree)
+ (public_name lockfree)
+ (libraries kcas)
+ (modes native))

src/lf_bag.ml

@@ -4,8 +4,6 @@ Copyright (c) 2017, Nicolas ASSOUAD <nicolas.assouad@ens.fr>
 ########
 *)
 
-open Printf;;
-
 module type CoreDesc = sig
   val nb_domains : int;;
 end;;
@@ -40,12 +38,13 @@ module Make(Desc : CoreDesc) : S = struct
   ;;
 
   let push b v =
-    match Hash.find b (Domain.self ()) with
-    |Some(q) -> Queue.push q v
-    |None ->
-      let q = Queue.create () in
-      Queue.push q v;
-      Hash.add b (Domain.self ()) q
+    let domain_self = (Domain.self() :> int) in
+      match Hash.find b domain_self with
+      |Some(q) -> Queue.push q v
+      |None ->
+        let q = Queue.create () in
+        Queue.push q v;
+        Hash.add b domain_self q
   ;;
 
   let shuffle l =
@@ -55,7 +54,7 @@ module Make(Desc : CoreDesc) : S = struct
   ;;
 
   let rec pop b =
-    match Hash.find b (Domain.self ()) with
+    match Hash.find b (Domain.self() :> int) with
     |Some(q) -> begin
       match Queue.pop q with
       |Some(_) as out -> out

src/lf_bag.mli

@@ -9,21 +9,21 @@ module type CoreDesc = sig
 end;;
 
 module type S = sig
-  type 'a t;;
   (** The type of lock-free bag. *)
+  type 'a t;;
 
-  val create : unit -> 'a t;;
   (** Create a new bag, which is initially empty. *)
+  val create : unit -> 'a t;;
 
-  val is_empty : 'a t -> bool;;
   (** [is_empty b] returns empty if [b] is empty. *)
+  val is_empty : 'a t -> bool;;
 
-  val push : 'a t -> 'a -> unit;;
   (** [push b v] pushes [v] into the bag. *)
+  val push : 'a t -> 'a -> unit;;
 
-  val pop : 'a t -> 'a option;;
   (** [pop b] pops an element [e] from the bag and returns
       [Some v] if the bag is non-empty. Otherwise, returns [None]. *)
+  val pop : 'a t -> 'a option;;
 end;;
 
 module Make(Desc : CoreDesc) : S;;

src/lf_hash.ml

@@ -84,7 +84,7 @@ module Make(Desc : HashDesc) : S = struct
     Buffer.contents buf
   ;;
 
-  let rec split_compare x y =
+  let split_compare x y =
     let rec loop a b =
       if a = 0 && b = 0 then
         0
@@ -115,7 +115,7 @@ module Make(Desc : HashDesc) : S = struct
 
   let rec help_resize t old_access old_access_size =
     let b = Kcas.Backoff.create () in
-    let new_a = Array.init nb_bucket (fun i -> Cas.ref Uninitialized) in
+    let new_a = Array.init nb_bucket (fun _ -> Cas.ref Uninitialized) in
     Cas.set new_a.(0) (Allocated(old_access));
     let rec loop () =
       match Cas.get t.resize with
@@ -138,7 +138,7 @@ module Make(Desc : HashDesc) : S = struct
     |Some(_) -> help_resize t old_access old_access_size
     |None when c / s > load ->
       if 2*s <= old_access_size then begin
-        Cas.cas t.size s (2*s); check_size t
+        ignore(Cas.cas t.size s (2*s)); check_size t
       end else if Cas.cas t.resize None (Some(nb_bucket * old_access_size)) then begin
         help_resize t old_access old_access_size
      end  else
@@ -150,7 +150,7 @@ module Make(Desc : HashDesc) : S = struct
     let l = List.create () in
     let (_, n0) = List.sinsert l (0, None) split_compare in
     let (_, n1) = List.sinsert l (1, None) split_compare in
-    let tab = Array.init nb_bucket (fun i -> Cas.ref Uninitialized) in
+    let tab = Array.init nb_bucket (fun _ -> Cas.ref Uninitialized) in
     Cas.set tab.(0) (Initialized(n0));
     Cas.set tab.(1) (Initialized(n1));
     {
@@ -192,14 +192,14 @@ module Make(Desc : HashDesc) : S = struct
           let prev_hk = hk mod (get_closest_power hk) in
           let prev_s = get_bucket t prev_hk in
           match Cas.get a.(ind) with
-          |Initialized(s) as out -> out
+          | Initialized(_) as out -> out
           |_ ->
             let (_, s) = List.sinsert prev_s (hk, None) split_compare in
             Initialized(s)
         end else
-          Allocated(Array.init nb_bucket (fun i -> Cas.ref Uninitialized))
+          Allocated(Array.init nb_bucket (fun _ -> Cas.ref Uninitialized))
       in
-      Cas.cas a.(ind) Uninitialized new_elem;
+      ignore(Cas.cas a.(ind) Uninitialized new_elem);
       ()
     in
     let size = (Cas.get t.access_size) / nb_bucket in
@@ -212,7 +212,7 @@ module Make(Desc : HashDesc) : S = struct
     let s = get_bucket t hk in
     let v = List.find s (k, Some(Obj.magic ())) split_compare in
     match v with
-    |Some(k', out) -> out
+    |Some(_, out) -> out
     |None -> None
   ;;
 
@@ -224,7 +224,7 @@ module Make(Desc : HashDesc) : S = struct
   ;;
 
 
-  let rec add t k v =
+  let add t k v =
     check_size t;
     let hk = hash t k in
     let s = get_bucket t hk in

src/lf_hash.mli

@@ -11,34 +11,34 @@ module type HashDesc = sig
 end;;
 
 module type S = sig
-  type 'a t;;
   (** The type of lock-free hash table. *)
+  type 'a t;;
 
-  val to_string : 'a t -> ('a -> string) -> string;;
   (** [to_string h f] returns a string represantation of the hash table [h],
       given a function [f] which gives a string represantation of an element of the list. *)
-
-  val create : unit -> 'a t;;
+  val to_string : 'a t -> ('a -> string) -> string;;
+
   (** [create ()] returns a fresh empty hash table. *)
+  val create : unit -> 'a t;;
 
-  val find : 'a t -> int -> 'a option;;
   (** [find h k] returns [Some v] if [v] is bounded with [k] in the hash table [h],
       [None] otherwise. *)
+  val find : 'a t -> int -> 'a option;;
 
-  val mem : 'a t -> int -> bool;;
   (** [mem h k] returns [true] if there is some value [v] which is bounded to [k],
       [false] otherwise. *)
-
-  val add : 'a t -> int -> 'a -> unit;;
+  val mem : 'a t -> int -> bool;;
+
   (** [add h k v] adds a new binding [(k, v)] to the hash table [h].
       If [k] is already bounded, the binding is replaced. *)
+  val add : 'a t -> int -> 'a -> unit;;
 
-  val remove : 'a t -> int -> bool;;
   (** [remove h k] removes the binding of the key [k] in the hash table [h],
       and returns [true] if it has succeed. *)
+  val remove : 'a t -> int -> bool;;
 
-  val elem_of : 'a t -> 'a list;;
   (** [elem_of h] returns the list of the value bounded in the hash table [h]. *)
+  val elem_of : 'a t -> 'a list;;
 end;;
 
 module Make(Desc : HashDesc) : S;;

src/lf_list.ml

@@ -25,10 +25,6 @@ end;;
 module M : S = struct
   module Cas = Kcas.W1;;
 
-  exception Head_Of_List;;
-  exception End_Of_List;;
-  exception Not_Found;;
-
   type 'a t = (bool * 'a node) Cas.ref
   and 'a node =
     |Node of 'a comparable * 'a t
@@ -59,7 +55,7 @@ module M : S = struct
     let buf = Buffer.create 17 in
     let rec loop l not_first =
       match Cas.get l with
-      |mark, Node(v, next) -> begin
+      |_, Node(v, next) -> begin
         match v with
         |Min -> loop next false
         |Max -> loop next false
@@ -101,7 +97,7 @@ module M : S = struct
       Cas.set next (false, Node(Val(v), Cas.ref vnext))
   ;;
 
-  let rec push l v =
+  let push l v =
     let b = Kcas.Backoff.create () in
     let rec loop () =
       match Cas.get l with
@@ -185,26 +181,26 @@ module M : S = struct
     let rec loop prev vprev n =
       match Cas.get n with
       |_, Nil -> failwith "Lock_Free_List.sfind: impossible"
-      |status, Node(v', next') as vn ->
+      |_, Node(v', next') as vn ->
         if compare v v' <= 0 then begin
           (prev, vprev, n, vn)
         end else
           loop n vn next'
     in
     match Cas.get l with
     |_, Nil -> failwith "Lock_Free_List.sfind: impossible"
-    |status, Node(v', next') as vl -> loop l vl next'
+    |_, Node(_, next') as vl -> loop l vl next'
   ;;
 
   let sinsert l v f =
     let b = Kcas.Backoff.create () in
     let v = Val(v) in
     let compare = mk_compare f in
-    let rec loop (prev, vprev, n, vn) =
+    let rec loop (_, vprev, _, vn) =
       match snd vn with
       |Node(nv_v, nv_next) -> begin
         match snd vprev with
-        |Node(vprev_v, vprev_next) ->
+        |Node(_, vprev_next) ->
           if compare nv_v v <> 0 then
             let new_node = (false, Node(v, Cas.ref vn)) in
             if not (Cas.cas vprev_next vn new_node) then
@@ -233,14 +229,14 @@ module M : S = struct
     let b = Kcas.Backoff.create () in
     let v = Val(v) in
     let compare = mk_compare f in
-    let rec loop (prev, vprev, n, vn) =
+    let rec loop (_, vprev, _, vn) =
       match snd vn with
       |Node(vn_v, vn_next) ->
         if compare v vn_v = 0 then
           let (vn_next_v, marked_vn_next_v) = marked vn_next in
           if Cas.cas vn_next vn_next_v marked_vn_next_v then begin
             match snd vprev with
-            |Node(vprev_v, vprev_next) ->
+            |Node(_, vprev_next) ->
               if get_mark (Cas.get vprev_next) || not (Cas.cas vprev_next vn vn_next_v) then
                 (Cas.set vn_next vn_next_v; Kcas.Backoff.once b; loop (sfind l v f))
               else