diff --git a/README.md b/README.md index 4027eb4..92aa9b5 100644 --- a/README.md +++ b/README.md @@ -1170,7 +1170,7 @@ This may be useful during the process of porting existing code to Eio. - [lib_eio/eio.mli](lib_eio/eio.mli) documents Eio's public API. - [doc/rationale.md](doc/rationale.md) describes some of Eio's design tradeoffs in more detail. -- [doc/eio_null.md](doc/eio_null.md) is a skeleton Eio backend with no actual IO. +- [lib_eio/mock/backend.ml](lib_eio/mock/backend.ml) is a skeleton Eio backend with no actual IO. Some background about the effects system can be found in: diff --git a/doc/dune b/doc/dune index dfe58d8..16d9c90 100644 --- a/doc/dune +++ b/doc/dune @@ -1,4 +1,4 @@ (mdx (package eio_main) (packages eio_main) - (files multicore.md eio_null.md)) + (files multicore.md)) diff --git a/doc/eio_null.md b/doc/eio_null.md deleted file mode 100644 index 2000200..0000000 --- a/doc/eio_null.md +++ /dev/null @@ -1,104 +0,0 @@ -```ocaml -# #require "eio.utils";; -``` - -# A dummy Eio backend with no actual effects - -This is very inefficient and not thread-safe, but it demonstrates the idea. -A real backend would typically pass `main` some way to interact with it, like the other backends do. - -```ocaml -open Eio.Std - -(* An Eio backend with no actual IO *) -module Eio_null = struct - module Fiber_context = Eio.Private.Fiber_context - module Effect = Eio.Private.Effect (* For compatibility with 4.12+domains *) - - (* The scheduler could just return [unit], but this is clearer. *) - type exit = Exit_scheduler - - type t = { - (* Suspended fibers waiting to run again. - A real system would probably use [Eio_utils.Lf_queue]. *) - mutable run_q : (unit -> exit) list; - } - - (* Resume the next runnable fiber, if any. *) - let schedule t : exit = - match t.run_q with - | f :: fs -> t.run_q <- fs; f () - | [] -> Exit_scheduler (* Finished (or deadlocked) *) - - (* Run [main] in an Eio main loop. *) - let run main = - let t = { run_q = [] } in - let rec fork ~new_fiber:fiber fn = - (* Create a new fiber and run [fn] in it. *) - Effect.Deep.match_with fn () - { retc = (fun () -> Fiber_context.destroy fiber; schedule t); - exnc = (fun ex -> Fiber_context.destroy fiber; raise ex); - effc = fun (type a) (e : a Effect.t) : ((a, exit) Effect.Deep.continuation -> exit) option -> - match e with - | Eio.Private.Effects.Suspend f -> Some (fun k -> - (* Ask [f] to register whatever callbacks are needed to resume the fiber. - e.g. it might register a callback with a promise, for when that's resolved. *) - f fiber (function - (* The fiber is ready to run again. Add it to the queue. *) - | Ok v -> t.run_q <- t.run_q @ [fun () -> Effect.Deep.continue k v] - | Error ex -> t.run_q <- t.run_q @ [fun () -> Effect.Deep.discontinue k ex] - ); - (* Switch to the next runnable fiber while this one's blocked. *) - schedule t - ) - | Eio.Private.Effects.Fork (new_fiber, f) -> Some (fun k -> - (* Arrange for the forking fiber to run immediately after the new one. *) - t.run_q <- Effect.Deep.continue k :: t.run_q; - (* Create and run the new fiber (using fiber context [new_fiber]). *) - fork ~new_fiber f - ) - | Eio.Private.Effects.Get_context -> Some (fun k -> - Effect.Deep.continue k fiber - ) - | Eio.Private.Effects.Trace -> Some (fun k -> - Effect.Deep.continue k Eio.Private.default_traceln - ) - | _ -> None - } - in - let new_fiber = Fiber_context.make_root () in - let Exit_scheduler = fork ~new_fiber main in - () -end -``` - -It supports forking, tracing, suspending and cancellation: - -```ocaml -# Eio_null.run @@ fun () -> - let s = Eio.Stream.create 1 in - try - Fiber.both - (fun () -> - for x = 1 to 3 do - traceln "Sending %d" x; - Eio.Stream.add s x - done; - raise Exit - ) - (fun () -> - while true do - traceln "Got %d" (Eio.Stream.take s) - done - ) - with Exit -> - traceln "Finished!";; -+Sending 1 -+Sending 2 -+Got 1 -+Got 2 -+Sending 3 -+Got 3 -+Finished! -- : unit = () -``` diff --git a/lib_eio/mock/backend.ml b/lib_eio/mock/backend.ml new file mode 100644 index 0000000..9164ea5 --- /dev/null +++ b/lib_eio/mock/backend.ml @@ -0,0 +1,60 @@ +module Fiber_context = Eio.Private.Fiber_context +module Effect = Eio.Private.Effect (* For compatibility with 4.12+domains *) +module Lf_queue = Eio_utils.Lf_queue + +(* The scheduler could just return [unit], but this is clearer. *) +type exit = Exit_scheduler + +type t = { + (* Suspended fibers waiting to run again. + [Lf_queue] is like [Stdlib.Queue], but is thread-safe (lock-free) and + allows pushing items to the head too, which we need. *) + mutable run_q : (unit -> exit) Lf_queue.t; +} + +(* Resume the next runnable fiber, if any. *) +let schedule t : exit = + match Lf_queue.pop t.run_q with + | Some f -> f () + | None -> Exit_scheduler (* Finished (or deadlocked) *) + +(* Run [main] in an Eio main loop. *) +let run main = + let t = { run_q = Lf_queue.create () } in + let rec fork ~new_fiber:fiber fn = + (* Create a new fiber and run [fn] in it. *) + Effect.Deep.match_with fn () + { retc = (fun () -> Fiber_context.destroy fiber; schedule t); + exnc = (fun ex -> Fiber_context.destroy fiber; raise ex); + effc = fun (type a) (e : a Effect.t) : ((a, exit) Effect.Deep.continuation -> exit) option -> + match e with + | Eio.Private.Effects.Suspend f -> Some (fun k -> + (* Ask [f] to register whatever callbacks are needed to resume the fiber. + e.g. it might register a callback with a promise, for when that's resolved. *) + f fiber (function + (* The fiber is ready to run again. Add it to the queue. *) + | Ok v -> Lf_queue.push t.run_q (fun () -> Effect.Deep.continue k v) + | Error ex -> Lf_queue.push t.run_q (fun () -> Effect.Deep.discontinue k ex) + ); + (* Switch to the next runnable fiber while this one's blocked. *) + schedule t + ) + | Eio.Private.Effects.Fork (new_fiber, f) -> Some (fun k -> + (* Arrange for the forking fiber to run immediately after the new one. *) + Lf_queue.push_head t.run_q (Effect.Deep.continue k); + (* Create and run the new fiber (using fiber context [new_fiber]). *) + fork ~new_fiber f + ) + | Eio.Private.Effects.Get_context -> Some (fun k -> + Effect.Deep.continue k fiber + ) + | Eio.Private.Effects.Trace -> Some (fun k -> + Effect.Deep.continue k Eio.Private.default_traceln + ) + | _ -> None + } + in + let new_fiber = Fiber_context.make_root () in + let result = ref None in + let Exit_scheduler = fork ~new_fiber (fun () -> result := Some (main ())) in + Option.get !result diff --git a/lib_eio/mock/backend.mli b/lib_eio/mock/backend.mli new file mode 100644 index 0000000..3aa9f8e --- /dev/null +++ b/lib_eio/mock/backend.mli @@ -0,0 +1,4 @@ +(** A dummy Eio backend with no actual IO. *) + +val run : (unit -> 'a) -> 'a +(** [run fn] runs an event loop and then calls [fn env] within it. *) diff --git a/lib_eio/mock/dune b/lib_eio/mock/dune index bce09eb..a8bc406 100644 --- a/lib_eio/mock/dune +++ b/lib_eio/mock/dune @@ -1,4 +1,4 @@ (library (name eio_mock) (public_name eio.mock) - (libraries eio)) + (libraries eio eio.utils)) diff --git a/lib_eio/mock/eio_mock.ml b/lib_eio/mock/eio_mock.ml index 4d11c48..c04200f 100644 --- a/lib_eio/mock/eio_mock.ml +++ b/lib_eio/mock/eio_mock.ml @@ -2,3 +2,4 @@ module Action = Action module Handler = Handler module Flow = Flow module Net = Net +module Backend = Backend diff --git a/lib_eio/mock/eio_mock.mli b/lib_eio/mock/eio_mock.mli index d59b890..1d59b2d 100644 --- a/lib_eio/mock/eio_mock.mli +++ b/lib_eio/mock/eio_mock.mli @@ -80,7 +80,7 @@ module Handler : sig (** [run_default_action t] runs the default handler passed to {!make}. *) end -(** {2 Pre-defined mocks *) +(** {2 Pre-defined mocks} *) (** Mock {!Eio.Flow} sources and sinks. *) module Flow : sig @@ -148,3 +148,10 @@ module Net : sig unit (** [on_accept socket actions] configures how to respond when the server calls "accept". *) end + +(** {2 Backend for mocks} + + The mocks can be used with any backend, but if you don't need any IO then you can use this one + to avoid a dependency on eio_main. *) + +module Backend = Backend diff --git a/tests/buf_reader.md b/tests/buf_reader.md index cf149ee..6982140 100644 --- a/tests/buf_reader.md +++ b/tests/buf_reader.md @@ -1,6 +1,5 @@ ```ocaml # #require "eio";; -# #require "eio.mock";; ``` ```ocaml module R = Eio.Buf_read;; @@ -599,6 +598,8 @@ Exception: Failure "Unexpected data after parsing (at offset 4)". ## Test using mock flow ```ocaml +# #require "eio.mock";; + # let flow = Eio_mock.Flow.make "flow" in Eio_mock.Flow.on_read flow [ `Return "foo\nba"; diff --git a/tests/mocks.md b/tests/mocks.md index d728736..635b0dd 100644 --- a/tests/mocks.md +++ b/tests/mocks.md @@ -1,7 +1,6 @@ ## Setup ```ocaml -# #require "eio_main";; # #require "eio.mock";; ``` @@ -14,7 +13,7 @@ let stdout = Eio_mock.Flow.make "stdout" ## Flows ```ocaml -# Eio_main.run @@ fun _ -> +# Eio_mock.Backend.run @@ fun _ -> Eio_mock.Flow.on_read stdin [ `Return "chunk1"; `Return "chunk2"; @@ -47,7 +46,7 @@ let echo_server ~net addr = The server handles a connection: ```ocaml -# Eio_main.run @@ fun _ -> +# Eio_mock.Backend.run @@ fun _ -> let net = Eio_mock.Net.make "mocknet" in let listening_socket = Eio_mock.Net.listening_socket "tcp/80" in Eio_mock.Net.on_listen net [`Return listening_socket]; @@ -66,3 +65,37 @@ The server handles a connection: +tcp/80: closed - : unit = () ``` + +## Backend + +`Eio_mock.Backend` supports forking, tracing, suspending and cancellation: + +```ocaml +# Eio_mock.Backend.run @@ fun () -> + let s = Eio.Stream.create 1 in + try + Fiber.both + (fun () -> + for x = 1 to 3 do + traceln "Sending %d" x; + Eio.Stream.add s x + done; + raise Exit + ) + (fun () -> + while true do + traceln "Got %d" (Eio.Stream.take s) + done + ) + with Exit -> + traceln "Finished!";; ++Sending 1 ++Sending 2 ++Got 1 ++Got 2 ++Sending 3 ++Got 3 ++Finished! +- : unit = () +``` + diff --git a/tests/test_switch.md b/tests/test_switch.md index 4cb9f9d..fbdd6cb 100644 --- a/tests/test_switch.md +++ b/tests/test_switch.md @@ -1,14 +1,14 @@ # Setting up the environment ```ocaml -# #require "eio_main";; +# #require "eio.mock";; ``` ```ocaml open Eio.Std -let run (fn : Switch.t -> unit) = - Eio_main.run @@ fun _e -> +let run (fn : Switch.t -> _) = + Eio_mock.Backend.run @@ fun () -> Switch.run fn ``` @@ -125,10 +125,7 @@ Exception: Failure "Cancel". You can't use a switch after leaving its scope: ```ocaml -# let sw = - let x = ref None in - run (fun sw -> x := Some sw); - Option.get !x;; +# let sw = run Fun.id;; val sw : Switch.t = # Switch.check sw;; Exception: Invalid_argument "Switch finished!".