Remove unnecessary wakeups and use requestIdleCallback

Author: patricoferris

lib_eio_js/browser/dune

@@ -1,4 +1,8 @@
 (library
  (name eio_browser)
  (public_name eio_browser)
+ (foreign_stubs
+   (language c)
+   (names stubs))
+ (js_of_ocaml (javascript_files runtime.js))
  (libraries eio brr))

lib_eio_js/browser/eio_browser.ml

@@ -64,32 +64,44 @@ module Suspended = struct
     Effect.Deep.discontinue t.k ex
 end
 
+(* Resume the next runnable fiber, if any. *)
+let rec wakeup run_q =
+  match Run_queue.pop run_q with
+  | Some f ->
+    f ();
+    wakeup run_q
+  | None -> ()
+
 (* The Javascript backend scheduler is implemented as an event listener.
    We don't need to worry about multiple domains. Here any time something
    asynchronously enqueues a task to our queue, it also sends a wakeup event to
    the event listener which will run the callback calling the scheduler. *)
 module Scheduler = struct
   type t = {
-    scheduler : El.t;
     run_q : (unit -> unit) Run_queue.t;
-    mutable listener : Ev.listener;
+    mutable idle_callback : Jv.t option;
   }
 
-  let v ~schedule run_q =
-    let open Brr_io in
-    let scheduler = El.div [] in
-    let listener =
-      Brr.Ev.listen Message.Ev.message (fun _ev -> schedule run_q) (El.as_target scheduler)
-    in
-    { scheduler; run_q; listener }
+  let v run_q =
+    let idle_callback = None in
+    { run_q; idle_callback }
 
-  let stop t = Brr.Ev.unlisten t.listener
+  external _request_idle_callback : Jv.t -> Jv.t = "requestIdleCallbackShim"
+  external _cancel_idle_callback : Jv.t -> unit = "cancelIdleCallbackShim"
+
+  let request_idle_callback cb =
+    _request_idle_callback (Jv.callback ~arity:1 (fun _ -> cb ()))
 
-  (* A new message must be created for every call. *)
   let wakeup t =
-    let open Brr_io in
-    let args = [| Ev.create Message.Ev.message |> Ev.to_jv |] in
-    Jv.call (El.to_jv t.scheduler) "dispatchEvent" args |> ignore
+    (* No need to schedule a wakeup if the idle_callback is already set. *)
+    if Option.is_some t.idle_callback then () else begin
+      let idle_callback = request_idle_callback (fun () -> t.idle_callback <- None; wakeup t.run_q) in
+      t.idle_callback <- Some idle_callback
+    end
+
+  let stop t =
+    Option.iter _cancel_idle_callback t.idle_callback;
+    t.idle_callback <- None
 
   let enqueue_thread t k v =
     Run_queue.push t.run_q (fun () -> Suspended.continue k v);
@@ -98,19 +110,15 @@ module Scheduler = struct
   let enqueue_failed_thread t k v =
     Run_queue.push t.run_q (fun () -> Suspended.discontinue k v);
     wakeup t
+
+  let enqueue_at_head t k v =
+    Run_queue.push_head t.run_q (fun () -> Suspended.continue k v);
+    wakeup t
 end
 
 type _ Effect.t += Enter_unchecked : (Scheduler.t -> 'a Suspended.t -> unit) -> 'a Effect.t
 let enter_unchecked fn = Effect.perform (Enter_unchecked fn)
 
-(* Resume the next runnable fiber, if any. *)
-let rec schedule run_q : unit =
-  match Run_queue.pop run_q with
-  | Some f ->
-    f ();
-    schedule run_q
-  | None -> ()
-
 module Timeout = struct
   let sleep ~ms =
     enter_unchecked @@ fun st k ->
@@ -147,10 +155,10 @@ let next_event : 'a Brr.Ev.type' -> Brr.Ev.target -> 'a Brr.Ev.t = fun typ targe
 (* Largely based on the Eio_mock.Backend event loop. *)
 let run main =
   let run_q = Run_queue.create () in
-  let scheduler = Scheduler.v ~schedule run_q in
+  let scheduler = Scheduler.v run_q in
   let rec fork ~new_fiber:fiber fn =
     Effect.Deep.match_with fn ()
-      { retc = (fun () -> Fiber_context.destroy fiber; schedule run_q);
+      { retc = (fun () -> Fiber_context.destroy fiber);
         exnc = (fun ex ->
             let bt = Printexc.get_raw_backtrace () in
             Fiber_context.destroy fiber;
@@ -159,18 +167,18 @@ let run main =
         effc = fun (type a) (e : a Effect.t) : ((a, unit) Effect.Deep.continuation -> unit) option ->
           match e with
           | Eio.Private.Effects.Suspend f -> Some (fun k ->
+              let k = { Suspended.k; fiber } in
               f fiber (function
-                  | Ok v -> Run_queue.push run_q (fun () -> Effect.Deep.continue k v)
-                  | Error ex -> Run_queue.push run_q (fun () -> Effect.Deep.discontinue k ex)
-                );
-              schedule run_q
+                  | Ok v -> Scheduler.enqueue_thread scheduler k v
+                  | Error ex -> Scheduler.enqueue_failed_thread scheduler k ex
+                )
             )
           | Enter_unchecked fn -> Some (fun k ->
-              fn scheduler { Suspended.k; fiber };
-              schedule run_q
+              fn scheduler { Suspended.k; fiber }
             )
           | Eio.Private.Effects.Fork (new_fiber, f) -> Some (fun k ->
-              Run_queue.push_head run_q (Effect.Deep.continue k);
+              let k = { Suspended.k; fiber } in
+              Scheduler.enqueue_at_head scheduler k ();
               fork ~new_fiber f
             )
           | Eio.Private.Effects.Get_context -> Some (fun k ->

lib_eio_js/browser/example/dune

@@ -10,7 +10,7 @@
  (alias runtest)
  (deps index.bc)
  (targets index.bc.js)
- (action (run %{bin:js_of_ocaml} -o %{targets} --enable=effects %{dep:index.bc})))
+ (action (run %{bin:js_of_ocaml} -o %{targets} --enable=effects %{lib:eio_browser:runtime.js} %{dep:index.bc})))
 
 (rule
  (alias runtest)

lib_eio_js/browser/runtime.js

@@ -0,0 +1,27 @@
+// A shim for safari: https://developer.chrome.com/blog/using-requestidlecallback/
+
+// Provides: requestIdleCallbackShim
+function requestIdleCallbackShim (cb) {
+    if (window.requestIdleCallback) {
+        window.requestIdleCallback(cb)
+    } else {
+        var start = Date.now();
+        globalThis.setTimeout(function () {
+            cb({
+                didTimeout: false,
+                timeRemaining: function () {
+                    return Math.max(0, 50 - (Date.now() - start));
+                }
+            });
+        }, 1);
+    }
+}
+
+// Provides: cancelIdleCallbackShim
+function cancelIdleCallbackShim (id) {
+    if (window.cancelIdleCallback) {
+        window.cancelIdleCallback(id);
+    } else {
+        globalThis.clearTimeout(id);
+    }
+}

lib_eio_js/browser/stubs.c

@@ -0,0 +1,5 @@
+
+#include <stdlib.h>
+#include <stdio.h>
+void requestIdleCallbackShim () { fprintf(stderr, "Unimplemented Javascript primitive requestIdleCallbackShim!\n"); exit(1); }
+void cancelIdleCallbackShim () { fprintf(stderr, "Unimplemented Javascript primitive cancelIdleCallbackShim!\n"); exit(1); }

lib_eio_js/browser/test/dune

@@ -13,7 +13,7 @@
  (alias runtest)
  (deps test.bc)
  (targets test.bc.js)
- (action (run %{bin:js_of_ocaml} -o %{targets} --enable=effects --setenv=ALCOTEST_COLOR=always +alcotest/runtime.js %{dep:test.bc})))
+ (action (run %{bin:js_of_ocaml} -o %{targets} --enable=effects --setenv=ALCOTEST_COLOR=always %{lib:eio_browser:runtime.js} +alcotest/runtime.js %{dep:test.bc})))
 
 (rule
  (alias runtest)

lib_eio_js/browser/test/test.ml

@@ -76,7 +76,7 @@ module Browser_tests = struct
   let test_multiple_timeouts () =
     let lst = List.init 100 Fun.id in
     let v =
-       Eio_browser.Timeout.sleep ~ms:1; lst
+      Fiber.List.map (fun v -> Eio_browser.Timeout.sleep ~ms:100; v) lst
     in
     Alcotest.(check (list int)) "timeouts" lst v