feat: somewhat compatible with zelus output

This commit is contained in:
Henri Saudubray 2025-06-23 15:48:58 +02:00
parent 589f89c768
commit 6d92261afd
Signed by: hms
GPG key ID: 7065F57ED8856128
19 changed files with 107 additions and 515 deletions

View file

@ -1,131 +0,0 @@
(* 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 }

View file

@ -1,137 +0,0 @@
(* 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 }

View file

@ -1,135 +0,0 @@
(* 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 }

Binary file not shown.

View file

@ -2,18 +2,21 @@ let g = 9.81
let y0 = 50.0
let y'0 = 0.0
let hybrid ball (y0, y'0) = y where
let hybrid ball (y0, y'0) = (y, y', z) 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 -> (
let rec der p = 1.0 init -0.01 reset s -> -0.01
and s = up(p) in
let (y, y', z) = ball (y0, y'0) in
present z | s -> (
print_float t;
print_string "\t";
print_float y;
print_string "\t";
print_float y';
print_newline ()
); ()

6
exm/zelus/ballz/dune Normal file
View file

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

6
exm/zelus/sincos/dune Normal file
View file

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

View file

@ -1,45 +0,0 @@
(* 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 }

Binary file not shown.