nebius/SWE-rebench-V2-PRs huggingface dataset:
Repository: ocaml-multicore/picos
Pull request #13 (2023-11-01 23:11:35)

Add `Fiber.continue` and `Fiber.continue_with` helpers
These help to reduce the overhead of continuing a fiber.


Patch:
diff --git a/lib/picos/effects_intf.ocaml5.ml b/lib/picos/effects_intf.ocaml5.ml
index f86393b..4605f4d 100644
--- a/lib/picos/effects_intf.ocaml5.ml
+++ b/lib/picos/effects_intf.ocaml5.ml
@@ -63,6 +63,27 @@ module type Fiber = sig
   type _ t
   type _ as_cancelable
 
+  val continue : 'a t -> ('v, 'r) Effect.Deep.continuation -> 'v -> 'r
+  (** [continue fiber k v] is equivalent to:
+      {[
+        match Fiber.canceled fiber with
+        | None -> Effect.Deep.continue k v
+        | Some exn_bt -> Exn_bt.discontinue k exn_bt
+      ]} *)
+
+  val continue_with :
+    'a t ->
+    ('v, 'b) Effect.Shallow.continuation ->
+    'v ->
+    ('b, 'r) Effect.Shallow.handler ->
+    'r
+  (** [continue_with fiber k v h] is equivalent to:
+      {[
+        match Fiber.canceled fiber with
+        | None -> Effect.Shallow.continue_with k v h
+        | Some exn_bt -> Exn_bt.discontinue_with k exn_bt h
+      ]} *)
+
   (** Schedulers may handle the {!Current} effect to customize the behavior of
       [current].
 
diff --git a/lib/picos/picos.ocaml5.ml b/lib/picos/picos.ocaml5.ml
index 3d83aac..ebf4abb 100644
--- a/lib/picos/picos.ocaml5.ml
+++ b/lib/picos/picos.ocaml5.ml
@@ -34,6 +34,20 @@ end
 module Fiber = struct
   include Bootstrap.Fiber
 
+  let continue (Fiber r) k v =
+    if r.forbid then Effect.Deep.continue k v
+    else
+      match Atomic.get r.computation with
+      | Canceled exn_bt -> Exn_bt.discontinue k exn_bt
+      | Continue _ | Returned _ -> Effect.Deep.continue k v
+
+  let continue_with (Fiber r) k v h =
+    if r.forbid then Effect.Shallow.continue_with k v h
+    else
+      match Atomic.get r.computation with
+      | Canceled exn_bt -> Exn_bt.discontinue_with k exn_bt h
+      | Continue _ | Returned _ -> Effect.Shallow.continue_with k v h
+
   type _ Effect.t += Current : [ `Sync | `Async ] t Effect.t
 
   let current () =


Test patch:
diff --git a/test/lib/schedulers/fifos.ml b/test/lib/schedulers/fifos.ml
index 7502322..4eab075 100644
--- a/test/lib/schedulers/fifos.ml
+++ b/test/lib/schedulers/fifos.ml
@@ -43,19 +43,11 @@ let run ~forbid main =
     then Mutex_and_condition.broadcast t.mc
   in
   let rec fork fiber main =
-    let current =
-      Some
-        (fun k ->
-          match Fiber.canceled fiber with
-          | None -> Effect.Deep.continue k fiber
-          | Some exn_bt -> Exn_bt.discontinue k exn_bt)
+    let current = Some (fun k -> Fiber.continue fiber k fiber)
     and yield =
       Some
         (fun k ->
-          Mpsc_queue.enqueue t.ready (fun () ->
-              match Fiber.canceled fiber with
-              | None -> Effect.Deep.continue k ()
-              | Some exn_bt -> Exn_bt.discontinue k exn_bt);
+          Mpsc_queue.enqueue t.ready (Fiber.continue fiber k);
           next t)
     in
     let effc (type a) :
Repository: ocaml-multicore/picos
Pull request #58 (2024-03-18 01:18:49)

Add `Computation.wait`


Patch:
diff --git a/lib/picos/picos.common.ml b/lib/picos/picos.common.ml
index f9f0209..57b99e7 100644
--- a/lib/picos/picos.common.ml
+++ b/lib/picos/picos.common.ml
@@ -21,6 +21,7 @@ module Computation = struct
     else t
 
   let await t = get_or block t
+  let wait t = if is_running t then ignore (block t)
 end
 
 module Fiber = struct
diff --git a/lib/picos/picos.mli b/lib/picos/picos.mli
index 3bc2484..d424974 100644
--- a/lib/picos/picos.mli
+++ b/lib/picos/picos.mli
@@ -725,6 +725,9 @@ module Computation : sig
       ℹ️ If the computation has already completed, then [await] returns or raises
       immediately without performing any effects. *)
 
+  val wait : _ t -> unit
+  (** [wait computation] waits for the computation to complete. *)
+
   (** {2 Interface for propagating cancelation} *)
 
   val canceler : from:_ t -> into:_ t -> Trigger.t


Test patch:
diff --git a/test/test_picos.ml b/test/test_picos.ml
index 3c38e38..0f03954 100644
--- a/test/test_picos.ml
+++ b/test/test_picos.ml
@@ -60,6 +60,9 @@ let test_trigger_basics () =
 let test_computation_basics () =
   Test_scheduler.run @@ fun () ->
   let computation = Computation.create () in
+  Computation.cancel computation (Exn_bt.get Exit);
+  Computation.wait computation;
+  let computation = Computation.create () in
   let@ _ =
     finally Domain.join @@ fun () ->
     Domain.spawn @@ fun () ->
Repository: ocaml-multicore/picos
Pull request #182 (2024-07-19 11:28:22)

Fix all sample schedulers to complete the root computation


Patch:
diff --git a/lib/picos_lwt/picos_lwt.ml b/lib/picos_lwt/picos_lwt.ml
index 8c00c7d..a438ee5 100644
--- a/lib/picos_lwt/picos_lwt.ml
+++ b/lib/picos_lwt/picos_lwt.ml
@@ -109,4 +109,8 @@ let run ?(forbid = false) system main =
   if not (Picos_thread.is_main_thread ()) then not_main_thread ();
   let computation = Computation.create ~mode:`LIFO () in
   let fiber = Fiber.create ~forbid computation in
+  let main () =
+    Computation.capture computation main ();
+    Computation.await computation
+  in
   go fiber system (Effect.Shallow.fiber main) (Ok ())
diff --git a/lib/picos_threaded/picos_threaded.ml b/lib/picos_threaded/picos_threaded.ml
index 191e84c..6b8a363 100644
--- a/lib/picos_threaded/picos_threaded.ml
+++ b/lib/picos_threaded/picos_threaded.ml
@@ -136,5 +136,10 @@ and handler = Handler.{ current; spawn; yield; cancel_after; await }
 
 let run ?(forbid = false) main =
   Select.check_configured ();
-  let packed = Computation.Packed (Computation.create ~mode:`LIFO ()) in
-  Handler.using handler (create_packed ~forbid packed) main
+  let computation = Computation.create ~mode:`LIFO () in
+  let context = create_packed ~forbid (Packed computation) in
+  let main () =
+    Computation.capture computation main ();
+    Computation.await computation
+  in
+  Handler.using handler context main


Test patch:
diff --git a/test/test_schedulers.ml b/test/test_schedulers.ml
index 59191ab..2ff83c0 100644
--- a/test/test_schedulers.ml
+++ b/test/test_schedulers.ml
@@ -7,6 +7,31 @@ let test_returns () =
   let actual = Test_scheduler.run @@ fun () -> 42 in
   assert (actual = 42)
 
+let test_completes () =
+  let packed = ref (Computation.Packed (Computation.create ())) in
+  let result =
+    Test_scheduler.run (fun () ->
+        packed := Fiber.get_computation (Fiber.current ());
+        101)
+  in
+  assert (result = 101);
+  let (Packed computation) = !packed in
+  assert (not (Computation.is_running computation));
+  assert (not (Computation.is_canceled computation));
+  begin
+    match
+      Test_scheduler.run (fun () ->
+          packed := Fiber.get_computation (Fiber.current ());
+          (failwith "42" : unit))
+    with
+    | () -> assert false
+    | exception Failure msg -> assert (msg = "42")
+    | exception _ -> assert false
+  end;
+  let (Packed computation) = !packed in
+  assert (not (Computation.is_running computation));
+  assert (Computation.is_canceled computation)
+
 let test_current () =
   Test_scheduler.run ~max_domains:2 @@ fun () ->
   let fiber_parent = Fiber.current () in
@@ -33,6 +58,7 @@ let test_cancel_after_long_timeout () =
 let () =
   [
     ("Returns", [ Alcotest.test_case "" `Quick test_returns ]);
+    ("Completes", [ Alcotest.test_case "" `Quick test_completes ]);
     ("Current", [ Alcotest.test_case "" `Quick test_current ]);
     ( "Cancel_after",
       [
Repository: ocaml-multicore/picos
Pull request #193 (2024-07-29 00:05:57)

Add `Event.always`


Patch:
diff --git a/lib/picos_sync/event.ml b/lib/picos_sync/event.ml
index d7c238c..b2e5a92 100644
--- a/lib/picos_sync/event.ml
+++ b/lib/picos_sync/event.ml
@@ -84,6 +84,12 @@ let[@alert "-handler"] from_computation source =
   in
   Request { request }
 
+let always value =
+  let request computation to_result =
+    Computation.return computation @@ fun () -> to_result value
+  in
+  Request { request }
+
 type 'a event = 'a t
 
 let[@inline] from_request p = Request p
diff --git a/lib/picos_sync/picos_sync.mli b/lib/picos_sync/picos_sync.mli
index 53e446c..f870763 100644
--- a/lib/picos_sync/picos_sync.mli
+++ b/lib/picos_sync/picos_sync.mli
@@ -184,6 +184,10 @@ module Event : sig
       {{:https://ocaml.org/manual/5.2/api/Event.html} [Event]} module
       signature. *)
 
+  val always : 'a -> 'a t
+  (** [always value] returns an event that can always be committed to resulting
+      in the given [value]. *)
+
   (** {2 Composing events} *)
 
   val choose : 'a t list -> 'a t


Test patch:
diff --git a/test/test_sync.ml b/test/test_sync.ml
index 3dcdda0..dd92255 100644
--- a/test/test_sync.ml
+++ b/test/test_sync.ml
@@ -209,7 +209,7 @@ let test_event_basics () =
     Event.select
       [
         Event.from_computation (Computation.create ());
-        Event.from_computation (Computation.returned 51) |> Event.map (( + ) 50);
+        Event.always 51 |> Event.map (( + ) 50);
       ]
     = 101);
   begin
@@ -221,10 +221,7 @@ let test_event_basics () =
   end;
   begin
     match
-      [
-        Event.guard (fun () -> raise Exit);
-        Event.from_computation (Computation.returned 42);
-      ]
+      [ Event.guard (fun () -> raise Exit); Event.always 42 ]
       |> Event.choose |> Event.sync
     with
     | _ -> assert false
Repository: ocaml-multicore/picos
Pull request #196 (2024-07-30 21:08:36)

Fix `Finally.move` to be lazy


Patch:
diff --git a/lib/picos_structured/finally.ml b/lib/picos_structured/finally.ml
index 8646a9e..b76a6c3 100644
--- a/lib/picos_structured/finally.ml
+++ b/lib/picos_structured/finally.ml
@@ -65,9 +65,11 @@ let[@inline never] check_no_resource () =
   Fiber.check (Fiber.current ());
   invalid_arg "no resource to move"
 
+let nothing = (ignore, check_no_resource)
+
 let move moveable =
   match Atomic.get moveable with
-  | Nothing -> check_no_resource ()
+  | Nothing -> nothing
   | Resource r ->
       let acquire () =
         match Atomic.exchange moveable Nothing with


Test patch:
diff --git a/test/test_structured.ml b/test/test_structured.ml
index a3871e7..c7ea83c 100644
--- a/test/test_structured.ml
+++ b/test/test_structured.ml
@@ -1,5 +1,6 @@
 module Exn_bt = Picos.Exn_bt
 open Picos_structured
+open Picos_structured.Finally
 open Picos_sync
 
 (** Helper to check that computation is restored *)
@@ -17,6 +18,22 @@ let check join_after scope =
   assert (before != during);
   scope bundle
 
+let test_move_is_lazy () =
+  Test_scheduler.run @@ fun () ->
+  let^ moveable = finally Fun.id Fun.id in
+  let@ _ = move moveable in
+  begin
+    match move moveable with _ -> () | exception _ -> assert false
+  end;
+  begin
+    match
+      let@ _ = move moveable in
+      ()
+    with
+    | () -> assert false
+    | exception Invalid_argument _ -> ()
+  end
+
 let test_fork_after_terminate () =
   Test_scheduler.run @@ fun () ->
   check Bundle.join_after @@ fun bundle ->
@@ -279,6 +296,7 @@ let () =
   [
     ( "Bundle",
       [
+        Alcotest.test_case "move is lazy" `Quick test_move_is_lazy;
         Alcotest.test_case "fork after terminate" `Quick
           test_fork_after_terminate;
         Alcotest.test_case "fork after escape" `Quick test_fork_after_escape;