feat: somewhat compatible with zelus output
This commit is contained in:
parent
589f89c768
commit
6d92261afd
GPG key ID:
7065F57ED8856128
19 changed files with 107 additions and 515 deletions
|
|
@ -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 }
|
||||
|
|
@ -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 }
|
||||
|
|
@ -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.
|
|
@ -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
6
exm/zelus/ballz/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(rule
|
||||
(targets ballz.ml ballz.zci)
|
||||
(deps
|
||||
(:zl ballz.zls))
|
||||
(action
|
||||
(run zeluc %{zl})))
|
||||
Loading…
Add table
Add a link
Reference in a new issue