From 3d6d2d9cd1c7750f2e97449516235a692b28bf56 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Sun, 15 Dec 2024 03:19:05 -0600 Subject: [PATCH] Bump saturn. (#4105) --- .github/opam/liquidsoap-core-windows.opam | 2 +- .github/scripts/build-posix.sh | 2 +- .github/workflows/ci.yml | 4 +- dune-project | 2 +- liquidsoap-lang.opam | 2 +- src/lang/queues.ml | 50 +++++++++-------------- src/lang/queues.mli | 6 +++ 7 files changed, 32 insertions(+), 36 deletions(-) diff --git a/.github/opam/liquidsoap-core-windows.opam b/.github/opam/liquidsoap-core-windows.opam index 8ae3bcb0a0..b5b71121f2 100644 --- a/.github/opam/liquidsoap-core-windows.opam +++ b/.github/opam/liquidsoap-core-windows.opam @@ -24,7 +24,7 @@ depends: [ "mm-windows" {>= "0.8.4"} "re-windows" {>= "1.11.0"} "cry-windows" {>= "1.0.1"} - "saturn_lockfree-windows" {>= "0.4.1" & < "0.5.0"} + "saturn_lockfree-windows" {>= "0.5.0"} "sedlex" {>= "3.2"} "sedlex-windows" {>= "3.2"} "magic-mime-windows" diff --git a/.github/scripts/build-posix.sh b/.github/scripts/build-posix.sh index f48ebf65eb..70f67880ea 100755 --- a/.github/scripts/build-posix.sh +++ b/.github/scripts/build-posix.sh @@ -52,7 +52,7 @@ cd .. opam update opam remove -y jemalloc -opam install -y tls.1.0.2 ca-certs mirage-crypto-rng cstruct saturn_lockfree.0.4.1 ppx_hash memtrace +opam install -y tls.1.0.2 ca-certs mirage-crypto-rng cstruct saturn_lockfree.0.5.0 ppx_hash memtrace cd /tmp/liquidsoap-full diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4e148ace55..434b7b81f4 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -85,7 +85,7 @@ jobs: cp PACKAGES.minimal PACKAGES opam update opam pin -yn . - opam install -y saturn_lockfree.0.4.1 ppx_hash + opam install -y saturn_lockfree.0.5.0 ppx_hash opam info -f "depopts:" liquidsoap-core | grep -v osx-secure-transport | xargs opam remove -y inotify ffmpeg-avutil cohttp-lwt-unix prometheus-app ${{ needs.build_details.outputs.minimal_exclude_deps }} opam install -y mem_usage echo "::endgroup::" @@ -121,7 +121,7 @@ jobs: cd /tmp/liquidsoap-full/liquidsoap eval "$(opam config env)" opam update - opam install -y xml-light + opam install -y xml-light saturn_lockfree.0.5.0 dune build --profile release ./src/js/interactive_js.bc.js tree_sitter_parse: diff --git a/dune-project b/dune-project index 7b1be7b7f6..2a47da480d 100644 --- a/dune-project +++ b/dune-project @@ -148,7 +148,7 @@ (depends (ocaml (>= 4.14)) dune-site - (saturn_lockfree (and (>= 0.4.1) (< 0.5.0))) + (saturn_lockfree (>= 0.5.0)) (re (>= 1.11.0)) (ppx_string :build) (ppx_hash :build) diff --git a/liquidsoap-lang.opam b/liquidsoap-lang.opam index afc9905e8e..b72fb9b980 100644 --- a/liquidsoap-lang.opam +++ b/liquidsoap-lang.opam @@ -11,7 +11,7 @@ depends: [ "dune" {>= "3.6"} "ocaml" {>= "4.14"} "dune-site" - "saturn_lockfree" {>= "0.4.1" & < "0.5.0"} + "saturn_lockfree" {>= "0.5.0"} "re" {>= "1.11.0"} "ppx_string" {build} "ppx_hash" {build} diff --git a/src/lang/queues.ml b/src/lang/queues.ml index 18fb488309..e8b7aa9278 100644 --- a/src/lang/queues.ml +++ b/src/lang/queues.ml @@ -25,11 +25,14 @@ module Queue = struct let flush_elements q = let rec flush_elements_f elements = - try flush_elements_f (pop q :: elements) with Empty -> List.rev elements + match pop_exn q with + | el -> flush_elements_f (el :: elements) + | exception Empty -> List.rev elements in flush_elements_f [] - let pop q = try pop q with Empty -> raise Not_found + let pop q = try pop_exn q with Empty -> raise Not_found + let peek q = try peek_exn q with Empty -> raise Not_found let flush_iter q fn = List.iter fn (flush_elements q) let flush_fold q fn ret = @@ -37,30 +40,17 @@ module Queue = struct List.fold_left flush_fold_f ret (flush_elements q) let elements q = - let rec elements_f l cursor = - match next cursor with - | Some (el, cursor) -> elements_f (el :: l) cursor - | None -> List.rev l + let rec elements_f l = + match pop_exn q with + | el -> elements_f (el :: l) + | exception Empty -> List.rev l in - elements_f [] (snapshot q) - - let exists q fn = - let rec exists_f l cursor = - match next cursor with - | Some (el, _) when fn el -> true - | Some (el, cursor) -> exists_f (el :: l) cursor - | None -> false - in - exists_f [] (snapshot q) - - let length q = - let rec length_f pos cursor = - match next cursor with - | Some (_, cursor) -> length_f (pos + 1) cursor - | None -> pos - in - length_f 0 (snapshot q) + let elements = elements_f [] in + List.iter (push q) elements; + elements + let exists q fn = List.exists fn (elements q) + let length q = List.length (elements q) let iter q fn = List.iter fn (elements q) let fold q fn v = List.fold_left (fun v e -> fn e v) v (elements q) @@ -129,16 +119,16 @@ module WeakQueue = struct let fold q fn v = List.fold_left (fun v e -> fn e v) v (elements q) let filter q fn = - let rec filter_f cursor = - match next cursor with - | Some (el, cursor) -> + let rec filter_f () = + match pop_exn q with + | el -> for i = 0 to Weak.length el - 1 do match Weak.get el i with | Some p when fn p -> () | _ -> Weak.set el i None done; - filter_f cursor - | None -> () + filter_f () + | exception Empty -> () in - filter_f (snapshot q) + filter_f () end diff --git a/src/lang/queues.mli b/src/lang/queues.mli index e16a530a66..d7f26f4898 100644 --- a/src/lang/queues.mli +++ b/src/lang/queues.mli @@ -20,6 +20,9 @@ *****************************************************************************) +(** Note: these queues a lock-free and not intended to hold large number + of values. *) + module Queue : sig type 'a t @@ -31,7 +34,10 @@ module Queue : sig val pop : 'a t -> 'a val pop_opt : 'a t -> 'a option + + (** Raises [Not_found] when no element can be found. *) val peek : 'a t -> 'a + val peek_opt : 'a t -> 'a option val flush_iter : 'a t -> ('a -> unit) -> unit val flush_fold : 'a t -> ('a -> 'b -> 'b) -> 'b -> 'b