Merge branch 'riot-ml:main' into main

bench/spawn_many.ml

@@ -7,7 +7,7 @@ module Test_app = struct
 
   let loop count =
     match receive_any () with
-    | Loop_stop -> Log.debug (fun f -> f "dead at %d%!" count)
+    | Loop_stop -> Riot_runtime.Log.debug (fun f -> f "dead at %d%!" count)
 
   let main t0 () =
     Logger.info (fun f -> f "boot test app");

riot/dune

@@ -1,4 +1,4 @@
 (library
  (name riot)
  (public_name riot)
- (libraries lib runtime))
+ (libraries lib riot_runtime))

riot/lib/dune

@@ -4,7 +4,7 @@
  (libraries
   global
   logger
-  runtime
+  riot_runtime
   tls
   bytestring
   telemetry

riot/lib/gen_server.ml

@@ -1,19 +1,33 @@
 open Global
 
 type 'res req = ..
+type cast_req = ..
+type cont_req = ..
 
 type Message.t +=
   | Call : Pid.t * 'res Ref.t * 'res req -> Message.t
+  | Cast : cast_req -> Message.t
   | Reply : 'res Ref.t * 'res -> Message.t
 
 type 'state init_result = Ok of 'state | Error | Ignore
 
+type ('res, 'state) call_result =
+  | Reply of ('res * 'state)
+  | Reply_continue of ('res * 'state * cont_req)
+
+type 'state cast_result = No_reply of 'state
+
 module type Impl = sig
   type args
   type state
 
   val init : args -> state init_result
-  val handle_call : 'res. 'res req -> Pid.t -> state -> 'res * state
+
+  val handle_call :
+    'res. 'res req -> Pid.t -> state -> ('res, state) call_result
+
+  val handle_cast : cast_req -> state -> state cast_result
+  val handle_continue : cont_req -> state -> state
   val handle_info : Message.t -> state -> unit
 end
 
@@ -35,14 +49,23 @@ let call : type res. Pid.t -> res req -> res =
   in
   receive ~selector ()
 
+let cast pid req = send pid (Cast req)
+
 let rec loop : type args state. (args, state) impl -> state -> unit =
  fun impl state ->
   let (module I : Impl with type args = args and type state = state) = impl in
   match receive_any () with
-  | Call (pid, ref, req) ->
-      let res, state = I.handle_call req pid state in
-      send pid (Reply (ref, res));
-      loop impl state
+  | Call (pid, ref, req) -> (
+      match I.handle_call req pid state with
+      | Reply (res, state) ->
+          send pid (Reply (ref, res));
+          loop impl state
+      | Reply_continue (res, state, cont_req) ->
+          send pid (Reply (ref, res));
+          let state = I.handle_continue cont_req state in
+          loop impl state)
+  | Cast req -> (
+      match I.handle_cast req state with No_reply state -> loop impl state)
   | msg ->
       let _res = I.handle_info msg state in
       loop impl state
@@ -65,5 +88,7 @@ let start_link :
 module Default = struct
   let init _args = Ignore
   let handle_call _req _from _state = failwith "unimplemented"
+  let handle_cast _req _state = failwith "unimplemented"
+  let handle_continue _req _state = failwith "unimplemented"
   let handle_info _msg _state = failwith "unimplemented"
 end

riot/lib/global/dune

@@ -1,4 +1,4 @@
 (library
  (package riot)
  (name global)
- (libraries runtime))
+ (libraries riot_runtime))

riot/lib/global/global.ml

@@ -1,7 +1,7 @@
-include Runtime.Import
+include Riot_runtime.Import
 
 (* TODO(@leostera): move these into the Runtime module below *)
-include Runtime.Core.Process.Exn
-include Runtime.Core.Proc_registry.Exn
+include Riot_runtime.Core.Process.Exn
+include Riot_runtime.Core.Proc_registry.Exn
 
 let ( let* ) = Result.bind

riot/lib/hashmap.ml

@@ -1 +1 @@
-include Runtime.Util.Dashmap
+include Riot_runtime.Util.Dashmap

riot/lib/key_value_store.ml

@@ -16,11 +16,15 @@ module MakeServer (B : Base) = struct
   let init () = Gen_server.Ok { tbl = Hashtbl.create 0 }
 
   let handle_call :
-      type res. res Gen_server.req -> Pid.t -> state -> res * state =
+      type res.
+      res Gen_server.req ->
+      Pid.t ->
+      state ->
+      (res, state) Gen_server.call_result =
    fun req _from state ->
     match req with
-    | Get k -> (Hashtbl.find_opt state.tbl k, state)
-    | Put (k, v) -> (Hashtbl.replace state.tbl k v, state)
+    | Get k -> Gen_server.Reply (Hashtbl.find_opt state.tbl k, state)
+    | Put (k, v) -> Gen_server.Reply (Hashtbl.replace state.tbl k v, state)
     | _ -> failwith "invalid call"
 end
 

riot/lib/logger/dune

@@ -1,4 +1,4 @@
 (library
  (package riot)
  (name logger)
- (libraries global runtime))
+ (libraries global riot_runtime))

riot/lib/logger/logger.ml

@@ -1,5 +1,5 @@
-module Scheduler_uid = Runtime.Core.Scheduler_uid
-module Log = Runtime.Log
+module Scheduler_uid = Riot_runtime.Core.Scheduler_uid
+module Log = Riot_runtime.Log
 open Global
 
 type opts = { print_source : bool; print_time : bool; color_output : bool }
@@ -43,7 +43,7 @@ end
 type log = {
   level : level;
   ts : Ptime.t;
-  src : Scheduler_uid.t * Core.Pid.t;
+  src : Scheduler_uid.t * Riot_runtime.Core.Pid.t;
   ns : namespace;
   message : string;
 }
@@ -55,7 +55,7 @@ let on_log log = !__on_log__ log
 let write : type a. level -> namespace -> (a, unit) logger_format -> unit =
  fun level ns msgf ->
   let ts = Ptime_clock.now () in
-  let sch = Scheduler.get_current_scheduler () in
+  let sch = Riot_runtime.Scheduler.get_current_scheduler () in
   let pid = self () in
   let src = (sch.uid, pid) in
   let buf = Buffer.create 128 in

riot/lib/message.ml

@@ -1 +1 @@
-include Runtime.Core.Message
+include Riot_runtime.Core.Message

riot/lib/pid.ml

@@ -1 +1 @@
-include Runtime.Core.Pid
+include Riot_runtime.Core.Pid

riot/lib/process.ml

@@ -1,5 +1,5 @@
-open Runtime.Import
-module P = Runtime.Core.Process
+open Riot_runtime.Import
+module P = Riot_runtime.Core.Process
 
 open Logger.Make (struct
   let namespace = [ "riot"; "process" ]

riot/lib/queue.ml

@@ -1 +1 @@
-include Runtime.Util.Lf_queue
+include Riot_runtime.Util.Lf_queue

riot/lib/ref.ml

@@ -1 +1 @@
-include Runtime.Core.Ref
+include Riot_runtime.Core.Ref

riot/lib/runtime_lib.ml

@@ -1,6 +1,6 @@
 open Global
 
-let set_log_level = Runtime.Log.set_log_level
+let set_log_level = Riot_runtime.Log.set_log_level
 
 let syscalls () =
   let pool = _get_pool () in
@@ -26,11 +26,11 @@ module Stats = struct
     let total_schedulers = pool.schedulers |> List.length in
     let breakdown =
       pool.schedulers
-      |> List.map (fun (sch : Scheduler.t) ->
+      |> List.map (fun (sch : Riot_runtime.Scheduler.t) ->
              Format.asprintf "  sch #%a [live_procs=%d; timers=%d]"
-               Runtime.Core.Scheduler_uid.pp sch.uid
-               (Runtime.Core.Proc_queue.size sch.run_queue)
-               (Runtime.Time.Timer_wheel.size sch.timers))
+               Riot_runtime.Core.Scheduler_uid.pp sch.uid
+               (Riot_runtime.Core.Proc_queue.size sch.run_queue)
+               (Riot_runtime.Time.Timer_wheel.size sch.timers))
       |> String.concat "\n"
     in
     info (fun f ->

riot/lib/telemetry_app.ml

@@ -5,7 +5,7 @@ type event = Telemetry.event = ..
 let name = "Riot.Telemetry"
 
 module Dispatcher = struct
-  type Core.Message.t += Event of Telemetry.event
+  type Riot_runtime.Core.Message.t += Event of Telemetry.event
 
   let __main_dispatcher__ : Pid.t ref = ref Pid.zero
 

riot/riot.ml

@@ -1,5 +1,15 @@
 include Lib
 
+open struct
+  open Riot_runtime
+  module Log = Log
+  module Core = Core
+  module Import = Import
+  module Util = Util
+  module Scheduler = Scheduler
+  module Time = Time
+end
+
 open Logger.Make (struct
   let namespace = [ "riot" ]
 end)

riot/riot.mli

@@ -141,7 +141,7 @@ module Process : sig
       [None] if no process was registered for that name.
   *)
 
-  val sid : t -> Core.Scheduler_uid.t
+  val sid : t -> Riot_runtime.Core.Scheduler_uid.t
   (** [sid t] returns the scheduler id for the scheduler in charge of the
       process. *)
 
@@ -352,6 +352,9 @@ module Gen_server : sig
       ]}
     *)
 
+  type cast_req = ..
+  type cont_req = ..
+
   (** [state init_result] is used to initialize a new generic server. *)
   type 'state init_result =
     | Ok of 'state
@@ -360,6 +363,12 @@ module Gen_server : sig
         (** use this value to crash the process and notify a supervisor of it *)
     | Ignore  (** use this value to exit the process normally *)
 
+  type ('res, 'state) call_result =
+    | Reply of ('res * 'state)
+    | Reply_continue of ('res * 'state * cont_req)
+
+  type 'state cast_result = No_reply of 'state
+
   (** [Impl] is the module type of the generic server base implementations. You
       can use this type when defining new gen servers like this:
 
@@ -380,7 +389,12 @@ module Gen_server : sig
     type state
 
     val init : args -> state init_result
-    val handle_call : 'res. 'res req -> Pid.t -> state -> 'res * state
+
+    val handle_call :
+      'res. 'res req -> Pid.t -> state -> ('res, state) call_result
+
+    val handle_cast : cast_req -> state -> state cast_result
+    val handle_continue : cont_req -> state -> state
     val handle_info : Message.t -> state -> unit
   end
 
@@ -396,6 +410,11 @@ module Gen_server : sig
       TODO(leostera): add ?timeout param
     *)
 
+  val cast : Pid.t -> cast_req -> unit
+  (** [cast pid req] will send a type-safe request [req] to the generic server behind [pid]
+      and does not wait for a response.
+    *)
+
   val start_link :
     ('args, 'state) impl -> 'args -> (Pid.t, [> `Exn of exn ]) result
   (** [start_link (module S) args] will spawn and link a new process that will

riot/runtime/core/core.ml

@@ -0,0 +1,13 @@
+module Core = Core
+module Mailbox = Mailbox
+module Message = Message
+module Pid = Pid
+module Proc_effect = Proc_effect
+module Proc_queue = Proc_queue
+module Proc_registry = Proc_registry
+module Proc_set = Proc_set
+module Proc_state = Proc_state
+module Proc_table = Proc_table
+module Process = Process
+module Ref = Ref
+module Scheduler_uid = Scheduler_uid

riot/runtime/dune

@@ -1,4 +1,14 @@
 (library
  (package riot)
- (name runtime)
- (libraries core log scheduler time util rio))
+ (name riot_runtime)
+ (libraries
+  gluon
+  mtime
+  mtime.clock.os
+  ptime
+  ptime.clock.os
+  rio
+  runtime_events
+  unix))
+
+(include_subdirs unqualified)

riot/runtime/runtime.ml → riot/runtime/riot_runtime.ml

@@ -2,6 +2,7 @@ module Log = Log
 module Core = Core
 module Import = Import
 module Util = Util
+module Scheduler = Scheduler
 module Time = Time
 
 let set_log_level = Log.set_log_level

riot/runtime/time/time.ml

@@ -0,0 +1 @@
+module Timer_wheel = Timer_wheel

riot/runtime/util/util.ml

@@ -0,0 +1,9 @@
+module Dashmap = Dashmap
+module Lf_queue = Lf_queue
+module Min_heap = Min_heap
+module Thread_local = Thread_local
+module Timeout = Timeout
+module Trace = Trace
+module Uid = Uid
+module Util = Util
+module Weak_ref = Weak_ref