137 lines
5 KiB
OCaml
137 lines
5 KiB
OCaml
(* 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 }
|