feat: start of lift, debugging, cleanup

exm/zelus/ballz/ballz.ml

@@ -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 }