WIP : Trying with unwrapped lib and a module named multicore_magic. C…

…ycling deps issue.

src/dscheck/dune

@@ -1,4 +1,6 @@
 (library
  (name multicore_magic_dscheck)
- (package multicore-magic-dscheck)
- (libraries multicore-magic dscheck))
+ (public_name multicore-magic-dscheck)
+ (wrapped false)
+ (root_module Deps)
+ (libraries multicore-magic dscheck))

src/dscheck/multicore_magic.ml

@@ -0,0 +1,37 @@
+include Deps.Multicore_magic
+module Atomic = Deps.Dscheck.TracedAtomic
+
+module Transparent_atomic = struct
+  include Atomic
+
+  let fenceless_get = get
+  let fenceless_set = set
+end
+
+let[@inline] fenceless_get (atomic : 'a Atomic.t) =
+  !(Sys.opaque_identity (Obj.magic atomic : 'a ref))
+
+let[@inline] fenceless_set (atomic : 'a Atomic.t) value =
+  (Obj.magic atomic : 'a ref) := value
+
+let[@inline] fence atomic = Atomic.fetch_and_add atomic 0 |> ignore
+
+module Atomic_array = struct
+  type 'a t = 'a Atomic.t array
+
+  let[@inline] at (type a) (xs : a t) i : a Atomic.t =
+    (* ['a t] does not contain [float]s. *)
+    Obj.magic (Array.unsafe_get (Obj.magic xs : a ref array) i)
+
+  let[@inline] make n v = Array.init n @@ fun _ -> Atomic.make v
+  let[@inline] init n fn = Array.init n @@ fun i -> Atomic.make (fn i)
+  let[@inline] of_array xs = init (Array.length xs) (Array.unsafe_get xs)
+
+  external length : 'a array -> int = "%array_length"
+
+  let[@inline] unsafe_fenceless_set xs i v = Obj.magic (at xs i) := v
+  let[@inline] unsafe_fenceless_get xs i = !(Obj.magic (at xs i))
+
+  let[@inline] unsafe_compare_and_set xs i b a =
+    Atomic.compare_and_set (at xs i) b a
+end