{"id":19112141,"url":"https://github.com/ocaml-multicore/single-use-event","last_synced_at":"2026-06-18T04:31:51.882Z","repository":{"id":195993635,"uuid":"694098444","full_name":"ocaml-multicore/single-use-event","owner":"ocaml-multicore","description":"A scheduler agnostic blocking mechanism","archived":false,"fork":false,"pushed_at":"2023-09-22T13:59:56.000Z","size":366,"stargazers_count":1,"open_issues_count":1,"forks_count":0,"subscribers_count":9,"default_branch":"main","last_synced_at":"2025-02-22T11:32:09.501Z","etag":null,"topics":[],"latest_commit_sha":null,"homepage":"","language":"OCaml","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":"isc","status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/ocaml-multicore.png","metadata":{"files":{"readme":"README.md","changelog":null,"contributing":null,"funding":null,"license":"LICENSE.md","code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null}},"created_at":"2023-09-20T10:26:03.000Z","updated_at":"2024-04-10T12:24:01.000Z","dependencies_parsed_at":"2023-09-23T05:20:25.202Z","dependency_job_id":null,"html_url":"https://github.com/ocaml-multicore/single-use-event","commit_stats":null,"previous_names":["ocaml-multicore/single-use-event"],"tags_count":0,"template":false,"template_full_name":null,"purl":"pkg:github/ocaml-multicore/single-use-event","repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/ocaml-multicore%2Fsingle-use-event","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/ocaml-multicore%2Fsingle-use-event/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/ocaml-multicore%2Fsingle-use-event/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/ocaml-multicore%2Fsingle-use-event/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/ocaml-multicore","download_url":"https://codeload.github.com/ocaml-multicore/single-use-event/tar.gz/refs/heads/main","sbom_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/ocaml-multicore%2Fsingle-use-event/sbom","scorecard":null,"host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":286080680,"owners_count":34476727,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2026-05-26T15:22:16.424Z","status":"online","status_checked_at":"2026-06-18T02:00:06.871Z","response_time":128,"last_error":null,"robots_txt_status":"success","robots_txt_updated_at":"2025-07-24T06:49:26.215Z","robots_txt_url":"https://github.com/robots.txt","online":true,"can_crawl_api":true,"host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":[],"created_at":"2024-11-09T04:31:48.929Z","updated_at":"2026-06-18T04:31:51.866Z","avatar_url":"https://github.com/ocaml-multicore.png","language":"OCaml","funding_links":[],"categories":[],"sub_categories":[],"readme":"[API reference](https://ocaml-multicore.github.io/single-use-event/doc/single-use-event/Single_use_event/index.html)\n\n# **Single-use-event** \u0026mdash; Scheduler agnostic blocking\n\nThis is a 3rd generation proposal for a standard blocking mechanism for OCaml.\n\nThe mechanism is designed to be **minimalistic** and to **straightforward**ly,\n**safe**ly, and **efficient**ly handle all the basic concurrency issues that\nmight arise, namely the essential race conditions due to the nature of the\nproblem, within the scope of the provided functionality.\n\nPrevious proposals include\n\n- [Unified interface](https://github.com/deepali2806/unified_interface) aka\n  [`Suspend` effect](https://github.com/deepali2806/unified_interface/blob/512eadd456e77dc7d02a1aa0813819254308b5f4/lib/sched.mli#L4-L5),\n  and\n- [Domain local await](https://github.com/ocaml-multicore/domain-local-await/).\n\nSee the\n[API reference](https://ocaml-multicore.github.io/single-use-event/doc/single-use-event/Single_use_event/index.html)\nfor details.\n\n\u003c!--\n```ocaml\n# #thread\n# #require \"single-use-event\"\n# #require \"backoff\"\n```\n--\u003e\n\n## Examples\n\n### Promise\n\n```ocaml\nmodule Promise : sig\n  type 'a t\n  val create : unit -\u003e 'a t\n  val fill : 'a t -\u003e 'a -\u003e unit\n  val await : 'a t -\u003e 'a\nend = struct\n  type 'a state =\n    | Empty of Single_use_event.t list\n    | Full of 'a\n\n  type 'a t = 'a state Atomic.t\n\n  let create () = Atomic.make (Empty [])\n\n  let rec fill backoff t full =\n    match Atomic.get t with\n    | Empty sues as before -\u003e\n        if Atomic.compare_and_set t before full then\n          List.iter Single_use_event.signal sues\n        else\n          fill (Backoff.once backoff) t full\n    | Full _ -\u003e\n        invalid_arg \"Promise: already full\"\n\n  let fill t value = fill Backoff.default t (Full value)\n\n  let rec cleanup backoff t sue =\n    match Atomic.get t with\n    | Full _ -\u003e\n        ()\n    | Empty sues as before -\u003e\n        let after = Empty (List.filter ((!=) sue) sues) in\n        if not (Atomic.compare_and_set t before after) then\n          cleanup (Backoff.once backoff) t sue\n\n  let rec await backoff t =\n    match Atomic.get t with\n    | Full value -\u003e\n        value\n    | Empty sues as before -\u003e\n        let sue = Single_use_event.create () in\n        let after = Empty (sue :: sues) in\n        if Atomic.compare_and_set t before after then\n          match Single_use_event.await sue with\n          | () -\u003e\n            await backoff t\n          | exception cancellation_exn -\u003e\n            cleanup backoff t sue;\n            raise cancellation_exn\n        else\n          await (Backoff.once backoff) t\n\n  let await t = await Backoff.default t\nend\n```\n\n### Transparently asynchronous IO\n\n```ocaml version\u003e=5.0.0\nmodule Atomic = struct\n  include Stdlib.Atomic\n\n  let rec update t fn =\n    let before = Atomic.get t in\n    let after = fn before in\n    if Atomic.compare_and_set t before after then\n      before\n    else\n      update t fn\n\n  let modify t fn = update t fn |\u003e ignore\nend\n```\n\n```ocaml version\u003e=5.0.0\nmodule Async_io : sig\n  open Unix\n  val read : file_descr -\u003e bytes -\u003e int -\u003e int -\u003e int\n  val write : file_descr -\u003e bytes -\u003e int -\u003e int -\u003e int\n  val accept : ?cloexec:bool -\u003e file_descr -\u003e file_descr * sockaddr\nend = struct\n  module Awaiter = struct\n    type t = { file_descr : Unix.file_descr; sue : Single_use_event.t }\n\n    let file_descr_of t = t.file_descr\n\n    let rec signal aws file_descr =\n      match aws with\n      | [] -\u003e ()\n      | aw :: aws -\u003e\n          if aw.file_descr == file_descr then\n            Single_use_event.signal aw.sue\n          else signal aws file_descr\n\n    let signal_or_wakeup wakeup aws file_descr =\n      if file_descr == wakeup then begin\n        let n = Unix.read file_descr (Bytes.create 1) 0 1 in\n        assert (n = 1)\n      end\n      else signal aws file_descr\n\n    let reject file_descr =\n      List.filter (fun aw -\u003e aw.file_descr != file_descr)\n  end\n\n  type state = {\n    mutable state : [ `Init | `Locked | `Alive | `Dead ];\n    mutable pipe_out : Unix.file_descr;\n    reading : Awaiter.t list Atomic.t;\n    writing : Awaiter.t list Atomic.t;\n  }\n\n  let key =\n    Domain.DLS.new_key @@ fun () -\u003e {\n      state = `Init;\n      pipe_out =\n        (* Unfortunately we cannot safely allocate a pipe here,\n           so we use stdin as a dummy value. *)\n        Unix.stdin;\n      reading = Atomic.make [];\n      writing = Atomic.make [];\n    }\n\n  let[@poll error] try_lock s =\n    s.state == `Init \u0026\u0026 begin\n      s.state \u003c- `Locked;\n      true\n    end\n\n  let needs_init s =\n    s.state != `Alive\n\n  let[@poll error] unlock s pipe_out =\n    s.pipe_out \u003c- pipe_out;\n    s.state \u003c- `Alive\n\n  let wakeup s =\n    let n = Unix.write s.pipe_out (Bytes.create 1) 0 1 in\n    assert (n = 1)\n\n  let rec init s =\n    (* DLS initialization may be run multiple times, so we\n       perform more involved initialization here. *)\n    if try_lock s then begin\n      (* The pipe is used to wake up the select after changing\n         the lists of reading and writing file descriptors. *)\n      let pipe_inn, pipe_out = Unix.pipe ~cloexec:true () in\n      unlock s pipe_out;\n      let t =\n        ()\n        |\u003e Thread.create @@ fun () -\u003e\n           (* This is the IO select loop that performs select and\n              then wakes up fibers blocked on IO. *)\n           while s.state != `Dead do\n             let rs, ws, _ =\n               Unix.select\n                 (pipe_inn\n                  :: List.map Awaiter.file_descr_of (Atomic.get s.reading))\n                 (List.map Awaiter.file_descr_of (Atomic.get s.writing))\n                 []\n                 (-1.0)\n             in\n             List.iter\n               (Awaiter.signal_or_wakeup pipe_inn (Atomic.get s.reading))\n               rs;\n             List.iter (Awaiter.signal (Atomic.get s.writing)) ws;\n             Atomic.modify s.reading (List.fold_right Awaiter.reject rs);\n             Atomic.modify s.writing (List.fold_right Awaiter.reject ws);\n         done;\n         Unix.close pipe_inn;\n         Unix.close pipe_out\n      in\n      Domain.at_exit @@ fun () -\u003e\n        s.state \u003c- `Dead;\n        wakeup s;\n        Thread.join t\n    end\n    else if needs_init s then begin\n      Thread.yield ();\n      init s;\n    end\n\n  let get () =\n    let s = Domain.DLS.get key in\n    if needs_init s then\n      init s;\n    s\n\n  let await s r file_descr =\n    let sue = Single_use_event.create () in\n    let awaiter = Awaiter.{ file_descr; sue } in\n    Atomic.modify r (List.cons awaiter);\n    wakeup s;\n    try Single_use_event.await sue\n    with cancellation_exn -\u003e\n      Atomic.modify r (List.filter ((!=) awaiter));\n      raise cancellation_exn\n\n  let read file_descr bytes pos len =\n    let s = get () in\n    await s s.reading file_descr;\n    Unix.read file_descr bytes pos len\n\n  let write file_descr bytes pos len =\n    let s = get () in\n    await s s.writing file_descr;\n    Unix.write file_descr bytes pos len\n\n  let accept ?cloexec file_descr =\n    let s = get () in\n    await s s.reading file_descr;\n    Unix.accept ?cloexec file_descr\nend\n```\n\n```ocaml version\u003e=5.0.0\nmodule Toy_scheduler : sig\n  val fiber : (unit -\u003e unit) -\u003e unit\n  val run : (unit -\u003e unit) -\u003e unit\nend = struct\n  let ready = Atomic.make []\n  let num_alive_fibers = ref 0\n\n  let fiber thunk =\n    incr num_alive_fibers;\n    let thunk () =\n      thunk ();\n      decr num_alive_fibers\n    in\n    Atomic.modify ready (List.cons thunk)\n\n  let run program =\n    let needs_wakeup = Atomic.make false in\n    let pipe_inn, pipe_out = Unix.pipe ~cloexec:true () in\n    let rec scheduler () =\n      match Atomic.update ready (function [] -\u003e [] | _::xs -\u003e xs) with\n      | work::_ -\u003e\n        let effc (type a) : a Effect.t -\u003e _ = function\n          | Single_use_event.Await sue -\u003e\n            Some (fun (k: (a, _) Effect.Deep.continuation) -\u003e\n            if\n              not (Single_use_event.is_signaled sue) \u0026\u0026\n              let enqueue () =\n                Atomic.modify ready (List.cons (Effect.Deep.continue k));\n                if\n                  Atomic.get needs_wakeup \u0026\u0026\n                  Atomic.compare_and_set needs_wakeup true false\n                then\n                  (* The scheduler is potentially waiting on select,\n                    so we need to perform a wakeup. *)\n                  let n = Unix.write pipe_out (Bytes.create 1) 0 1 in\n                  assert (n = 1)\n              in\n              Single_use_event.try_attach sue enqueue\n            then\n              ()\n            else\n              Effect.Deep.continue k ())\n          | _ -\u003e\n            None in\n        Effect.Deep.try_with work () { effc };\n        scheduler ()\n      | [] -\u003e\n        if !num_alive_fibers \u003c\u003e 0 then begin\n          if Atomic.get needs_wakeup then\n            (* There are blocked fibers, so we wait for them to\n               become unblocked. *)\n            let _ = Unix.select [pipe_inn] [] [] (-1.0) in\n            let n = Unix.read pipe_inn (Bytes.create 1) 0 1 in\n            assert (n = 1)\n          else\n            (* There are blocked fibers, so we need to wait for\n               them to become ready.  But we need to check the\n               ready list once more before we do so. *)\n            Atomic.set needs_wakeup true;\n          scheduler ()\n        end\n    in\n    incr num_alive_fibers;\n    let program () =\n      program ();\n      decr num_alive_fibers\n    in\n    Atomic.modify ready (List.cons program);\n    scheduler ()\nend\n```\n\n```ocaml version\u003e=5.0.0\n# Toy_scheduler.run @@ fun () -\u003e\n\n  let n = 100 in\n  let port = Random.int 1000 + 3000 in\n  let server_addr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in\n\n  let () =\n    Toy_scheduler.fiber @@ fun () -\u003e\n    Printf.printf \"  Client running\\n%!\";\n    let socket = Unix.socket ~cloexec:true PF_INET SOCK_STREAM 0 in\n    Fun.protect ~finally:(fun () -\u003e Unix.close socket) @@ fun () -\u003e\n    Unix.connect socket server_addr;\n    Printf.printf \"  Client connected\\n%!\";\n    let bytes = Bytes.create n in\n    let n = Async_io.write socket bytes 0 (Bytes.length bytes) in\n    Printf.printf \"  Client wrote %d\\n%!\" n;\n    let n = Async_io.read socket bytes 0 (Bytes.length bytes) in\n    Printf.printf \"  Client read %d\\n%!\" n\n  in\n\n  let () =\n    Toy_scheduler.fiber @@ fun () -\u003e\n    Printf.printf \"  Server running\\n%!\";\n    let client, _client_addr =\n      let socket = Unix.socket ~cloexec:true PF_INET SOCK_STREAM 0 in\n      Fun.protect ~finally:(fun () -\u003e Unix.close socket) @@ fun () -\u003e\n      Unix.set_nonblock socket;\n      Unix.bind socket server_addr;\n      Unix.listen socket 1;\n      Printf.printf \"  Server listening\\n%!\";\n      Async_io.accept ~cloexec:true socket\n    in\n    Fun.protect ~finally:(fun () -\u003e Unix.close client) @@ fun () -\u003e\n    Unix.set_nonblock client;\n    let bytes = Bytes.create n in\n    let n = Async_io.read client bytes 0 (Bytes.length bytes) in\n    Printf.printf \"  Server read %d\\n%!\" n;\n    let n = Async_io.write client bytes 0 (n / 2) in\n    Printf.printf \"  Server wrote %d\\n%!\" n\n  in\n\n  Printf.printf \"Client server test\\n%!\"\nClient server test\n  Server running\n  Server listening\n  Client running\n  Client connected\n  Client wrote 100\n  Server read 100\n  Server wrote 50\n  Client read 50\n- : unit = ()\n```\n","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Focaml-multicore%2Fsingle-use-event","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Focaml-multicore%2Fsingle-use-event","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Focaml-multicore%2Fsingle-use-event/lists"}