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

exm/builtins/main.ml

@@ -73,21 +73,21 @@ let output =
 let sim =
   if !sundials then
     let open StatefulSundials in
-    let c = if !inplace then InPlace.csolve else Functional.csolve in
+    let c = if !inplace then InPlace.csolve () else Functional.csolve () in
     let open StatefulZ in
-    let z = if !inplace then InPlace.zsolve else Functional.zsolve in
+    let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
     let s = Solver.solver c (d_of_dc z) in
     let open Sim.Sim(val st) in
-    run_until_n (output !sample (run m s))
+    Hsim.Utils.run_until_n (output !sample (run m s))
   else
     let open StatefulRK45 in
-    let c = if !inplace then InPlace.csolve else Functional.csolve in
+    let c = if !inplace then InPlace.csolve () else Functional.csolve () in
     let open StatefulZ in
-    let z = if !inplace then InPlace.zsolve else Functional.zsolve in
+    let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
     let s = Solver.solver_c c z in
     let open Sim.Sim(val st) in
     let n = if !accel then accelerate m s else run m (d_of_dc s) in
-    run_until_n (output !sample n)
+    Hsim.Utils.run_until_n (output !sample n)
 
 let () = sim !stop !steps ignore
 

exm/zelus/ball/dune

@@ -4,9 +4,9 @@
    (:standard -w -a))))
 
 (rule
- (targets ballz.ml ballz.zci)
+ (targets ball.ml ball.zci)
  (deps
-  (:zl ballz.zls))
+  (:zl ball.zls))
  (action
   (run zeluc %{zl})))
 

exm/zelus/ball/main.ml

@@ -3,4 +3,4 @@ open Std
 
 let input _ = ()
 let output (now, (y, _, _)) = Format.printf "%.10e\t%.10e\n" now y
-let () = Runtime.go input Ballz.ball output
+let () = Runtime.go input Ball.ball output

exm/zelus/ball/ztypes.ml

@@ -0,0 +1,12 @@
+include Std
+include Ztypes
+include Solvers
+
+module type IGNORE = sig end
+module Defaultsolver : IGNORE = struct end
+
+module Zlsrun = struct
+  module Make (S : IGNORE) = struct
+    let go _ = ()
+  end
+end

exm/zelus/ballz/ztypes.ml

@@ -1,21 +0,0 @@
-include Std
-include Ztypes
-include Solvers
-
-module type IGNORE = sig end
-module Defaultsolver : IGNORE = struct end
-
-module Zlsrun = struct
-  module Make (S : IGNORE) = struct
-    let go s =
-      let s = Lift.lift_hsim s in
-      let open Hsim in
-      let state = (module State.InPlaceSimState : State.SimState) in
-      let solver =
-        Solver.solver (StatefulSundials.InPlace.csolve)
-        (Types.d_of_dc StatefulZ.InPlace.zsolve) in
-      let open Sim.Sim(val state) in
-      ()
-      (* run_until_n (Utils.ignore 0 (run s solver)) 30. 1 ignore *)
-  end
-end

exm/zelus/cradle/cradle.zls

@@ -0,0 +1,51 @@
+
+let mp6 = -. (3.1416 /. 6.)
+let g = 9.80665
+let l = 0.2
+
+let pi0 = mp6
+let pi1 = 0.
+let pi2 = 0.
+
+let acc x = -. g /. l *. (sin x)
+
+let hybrid cradle2() =
+  let rec der p0 = v0      init pi0 reset h01 -> last p1
+      and der v0 = acc(p0) init 0.0 reset h01 -> last v1
+      and der p1 = v1      init pi1 reset h01 -> last p0
+      and der v1 = acc(p1) init 0.0 reset h01 -> last v0
+      and h01 = up(last p0 -. last p1)
+      and init h = -0.1
+      and present h01 -> do h = -1.0 *. last h done
+             else do der h = 0.0 done
+  in (h, (p0, v0 /. 10.) , (p1, v1 /. 10.))
+
+let hybrid cradle3() =
+  let rec der p0 = v0      init pi0 reset h01 -> last p1
+      and der v0 = acc(p0) init 0.0 reset h01 -> last v1
+      and der p1 = v1      init pi1 reset h01 -> last p0 | h12 -> last p2
+      and der v1 = acc(p1) init 0.0 reset h01 -> last v0 | h12 -> last v2
+      and der p2 = v2      init pi2 reset h12 -> last p1
+      and der v2 = acc(p2) init 0.0 reset h12 -> last v1
+      and h01 = up(last p0 -. last p1)
+      and h12 = up(last p1 -. last p2)
+      and init h1 = -0.1
+      and present h01 -> do h1 = -1.0 *. last h1 done else do der h1 = 0.0 done
+      and init h2 = -0.1
+      and present h12 -> do h2 = -1.0 *. last h2 done else do der h2 = 0.0 done
+  in (p0, p1, p2, h1, h2)
+
+let node print(v, s) =
+  Format.printf "% .10e%s" v s
+
+let hybrid main() =
+  let der t = 1.0 init 0.0 in
+  let (p0, p1, p2, h1, h2) = cradle3() in
+  present (period(0.05)) -> (
+    print(t, "\t");
+	print(p0, "\t");
+	print(p1, "\t");
+	print(p2, "\t");
+	print(h1, "\t");
+	print(h2, "\n")
+  ); ()

exm/zelus/cradle/dune

@@ -0,0 +1,17 @@
+(env
+ (dev
+  (flags
+   (:standard -w -a))))
+
+(rule
+ (targets cradle.ml cradle.zci format.zci)
+ (deps
+  (:zl cradle.zls)
+  (:zli format.zli))
+ (action
+  (run zeluc %{zli} %{zl})))
+
+(executable
+ (public_name cradle.exe)
+ (name main)
+ (libraries std))

exm/zelus/cradle/format.zli

@@ -0,0 +1,2 @@
+
+val printf : string -> float -> string -> unit

exm/zelus/cradle/main.ml

@@ -0,0 +1,30 @@
+
+open Std
+
+let input2 _ = ()
+let output2 (now, (h, (p0, v0), (p1, v1))) =
+  Format.printf "%.10e\t%.10e\t%.10e\n" now p0 p1
+
+let input3 _ = ()
+let output3 (now, (p0, p1, p2, h1, h2)) =
+  Format.printf "%.10e\t%.10e\t%.10e\t%.10e\t%.10e\t%.10e\n"
+  now p0 (p1 +. 1.0) (p2 +. 2.0) (h1 +. 3.0) (h2 +. 4.0)
+
+let input_main _ = ()
+let output_main (now, ()) = ()
+
+let three = ref false
+let main  = ref false
+
+let toggle y n () =
+  y := true;
+  List.iter (fun n -> n := false) n
+
+let () =
+  Runtime.register_args [
+    "-three", Arg.Unit (toggle three [main]), "\tUse the third model";
+    "-main", Arg.Unit (toggle main [three]), "\tUse the main model";
+  ];
+  if !main then Runtime.go input_main Cradle.main output_main
+  else if !three then Runtime.go input3 Cradle.cradle3 output3
+  else Runtime.go input2 Cradle.cradle2 output2

exm/zelus/cradle/ztypes.ml

@@ -0,0 +1,12 @@
+include Std
+include Ztypes
+include Solvers
+
+module type IGNORE = sig end
+module Defaultsolver : IGNORE = struct end
+
+module Zlsrun = struct
+  module Make (S : IGNORE) = struct
+    let go _ = ()
+  end
+end

exm/zelus/sincos/ztypes.ml

@@ -7,15 +7,6 @@ module Defaultsolver : IGNORE = struct end
 
 module Zlsrun = struct
   module Make (S : IGNORE) = struct
-    let go s =
-      let s = Lift.lift_hsim s in
-      let open Hsim in
-      let state = (module State.InPlaceSimState : State.SimState) in
-      let solver =
-        Solver.solver (StatefulSundials.InPlace.csolve)
-        (Types.d_of_dc StatefulZ.InPlace.zsolve) in
-      let open Sim.Sim(val state) in
-      ()
-      (* run_until_n (Utils.ignore 0 (run s solver)) 30. 1 ignore *)
+    let go _ = ()
   end
 end

exm/zelus/solve/dune

@@ -0,0 +1,17 @@
+(env
+ (dev
+  (flags
+   (:standard -w -a))))
+
+(rule
+ (targets time.ml time.zci)
+ (deps
+  (:zl time.zls)
+  (:zli solve.zli))
+ (action
+  (run zeluc %{zli} %{zl})))
+
+(executable
+ (public_name time.exe)
+ (name main)
+ (libraries std))

exm/zelus/solve/main.ml

@@ -0,0 +1,10 @@
+
+open Std
+
+let input () = ()
+let output () = flush stdout
+
+let () =
+  Runtime.parse_args ();
+  Runtime.go_discrete input Time.main output
+

exm/zelus/solve/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

exm/zelus/solve/time.zls

@@ -0,0 +1,59 @@
+
+let epsilon = 0.0001
+
+let input _ = ()
+
+let hybrid sincos() =
+  let rec der sin = cos    init 0.0
+      and der cos = -. sin init 1.0
+  in (sin, cos)
+
+let sincos_ode45    = Solve.solve_ode45(sincos)
+let sincos_sundials = Solve.solve_sundials(sincos)
+let sincos_both     = Solve.synchr(sincos_ode45)(sincos_sundials)
+
+let hybrid ball () =
+  let rec der y  = y'    init 50.0 reset z -> 0.0
+      and der y' = -9.81 init 0.0 reset z -> -0.8 *. (last y')
+      and z = up(-. y)
+  in y
+
+let ball_ode45    = Solve.solve_ode45(ball)
+let ball_sundials = Solve.solve_sundials(ball)
+let ball_both     = Solve.synchr(ball_ode45)(ball_sundials)
+
+let node print_ball_both (now, (y1, y2)) =
+  print_float(now); print_string("\t");
+  print_float(y1);  print_string("\t");
+  print_float(y2);  print_string("\n");
+  ()
+
+let node print_sincos (now, (sin, cos)) =
+  print_float now; print_string "\t";
+  print_float sin; print_string "\t";
+  print_float cos; print_string "\n"
+
+let node print_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
+  print_float now;  print_string "\t";
+  print_float sin1; print_string "\t";
+  print_float sin2; print_string "\t";
+  print_float cos1; print_string "\t";
+  print_float cos2; print_string "\n"
+
+let node check_sincos (now, (sin, cos)) =
+  print_sincos (now, (sin, cos));
+  sin <= 1.0 +. epsilon && sin >= -1.0 -. epsilon &&
+  cos <= 1.0 +. epsilon && cos >= -1.0 -. epsilon
+
+let node check_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
+  print_sincos2 (now, ((sin1, cos1), (sin2, cos2)));
+  sin1 <= 1.0 +. epsilon && sin1 >= -1.0 -. epsilon &&
+  cos1 <= 1.0 +. epsilon && cos1 >= -1.0 -. epsilon &&
+  sin2 <= 1.0 +. epsilon && sin2 >= -1.0 -. epsilon &&
+  cos2 <= 1.0 +. epsilon && cos2 >= -1.0 -. epsilon
+
+let node main() =
+  let input = Some (Solve.make (30.0, input)) fby None in
+  let o = run sincos_sundials input in
+  Solve.check_t 100 check_sincos o
+

exm/zelus/solve/ztypes.ml

@@ -0,0 +1,16 @@
+include Std
+include Ztypes
+include Solvers
+
+module type IGNORE = sig end
+module Defaultsolver : IGNORE = struct end
+
+module Zlsrun = struct
+  module Make (S : IGNORE) = struct
+    let go _ = ()
+  end
+end
+
+module Stdlib = struct
+  type nonrec 'a option = 'a option
+end

exm/zelus_2024/ball/ball.ml

@@ -0,0 +1,58 @@
+(* The Zelus compiler, version 2024-dev
+  (2025-06-4-15:49) *)
+open Ztypes
+
+type ('e, 'd, 'c, 'b, 'a) ball =
+  { mutable time: 'e; mutable major: 'd; mutable up: 'c;
+    mutable y': 'b; mutable y: 'a }
+
+let ball =
+  let machine cstate = 
+    let alloc _ =
+      cstate.cmax <- cstate.cmax + 1;
+      cstate.zmax <- cstate.zmax + 1;
+      { time = -1.;
+        major = false;
+        up = { zin = false; zout = 1. };
+        y' = -1.;
+        y = { pos = -1.; der = 0. };
+      } in
+    let step self _ =
+      let cindex = cstate.cindex in
+      let cpos = ref cindex in
+      let zindex = cstate.zindex in
+      let zpos = ref zindex in
+      cstate.cindex <- cstate.cindex + 1;
+      cstate.zindex <- cstate.zindex + 1;
+      self.major <- cstate.major;
+      self.time <- cstate.time;
+      if cstate.major then
+        for i = cindex to 0 do Zls.set cstate.dvec i 0. done
+      else begin
+        self.y.pos <- Zls.get cstate.cvec !cpos;
+        cpos := !cpos + 1
+      end;
+      let result =
+        self.up.zout <- -. self.y.pos;
+        if self.up.zin then self.y' <- -0.8 *. self.y';
+        self.y.der <- self.y';
+        self.y.pos, self.y', self.up.zin in
+      cpos := cindex;
+      if cstate.major then begin
+         Zls.set cstate.cvec !cpos self.y.pos;
+         cpos := !cpos + 1;
+         self.up.zin <- false
+      end else begin
+        self.up.zin <- Zls.get_zin cstate.zinvec !zpos;
+        zpos := !zpos + 1
+      end;
+      zpos := zindex;
+      Zls.set cstate.zoutvec !zpos self.up.zout;
+      zpos := !zpos + 1;
+      Zls.set cstate.dvec !cpos self.y.der;
+      cpos := !cpos + 1;
+      result in
+    let reset self =
+      self.y.pos <- 50.; self.y' <- 0. in
+    Node { alloc; step; reset } in
+  machine

exm/zelus_2024/ball/dune

@@ -0,0 +1,9 @@
+(env
+ (dev
+  (flags
+   (:standard -w -a))))
+
+(executable
+ (public_name newball.exe)
+ (name main)
+ (libraries std))

exm/zelus_2024/ball/main.ml

@@ -0,0 +1,7 @@
+
+open Std
+
+let input _ = ()
+let output (now, (y, _, _)) = Format.printf "%.10e\t%.10e\n" now y
+let () = Runtime.go_2024 input Ball.ball output
+

exm/zelus_2024/ball/ztypes.ml

@@ -0,0 +1,12 @@
+include Std
+include Ztypes
+include Solvers
+
+module type IGNORE = sig end
+module Defaultsolver : IGNORE = struct end
+
+module Zlsrun = struct
+  module Make (S : IGNORE) = struct
+    let go _ = ()
+  end
+end