feat: a lot of stuff

exm/ball.ml

@@ -1,6 +1,6 @@
 
 open Hsim.Types
-open Solvers
+open Solvers.Zls
 
 (* let hybrid bouncing () = (x, y) where
      rec der y  = y' init y0
@@ -11,8 +11,8 @@ open Solvers
 let of_array = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout
 
 type state =
-  { zin : Zls.zarray;
-    lx : Zls.carray; (* [h';h;x';x] *)
+  { zin : zarray;
+    lx  : carray; (* [h';h;x';x] *)
     i   : bool }
 
 let g   = -9.81
@@ -20,39 +20,40 @@ let y0  = 50.0
 let y'0 = 0.0
 let x0  = 0.0
 let x'0 = 1.0
+let zsize = 1
+let csize = 4
 
-let bouncing_ball () =
-  let zfalse = Zls.zmake 1 in
-  let fder _ (y: Zls.carray) (yd: Zls.carray) =
-    if true (* y.{1} >= 0.0 *) then
-      begin yd.{0} <- g; yd.{1} <- y.{0}; yd.{2} <- 0.0; yd.{3} <- y.{2} end
-    else
-      begin yd.{0} <- 0.0; yd.{1} <- 0.0; yd.{2} <- 0.0; yd.{3} <- 0.0 end in
-  let fzer _ (y: Zls.carray) (zout: Zls.carray) = zout.{0} <- -. y.{1} in
-  let fout _ (y: Zls.carray): Zls.carray = of_array [| y.{1} |] in
-  let step ({ zin; lx; _ } as s) _ : Zls.carray * state =
-    let lx = if zin.{0} = 1l then
-      of_array [| -. 0.8 *. lx.{0}; 0.0; lx.{2}; lx.{3} |] else lx in
-    of_array [| s.lx.{1} |], { zin=zfalse; lx; i=false } in
-  let cget s = s.lx in
-  let cset s lx = { s with lx } in
-  let zset s zin = { s with zin } in
-  let yd    = Zls.cmake 4 in
-  let zout  = Zls.cmake 1 in
-  let state = { zin=zfalse; lx=of_array [|y'0;y0;x'0;x0|]; i=true } in
-  let reset _ _ = state in
-  let jump _ = true in
-  let zsize = 1 in
-  HNode
-  { state = state;
-    fder = (fun _ _ y -> fder 0.0 y yd; yd);
-    fzer = (fun _ _ y -> fzer 0.0 y zout; zout);
-    fout = (fun s _ y -> fout s y);
-    step;
-    horizon = (fun _ -> max_float);
-    cset; cget; zset; reset; jump; zsize }
+let fder y yd =
+  if true (* y.{1} >= 0.0 *) then
+    begin yd.{0} <- g; yd.{1} <- y.{0}; yd.{2} <- 0.0; yd.{3} <- y.{2} end
+  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} |]
+let jump _     = true
+let horizon _  = max_float
+let cget s     = s.lx
+let cset s lx  = { s with lx }
+let zset s zin = { s with zin }
+let step ({ zin; lx; _ } as s) zfalse =
+  let lx = if zin.{0} = 1l then
+    of_array [| -. 0.8 *. lx.{0}; 0.0; lx.{2}; lx.{3} |] else lx in
+  of_array [| s.lx.{1} |], { zin=zfalse; lx; i=false }
+
+let bouncing_ball ()
+: (state, _, _, carray, carray, carray, zarray, carray) hnode
+= 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 init _     = { zin=zfalse; lx=of_array [|y'0;y0;x'0;x0|]; i=true } in
+  let reset _ _  = init () in
+  HNode { init; fder; fzer; fout; step; reset; horizon;
+          jump; cset; cget; zset; csize; zsize }
 
 let errmsg = "Too many arguments for the model (needed: 0)"
-let bouncing_ball = function
+let init = function
   | [] -> bouncing_ball ()
   | _  -> raise (Invalid_argument errmsg)

exm/model.ml

@@ -0,0 +1,8 @@
+open Hsim.Types
+open Solvers.Zls
+
+module type Model =
+  sig
+    type state
+    val init : string list -> (state, 'b, 'c, carray, carray, carray, zarray, carray) hnode
+  end

exm/sincos.ml

@@ -6,12 +6,15 @@ let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
 
 type state = { si : bool; sx : carray }
 
-let yd    = cmake 3
-let zout  = cmake 1
+let csize = 3
 let zsize = 1
 
-let fzer _ _ _ = zout
+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 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 }
 let cget s     = s.sx
 let cset s lx  = { s with sx=lx }
 let zset s _   = s
@@ -21,21 +24,20 @@ let horizon _  = max_float
 let sinus_cosinus theta0 omega =
   let sin0 = Float.sin theta0 in
   let cos0 = Float.cos theta0 in
-  let fder _ _ y =
-    yd.{0} <- omega *. y.{1}; yd.{1} <- -.omega *. y.{0}; yd.{2} <- 1.0; yd in
-  let step { si; sx } _ =
-    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 } in
-  let state     = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
-  let reset _ _ = state in
-  HNode {
-    state; fder; fzer; fout; step; horizon; cset; cget; zset; zsize; reset; jump
-  }
+  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 init _     = { sx=of_array [| sin0; cos0; 0.0 |]; si=true } in
+  let reset _ _  = init () in
+  HNode { init; fder; fzer; fout; step; reset; horizon;
+          jump; cset; cget; zset; csize; zsize }
 
 let errmsg_invalid = "Invalid arguments to model (needed: 2 floats)"
 let errmsg_few     = "Too few arguments to model (needed: 2 floats)"
 let errmsg_many    = "Too many arguments to model (needed: 2 floats)"
-let sinus_cosinus = function
+let init = function
   | [t0; om] ->
       let t0, om = try float_of_string t0, float_of_string om
       with Failure _ -> raise (Invalid_argument errmsg_invalid) in

exm/sqrt.ml

@@ -57,6 +57,7 @@ let sqrt () =
   let yd = cmake 2 in
   let zout = cmake 1 in
   let zsize = 1 in
+  let csize = 2 in
   let s_init =
     { s_encore = false;
       s_auto = Good;
@@ -64,15 +65,15 @@ let sqrt () =
       s_zin = zmake 1 } in
   let reset _ _ = s_init in
   let jump _ = true in
-  HNode { state = s_init;
+  HNode { init = (fun _ -> 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);
     horizon = (fun s -> if s.s_encore then 0.0 else max_float);
-    cset; cget; zset; zsize; reset; jump }
+    cset; cget; zset; zsize; csize; reset; jump }
 
 let errmsg = "Too many arguments to model (needed: 0)"
-let sqrt = function
+let init = function
   | [] -> sqrt ()
   | _  -> raise (Invalid_argument errmsg)

exm/vdp.ml

@@ -11,33 +11,36 @@ let mu = 5.0
 let x0 = 1.0
 let y0 = 1.0
 
+let csize = 2
 let zsize = 1
-let yd    = cmake 2
-let zout  = cmake 1
 
-let fder _ _ y =
+let fder y yd =
   yd.{0} <- y.{1};
   yd.{1} <- (mu *. (1.0 -. (y.{0} *. y.{0})) *. y.{1}) -. y.{0};
   yd
-let fzer _ _ _ = zout
 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
-let cset s lx  = { s with lx }
-let zset s _   = s
-let state      = { lx=of_array [| x0; y0 |]; i=true }
-let reset _ _  = state
-let jump _     = true
-let horizon _  = max_float
+let cget s    = s.lx
+let cset s lx = { s with lx }
+let zset s _  = s
+let jump _    = true
+let horizon _ = max_float
 
-let van_der_pol () = HNode {
-  state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset; zsize
-}
+let van_der_pol ()
+: (state, _, _, 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 init _     = { lx=of_array [| x0; y0 |]; i=true } in
+  let reset _ _  = init () in
+  HNode { init; fder; fzer; fout; step; reset; horizon;
+          jump; cset; cget; zset; csize; zsize }
 
 let errmsg = "Too many arguments for the model (needed: 0)"
-let van_der_pol = function
+let init = function
   | [] -> van_der_pol ()
   | _  -> raise (Invalid_argument errmsg)