feat: start of lift, debugging, cleanup

exm/zelus/ballz/ballz.ml.bak

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