From d509fc63e3cbe617aa8d14f1da0514dab5a36cf9 Mon Sep 17 00:00:00 2001
From: Carine Morel <carine@tarides.com>
Date: Thu, 21 Nov 2024 18:51:27 +0100
Subject: [PATCH] Fix treiber minor issues (#163)

* Fix stack overflow in test, due to List.@ not being not tail rec.

* Run mdx on the .mli.
---
 src/dune                                |  9 +++++++++
 src/treiber_stack.ml                    | 11 ++++-------
 src/treiber_stack.mli                   |  8 ++++----
 test/treiber_stack/stm_treiber_stack.ml |  2 +-
 4 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/src/dune b/src/dune
index 3ffdf3bf..739869ca 100644
--- a/src/dune
+++ b/src/dune
@@ -28,4 +28,13 @@ let () =
   (< %{ocaml_version} 5.2.0))
  (action
   (copy atomic.without_contended.ml atomic.ml))) 
+
+(mdx
+ (package saturn)
+ (enabled_if
+  (and
+   (<> %{os_type} Win32)
+   (>= %{ocaml_version} 5.0.0)))
+ (libraries saturn)
+ (files treiber_stack.mli))
 |}
diff --git a/src/treiber_stack.ml b/src/treiber_stack.ml
index b3ba2ee6..1de9ed3b 100644
--- a/src/treiber_stack.ml
+++ b/src/treiber_stack.ml
@@ -66,13 +66,10 @@ let push t value = push t value Backoff.default
 (**)
 
 let rec push_all_ t backoff values =
-  match Atomic.get t with
-  | [] ->
-      if Atomic.compare_and_set t [] values then ()
-      else push_all_ t (Backoff.once backoff) values
-  | _ as old_head ->
-      if Atomic.compare_and_set t old_head (values @ old_head) then ()
-      else push_all_ t (Backoff.once backoff) values
+  let before = Atomic.get t in
+  if Atomic.compare_and_set t before (List.rev_append (List.rev values) before)
+  then ()
+  else push_all_ t (Backoff.once backoff) values
 
 let push_all t values =
   match values with
diff --git a/src/treiber_stack.mli b/src/treiber_stack.mli
index bd7ff970..3980a9bd 100644
--- a/src/treiber_stack.mli
+++ b/src/treiber_stack.mli
@@ -52,7 +52,7 @@ val pop_all : 'a t -> 'a list
 order. 
 
   {[
-  # open Saturn_lockfree.Stack
+  # open Saturn.Stack
   # let t : int t = create ()
   val t : int t = <abstr>
   # push t 1
@@ -105,7 +105,7 @@ val add_seq : 'a t -> 'a Seq.t -> unit
 (** {1 Examples}
   An example top-level session:
   {[
-    # open Saturn_lockfree.Stack
+    # open Saturn.Stack
     # let t : int t = create ()
     val t : int t = <abstr>
     # push t 42
@@ -119,11 +119,11 @@ val add_seq : 'a t -> 'a Seq.t -> unit
     # pop_all t
     - : int list = [2; 1; 42]
     # pop_exn t
-    Exception: Saturn_lockfree__Treiber_stack.Empty.]}
+    Exception: Saturn__Treiber_stack.Empty.]}
 
   A multicore example: 
   {@ocaml non-deterministic[
-    # open Saturn_lockfree.Stack
+    # open Saturn.Stack
     # let t : int t = create ()
     val t : int t = <abstr>
     # let barrier =  Atomic.make 2
diff --git a/test/treiber_stack/stm_treiber_stack.ml b/test/treiber_stack/stm_treiber_stack.ml
index 9d5643dc..ccb47e02 100644
--- a/test/treiber_stack/stm_treiber_stack.ml
+++ b/test/treiber_stack/stm_treiber_stack.ml
@@ -38,7 +38,7 @@ module Spec = struct
       (Gen.oneof
          [
            Gen.map (fun i -> Push i) int_gen;
-           Gen.map (fun l -> Push_all l) (Gen.list int_gen);
+           Gen.map (fun l -> Push_all l) (Gen.small_list int_gen);
            Gen.return Pop_opt;
            Gen.return Pop_all;
            Gen.return Peek_opt;