feat: lift runtime into language, start of zelus 2024 compatibility

src/lib/hsim/sim.ml

@@ -171,34 +171,4 @@ module Sim (S : SimState) =
         update ms ss (set_idle st) in
 
       DNode { state; step; reset }
-
-    (** Run the model on the given input until the end of the input or until the
-        model stops answering. *)
-    let run_on (DNode n) input use =
-      let out = n.step n.state (Some input) in
-      let state = match out with None, s -> s | Some o, s -> use o; s in
-      let rec loop state =
-        let o, state = n.step state None in
-        match o with None -> () | Some o -> use o; loop state in
-      loop state
-
-    (** Run the model on multiple inputs. *)
-    let run_on_n (DNode n) inputs use =
-      ignore @@ List.fold_left (fun state i ->
-        let o, state = n.step state (Some i) in
-        begin match o with None -> () | Some o -> use o end;
-        let rec loop state =
-          let o, state = n.step state None in
-          match o with None -> state | Some o -> use o; loop state in
-        loop state) n.state inputs
-
-    (** Run the model autonomously until [h], or until the model stops
-        answering. *)
-    let run_until n h = run_on n { h; c=Discontinuous; u = fun _ -> () }
-
-    (** Run the model autonomously until [h], split in [k] steps. *)
-    let run_until_n n h k =
-      let h = h /. float_of_int k in
-      run_on_n n (List.init k (fun _ -> { h; c=Continuous; u=fun _ -> () }))
-
   end

src/lib/hsim/types.ml

@@ -14,6 +14,10 @@ type 'a value =
   - [u: [0, h] -> α] *)
 type 'a signal = 'a value option
 
+(** A time signal with absolute timestamps added.
+    These represent the starting date for the value. *)
+type 'a signal_t = ('a value * time) option
+
 type ('s, 'p, 'a, 'b) drec =
   { state : 's;
     step  : 's -> 'a -> 'b * 's;

src/lib/hsim/utils.ml

@@ -7,6 +7,34 @@ let dot v = { h=0.0; c=Discontinuous; u=fun _ -> v }
 let offset (u : time -> 'a) (now : time) : time -> 'a =
   fun t -> u (t +. now)
 
+(** Cut a value into two at a specified timestamp. *)
+let cutoff { h; u; c } t =
+  if t < 0.0 then
+    raise (Invalid_argument "Cutoff point cannot be negative");
+  if t > h then
+    raise (Invalid_argument "Cutoff point cannot be greater than horizon");
+  { h=t; c=Continuous; u }, { h=h -. t; c; u=fun n -> u (t +. n) }
+
+(** Join two values. *)
+let join { h=hl; u=ul; c=cl } { h=hr; u=ur; c=cr } =
+  let h = min hl hr in
+  let u = fun t -> ul t, ur t in
+  let c = match cl, cr with
+    | Continuous, Continuous -> Continuous
+    | _ -> Discontinuous in
+  { h; u; c }
+
+(** Map a function. *)
+let map_value f ({ u; _ } as v) =
+  { v with u=fun t -> f (u t) }
+
+(** Swap a pair. *)
+let swap v = map_value (fun (a, b) -> b, a) v
+
+let map_signal f v = Option.map (map_value f) v
+
+let swap_signal v = Option.map swap v
+
 (** Concatenate functions. *)
 let rec concat = function
   | [] -> raise (Invalid_argument "Cannot concatenate an empty value list")
@@ -67,7 +95,7 @@ let compose_sim
   DNode { state; step; reset }
 
 (** Track the evolution of a signal in time. *)
-let track : (unit, 'a signal, ('a value * time) option) dnode =
+let track : (unit, 'a signal, 'a signal_t) dnode =
   let state = 0.0 in
   let step now = function
     | None -> None, now
@@ -101,3 +129,31 @@ let do_and_reset (DNode m) (DNode n) f =
     m.reset ms mp, n.reset ns np in
   DNode { state; step; reset }
 
+(** Run a model on the given input until the end of the input or until the model
+    stops answering. *)
+let run_on (DNode n) input use =
+  let out = n.step n.state (Some input) in
+  let state = match out with None, s -> s | Some o, s -> use o; s in
+  let rec loop state =
+    let o, state = n.step state None in
+    match o with None -> () | Some o -> use o; loop state in
+  loop state
+
+(** Run the model on multiple inputs. *)
+let run_on_n (DNode n) inputs use =
+  Stdlib.ignore @@ List.fold_left (fun state i ->
+    let o, state = n.step state (Some i) in
+    begin match o with None -> () | Some o -> use o end;
+    let rec loop state =
+      let o, state = n.step state None in
+      match o with None -> state | Some o -> use o; loop state in
+    loop state) n.state inputs
+
+(** Run the model autonomously until [h], or until the model stops answering. *)
+let run_until n h = run_on n { h; c=Discontinuous; u = fun _ -> () }
+
+(** Run the model autonomously until [h], split in [k] steps. *)
+let run_until_n n h k =
+  let h = h /. float_of_int k in
+  run_on_n n (List.init k (fun _ -> { h; c=Continuous; u=fun _ -> () }))
+

src/lib/solvers/statefulRK45.ml

@@ -7,7 +7,8 @@ module Functional =
   struct
     type ('state, 'vec) state = { state: 'state; vec: 'vec }
 
-    let csolve : (carray, carray) csolver_c =
+    let csolve () : (carray, carray) csolver_c =
+      Common.Debug.print "Instantiating RK45";
       let open Odexx.Ode45 in
 
       let state =
@@ -37,7 +38,8 @@ module InPlace =
   struct
     type ('state, 'vec) state = { mutable state: 'state; mutable vec : 'vec }
 
-    let csolve : (carray, carray) csolver_c =
+    let csolve () : (carray, carray) csolver_c =
+      Common.Debug.print "Instantiating RK45";
       let open Odexx.Ode45 in
 
       let state =

src/lib/solvers/statefulSundials.ml

@@ -7,7 +7,8 @@ module Functional =
   struct
     type ('state, 'vec) state = { state : 'state; vec : 'vec }
 
-    let csolve : (carray, carray) csolver =
+    let csolve () : (carray, carray) csolver =
+      Format.printf "Instantiating Sundials";
       let open Cvode in
 
       let state =
@@ -37,7 +38,8 @@ module InPlace =
   struct
     type ('state, 'vec) state = { mutable state: 'state; mutable vec : 'vec }
 
-    let csolve : (carray, carray) csolver =
+    let csolve () : (carray, carray) csolver =
+      Common.Debug.print "Instantiating Sundials";
       let open Cvode in
 
       let state =

src/lib/solvers/statefulZ.ml

@@ -7,7 +7,7 @@ module Functional =
   struct
     type ('state, 'vec) state = { state: 'state; vec: 'vec }
 
-    let zsolve : (carray, zarray, carray) zsolver_c =
+    let zsolve () : (carray, zarray, carray) zsolver_c =
       let open Illinois in
 
       let state =
@@ -38,7 +38,7 @@ module InPlace =
   struct
     type ('state, 'vec) state = { mutable state : 'state; mutable vec : 'vec }
 
-    let zsolve : (carray, zarray, carray) zsolver_c =
+    let zsolve () : (carray, zarray, carray) zsolver_c =
       let open Illinois in
 
       let state =

src/lib/std/lift.ml

@@ -6,8 +6,10 @@ open Ztypes
 type ('s, 'a) state =
   { mutable state : 's; mutable input : 'a option; mutable time : time }
 
-let lift f =
-  let cstate =
+let lift
+  (f : cstate -> (time * 'a, 'b) node)
+: (unit, 'a, 'b, cvec, dvec, zinvec, zoutvec) Hsim.Types.hnode
+= let cstate =
     { cvec = cmake 0; dvec = cmake 0; cindex = 0; zindex = 0;
       cend = 0; zend = 0; cmax = 0; zmax = 0;
       zinvec = zmake 0; zoutvec = cmake 0;
@@ -61,7 +63,7 @@ let lift f =
     let o = f_step state (st.time, input) in
     o, st in
 
-  let reset _ ({ state; _ } as st) = f_reset state; st in
+  let reset () ({ state; _ } as st) = f_reset state; st in
 
   (* horizon *)
   let horizon { time; _ } =
@@ -140,3 +142,107 @@ let lift_hsim n =
     derivative state cstates ignore_der no_roots_in no_roots_out no_time; cstates in
 
   HNode { state; fder; fzer; fout; step; reset; horizon; jump; cget; cset; zset; csize; zsize }
+
+let lift_2024
+  (f : Ztypes.cstate_new -> (time * 'a, 'b) node)
+: (unit, 'a, 'b, cvec, dvec, zinvec, zoutvec) Hsim.Types.hnode
+= let cstate =
+    { cvec = cmake 0; dvec = cmake 0; cindex = 0; zindex = 0;
+      cend = 0; zend = 0; cmax = 0; zmax = 0;
+      zinvec = zmake 0; zoutvec = cmake 0;
+      major = false; horizon = max_float; time=0.0 } in
+  let Node { alloc=f_alloc; step=f_step; reset=f_reset } = f cstate in
+  let state = { state = f_alloc (); input = None; time = 0.0 } in
+  let csize, zsize = cstate.cmax, cstate.zmax in
+  let no_roots_in  = zmake zsize in
+  let no_roots_out = cmake zsize in
+  let ignore_der   = cmake csize in
+  let cstates      = cmake csize in
+  cstate.cvec <- cstates;
+  f_reset state.state;
+
+  let no_time = -1.0 in
+
+  (* the function that compute the derivatives *)
+  let fder { state; time; _ } offset input y =
+    cstate.major <- false; cstate.cvec <- y; cstate.dvec <- ignore_der;
+    cstate.zinvec <- no_roots_in; cstate.zoutvec <- no_roots_out;
+    cstate.cindex <- 0; cstate.zindex <- 0; cstate.time <- time;
+    ignore (f_step state (time +. offset, input));
+    cstate.dvec in
+
+  (* the function that compute the zero-crossings *)
+  let fzer { state; time; _ } offset input y =
+    cstate.major <- false; cstate.cvec <- y; cstate.dvec <- ignore_der;
+    cstate.zinvec <- no_roots_in; cstate.zoutvec <- no_roots_out;
+    cstate.cindex <- 0; cstate.zindex <- 0; cstate.time <- time;
+    ignore (f_step state (time +. offset, input));
+    cstate.zoutvec in
+
+  (* the function which compute the output during integration *)
+  let fout { state; time; _ } offset input y =
+    cstate.major <- false; cstate.cvec <- y; cstate.dvec <- ignore_der;
+    cstate.zinvec <- no_roots_in; cstate.zoutvec <- no_roots_out;
+    cstate.cindex <- 0; cstate.zindex <- 0; cstate.time <- time;
+    f_step state (time +. offset, input) in
+
+  (* the function which compute a discrete step *)
+  let step ({ state; time; _ } as st) offset input =
+    st.input <- Some input;
+    st.time <- time +. offset;
+    cstate.time <- time;
+    cstate.major <- true;
+    cstate.horizon <- infinity;
+    cstate.zinvec <- no_roots_in;
+    cstate.zoutvec <- no_roots_out;
+    cstate.dvec <- ignore_der;
+    cstate.cindex <- 0;
+    cstate.zindex <- 0;
+    let o = f_step state (st.time, input) in
+    o, st in
+
+  let reset () ({ state; _ } as st) = f_reset state; st in
+
+  (* horizon *)
+  let horizon { time; _ } =
+    cstate.horizon -. time in
+
+  let jump _ = true in
+
+  (* the function which sets the zinvector into the *)
+  (* internal zero-crossing variables *)
+  let zset ({ state; input; _ } as st) zinvec =
+    cstate.major <- false;
+    cstate.zoutvec <- no_roots_out;
+    cstate.dvec <- ignore_der;
+    cstate.zinvec <- zinvec;
+    cstate.cindex <- 0;
+    cstate.zindex <- 0;
+    ignore (f_step state (no_time, Option.get input));
+    st in
+
+  let cset ({ state; input; _ } as st) _ =
+    cstate.major <- false;
+    cstate.horizon <- infinity;
+    cstate.zinvec <- no_roots_in;
+    cstate.zoutvec <- no_roots_out;
+    cstate.dvec <- ignore_der;
+    cstate.cindex <- 0;
+    cstate.zindex <- 0;
+    ignore (f_step state (no_time, Option.get input));
+    st in
+
+  let cget { state; input; _ } =
+    cstate.major <- false;
+    cstate.horizon <- infinity;
+    cstate.zinvec <- no_roots_in;
+    cstate.zoutvec <- no_roots_out;
+    cstate.dvec <- ignore_der;
+    cstate.cindex <- 0;
+    cstate.zindex <- 0;
+    ignore (f_step state (no_time, Option.get input));
+    cstate.cvec in
+
+  HNode
+    { state; fder; fzer; step; fout; reset;
+      horizon; cset; cget; zset; zsize; csize; jump }

src/lib/std/runtime.ml

@@ -1,31 +1,55 @@
 
 open Hsim.Types
 
-let sample = ref 0
-let stop   = ref 10.0
+let sample   = ref 0
+let stop     = ref 10.0
+let sundials = ref false
 
-let options = [
+let opts = ref [
   "-sample", Arg.Set_int sample, "\tSampling frequency (default=0)";
   "-stop", Arg.Set_float stop, "\tStop time (default=10.0)";
   "-debug", Arg.Set Common.Debug.debug, "\tShow debug information";
+  "-sundials", Arg.Set sundials, "\tUse sundials cvode";
 ]
 
-let arg s =
-  Format.eprintf "Unexpected argument: %s\n" s; exit 1
+let anon = ref (fun s -> Format.eprintf "Unexpected argument: %s\n" s; exit 1)
 
 let usage = ""
 
+let register_args l = opts := !opts @ l
+let register_anon f = anon := f
+let parse_args () = Arg.parse (Arg.align !opts) !anon usage
+
 let go
   (input : time -> 'a)
   (model : Ztypes.cstate -> (time * 'a, 'b) Ztypes.node)
   (output : (time * 'b) -> unit)
-= Arg.parse options arg usage;
+: unit
+= parse_args ();
   let input = { h=(!stop); c=Discontinuous; u=input } in
   let output o = List.iter output @@ Hsim.Utils.sample_tracked o !sample in
-  let model = Lift.lift model in
-  let open Hsim in
-  let solver = Solver.solver_c Solvers.StatefulRK45.InPlace.csolve
-                               Solvers.StatefulZ.InPlace.zsolve in
-  let open Sim.Sim(State.InPlaceSimState) in
-  let sim = Hsim.Utils.(compose (run model (d_of_dc solver)) track) in
-  run_on sim input output
+  let solver = Solve.(if !sundials then Sundials else RK45) in
+  Hsim.Utils.run_on (Solve.build_sim solver model) input output
+
+let go_discrete
+  (input : unit -> 'a)
+  (Ztypes.Node { alloc; step; reset } : ('a, 'b) Ztypes.node)
+  (output : 'b -> unit)
+: unit
+= parse_args ();
+  let mem = alloc () in
+  reset mem;
+  while true do
+    input () |> step mem |> output
+  done; ()
+
+let go_2024
+  (input : time -> 'a)
+  (model : Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node)
+  (output : (time * 'b) -> unit)
+: unit
+= parse_args ();
+  let input = { h=(!stop); c=Discontinuous; u=input } in
+  let output o = List.iter output @@ Hsim.Utils.sample_tracked o !sample in
+  let solver = Solve.(if !sundials then Sundials else RK45) in
+  Hsim.Utils.run_on (Solve.build_sim_2024 solver model) input output

src/lib/std/runtime.mli

@@ -0,0 +1,24 @@
+
+open Hsim.Types
+
+val register_args : (string * Arg.spec * string) list -> unit
+val register_anon : (string -> unit) -> unit
+val parse_args : unit -> unit
+
+val go :
+  (time -> 'a) ->
+  (Ztypes.cstate -> (time * 'a, 'b) Ztypes.node) ->
+  ((time * 'b) -> unit) ->
+  unit
+
+val go_2024 :
+  (time -> 'a) ->
+  (Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node) ->
+  ((time * 'b) -> unit) ->
+  unit
+
+val go_discrete :
+  (unit -> 'a) ->
+  ('a, 'b) Ztypes.node ->
+  ('b -> unit) ->
+  unit

src/lib/std/solve.ml

@@ -0,0 +1,228 @@
+
+open Hsim
+open Types
+
+type nonrec 'a value = 'a value
+type nonrec 'a signal = 'a signal
+type nonrec 'a signal_t = 'a signal_t
+
+type time = float
+
+type solver = RK45 | Sundials
+
+(** Get a value's horizon [h] (reminder: a value is defined on [[0,h]]). *)
+let horizon { h; _ } = h
+
+(** Create a value from a horizon and function. *)
+let make (h, u) = { h; u; c=Discontinuous }
+
+(** Apply a value at a time t. *)
+let apply ({ u; h; _ }, t) =
+  if t > h then raise (Invalid_argument (Format.sprintf
+    "Requested time t=%.10e is greater than the horizon h=%.10e" t h)); 
+  u t
+
+let build_sim
+  (solver : solver)
+  (model : Ztypes.cstate -> (time * 'a, 'b) Ztypes.node)
+: (unit *
+   ((Ztypes.cvec, Ztypes.dvec) Solver.ivp *
+    (Ztypes.cvec, Ztypes.zoutvec) Solver.zc), 'a signal, 'b signal_t) dnode
+= let model = Lift.lift model in
+  let solver = Hsim.Solver.solver
+    (match solver with
+     | RK45 -> d_of_dc @@ Solvers.StatefulRK45.InPlace.csolve ()
+     | Sundials -> Solvers.StatefulSundials.InPlace.csolve ())
+    (d_of_dc @@ Solvers.StatefulZ.InPlace.zsolve ()) in
+  let open Hsim.Sim.Sim(Hsim.State.InPlaceSimState) in
+  let DNode s = Hsim.Utils.(compose (run model solver) track) in
+  DNode { s with reset=fun p -> s.reset (p, ())}
+
+let build_sim_2024
+  (solver : solver)
+  (model : Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node)
+: (unit *
+   ((Ztypes.cvec, Ztypes.dvec) Solver.ivp *
+    (Ztypes.cvec, Ztypes.zoutvec) Solver.zc), 'a signal, 'b signal_t) dnode
+= let model = Lift.lift_2024 model in
+  let solver = Hsim.Solver.solver
+    (match solver with
+     | RK45 -> d_of_dc @@ Solvers.StatefulRK45.InPlace.csolve ()
+     | Sundials -> Solvers.StatefulSundials.InPlace.csolve ())
+    (d_of_dc @@ Solvers.StatefulZ.InPlace.zsolve ()) in
+  let open Hsim.Sim.Sim(Hsim.State.InPlaceSimState) in
+  let DNode s = Hsim.Utils.(compose (run model solver) track) in
+  DNode { s with reset=fun p -> s.reset (p, ())}
+
+(** Lift a hybrid node into a discrete node on streams of functions. *)
+let solve
+  (solver : solver)
+  (model : Ztypes.cstate -> (time * 'a, 'b) Ztypes.node)
+: ('a signal, 'b signal_t) Ztypes.node
+= let DNode sim = build_sim solver model in
+  let alloc () = ref sim.state in
+  let step s a = let b, s' = sim.step !s a in s := s'; b in
+  let reset _ = () in
+  Ztypes.Node { alloc; step; reset }
+
+let solve_2024
+  (solver : solver)
+  (model : Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node)
+: ('a signal, 'b signal_t) Ztypes.node
+= let DNode sim = build_sim_2024 solver model in
+  let alloc () = ref sim.state in
+  let step s a = let b, s' = sim.step !s a in s := s'; b in
+  let reset _ = () in
+  Ztypes.Node { alloc; step; reset }
+
+let solve_ode45         m = solve      RK45     m
+let solve_ode45_2024    m = solve_2024 RK45     m
+let solve_sundials      m = solve      Sundials m
+let solve_sundials_2024 m = solve_2024 Sundials m
+
+(** Utility function for [synchr].
+
+    During synchronization, step the simulation that is lagging behind ([m]) and
+    join it with the stored value for the other ([n]).
+    Takes as arguments:
+    - The step method for [m];
+    - The input;
+    - The last stop times for [m] and [n];
+    - The state of [m];
+    - The stored value for [n].
+
+    Returns:
+    - The common output value up to the common reached date;
+    - The new reached date of [m];
+    - The stored value for [m];
+    - The stored value for [n]. *)
+let synchr_neq
+  (m_step : 'ms -> 'a signal -> 'b signal_t)
+  (input : 'a signal)
+  (m_stop : time) (n_stop : time) (m_state : 'ms) (n_value : 'c value)
+: ('b * 'c) signal_t * time * 'b signal * 'c signal
+= match m_step m_state input with
+  | None -> None, m_stop, None, Some n_value
+  | Some (m_value, m_start) ->
+      let m_stop = m_start +. m_value.h in
+      let m_value, n_value, m_rest, n_rest =
+        (* Three possible scenarios: *)
+        if m_stop < n_stop then begin
+          (* [m] is still behind [n]: cut off [n_value] at [m_stop'] *)
+          let n_value, n_rest = Utils.cutoff n_value m_value.h in
+          m_value, n_value, None, Some n_rest
+        end else if n_stop < m_stop then begin
+          (* [m] overtakes [n]: cut off [m_value] at [n_stop] *)
+          let m_value, m_rest = Utils.cutoff m_value (n_stop -. m_start) in
+          m_value, n_value, Some m_rest, None
+        end else
+          (* [m] reaches [n] exactly: *)
+          m_value, n_value, None, None in
+      let mn_value = Utils.join m_value n_value in
+      Some (mn_value, m_start), m_stop, m_rest, n_rest
+
+(** Utility function for [synchr].
+
+    During synchronization, step both simulations at the same time.
+    Takes as arguments:
+    - The step functions for both simulations;
+    - The input;
+    - The states of both simulations;
+    - The last stop times of both simulations.
+
+    Returns:
+    - The common output value up to the common reached date;
+    - The new stop times for both simulations;
+    - The new stored values for both simulations. *)
+let synchr_eq
+  (m_step : 'ms -> 'a signal -> 'b signal_t)
+  (n_step : 'ns -> 'a signal -> 'c signal_t)
+  (input : 'a signal) (m_state : 'ms) (n_state : 'ns)
+  (m_stop : time) (n_stop : time)
+: ('b * 'c) signal_t * time * time * 'b signal * 'c signal
+= match m_step m_state input, n_step n_state input with
+  | Some (m_value, m_start), Some (n_value, n_start) ->
+      let m_stop, n_stop = m_start +. m_value.h, n_start +. n_value.h in
+      let m_value, n_value, m_rest, n_rest =
+        if m_stop < n_stop then
+          let n_value, n_rest = Utils.cutoff n_value m_value.h in
+          m_value, n_value, None, Some n_rest
+        else if m_stop > n_stop then
+          let m_value, m_rest = Utils.cutoff m_value n_value.h in
+          m_value, n_value, Some m_rest, None
+        else m_value, n_value, None, None in
+      let mn_value = Utils.join m_value n_value in
+      Some (mn_value, min m_stop n_stop), m_stop, n_stop, m_rest, n_rest
+  | None, None -> None, m_stop, n_stop, None, None
+  | _ -> assert false
+
+(** Synchronize two simulations as much as possible. *)
+let synchr
+  (m : ('a signal, 'b signal_t) Ztypes.node)
+  (n : ('a signal, 'c signal_t) Ztypes.node)
+: ('a signal, ('b * 'c) signal_t) Ztypes.node
+= let Ztypes.Node { alloc=m_alloc; step=m_step; reset=m_reset } = m in
+  let Ztypes.Node { alloc=n_alloc; step=n_step; reset=n_reset } = n in
+  let alloc () =
+    ref ((0.0, None, m_alloc ()), (0.0, None, n_alloc ())) in
+  let step state input =
+    let (m_stop, m_value, m_state), (n_stop, n_value, n_state) = !state in
+    let m_stop, m_rest, m_state, n_stop, n_rest, n_state, output =
+      if m_stop < n_stop then
+        let n_value = Option.get n_value in
+        let output, m_stop, m_rest, n_rest =
+          synchr_neq m_step input m_stop n_stop m_state n_value in
+        m_stop, m_rest, m_state, n_stop, n_rest, n_state, output
+      else if m_stop > n_stop then
+        let m_value = Option.get m_value in
+        let output, n_stop, n_rest, m_rest =
+          synchr_neq n_step input n_stop m_stop n_state m_value in
+        let output = Option.map (fun (u, t) -> Utils.swap u, t) output in
+        m_stop, m_rest, m_state, n_stop, n_rest, n_state, output
+      else
+        let output, m_stop, n_stop, m_rest, n_rest =
+          synchr_eq m_step n_step input m_state n_state m_stop n_stop in
+        m_stop, m_rest, m_state, n_stop, n_rest, n_state, output in
+    state := (m_stop, m_rest, m_state), (n_stop, n_rest, n_state);
+    output in
+  let reset ({ contents=((_, _, ms), (_, _, ns)) } as s) =
+    n_reset ns; m_reset ms; s := (0.0, None, ms), (0.0, None, ns) in
+  Ztypes.Node { alloc; step; reset }
+
+(** Sample a value [n] times and iterate [f] on the samples. *)
+let iter n f =
+  let Ztypes.Node { alloc; step; reset } = f in
+  let step s =
+    Option.iter @@ fun (v, _) ->
+      List.iter (fun (_, v) -> step s v) @@ Utils.sample v n in
+  Ztypes.Node { alloc; step; reset }
+
+(** Sample a value [n] times and iterate [f] on the dated samples. *)
+let iter_t n f =
+  let Ztypes.Node { alloc; step; reset } = f in
+  let step s =
+    Option.iter @@ fun (v, h) ->
+      List.iter (fun (t, v) -> step s (t +. h, v)) @@ Utils.sample v n in
+  Ztypes.Node { alloc; step; reset }
+
+(** Sample a value [n] times and assert [f] on the samples. *)
+let check
+  (n : int)
+  (Ztypes.Node { alloc; step; reset } : ('a, bool) Ztypes.node)
+: ('a signal_t, unit) Ztypes.node
+= let step s (now, v) =
+    try assert (step s v)
+    with Assert_failure _ ->
+      (Format.eprintf "Assertion failed at time %.10e\n" now; exit 1) in
+  iter_t n (Ztypes.Node { alloc; reset; step })
+
+(** Sample a value [n] times and assert [f] on the dated samples. *)
+let check_t
+  (n : int)
+  (Ztypes.Node { alloc; step; reset } : (time * 'a, bool) Ztypes.node)
+: ('a signal_t, unit) Ztypes.node
+= let step s (now, v) =
+    try assert (step s (now, v))
+    with Assert_failure _ ->
+      (Format.eprintf "Assertion failed at time %.10e\n" now; exit 1) in
+  iter_t n (Ztypes.Node { alloc; reset; step })

src/lib/std/solve.mli

@@ -0,0 +1,61 @@
+
+type time = float
+type 'a value = 'a Hsim.Types.value
+type 'a signal = 'a value option
+type 'a signal_t = ('a value * time) option
+
+type solver = RK45 | Sundials
+
+val horizon : 'a value -> time
+val make    : time * (time -> 'a) -> 'a value
+val apply   : 'a value * time -> 'a
+
+val build_sim :
+  solver ->
+  (Ztypes.cstate -> (time * 'a, 'b) Ztypes.node) ->
+  (unit *
+   ((Ztypes.cvec, Ztypes.dvec) Hsim.Solver.ivp *
+    (Ztypes.cvec, Ztypes.zoutvec) Hsim.Solver.zc),
+   'a signal, 'b signal_t) Hsim.Types.dnode
+
+val build_sim_2024 :
+  solver ->
+  (Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node) ->
+  (unit *
+   ((Ztypes.cvec, Ztypes.dvec) Hsim.Solver.ivp *
+    (Ztypes.cvec, Ztypes.zoutvec) Hsim.Solver.zc),
+   'a signal, 'b signal_t) Hsim.Types.dnode
+
+val solve :
+  solver ->
+  (Ztypes.cstate -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+
+val solve_2024 :
+  solver ->
+  (Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+
+val solve_ode45 :
+  (Ztypes.cstate -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+val solve_ode45_2024 :
+  (Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+val solve_sundials :
+  (Ztypes.cstate -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+val solve_sundials_2024 :
+  (Ztypes.cstate_new -> (time * 'a, 'b) Ztypes.node) -> 
+  ('a signal, 'b signal_t) Ztypes.node
+
+val synchr :
+  ('a signal, 'b signal_t) Ztypes.node ->
+  ('a signal, 'c signal_t) Ztypes.node ->
+  ('a signal, ('b * 'c) signal_t) Ztypes.node
+
+val iter   : int -> ('a, unit) Ztypes.node -> ('a signal_t, unit) Ztypes.node
+val iter_t : int -> (time * 'a, unit) Ztypes.node -> ('a signal_t, unit) Ztypes.node
+
+val check   : int -> ('a, bool) Ztypes.node -> ('a signal_t, unit) Ztypes.node
+val check_t : int -> (time * 'a, bool) Ztypes.node -> ('a signal_t, unit) Ztypes.node

src/lib/std/solve.zli

@@ -0,0 +1,23 @@
+
+type time = float
+type 'a value
+type 'a signal = 'a value option
+type 'a signal_t = ('a value * time) option 
+
+val horizon : 'a value -> time
+val make    : time -> (time -> 'a) -> 'a value
+val apply   : 'a value -> time -> 'a
+
+val solve_ode45    : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
+val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
+
+val synchr :
+  ('a signal -D-> 'b signal_t) -S->
+  ('a signal -D-> 'c signal_t) -S->
+  'a signal -D-> ('b * 'c) signal_t
+
+val iter    : int -S-> ('a        -D-> unit) -S-> 'a signal_t -D-> unit
+val iter_t  : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
+
+val check   : int -S-> ('a        -D-> bool) -S-> 'a signal_t -D-> unit
+val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit

src/lib/std/ztypes.ml

@@ -43,10 +43,10 @@ type ('a, 'b) cnode =
 
 open Bigarray
 
-type time = float
-type cvec = (float, float64_elt, c_layout) Array1.t
-type dvec = (float, float64_elt, c_layout) Array1.t
-type zinvec = (int32, int32_elt,   c_layout) Array1.t
+type time    = float
+type cvec    = (float, float64_elt, c_layout) Array1.t
+type dvec    = (float, float64_elt, c_layout) Array1.t
+type zinvec  = (int32, int32_elt,   c_layout) Array1.t
 type zoutvec = (float, float64_elt, c_layout) Array1.t
 
 (* The interface with the ODE solver *)
@@ -67,6 +67,23 @@ type cstate =
     mutable major : bool; (* integration iff [major = false] *)
   }
 
+(* The interface with the ODE solver (new Zélus version). *)
+type cstate_new =
+  { mutable dvec    : dvec;          (* Derivative vector.                    *)
+    mutable cvec    : cvec;          (* Position vector.                      *)
+    mutable zinvec  : zinvec;        (* Zero-crossing result vector.          *)
+    mutable zoutvec : zoutvec;       (* Zero-crossing value vector.           *)
+    mutable cindex  : int;           (* Position in position vector.          *)
+    mutable zindex  : int;           (* Position in zero-crossing vector.     *)
+    mutable cend    : int;           (* End of position vector.               *)
+    mutable zend    : int;           (* End of zero-crossing vector.          *)
+    mutable cmax    : int;           (* Maximum size of position vector.      *)
+    mutable zmax    : int;           (* Maximum size of zero-crossing vector. *)
+    mutable horizon : float;         (* Next horizon.                         *)
+    mutable major   : bool;          (* Step mode: major <-> discrete.        *)
+    mutable time    : float;         (* Simulation time.                      *)
+  }
+
 (* A hybrid node is a node that is parameterised by a continuous state *)
 (* all instances points to this global parameter and read/write on it *)
 type ('a, 'b) hnode = cstate -> (time * 'a, 'b) node