hms/hsim
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat: start of lift, debugging, cleanup

Browse source
This commit is contained in:
Henri Saudubray 2025-06-23 10:06:01 +02:00
parent 883e5fff01
commit 589f89c768
Signed by: hms
GPG key ID: 7065F57ED8856128
31 changed files with 1297 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

8
exm/ball.ml
View file

@ -40,7 +40,7 @@ let step ({ zin; lx; _ } as s) zfalse =
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 () : (_, _, carray, carray, carray, zarray, carray) hnode =
let bouncing_ball () : (_, _, _, carray, carray, carray, zarray, carray) hrec =
let yd = cmake csize in
let zout = cmake zsize in
let zfalse = zmake 1 in
@ -49,10 +49,10 @@ let bouncing_ball () : (_, _, carray, carray, carray, zarray, carray) hnode =
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
HNode { state; fder; fzer; fout; step; reset; horizon;
jump; cset; cget; zset; csize; zsize }
{ state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset;
csize; zsize }
let errmsg = "Too many arguments for the model (needed: 0)"
let init = function
| [] -> bouncing_ball ()
| [] -> HNode (bouncing_ball ())
| _ -> raise (Invalid_argument errmsg)

6
exm/dune
View file

@ -1,3 +1,5 @@
(library
(name examples)
(libraries hsim solvers))
(name examples)
(libraries hsim solvers))
(include_subdirs unqualified)

72
exm/sin1x.ml Normal file
View file

@ -0,0 +1,72 @@
(* Example due to JB. Jeannin - zero-crossing detection *)
(* the signal x(t) is expected to have a zero-crossing at [t = 0.3] *)
(* to draw: ./main.exe -s sin_1_x -stop 2 -sample 10000 | feedgnuplot --stream --domain --lines *)
open Hsim.Types
open Solvers.Zls
(* let hybrid sin_1_x() =
let der t = 1.0 init 0.0 in
let t = t -. 0.3 in
let v = sin(1/t) in
let o = t *. (v *. v) in [that is: t *. (sin(1/t)^2]
present up(o) -> 1.0 else 0.0, o *)
let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
type ('a, 'b) state = { s_x: 'a; zin: 'b }
let csize = 1
let zsize = 1
let fder _ _ yd = yd.{0} <- 1.0
let fzer _ y zout =
let t = y.{0} in
let t = t -. 0.3 in
let v = sin(1.0 /. t) in
let o = t *. (v *. v) in
zout.{0} <- o
let fout s y =
let z = if s.zin.{0} = 1l then 1.0 else 0.0 in
let t = y.{0} in
let t = t -. 0.3 in
let v = sin(1.0 /. t) in
let o = t *. (v *. v) in
of_array [| z; o |]
let step ({ s_x; zin } as s) zfalse =
let z = if zin.{0} = 1l then 1.0 else 0.0 in
let t = s_x.{0} in
let t = t -. 0.3 in
let v = sin(1.0 /. t) in
let o = t *. (v *. v) in
of_array [| z; o |], { s with zin = zfalse }
let reset _ s = s
let cget { s_x; _ } = s_x
let cset s l_x = { s with s_x = l_x }
let zset s zin = { s with zin }
let jump _ = true
let horizon _ = max_float
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 state = { s_x = of_array [| 0.0 |]; zin = zfalse } in
{ state; fder; fzer; fout; step; reset; horizon;
cset; cget; zset; csize; zsize; jump }
let errmsg = "Too many arguments for the model (needed: 0)"
let init = function
| [] -> HNode (sin_1_x ())
| _ -> raise (Invalid_argument errmsg)

79
exm/sin1x_der.ml Normal file
View file

@ -0,0 +1,79 @@
(* Example due to JB. Jeannin - zero-crossing detection. *)
(* The same as [sin1x.ml] but with an integrator.
d(t . (sin(1/t))^2))/dt = sin(1/t)(sin(1/t) - (2 . cos(1/t)) / t)
d(sin(f(x)))/dx = cos(f(x)) f'(x) *)
open Hsim.Types
open Solvers.Zls
(* let hybrid sin_1_x() =
let der t0 = 1.0 init 0.0 in
let d = 0.6 in
let t = t0 -. d in
let der o = sin(1.0 /. t) *. (sin(1.0 /. t) -. (2.0 *. cos(1.0 /. t)) /. t)
init (-. d *. (sin(1.0 /. (-. d))) ** 2.0) in
present up(o) -> 1.0 else 0.0, o *)
let of_array a = Bigarray.Array1.of_array Bigarray.Float64 Bigarray.c_layout a
type ('a, 'b) state = { s_x: 'a; zin: 'b }
let d = 0.66
let y0 = -. d *. let v = (sin(1.0 /. (-. d))) in v *. v
let csize = 2
let zsize = 1
let fder d y yd =
yd.{0} <- 1.0;
let t = y.{0} -. d in
yd.{1} <- sin(1.0 /. t) *. (sin(1.0 /. t) -. (2.0 *. cos(1.0 /. t)) /. t)
let fzer z y zout =
let o = y.{1} in
zout.{0} <- if z then o else 1.0
let fout s y =
let z = if s.zin.{0} = 1l then 1.0 else 0.0 in
let o = y.{1} in
of_array [| z; o |]
let step ({ s_x; zin } as s) zfalse =
let z = if zin.{0} = 1l then 1.0 else -1.0 in
let o = s_x.{1} in
of_array [| z; o |], { s with zin = zfalse }
let reset _ s = s
let cget { s_x; _ } = s_x
let cset s l_x = { s with s_x = l_x }
let zset s zin = { s with zin }
let horizon _ = max_float
let jump _ = true
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 state = { s_x = of_array [| 0.0; y0 |]; zin = zfalse } in
{ state; fder; fzer; fout; step; horizon;
cset; cget; zset; csize; zsize; reset; jump }
let errmsg_many = "Too many arguments to model (needed: [bool, float])"
let errmsg_few = "Too few arguments to model (needed: [bool, float])"
let errmsg_invalid = "Invalid arguments to model (needed: [bool, float])"
let init = function
| [zer; d] ->
let zer, d = try bool_of_string zer, float_of_string d
with _ -> raise (Invalid_argument errmsg_invalid) in
HNode (sin_1_x zer d)
| [] | [_] -> raise (Invalid_argument errmsg_few)
| _ -> raise (Invalid_argument errmsg_many)

8
exm/sincos.ml
View file

@ -34,11 +34,11 @@ let sinus_cosinus theta0 omega =
HNode { state; 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 errmsg_invalid = "Invalid arguments to model (needed: [float, float])"
let errmsg_few = "Too few arguments to model (needed: [float, float])"
let errmsg_many = "Too many arguments to model (needed: [float, float])"
let init = function
| [t0; om] ->
| [om; t0] ->
let t0, om = try float_of_string t0, float_of_string om
with Failure _ -> raise (Invalid_argument errmsg_invalid) in
sinus_cosinus t0 om

131
exm/zelus/ballz/ballz.ml Normal file
View file

@ -0,0 +1,131 @@
(* The Zelus compiler, version 2.2-dev
(2025-06-16-15:24) *)
open Common
open Ztypes
open Solvers
let (+=) r v = r := !r + v
let g = 9.81
let y0 = 50.
let y'0 = 0.
type ball =
{ mutable major : bool;
mutable h : float;
mutable init : bool;
mutable z : (bool, float) zerocrossing;
mutable y' : float continuous;
mutable y : float continuous }
let ball cstate =
let ball_alloc _ =
cstate.cmax <- cstate.cmax + 2;
cstate.zmax <- cstate.zmax + 1;
{ major = false;
h = 42.;
init = false;
z = { zin = false; zout = 1. };
y' = { pos = 42.; der = 0. };
y = { pos = 42.; der = 0. }
} in
let ball_step self (_, ()) =
let cidx = cstate.cindex in let cpos = ref cidx in
let zidx = cstate.zindex in let zpos = ref zidx in
cstate.cindex <- cstate.cindex + 2;
cstate.zindex <- cstate.zindex + 1;
self.major <- cstate.major;
if cstate.major then
for i = cidx to 1 do Zls.set cstate.dvec i 0. done
else begin
self.y'.pos <- Zls.get cstate.cvec !cpos; cpos += 1;
self.y.pos <- Zls.get cstate.cvec !cpos; cpos += 1
end;
let res0, res1 =
let encore = ref false in
if self.init then self.y'.pos <- y'0;
let last_y' = self.y'.pos in
if self.z.zin then begin
encore := true; self.y'.pos <- -0.8 *. last_y'
end;
self.h <- if !encore then 0. else infinity;
if self.init then self.y.pos <- y0;
self.init <- false;
self.z.zout <- -. self.y.pos;
self.y'.der <- -. g;
self.y.der <- self.y'.pos;
self.y.pos, self.y.der
in
cstate.horizon <- min cstate.horizon self.h;
cpos := cidx;
if cstate.major then begin
Zls.set cstate.cvec !cpos self.y'.pos; cpos += 1;
Zls.set cstate.cvec !cpos self.y.pos; cpos += 1;
self.z.zin <- false
end else begin
self.z.zin <- Zls.get_zin cstate.zinvec !zpos; zpos += 1;
zpos := zidx;
Zls.set cstate.zoutvec !zpos self.z.zout; zpos += 1;
Zls.set cstate.dvec !cpos self.y'.der; cpos += 1;
Zls.set cstate.dvec !cpos self.y.der; cpos += 1
end;
Bigarray.(Array1.of_array Float64 c_layout [| res0; res1 |]) in
let ball_reset self = self.init <- true in
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
type ('f , 'e , 'd , 'c , 'b , 'a) _main =
{ mutable i_73 : 'f ;
mutable major_62 : 'e ;
mutable h_72 : 'd ;
mutable i_70 : 'c ; mutable h_68 : 'b ; mutable t_63 : 'a }
let main (cstate_80:Ztypes.cstate) =
let Node { alloc = i_73_alloc; step = i_73_step ; reset = i_73_reset } = ball
cstate_80 in
let main_alloc _ =
cstate_80.cmax <- (+) cstate_80.cmax 1;
{ major_62 = false ;
h_72 = 42. ;
i_70 = (false:bool) ;
h_68 = (42.:float) ; t_63 = { pos = 42.; der = 0. };
i_73 = i_73_alloc () (* continuous *) } in
let main_step self ((time_61:float) , ()) =
((let (cindex_81:int) = cstate_80.cindex in
let cpos_83 = ref (cindex_81:int) in
cstate_80.cindex <- (+) cstate_80.cindex 1 ;
self.major_62 <- cstate_80.major ;
(if cstate_80.major then
for i_1 = cindex_81 to 0 do Zls.set cstate_80.dvec i_1 0. done
else ((self.t_63.pos <- Zls.get cstate_80.cvec !cpos_83 ;
cpos_83 := (+) !cpos_83 1))) ;
(let (result_85) =
let h_71 = ref (infinity:float) in
(if self.i_70 then self.h_68 <- (+.) time_61 0.) ;
(let (z_69:bool) = (&&) self.major_62 ((>=) time_61 self.h_68) in
self.h_68 <- (if z_69 then (+.) self.h_68 0.01 else self.h_68) ;
h_71 := min !h_71 self.h_68 ;
self.h_72 <- !h_71 ;
self.i_70 <- false ;
self.t_63.der <- 1. ;
(let (y_64:float) = (i_73_step self.i_73 (time_61 , ())).{0} in
(begin match z_69 with
| true -> Printf.printf "%.10e\t%.10e\n" self.t_63.pos y_64
| _ -> () end) ;
Bigarray.(Array1.create Float64 c_layout 0))) in
cstate_80.horizon <- min cstate_80.horizon self.h_72 ;
cpos_83 := cindex_81 ;
(if cstate_80.major then
(((Zls.set cstate_80.cvec !cpos_83 self.t_63.pos ;
cpos_83 := (+) !cpos_83 1)))
else (((Zls.set cstate_80.dvec !cpos_83 self.t_63.der ;
cpos_83 := (+) !cpos_83 1)))) ; result_85))) in
let main_reset self =
((self.i_70 <- true ; self.t_63.pos <- 0. ; i_73_reset self.i_73 ):
unit) in
Node { alloc = main_alloc; step = main_step ; reset = main_reset }

137
exm/zelus/ballz/ballz.ml.bak Normal file
View file

@ -0,0 +1,137 @@
(* The Zelus compiler, version 2.2-dev
(2025-06-16-15:24) *)
open Common
open Ztypes
open Solvers
let g = 9.81
let y0 = 50.
let y'0 = 0.
type ('g , 'f , 'e , 'd , 'c , 'b , 'a) _ball =
{ mutable major_50 : 'g ;
mutable h_60 : 'f ;
mutable h_58 : 'e ;
mutable i_56 : 'd ;
mutable x_55 : 'c ; mutable y'_52 : 'b ; mutable y_51 : 'a }
let ball (cstate_74:Ztypes.cstate) =
let ball_alloc _ =
cstate_74.cmax <- (+) cstate_74.cmax 2 ;
cstate_74.zmax <- (+) cstate_74.zmax 1;
{ major_50 = false ;
h_60 = 42. ;
h_58 = (42.:float) ;
i_56 = (false:bool) ;
x_55 = { zin = false; zout = 1. } ;
y'_52 = { pos = 42.; der = 0. } ; y_51 = { pos = 42.; der = 0. } } in
let ball_step self ((_time_49:float) , ((y0_48:float) , (y'0_47:float))) =
Printf.printf "STEP (%d)\n" cstate_74.cindex;
((let (cindex_75:int) = cstate_74.cindex in
let cpos_77 = ref (cindex_75:int) in
let (zindex_76:int) = cstate_74.zindex in
let zpos_78 = ref (zindex_76:int) in
cstate_74.cindex <- (+) cstate_74.cindex 2 ;
cstate_74.zindex <- (+) cstate_74.zindex 1 ;
self.major_50 <- cstate_74.major ;
(if cstate_74.major then
for i_1 = cindex_75 to 1 do Zls.set cstate_74.dvec i_1 0. done
else ((self.y'_52.pos <- Zls.get cstate_74.cvec !cpos_77 ;
cpos_77 := (+) !cpos_77 1) ;
(self.y_51.pos <- Zls.get cstate_74.cvec !cpos_77 ;
cpos_77 := (+) !cpos_77 1))) ;
(let (result_79:float) =
let h_59 = ref (infinity:float) in
let encore_57 = ref (false:bool) in
(if self.i_56 then self.y'_52.pos <- y'0_47) ;
(let (l_54:float) = self.y'_52.pos in
(begin match self.x_55.zin with
| true ->
encore_57 := true ;
self.y'_52.pos <- ( *. ) (-0.8) l_54 | _ -> () end)
;
self.h_58 <- (if !encore_57 then 0. else infinity) ;
h_59 := min !h_59 self.h_58 ;
self.h_60 <- !h_59 ;
(if self.i_56 then self.y_51.pos <- y0_48) ;
self.i_56 <- false ;
self.x_55.zout <- (~-.) self.y_51.pos ;
self.y'_52.der <- (~-.) g ;
self.y_51.der <- self.y'_52.pos ; self.y_51.pos) in
cstate_74.horizon <- min cstate_74.horizon self.h_60 ;
cpos_77 := cindex_75 ;
(if cstate_74.major then
(((Printf.printf "idx: %d\n" !cpos_77;
Zls.set cstate_74.cvec !cpos_77 self.y'_52.pos ;
cpos_77 := (+) !cpos_77 1) ;
(Zls.set cstate_74.cvec !cpos_77 self.y_51.pos ;
cpos_77 := (+) !cpos_77 1)) ; ((self.x_55.zin <- false)))
else (((self.x_55.zin <- Zls.get_zin cstate_74.zinvec !zpos_78 ;
zpos_78 := (+) !zpos_78 1)) ;
zpos_78 := zindex_76 ;
((Zls.set cstate_74.zoutvec !zpos_78 self.x_55.zout ;
zpos_78 := (+) !zpos_78 1)) ;
((Zls.set cstate_74.dvec !cpos_77 self.y'_52.der ;
cpos_77 := (+) !cpos_77 1) ;
(Zls.set cstate_74.dvec !cpos_77 self.y_51.der ;
cpos_77 := (+) !cpos_77 1)))) ; result_79)):float) in
let ball_reset self =
(self.i_56 <- true:unit) in
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
type ('f , 'e , 'd , 'c , 'b , 'a) _main =
{ mutable main_ball : 'f ;
mutable main_major : 'e ;
mutable h_72 : 'd; mutable i_70 : 'c; mutable h : 'b;
mutable t_63 : 'a }
let main cs =
let Node
{ alloc = ball_alloc;
step = ball_step;
reset = ball_reset } = ball cs in
let main_alloc _ =
cs.cmax <- cs.cmax + 1;
{ main_major = false;
h_72 = 42.0; i_70 = false; h = 42.0;
t_63 = { pos = 42.; der = 0. };
main_ball = ball_alloc () } in
let main_step self (time, ()) =
let cindex = cs.cindex in
let cpos = ref cindex in
Printf.printf "main:cindex: %d\n" cs.cindex;
cs.cindex <- cs.cindex + 1;
self.main_major <- cs.major;
if cs.major then for i = cindex to 0 do Zls.set cs.dvec i 0. done
else begin self.t_63.pos <- Zls.get cs.cvec !cpos; cpos := !cpos + 1 end;
let result =
if self.i_70 then self.h <- time;
let z = self.main_major && (time >= self.h) in
if z then self.h <- self.h +. 0.01;
self.h_72 <- min infinity self.h;
self.i_70 <- false;
self.t_63.der <- 1.;
let y_64 = ball_step self.main_ball (time, (y0, y'0)) in
if z then begin
print_float self.t_63.pos;
print_string "\t";
print_float y_64;
print_newline ()
end;
Bigarray.(Array1.create Float64 c_layout 0) in
cs.horizon <- min cs.horizon self.h_72;
cpos := cindex;
if cs.major then Zls.set cs.cvec !cpos self.t_63.pos
else Zls.set cs.dvec !cpos self.t_63.der;
result in
let main_reset self =
self.i_70 <- true;
self.t_63.pos <- 0.;
ball_reset self.main_ball in
Node { alloc = main_alloc; step = main_step ; reset = main_reset }

135
exm/zelus/ballz/ballz.ml.bak2 Normal file
View file

@ -0,0 +1,135 @@
(* The Zelus compiler, version 2.2-dev
(2025-06-16-15:24) *)
open Common
open Ztypes
open Solvers
let g = 9.81
let y0 = 50.
let y'0 = 0.
type ('g , 'f , 'e , 'd , 'c , 'b , 'a) _ball =
{ mutable major_50 : 'g ;
mutable h_60 : 'f ;
mutable h_58 : 'e ;
mutable i_56 : 'd ;
mutable x_55 : 'c ; mutable y'_52 : 'b ; mutable y_51 : 'a }
let ball (cstate_74:Ztypes.cstate) =
let ball_alloc _ =
cstate_74.cmax <- (+) cstate_74.cmax 2 ;
cstate_74.zmax <- (+) cstate_74.zmax 1;
{ major_50 = false ;
h_60 = 42. ;
h_58 = (42.:float) ;
i_56 = (false:bool) ;
x_55 = { zin = false; zout = 1. } ;
y'_52 = { pos = 42.; der = 0. } ; y_51 = { pos = 42.; der = 0. } } in
let ball_step self ((_time_49:float) , ()) =
((let (cindex_75:int) = cstate_74.cindex in
let cpos_77 = ref (cindex_75:int) in
let (zindex_76:int) = cstate_74.zindex in
let zpos_78 = ref (zindex_76:int) in
cstate_74.cindex <- (+) cstate_74.cindex 2 ;
cstate_74.zindex <- (+) cstate_74.zindex 1 ;
self.major_50 <- cstate_74.major ;
(if cstate_74.major then
for i_1 = cindex_75 to 1 do Zls.set cstate_74.dvec i_1 0. done
else ((self.y'_52.pos <- Zls.get cstate_74.cvec !cpos_77 ;
cpos_77 := (+) !cpos_77 1) ;
(self.y_51.pos <- Zls.get cstate_74.cvec !cpos_77 ;
cpos_77 := (+) !cpos_77 1))) ;
(let (result_79:float) =
let h_59 = ref (infinity:float) in
let encore_57 = ref (false:bool) in
(if self.i_56 then self.y'_52.pos <- y'0) ;
(let (l_54:float) = self.y'_52.pos in
begin match self.x_55.zin with
| true ->
encore_57 := true ;
self.y'_52.pos <- ( *. ) (-0.8) l_54 | _ -> () end;
self.h_58 <- (if !encore_57 then 0. else infinity) ;
h_59 := min !h_59 self.h_58 ;
self.h_60 <- !h_59 ;
(if self.i_56 then self.y_51.pos <- y0) ;
self.i_56 <- false ;
self.x_55.zout <- (~-.) self.y_51.pos ;
self.y'_52.der <- (~-.) g ;
self.y_51.der <- self.y'_52.pos ; self.y_51.pos) in
cstate_74.horizon <- min cstate_74.horizon self.h_60 ;
cpos_77 := cindex_75 ;
(if cstate_74.major then
(((Zls.set cstate_74.cvec !cpos_77 self.y'_52.pos ;
cpos_77 := (+) !cpos_77 1) ;
(Zls.set cstate_74.cvec !cpos_77 self.y_51.pos ;
cpos_77 := (+) !cpos_77 1)) ; ((self.x_55.zin <- false)))
else (((self.x_55.zin <- Zls.get_zin cstate_74.zinvec !zpos_78 ;
zpos_78 := (+) !zpos_78 1)) ;
zpos_78 := zindex_76 ;
((Zls.set cstate_74.zoutvec !zpos_78 self.x_55.zout ;
zpos_78 := (+) !zpos_78 1)) ;
((Zls.set cstate_74.dvec !cpos_77 self.y'_52.der ;
cpos_77 := (+) !cpos_77 1) ;
(Zls.set cstate_74.dvec !cpos_77 self.y_51.der ;
cpos_77 := (+) !cpos_77 1)))) ;
Bigarray.(Array1.of_array Float64 c_layout [| result_79 |])))) in
let ball_reset self =
(self.i_56 <- true:unit) in
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
type ('f , 'e , 'd , 'c , 'b , 'a) _main =
{ mutable i_73 : 'f ;
mutable major_62 : 'e ;
mutable h_72 : 'd ;
mutable i_70 : 'c ; mutable h_68 : 'b ; mutable t_63 : 'a }
let main (cstate_80:Ztypes.cstate) =
let Node { alloc = i_73_alloc; step = i_73_step ; reset = i_73_reset } = ball
cstate_80 in
let main_alloc _ =
cstate_80.cmax <- (+) cstate_80.cmax 1;
{ major_62 = false ;
h_72 = 42. ;
i_70 = (false:bool) ;
h_68 = (42.:float) ; t_63 = { pos = 42.; der = 0. };
i_73 = i_73_alloc () (* continuous *) } in
let main_step self ((time_61:float) , ()) =
((let (cindex_81:int) = cstate_80.cindex in
let cpos_83 = ref (cindex_81:int) in
cstate_80.cindex <- (+) cstate_80.cindex 1 ;
self.major_62 <- cstate_80.major ;
(if cstate_80.major then
for i_1 = cindex_81 to 0 do Zls.set cstate_80.dvec i_1 0. done
else ((self.t_63.pos <- Zls.get cstate_80.cvec !cpos_83 ;
cpos_83 := (+) !cpos_83 1))) ;
(let (result_85) =
let h_71 = ref (infinity:float) in
(if self.i_70 then self.h_68 <- (+.) time_61 0.) ;
(let (z_69:bool) = (&&) self.major_62 ((>=) time_61 self.h_68) in
self.h_68 <- (if z_69 then (+.) self.h_68 0.01 else self.h_68) ;
h_71 := min !h_71 self.h_68 ;
self.h_72 <- !h_71 ;
self.i_70 <- false ;
self.t_63.der <- 1. ;
(let (y_64:float) = (i_73_step self.i_73 (time_61 , ())).{0} in
(begin match z_69 with
| true -> Printf.printf "%.10e\t%.10e\n" self.t_63.pos y_64
| _ -> () end) ;
Bigarray.(Array1.create Float64 c_layout 0))) in
cstate_80.horizon <- min cstate_80.horizon self.h_72 ;
cpos_83 := cindex_81 ;
(if cstate_80.major then
(((Zls.set cstate_80.cvec !cpos_83 self.t_63.pos ;
cpos_83 := (+) !cpos_83 1)))
else (((Zls.set cstate_80.dvec !cpos_83 self.t_63.der ;
cpos_83 := (+) !cpos_83 1)))) ; result_85))) in
let main_reset self =
((self.i_70 <- true ; self.t_63.pos <- 0. ; i_73_reset self.i_73 ):
unit) in
Node { alloc = main_alloc; step = main_step ; reset = main_reset }

BIN
exm/zelus/ballz/ballz.zci Normal file
View file

Binary file not shown.

19
exm/zelus/ballz/ballz.zls Normal file
View file

@ -0,0 +1,19 @@
let g = 9.81
let y0 = 50.0
let y'0 = 0.0
let hybrid ball (y0, y'0) = y where
rec der y = y' init y0
and der y' = -. g init y'0 reset z -> -0.8 *. (last y')
and z = up(-. y)
let hybrid main () =
let der t = 1.0 init 0.0 in
let y = ball (y0, y'0) in
let z = period(0.01) in
present z -> (
print_float t;
print_string "\t";
print_float y;
print_newline ()
); ()

74
exm/zelus/sin_1_x.ml Normal file
View file

@ -0,0 +1,74 @@
(* The Zelus compiler, version 2.2-dev
(2025-06-16-15:24) *)
open Common
open Ztypes
open Solvers
(* open Zls *)
type ('f , 'e , 'd , 'c , 'b , 'a) _sin_1_x =
{ mutable major_22 : 'f ;
mutable i_29 : 'e ;
mutable x_28 : 'd ;
mutable result_27 : 'c ; mutable o_26 : 'b ; mutable t0_23 : 'a }
let sin_1_x (cstate_30:Ztypes.cstate) =
let sin_1_x_alloc _ =
cstate_30.cmax <- (+) cstate_30.cmax 2 ;
cstate_30.zmax <- (+) cstate_30.zmax 1;
{ major_22 = false ;
i_29 = (false:bool) ;
x_28 = { zin = false; zout = 1. } ;
result_27 = (42.:float) ;
o_26 = { pos = 42.; der = 0. } ; t0_23 = { pos = 42.; der = 0. } } in
let sin_1_x_step self ((_time_21:float) , ()) =
((let (cindex_31:int) = cstate_30.cindex in
let cpos_33 = ref (cindex_31:int) in
let (zindex_32:int) = cstate_30.zindex in
let zpos_34 = ref (zindex_32:int) in
cstate_30.cindex <- (+) cstate_30.cindex 2 ;
cstate_30.zindex <- (+) cstate_30.zindex 1 ;
self.major_22 <- cstate_30.major ;
(if cstate_30.major then
for i_1 = cindex_31 to 1 do Zls.set cstate_30.dvec i_1 0. done
else ((self.o_26.pos <- Zls.get cstate_30.cvec !cpos_33 ;
cpos_33 := (+) !cpos_33 1) ;
(self.t0_23.pos <- Zls.get cstate_30.cvec !cpos_33 ;
cpos_33 := (+) !cpos_33 1))) ;
(let (result_35:(float * float)) =
(if self.i_29 then
self.o_26.pos <- ( *. ) ((~-.) 0.6)
(( ** ) (sin ((/.) 1. ((~-.) 0.6))) 2.))
;
self.i_29 <- false ;
self.t0_23.der <- 1. ;
(let (t_25:float) = (-.) self.t0_23.pos 0.6 in
self.o_26.der <- ( *. ) (sin ((/.) 1. t_25))
((-.) (sin ((/.) 1. t_25))
((/.) (( *. ) 2.
(cos ((/.) 1. t_25)))
t_25)) ;
self.x_28.zout <- self.o_26.pos ;
(begin match self.x_28.zin with
| true -> self.result_27 <- 1.
| _ -> self.result_27 <- 0. end) ;
(self.result_27 , self.o_26.pos)) in
cpos_33 := cindex_31 ;
(if cstate_30.major then
(((Zls.set cstate_30.cvec !cpos_33 self.o_26.pos ;
cpos_33 := (+) !cpos_33 1) ;
(Zls.set cstate_30.cvec !cpos_33 self.t0_23.pos ;
cpos_33 := (+) !cpos_33 1)) ; ((self.x_28.zin <- false)))
else (((self.x_28.zin <- Zls.get_zin cstate_30.zinvec !zpos_34 ;
zpos_34 := (+) !zpos_34 1)) ;
zpos_34 := zindex_32 ;
((Zls.set cstate_30.zoutvec !zpos_34 self.x_28.zout ;
zpos_34 := (+) !zpos_34 1)) ;
((Zls.set cstate_30.dvec !cpos_33 self.o_26.der ;
cpos_33 := (+) !cpos_33 1) ;
(Zls.set cstate_30.dvec !cpos_33 self.t0_23.der ;
cpos_33 := (+) !cpos_33 1)))) ; result_35)):float * float) in
let sin_1_x_reset self =
((self.i_29 <- true ; self.t0_23.pos <- 0.):unit) in
Node { alloc = sin_1_x_alloc; step = sin_1_x_step ; reset = sin_1_x_reset }

BIN
exm/zelus/sin_1_x.zci Normal file
View file

Binary file not shown.

7
exm/zelus/sin_1_x.zls Normal file
View file

@ -0,0 +1,7 @@
let hybrid sin_1_x () =
let der t0 = 1.0 init 0.0 in
let d = 0.6 in
let t = t0 -. d in
let der o = sin(1.0 /. t) *. (sin(1.0 /. t) -. (2.0 *. cos(1.0 /. t)) /. t)
init (-. d *. (sin(1.0 /. (-. d))) ** 2.0) in
(present up(o) -> 1.0 else 0.0), o

45
exm/zelus/sincos/sincosz.ml Normal file
View file

@ -0,0 +1,45 @@
(* The Zelus compiler, version 2.2-dev
(2025-06-16-15:24) *)
open Common
open Ztypes
open Solvers
type ('c , 'b , 'a) _f =
{ mutable major_11 : 'c ; mutable sin_13 : 'b ; mutable cos_12 : 'a }
let f (cstate_14:Ztypes.cstate) =
let f_alloc _ =
cstate_14.cmax <- (+) cstate_14.cmax 2;
{ major_11 = false ;
sin_13 = { pos = 42.; der = 0. } ; cos_12 = { pos = 42.; der = 0. } } in
let f_step self ((_time_10:float) , ()) =
((let (cindex_15:int) = cstate_14.cindex in
let cpos_17 = ref (cindex_15:int) in
cstate_14.cindex <- (+) cstate_14.cindex 2 ;
self.major_11 <- cstate_14.major ;
(if cstate_14.major then
for i_1 = cindex_15 to 1 do Zls.set cstate_14.dvec i_1 0. done
else ((self.sin_13.pos <- Zls.get cstate_14.cvec !cpos_17 ;
cpos_17 := (+) !cpos_17 1) ;
(self.cos_12.pos <- Zls.get cstate_14.cvec !cpos_17 ;
cpos_17 := (+) !cpos_17 1))) ;
(let (result_19) =
self.cos_12.der <- (~-.) self.sin_13.pos ;
self.sin_13.der <- self.cos_12.pos ;
Bigarray.(Array1.of_array Float64 c_layout
[| self.sin_13.pos; self.cos_12.pos |]) in
cpos_17 := cindex_15 ;
(if cstate_14.major then
(((Zls.set cstate_14.cvec !cpos_17 self.sin_13.pos ;
cpos_17 := (+) !cpos_17 1) ;
(Zls.set cstate_14.cvec !cpos_17 self.cos_12.pos ;
cpos_17 := (+) !cpos_17 1)))
else (((Zls.set cstate_14.dvec !cpos_17 self.sin_13.der ;
cpos_17 := (+) !cpos_17 1) ;
(Zls.set cstate_14.dvec !cpos_17 self.cos_12.der ;
cpos_17 := (+) !cpos_17 1)))) ; result_19))) in
let f_reset self =
((self.sin_13.pos <- 0. ; self.cos_12.pos <- 1.):unit) in
Node { alloc = f_alloc; step = f_step ; reset = f_reset }

BIN
exm/zelus/sincos/sincosz.zci Normal file
View file

Binary file not shown.

4
exm/zelus/sincos/sincosz.zls Normal file
View file

@ -0,0 +1,4 @@
let hybrid f () = (sin, cos) where
rec der sin = cos init 0.0
and der cos = -. sin init 1.0