feat: support for model-requested horizons

exm/ball.ml

@@ -29,7 +29,7 @@ let fder y yd =
   else begin yd.{0} <- 0.0; yd.{1} <- 0.0; yd.{2} <- 0.0; yd.{3} <- 0.0 end;
   yd
 let fzer y zo  = zo.{0} <- -. y.{1}; zo
-let fout _ _ y = of_array [| y.{1}; y.{0} |]
+let fout _ _ _ y = of_array [| y.{1}; y.{0} |]
 let jump _     = true
 let horizon _  = max_float
 let cget s     = s.lx
@@ -44,9 +44,9 @@ let bouncing_ball () : (_, _, _, carray, carray, carray, zarray, carray) hrec =
   let yd         = cmake csize in
   let zout       = cmake zsize in
   let zfalse     = zmake 1 in
-  let fder _ _ y = fder y yd in
-  let fzer _ _ y = fzer y zout in
-  let step s _   = step s zfalse in
+  let fder _ _ _ y = fder y yd in
+  let fzer _ _ _  y = fzer y zout in
+  let step s _ _   = step s zfalse in
   let state      = { zin=zfalse; lx=of_array [|y'0;y0;x'0;x0|]; i=true } in
   let reset _ _  = state in
   { state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset;

exm/dune

@@ -5,6 +5,9 @@
 
 (library
  (name examples)
- (libraries hsim solvers))
+ (libraries hsim solvers std))
+
+; (executable
+;  (name ballz_main))
 
 (include_subdirs unqualified)

exm/sin1x.ml

@@ -58,10 +58,10 @@ let sin_1_x () =
   let zfalse = zmake 1 in
   let yd     = cmake 1 in
   let zout   = cmake 1 in
-  let fder _ _ y = fder 0.0 y yd; yd in
-  let fzer _ _ y = fzer 0.0 y zout; zout in
-  let fout s _ y = fout s y in
-  let step s _ = step s zfalse in
+  let fder _ _ _ y = fder 0.0 y yd; yd in
+  let fzer _ _ _ y = fzer 0.0 y zout; zout in
+  let fout s _ _ y = fout s y in
+  let step s _ _ = step s zfalse in
   let state = { s_x = of_array [| 0.0 |]; zin = zfalse } in
   { state; fder; fzer; fout; step; reset; horizon;
     cset; cget; zset; csize; zsize; jump }

exm/sin1x_der.ml

@@ -58,10 +58,10 @@ let sin_1_x z d =
   let zfalse = zmake 1 in
   let yd     = cmake 2 in
   let zout   = cmake 1 in
-  let fder _ _ y = fder d y yd; yd in
-  let fzer _ _ y = fzer z y zout; zout in
-  let fout s _ y = fout s y in
-  let step s _ = step s zfalse in
+  let fder _ _ _ y = fder d y yd; yd in
+  let fzer _ _ _ y = fzer z y zout; zout in
+  let fout s _ _ y = fout s y in
+  let step s _  _ = step s zfalse in
   let state = { s_x = of_array [| 0.0; y0 |]; zin = zfalse } in
   { state; fder; fzer; fout; step; horizon;
     cset; cget; zset; csize; zsize; reset; jump }

exm/sincos.ml

@@ -11,7 +11,7 @@ let zsize = 1
 
 let fder y yd omega =
   yd.{0} <- omega *. y.{1}; yd.{1} <- -.omega *. y.{0}; yd.{2} <- 1.0; yd
-let fout _ _ y = of_array [| y.{0}; y.{1}; y.{2} |]
+let fout _ _ _ y = of_array [| y.{0}; y.{1}; y.{2} |]
 let step { si; sx } sin0 cos0 =
   let sx = if si then of_array [| sin0; cos0; 0.0 |] else sx in
   of_array [| sx.{0}; sx.{1}; sx.{2} |], { sx; si=false }
@@ -26,9 +26,9 @@ let sinus_cosinus theta0 omega =
   let cos0 = Float.cos theta0 in
   let yd   = cmake csize in
   let zout = cmake zsize in
-  let fder _ _ y = fder y yd omega in
-  let fzer _ _ _ = zout in
-  let step s _   = step s sin0 cos0 in
+  let fder _ _ _ y = fder y yd omega in
+  let fzer _ _ _ _ = zout in
+  let step s _ _   = step s sin0 cos0 in
   let state      = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
   let reset _ _  = state in
   HNode { state; fder; fzer; fout; step; reset; horizon;

exm/sqrt.ml

@@ -66,10 +66,10 @@ let sqrt () =
   let reset _ _ = s_init in
   let jump _ = true in
   HNode { state = s_init;
-    fder = (fun s _ y -> fder s y yd; yd);
-    fzer = (fun s _ y -> fzero s y zout; zout);
-    fout = (fun s _ y -> fout s y);
-    step = (fun s a -> fstep s a);
+    fder = (fun s _ _ y -> fder s y yd; yd);
+    fzer = (fun s _ _ y -> fzero s y zout; zout);
+    fout = (fun s _ _ y -> fout s y);
+    step = (fun s _ a -> fstep s a);
     horizon = (fun s -> if s.s_encore then 0.0 else max_float);
     cset; cget; zset; zsize; csize; reset; jump }
 

exm/vdp.ml

@@ -18,8 +18,8 @@ let fder y yd =
   yd.{0} <- y.{1};
   yd.{1} <- (mu *. (1.0 -. (y.{0} *. y.{0})) *. y.{1}) -. y.{0};
   yd
-let fout _ _ y = of_array [| y.{0}; y.{1} |]
-let step { i; lx } _ =
+let fout _ _ _ y = of_array [| y.{0}; y.{1} |]
+let step { i; lx } _ _ =
   let lx = if i then of_array [| x0; y0 |] else lx in
   of_array [| lx.{0}; lx.{1} |], { lx; i=false }
 let cget s    = s.lx
@@ -31,8 +31,8 @@ let horizon _ = max_float
 let van_der_pol () : (_, _, carray, carray, carray, zarray, carray) hnode =
   let yd         = cmake csize in
   let zout       = cmake zsize in
-  let fder _ _ y = fder y yd in
-  let fzer _ _ _ = zout in
+  let fder _ _ _ y = fder y yd in
+  let fzer _ _ _ _ = zout in
   let state      = { lx=of_array [| x0; y0 |]; i=true } in
   let reset _ _  = state in
   HNode { state; fder; fzer; fout; step; reset; horizon;

exm/zelus/ballz/ballz.zls

@@ -9,8 +9,7 @@ let hybrid ball (y0, y'0) = (y, y', z) where
 
 let hybrid main () =
   let der t = 1.0 init 0.0 in
-  let rec der p = 1.0 init -0.01 reset s -> -0.01
-      and s = up(p) in 
+  let s = period(0.01) in
   let (y, y', z) = ball (y0, y'0) in
   present z | s -> (
     print_float t;

exm/zelus/ballz/dune

@@ -1,6 +1,6 @@
 (rule
- (targets ballz.ml ballz.zci)
+ (targets ballz.ml ballz.zci ballz_main.ml)
  (deps
   (:zl ballz.zls))
  (action
-  (run zeluc %{zl})))
+  (run zeluc -s main -o ballz_main %{zl})))

exm/zelus/count/count.zls

@@ -0,0 +1,4 @@
+
+let node count () =
+  let rec n = 0 -> (pre n + 1) in
+  print_int n; print_newline ()

exm/zelus/count/dune

@@ -0,0 +1,6 @@
+(rule
+ (targets count.ml count.zci)
+ (deps
+  (:zl count.zls))
+ (action
+  (run zeluc %{zl})))

exm/zelus/sincos/sincosz.zls

@@ -1,4 +1,17 @@
 
-let hybrid f () = (sin, cos) where
+let hybrid g () = (sin, cos) where
   rec der sin = cos init 0.0
   and der cos = -. sin init 1.0
+
+let hybrid f () =
+  let der t = 1.0 init 0.0 in
+  let sin, cos = g () in
+  let z = period (0.01) in
+  present z -> (
+    print_float t;
+    print_string "\t";
+    print_float sin;
+    print_string "\t";
+    print_float cos;
+    print_newline ()
+  ); ()

exm/ztypes.ml

@@ -1,4 +1,21 @@
-include Common
+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