hms/hsim
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat: a LOT of stuff (final report, examples, simulation of a single assert, move from node instances to node definitions, etc.)

Browse source
This commit is contained in:
Henri Saudubray 2025-08-20 18:20:46 +02:00
parent ba5db5bd99
commit f2c545ce2c
Signed by: hms
GPG key ID: 7065F57ED8856128
49 changed files with 12377 additions and 1898 deletions
Download patch file Download diff file Expand all files Collapse all files

83
exm/builtins/ball_assert.ml Normal file
View file

@ -0,0 +1,83 @@
open Hsim.Types
open Solvers.Zls
(* let hybrid bouncing () = (x, y) where
rec der y = y' init y0
and der y' = -. g init y'0 reset z -> -0.8 *. last y'
and z = up (-. y)
and assert (up (-. (y +. epsilon))) *)
let of_array (a : time array) : carray =
Bigarray.(Array1.of_array Float64 c_layout) a
type state =
{ zin : zarray;
lx : carray; (* [| y'; y |] *)
i : bool; }
let g = -9.81
let y0 = 50.0
let y'0 = 0.0
let x0 = 0.0
let x'0 = 1.0
let ball ()
: (state, unit, unit, carray, carray, carray, zarray, carray) hrec
= let zsize = 1 in
let csize = 2 in
let yd = cmake csize in
let zout = cmake zsize in
let zfalse = zmake 1 in
let state = { zin=zfalse; lx=of_array [| y'0; y0 |]; i=true } in
let fder _ _ () y = yd.{0} <- g; yd.{1} <- y.{0}; yd in
let fzer _ _ () y = zout.{0} <- -. y.{1}; zout in
let fout _ _ _ y = y in
let step s _ () =
let lx =
if s.zin.{0} = 1l then of_array [| -. 0.8 *. s.lx.{0}; s.lx.{1} |]
else s.lx in
s.lx, { zin=zfalse; lx; i=false } in
let reset () _ = state in
let horizon _ = max_float in
let jump _ = true in
let cset s lx = { s with lx } in
let cget s = s.lx in
let zset s zin = { s with zin } in
{ state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset;
csize; zsize }
type astate = { zin_a: zarray }
let aball epsilon
: (astate, unit, state, bool, carray, carray, zarray, carray) hrec
= let zsize = 1 in
let csize = 0 in
let zin_a = zmake zsize in
let yd = cmake csize in
let zout = cmake zsize in
let state = { zin_a } in
let fder _ _ _ _ = yd in
let fzer _ _ st _ = zout.{0} <- -. (st.lx.{1} +. epsilon); zout in
let fout _ _ st _ = st.lx.{1} +. epsilon >= 0.0 in
let step { zin_a } _ st =
zin_a.{0} <> 1l && st.lx.{1} +. epsilon >= 0.0, { zin_a } in
let reset _ _ = state in
let horizon _ = max_float in
let jump _ = true in
let cset s _ = s in
let cget s = yd in
let zset _ zin_a = { zin_a } in
{ state; fder; fzer; fout; step; reset; horizon; jump; cset; cget; zset; csize; zsize }
let errmsg_invalid = "Invalid arguments to model (needed: [float])"
let errmsg_few = "Too few arguments to model (needed: [float])"
let errmsg_many = "Too many arguments to model (needed: [float])"
let init = function
| [eps] ->
let eps = try float_of_string eps
with Failure _ -> raise (Invalid_argument errmsg_invalid) in
let a = HNodeA { body=aball eps; assertions=[] } in
HNodeA { body=ball (); assertions=[a] }
| [] -> raise (Invalid_argument errmsg_few)
| _ -> raise (Invalid_argument errmsg_many)

74
exm/builtins/main.ml
View file

@ -4,19 +4,21 @@ open Solvers
open Common
open Types
let sample = ref 1
let stop = ref 10.0
let accel = ref false
let inplace = ref false
let sundials = ref false
let speed = ref false
let steps = ref 1
let model = ref None
let minstep = ref None
let maxstep = ref None
let mintol = ref None
let maxtol = ref None
let no_print = ref false
let sample = ref 1
let stop = ref 10.0
let accel = ref false
let inplace = ref false
let sundials = ref false
let speed = ref false
let steps = ref 1
let model = ref None
let minstep = ref None
let maxstep = ref None
let mintol = ref None
let maxtol = ref None
let no_print = ref false
let no_assert = ref false
let c_assert = ref false
let gt0i v i = v := if i <= 0 then 1 else i
let gt0f v f = v := if f <= 0.0 then 1.0 else f
@ -29,7 +31,7 @@ let set_model s =
| Some _ -> modelargs := s :: !modelargs
let opts = [
"-sample", Arg.Int (gt0i sample), "n \tSample count (default=10)";
"-sample", Arg.Int (gt0i sample), "n \tSample count (default=1)";
"-stop", Arg.Float (gt0f stop), "n \tStop time (default=10.0)";
"-debug", Arg.Set Debug.debug, "\tPrint debug information";
"-accelerate", Arg.Set accel, "\tConcatenate continuous functions";
@ -41,7 +43,9 @@ let opts = [
"-maxstep", Arg.String (opt maxstep), "\tSet maximum solver step length";
"-mintol", Arg.String (opt mintol), "\tSet minimum solver tolerance";
"-maxtol", Arg.String (opt maxtol), "\tSet maximum solver tolerance";
"-no-print", Arg.Set no_print, "\tDo not print output values";
"-noprint", Arg.Set no_print, "\tDo not print output values";
"-noassert", Arg.Set no_assert, "\tDo not check assertions";
"-cassert", Arg.Set c_assert, "\tCheck assertions continuously";
]
let errmsg = "Usage: " ^ Sys.executable_name ^ " [OPTIONS] MODEL\nOptions are:"
@ -53,12 +57,13 @@ let args = List.rev !modelargs
let m =
try match !model with
| None -> Format.eprintf "Missing model\n"; exit 2
| Some "ball" -> Ball.init args
| Some "vdp" -> Vdp.init args
| Some "sincos" -> Sincos.init args
| Some "sqrt" -> Sqrt.init args
| Some "sin1x" -> Sin1x.init args
| Some "sin1xd" -> Sin1x_der.init args
| Some "ball" -> a_of_h @@ Ball.init args
| Some "vdp" -> a_of_h @@ Vdp.init args
| Some "sincos" -> a_of_h @@ Sincos.init args
| Some "sqrt" -> a_of_h @@ Sqrt.init args
| Some "sin1x" -> a_of_h @@ Sin1x.init args
| Some "sin1xd" -> a_of_h @@ Sin1x_der.init args
| Some "aball" -> Ball_assert.init args
| Some s -> Format.eprintf "Unknown model: %s\n" s; exit 2
with Invalid_argument s -> Format.eprintf "%s\n" s; exit 2
@ -73,21 +78,30 @@ let output =
let sim =
if !sundials then
let open StatefulSundials in
let c = if !inplace then InPlace.csolve () else Functional.csolve () in
let c = if !inplace then InPlace.csolve else Functional.csolve in
let open StatefulZ in
let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
let s = Solver.solver c (d_of_dc z) in
let z = if !inplace then InPlace.zsolve else Functional.zsolve in
let s = Solver.solver c (fun () -> d_of_dc (z ())) in
let open Sim.Sim(val st) in
Hsim.Utils.run_until_n (output !sample (run m s))
let sim = if !no_assert then run (fun () -> h_of_a m) s
else if !c_assert then run_assert_continuous (fun () -> m) s
else run_assert_sample !sample (fun () -> m) s in
Hsim.Utils.run_until_n (output !sample sim ())
else
let open StatefulRK45 in
let c = if !inplace then InPlace.csolve () else Functional.csolve () in
let c = if !inplace then InPlace.csolve else Functional.csolve in
let open StatefulZ in
let z = if !inplace then InPlace.zsolve () else Functional.zsolve () in
let z = if !inplace then InPlace.zsolve else Functional.zsolve in
let s = Solver.solver_c c z in
let open Sim.Sim(val st) in
let n = if !accel then accelerate m s else run m (d_of_dc s) in
Hsim.Utils.run_until_n (output !sample n)
let sim =
if !no_assert then
if !accel then accelerate (fun () -> h_of_a m) s
else run (fun () -> h_of_a m) (fun () -> d_of_dc (s ()))
else
if !c_assert then run_assert_continuous (fun () -> m) (fun () -> d_of_dc (s ()))
else run_assert_sample !sample (fun () -> m) (fun () -> d_of_dc (s ())) in
Hsim.Utils.run_until_n (output !sample sim ())
let () = sim !stop !steps ignore
let () = ignore @@ sim !stop !steps ignore

BIN
exm/zelus/ballcos/ball.zci Normal file
View file

Binary file not shown.

41
exm/zelus/ballcos/ball.zls Normal file
View file

@ -0,0 +1,41 @@
(* Ball rolling on a cosine curve. *)
(* Illustrates the impact of an observer on the simulation. *)
let g = 9.81
let mu = 0.5 (* Friction coefficient. *)
let hybrid ball(v0) = (x, v) where
rec der x = v init 0.0
and der v = a *. (cos x) init v0
and a = g *. (sin x) -. mu *. v /. (cos x)
let hybrid vdp_c(mu) = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let hybrid print(p)(t, x, v, x', y) = () where
present(period(p)) -> do
() = print_endline(String.concat ",\t\t" (List.map string_of_float [t;x;v;x';y]))
done
(* Changing the period for [print] changes the result. *)
let hybrid main () = () where
rec der t = 1.0 init 0.0
and (x, v) = ball(2.953)
and (x', y) = vdp_c(0.5)
and () = print(0.5)(t, x, v, x', y)
(*
let input _ = 2.953
let node print_discrete (now, (x, v)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;v]))
let ball_discrete = Solve.solve_sundials(ball)
let node main_discrete () =
let input = Some (Solve.make(30.0, input)) fby None in
let o = run ball_discrete input in
Solve.period'_t 1.0 print_discrete o
*)

17
exm/zelus/ballcos/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets ball.ml ball.zci)
(deps
(:zl ball.zls)
(:zli solve.zli))
(action
(run zeluc %{zli} %{zl})))
(executable
(public_name ballcos.exe)
(name main)
(libraries std))

4
exm/zelus/ballcos/main.ml Normal file
View file

@ -0,0 +1,4 @@
open Std
let () = Runtime.go_discrete ignore Ball.main_discrete ignore

27
exm/zelus/ballcos/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

172
exm/zelus/ballcos/tmp/ball.ml Normal file
View file

@ -0,0 +1,172 @@
(* The Zelus compiler, version 2.2-dev
(2025-08-14-22:1) *)
open Ztypes
let g = 9.81
let mu = 0.5
type ('d , 'c , 'b , 'a) _ball =
{ mutable major_68 : 'd ;
mutable i_72 : 'c ; mutable x_71 : 'b ; mutable v_70 : 'a }
let ball (cstate_97:Ztypes.cstate) =
let ball_alloc _ =
cstate_97.cmax <- (+) cstate_97.cmax 2;
{ major_68 = false ;
i_72 = (false:bool) ;
x_71 = { pos = 42.; der = 0. } ; v_70 = { pos = 42.; der = 0. } } in
let ball_step self ((time_67:float) , (v0_66:float)) =
((let (cindex_98:int) = cstate_97.cindex in
let cpos_100 = ref (cindex_98:int) in
cstate_97.cindex <- (+) cstate_97.cindex 2 ;
self.major_68 <- cstate_97.major ;
(if cstate_97.major then
for i_1 = cindex_98 to 1 do Zls.set cstate_97.dvec i_1 0. done
else ((self.x_71.pos <- Zls.get cstate_97.cvec !cpos_100 ;
cpos_100 := (+) !cpos_100 1) ;
(self.v_70.pos <- Zls.get cstate_97.cvec !cpos_100 ;
cpos_100 := (+) !cpos_100 1))) ;
(let (result_102:(float * float)) =
(if self.i_72 then self.v_70.pos <- v0_66) ;
self.i_72 <- false ;
(let (a_69:float) =
(-.) (( *. ) g (sin self.x_71.pos))
((/.) (( *. ) mu self.v_70.pos) (cos self.x_71.pos)) in
self.v_70.der <- ( *. ) a_69 (cos self.x_71.pos) ;
self.x_71.der <- self.v_70.pos ; (self.x_71.pos , self.v_70.pos)) in
cpos_100 := cindex_98 ;
(if cstate_97.major then
(((Zls.set cstate_97.cvec !cpos_100 self.x_71.pos ;
cpos_100 := (+) !cpos_100 1) ;
(Zls.set cstate_97.cvec !cpos_100 self.v_70.pos ;
cpos_100 := (+) !cpos_100 1)))
else (((Zls.set cstate_97.dvec !cpos_100 self.x_71.der ;
cpos_100 := (+) !cpos_100 1) ;
(Zls.set cstate_97.dvec !cpos_100 self.v_70.der ;
cpos_100 := (+) !cpos_100 1)))) ; result_102)):float * float) in
let ball_reset self =
((self.i_72 <- true ; self.x_71.pos <- 0.):unit) in
Node { alloc = ball_alloc; step = ball_step ; reset = ball_reset }
type ('c , 'b , 'a) _vdp_c =
{ mutable major_75 : 'c ; mutable y_77 : 'b ; mutable x_76 : 'a }
let vdp_c (cstate_103:Ztypes.cstate) =
let vdp_c_alloc _ =
cstate_103.cmax <- (+) cstate_103.cmax 2;
{ major_75 = false ;
y_77 = { pos = 42.; der = 0. } ; x_76 = { pos = 42.; der = 0. } } in
let vdp_c_step self ((time_74:float) , (mu_73:float)) =
((let (cindex_104:int) = cstate_103.cindex in
let cpos_106 = ref (cindex_104:int) in
cstate_103.cindex <- (+) cstate_103.cindex 2 ;
self.major_75 <- cstate_103.major ;
(if cstate_103.major then
for i_1 = cindex_104 to 1 do Zls.set cstate_103.dvec i_1 0. done
else ((self.y_77.pos <- Zls.get cstate_103.cvec !cpos_106 ;
cpos_106 := (+) !cpos_106 1) ;
(self.x_76.pos <- Zls.get cstate_103.cvec !cpos_106 ;
cpos_106 := (+) !cpos_106 1))) ;
(let (result_108:(float * float)) =
self.y_77.der <- (-.) (( *. ) (( *. ) mu_73
((-.) 1.
(( *. ) self.x_76.pos
self.x_76.pos)))
self.y_77.pos) self.x_76.pos ;
self.x_76.der <- self.y_77.pos ; (self.x_76.pos , self.y_77.pos) in
cpos_106 := cindex_104 ;
(if cstate_103.major then
(((Zls.set cstate_103.cvec !cpos_106 self.y_77.pos ;
cpos_106 := (+) !cpos_106 1) ;
(Zls.set cstate_103.cvec !cpos_106 self.x_76.pos ;
cpos_106 := (+) !cpos_106 1)))
else (((Zls.set cstate_103.dvec !cpos_106 self.y_77.der ;
cpos_106 := (+) !cpos_106 1) ;
(Zls.set cstate_103.dvec !cpos_106 self.x_76.der ;
cpos_106 := (+) !cpos_106 1)))) ; result_108)):float * float) in
let vdp_c_reset self =
((self.y_77.pos <- 1. ; self.x_76.pos <- 1.):unit) in
Node { alloc = vdp_c_alloc; step = vdp_c_step ; reset = vdp_c_reset }
type ('g , 'f , 'e , 'd , 'c , 'b , 'a) _main =
{ mutable i_96 : 'g ;
mutable i_95 : 'f ;
mutable major_79 : 'e ;
mutable h_94 : 'd ;
mutable i_92 : 'c ; mutable h_90 : 'b ; mutable t_80 : 'a }
let main (cstate_109:Ztypes.cstate) =
let Node { alloc = i_96_alloc; step = i_96_step ; reset = i_96_reset } = ball
cstate_109 in
let Node { alloc = i_95_alloc; step = i_95_step ; reset = i_95_reset } = vdp_c
cstate_109 in
let main_alloc _ =
cstate_109.cmax <- (+) cstate_109.cmax 1;
{ major_79 = false ;
h_94 = 42. ;
i_92 = (false:bool) ;
h_90 = (42.:float) ; t_80 = { pos = 42.; der = 0. };
i_96 = i_96_alloc () (* continuous *) ;
i_95 = i_95_alloc () (* continuous *) } in
let main_step self ((time_78:float) , ()) =
((let (cindex_110:int) = cstate_109.cindex in
let cpos_112 = ref (cindex_110:int) in
cstate_109.cindex <- (+) cstate_109.cindex 1 ;
self.major_79 <- cstate_109.major ;
(if cstate_109.major then
for i_1 = cindex_110 to 0 do Zls.set cstate_109.dvec i_1 0. done
else ((self.t_80.pos <- Zls.get cstate_109.cvec !cpos_112 ;
cpos_112 := (+) !cpos_112 1))) ;
(let (result_114:unit) =
let h_93 = ref (infinity:float) in
(if self.i_92 then self.h_90 <- (+.) time_78 0.) ;
(let (z_91:bool) = (&&) self.major_79 ((>=) time_78 self.h_90) in
self.h_90 <- (if z_91 then (+.) self.h_90 0.01 else self.h_90) ;
h_93 := min !h_93 self.h_90 ;
self.h_94 <- !h_93 ;
self.i_92 <- false ;
(let ((x_82:float) , (v_81:float)) =
i_96_step self.i_96 (time_78 , 2.953) in
let ((x'_83:float) , (y_84:float)) =
i_95_step self.i_95 (time_78 , 0.0000000000000001) in
(begin match z_91 with
| true ->
let () =
print_endline (String.concat ",\t\t"
(List.map string_of_float
((::)
(
self.t_80.pos
,
(
(::)
(
x_82 ,
(
(::)
(
v_81 ,
(
(::)
(
x'_83 ,
(
(::)
(
y_84 ,
([]))))))))))))) in
() | _ -> () end) ; self.t_80.der <- 1. ; ())) in
cstate_109.horizon <- min cstate_109.horizon self.h_94 ;
cpos_112 := cindex_110 ;
(if cstate_109.major then
(((Zls.set cstate_109.cvec !cpos_112 self.t_80.pos ;
cpos_112 := (+) !cpos_112 1)))
else (((Zls.set cstate_109.dvec !cpos_112 self.t_80.der ;
cpos_112 := (+) !cpos_112 1)))) ; result_114)):unit) in
let main_reset self =
((self.i_92 <- true ;
self.t_80.pos <- 0. ; i_96_reset self.i_96 ; i_95_reset self.i_95 ):
unit) in
Node { alloc = main_alloc; step = main_step ; reset = main_reset }

8
exm/zelus/ballcos/tmp/dune Normal file
View file

@ -0,0 +1,8 @@
(env
(dev
(flags
(:standard -w -a))))
(executable
(name main_b)
(libraries zelus))

31
exm/zelus/ballcos/tmp/main_b.ml Normal file
View file

@ -0,0 +1,31 @@
open Ztypes
open Zls
(* simulation (continuous) function *)
let main =
let cstate =
{ dvec = cmake 0; cvec = cmake 0; zinvec = zmake 0; zoutvec = cmake 0;
cindex = 0; zindex = 0; cend = 0; zend = 0; cmax = 0; zmax = 0;
major = false; horizon = 0.0 } in
let Node { alloc = alloc; step = hstep; reset = reset } = Ball.main cstate in
let step mem cvec dvec zin t =
cstate.major <- true; cstate.cvec <- cvec; cstate.dvec <- dvec;
cstate.cindex <- 0; cstate.zindex <- 0; cstate.horizon <- infinity;
hstep mem (t, ()) in
let derivative mem cvec dvec zin zout t =
cstate.major <- false; cstate.cvec <- cvec; cstate.dvec <- dvec;
cstate.zinvec <- zin; cstate.zoutvec <- zout; cstate.cindex <- 0;
cstate.zindex <- 0; ignore (hstep mem (t, ())) in
let crossings mem cvec zin zout t =
cstate.major <- false; cstate.cvec <- cvec; cstate.zinvec <- zin;
cstate.zoutvec <- zout; cstate.cindex <- 0; cstate.zindex <- 0;
ignore (hstep mem (t, ())) in
let maxsize mem = cstate.cmax, cstate.zmax in
let csize mem = cstate.cend in
let zsize mem = cstate.zend in
let horizon mem = cstate.horizon in
Hsim { alloc; step; reset; derivative; crossings; maxsize; csize; zsize;
horizon };;
(* instantiate a numeric solver *)
module Runtime = Zlsrun.Make (Defaultsolver)
let _ = Runtime.go main

16
exm/zelus/ballcos/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

28
exm/zelus/brusselator/brusselator.zls Normal file
View file

@ -0,0 +1,28 @@
(* The Brusselator. *)
let hybrid brusselator(a, b) = (x, y) where
rec der x = a +. x *. x *. y -. b *. x -. x init 1.0
and der y = b *. x -. x *. x *. y init 1.0
let pi = 3.141592653589793
(* Add another oscillator. *)
let hybrid harmonic(p) = x where
rec der x = v init 1.0
and der v = -2.0 *. pi *. x /. p init 0.0
(* Putting the harmonic besides the brusselator changes the output of the first.
To visualize:
dune exec ./run.exe -- -speedup 1000 -maxstep 1.0 | feedgnuplot --stream --domain --lines
*)
let hybrid print(t, x) =
present (period (100.0)) ->
(print_endline (String.concat " " (List.map string_of_float [t; x])))
else ()
let hybrid simu() =
let der t = 1.0 init 0.0 in
let (x, y) = brusselator(1.0, 2.001) in
let z = harmonic(1e-5) in
print(t, x)

17
exm/zelus/brusselator/dune.bak Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets brusselator.ml)
(deps
(:zl brusselator.zls))
(action
(run zeluc %{zl})))
(executable
(name main)
(public_name brusselator.exe)
(libraries std)
(promote (until-clean)))

6
exm/zelus/brusselator/main.ml Normal file
View file

@ -0,0 +1,6 @@
open Std
let input _ = ()
let output (_, ()) = ()
let () = Runtime.go input Brusselator.simu output

17
exm/zelus/odes/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets odes.ml odes.zci)
(deps
(:zl odes.zls)
(:zli solve.zli))
(action
(run zeluc %{zli} %{zl})))
(executable
(public_name odes.exe)
(name main)
(libraries std))

9
exm/zelus/odes/main.ml Normal file
View file

@ -0,0 +1,9 @@
open Std
let input _ = ()
let output () = ()
let () = Runtime.go_discrete input Odes.main output

37
exm/zelus/odes/odes.zls Normal file
View file

@ -0,0 +1,37 @@
let hybrid vdp mu () = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let hybrid sincos () = (sin, cos) where
rec der sin = cos init 0.0
and der cos = -. sin init 1.0
let hybrid both () = (x, y, s, c) where
(x, y) = vdp 5.0 ()
and (s, c) = sincos ()
let vdp_d = Solve.solve_sundials (vdp 5.0)
let sincos_d = Solve.solve_sundials sincos
let both_d = Solve.solve_sundials both
let main_d = Solve.synchr sincos_d both_d
let node print_vdp (now, (x, y)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y]))
let node print_sincos (now, (s, c)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;s;c]))
let node print_both (now, (x, y, s, c)) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y;s;c]))
let node print_main (now, ((s1, c1), (x, y, s2, c2))) =
print_endline (String.concat ",\t\t" (List.map string_of_float [now;x;y]))
let input _ = ()
let node main () =
let i = Some (Solve.make(1000.0, input)) fby None in
let o = run main_d i in
Solve.period'_t 0.01 print_main o

26
exm/zelus/odes/solve.zli Normal file
View file

@ -0,0 +1,26 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

16
exm/zelus/odes/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

12
exm/zelus/parallel/dune Normal file
View file

@ -0,0 +1,12 @@
(env (dev (flags (:standard -w -a))))
(rule
(targets main.ml parallel.ml parallel.zci)
(deps (:zl parallel.zls) (:zli solve.zli))
(action
(run zeluc -deps -s main %{zli} %{zl})))
(executable
(public_name parallel.exe)
(name main)
(libraries std))

34
exm/zelus/parallel/parallel.zls Normal file
View file

@ -0,0 +1,34 @@
(* Parallel simulation of harmonic oscillators. *)
(* Illustrates the impact of unrelated parallel simulation. *)
let pi = 3.141592653589793
let hybrid harmonic(p) = x where
rec der x = v init 1.0
and der v = -2.0 *. pi *. x /. p init 0.0
let hybrid f () = (t, x, y) where
rec der t = 1.0 init 0.0
and x = harmonic(100.0)
and y = harmonic(1000.0)
let hybrid main' () =
let t, x, y = f () in
present (period (0.001)) ->
print_endline (String.concat ",\t" (List.map string_of_float [t;x;y]))
else ()
let hybrid f' () = harmonic(100.0)
let hybrid g' () = (harmonic(100.0), harmonic(1e-3))
let f_d = Solve.solve_sundials(f')
let g_d = Solve.solve_sundials(g')
let m = Solve.synchr f_d g_d
let node print (now, (xf, (xg, _))) =
print_endline (String.concat ",\t" (List.map string_of_float [now;xf;xg]))
let input _ = ()
let node main () =
let input = Some (Solve.make (100.0, input)) fby None in
Solve.period'_t 0.01 print (run m input)

27
exm/zelus/parallel/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

16
exm/zelus/parallel/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

8
exm/zelus/sincos/main.ml
View file

@ -1,6 +1,10 @@
open Std
(* let input _ = () *)
(* let output (now, (sin, cos)) = Format.printf "%.10e\t%.10e\t%.10e\n" now sin cos *)
(* let () = Runtime.go input Sincosz.g output *)
let input _ = ()
let output (now, (sin, cos)) = Format.printf "%.10e\t%.10e\t%.10e\n" now sin cos
let () = Runtime.go input Sincosz.g output
let output (now, sin, cos) = Format.printf "%.10e,%.10e,%.10e\n" now sin cos
let () = Runtime.go_discrete input Sincosz.sincos output

12
exm/zelus/sincos/sincosz.zls
View file

@ -1,4 +1,4 @@
(*
let hybrid g () = (sin, cos) where
rec der sin = cos init 0.0
and der cos = -. sin init 1.0
@ -15,3 +15,13 @@ let hybrid f () =
print_float cos;
print_newline ()
); ()
*)
let h = 0.01
let node integr(x0, x') = (x) where
rec x = x0 -> pre(x +. x' *. h)
let node sincos() = (now, sin, cos) where
rec sin = integr(0.0, cos)
and cos = integr(1.0, -. sin)
and now = integr(0.0, 1.0)

44
exm/zelus/solve/time.zls
View file

@ -3,6 +3,16 @@ let epsilon = 0.0001
let input _ = ()
let time t = t
let hybrid fsin t = s where der s = cos t init 0.0
let hybrid fcos t = c where der c = -. (sin t) init 1.0
let hybrid fboth t = (s, c) where (s, c) = (fsin t, fcos t)
let fsind = Solve.solve_sundials(fsin)
let fcosd = Solve.solve_sundials(fcos)
let fbothd = Solve.solve_sundials(fboth)
let hybrid sincos() =
let rec der sin = cos init 0.0
and der cos = -. sin init 1.0
@ -22,38 +32,36 @@ let ball_ode45 = Solve.solve_ode45(ball)
let ball_sundials = Solve.solve_sundials(ball)
let ball_both = Solve.synchr(ball_ode45)(ball_sundials)
let node print_ball_both (now, (y1, y2)) =
print_float(now); print_string("\t");
print_float(y1); print_string("\t");
print_float(y2); print_string("\n");
()
let node print1 (now, v) =
print_float(now); print_string "\t";
print_float v; print_string "\n"
let node print_sincos (now, (sin, cos)) =
let node print2 (now, (l, r)) =
print_float now; print_string "\t";
print_float sin; print_string "\t";
print_float cos; print_string "\n"
print_float l; print_string "\t";
print_float r; print_string "\n"
let node print_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
let node print22 (now, ((ll, rl), (lr, rr))) =
print_float now; print_string "\t";
print_float sin1; print_string "\t";
print_float sin2; print_string "\t";
print_float cos1; print_string "\t";
print_float cos2; print_string "\n"
print_float ll; print_string "\t";
print_float lr; print_string "\t";
print_float rl; print_string "\t";
print_float rr; print_string "\n"
let node check_sincos (now, (sin, cos)) =
print_sincos (now, (sin, cos));
print2 (now, (sin, cos));
sin <= 1.0 +. epsilon && sin >= -1.0 -. epsilon &&
cos <= 1.0 +. epsilon && cos >= -1.0 -. epsilon
let node check_sincos2 (now, ((sin1, cos1), (sin2, cos2))) =
print_sincos2 (now, ((sin1, cos1), (sin2, cos2)));
print22 (now, ((sin1, cos1), (sin2, cos2)));
sin1 <= 1.0 +. epsilon && sin1 >= -1.0 -. epsilon &&
cos1 <= 1.0 +. epsilon && cos1 >= -1.0 -. epsilon &&
sin2 <= 1.0 +. epsilon && sin2 >= -1.0 -. epsilon &&
cos2 <= 1.0 +. epsilon && cos2 >= -1.0 -. epsilon
let node main() =
let input = Some (Solve.make (30.0, input)) fby None in
let o = run sincos_sundials input in
Solve.check_t 100 check_sincos o
let input = Some (Solve.make (100.0, time)) fby None in
let o = run fbothd input in
Solve.iter_t 100 print2 o

17
exm/zelus/vdp/dune Normal file
View file

@ -0,0 +1,17 @@
(env
(dev
(flags
(:standard -w -a))))
(rule
(targets main.ml vdp.ml vdp.zci)
(deps
(:zl vdp.zls)
(:zli solve.zli))
(action
(run zeluc -deps -s main_d -o main %{zli} %{zl})))
(executable
(public_name vdp.exe)
(name main)
(libraries std))

27
exm/zelus/vdp/solve.zli Normal file
View file

@ -0,0 +1,27 @@
type time = float
type 'a value
type 'a signal = 'a value option
type 'a signal_t = ('a value * time) option
val horizon : 'a value -> time
val make : time * (time -> 'a) -> 'a value
val apply : 'a value * time -> 'a
val sustain : 'a -> 'a value
val solve_ode45 : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val solve_sundials : ('a -C-> 'b) -S-> 'a signal -D-> 'b signal_t
val synchr :
('a signal -D-> 'b signal_t) -S->
('a signal -D-> 'c signal_t) -S->
'a signal -D-> ('b * 'c) signal_t
val iter : int -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val iter_t : int -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit
val check : int -S-> ('a -D-> bool) -S-> 'a signal_t -D-> unit
val check_t : int -S-> (time * 'a -D-> bool) -S-> 'a signal_t -D-> unit
val period' : float -S-> ('a -D-> unit) -S-> 'a signal_t -D-> unit
val period'_t : float -S-> (time * 'a -D-> unit) -S-> 'a signal_t -D-> unit

54
exm/zelus/vdp/vdp.zls Normal file
View file

@ -0,0 +1,54 @@
let mu = 5.0
let hybrid vdp_c() = (x, y) where
rec der x = y init 1.0
and der y = (mu *. (1.0 -. (x *. x)) *. y) -. x init 1.0
let node forward(h)(x0, x') = x where
rec x = x0 fby (x +. h *. x')
let node backward(h)(x0, x') = x where
rec x = x0 -> pre x +. h *. x'
let node vdp_d(h)() = (x, y) where
rec x = backward(h)(1.0, y)
and y = forward(h)(1.0, (mu *. (1.0 -. (x *. x)) *. y) -. x)
let stop_time = 50.0
let node print (t, (x, y)) =
print_endline (String.concat ",\t" (List.map string_of_float [t;x;y]))
let node main_d() =
let rec t = 0.0 -> pre t +. 0.001 in
print(t, vdp_d(0.001)())
let node main_dc() =
let rec (t0, (x0, y0)) = ((0.0 -> pre t0 +. 0.1), vdp_d(0.1)()) in
let rec (t1, (x1, y1)) = ((0.0 -> pre t1 +. 0.2), vdp_d(0.2)()) in
let rec (t2, (x2, y2)) = ((0.0 -> pre t2 +. 0.3), vdp_d(0.3)()) in
let rec (t3, (x3, y3)) = ((0.0 -> pre t3 +. 0.4), vdp_d(0.4)()) in
let rec (t4, (x4, y4)) = ((0.0 -> pre t4 +. 0.5), vdp_d(0.5)()) in
let rec (t5, (x5, y5)) = ((0.0 -> pre t5 +. 0.6), vdp_d(0.6)()) in
let rec (t6, (x6, y6)) = ((0.0 -> pre t6 +. 0.7), vdp_d(0.7)()) in
let rec (t7, (x7, y7)) = ((0.0 -> pre t7 +. 0.8), vdp_d(0.8)()) in
let rec (t8, (x8, y8)) = ((0.0 -> pre t8 +. 0.9), vdp_d(0.9)()) in
let rec (t9, (x9, y9)) = ((0.0 -> pre t9 +. 1.0), vdp_d(1.0)()) in
print_endline (String.concat "\t" [string_of_float t0; "x0"; string_of_float x0; "y0"; string_of_float y0]);
print_endline (String.concat "\t" [string_of_float t1; "x1"; string_of_float x1; "y1"; string_of_float y1]);
print_endline (String.concat "\t" [string_of_float t2; "x2"; string_of_float x2; "y2"; string_of_float y2]);
print_endline (String.concat "\t" [string_of_float t3; "x3"; string_of_float x3; "y3"; string_of_float y3]);
print_endline (String.concat "\t" [string_of_float t4; "x4"; string_of_float x4; "y4"; string_of_float y4]);
print_endline (String.concat "\t" [string_of_float t5; "x5"; string_of_float x5; "y5"; string_of_float y5]);
print_endline (String.concat "\t" [string_of_float t6; "x6"; string_of_float x6; "y6"; string_of_float y6]);
print_endline (String.concat "\t" [string_of_float t7; "x7"; string_of_float x7; "y7"; string_of_float y7]);
print_endline (String.concat "\t" [string_of_float t8; "x8"; string_of_float x8; "y8"; string_of_float y8]);
print_endline (String.concat "\t" [string_of_float t9; "x9"; string_of_float x9; "y9"; string_of_float y9])
let input _ = ()
let vdp_s = Solve.solve_sundials vdp_c
let node main_c() =
let o = run vdp_s (Some (Solve.make(stop_time, input)) fby None) in
Solve.period'_t 1.0 print o

16
exm/zelus/vdp/ztypes.ml Normal file
View file

@ -0,0 +1,16 @@
include Std
include Ztypes
include Solvers
module type IGNORE = sig end
module Defaultsolver : IGNORE = struct end
module Zlsrun = struct
module Make (S : IGNORE) = struct
let go _ = ()
end
end
module Stdlib = struct
type nonrec 'a option = 'a option
end

122
exm/zelus_2024/ball/ball.ml
View file

@ -1,58 +1,72 @@
(* The Zelus compiler, version 2024-dev
(2025-06-4-15:49) *)
open Ztypes
type ('c, 'b, 'a) machine_17 =
{ mutable _up_16: 'c;
mutable y'_12: 'b;
mutable y_11: 'a }
type ('e, 'd, 'c, 'b, 'a) ball =
{ mutable time: 'e; mutable major: 'd; mutable up: 'c;
mutable y': 'b; mutable y: 'a }
let ball =
let machine cstate =
let alloc _ =
cstate.cmax <- cstate.cmax + 1;
cstate.zmax <- cstate.zmax + 1;
{ time = -1.;
major = false;
up = { zin = false; zout = 1. };
y' = -1.;
y = { pos = -1.; der = 0. };
} in
let step self _ =
let cindex = cstate.cindex in
let cpos = ref cindex in
let zindex = cstate.zindex in
let zpos = ref zindex in
cstate.cindex <- cstate.cindex + 1;
cstate.zindex <- cstate.zindex + 1;
self.major <- cstate.major;
self.time <- cstate.time;
if cstate.major then
for i = cindex to 0 do Zls.set cstate.dvec i 0. done
else begin
self.y.pos <- Zls.get cstate.cvec !cpos;
cpos := !cpos + 1
end;
let result =
self.up.zout <- -. self.y.pos;
if self.up.zin then self.y' <- -0.8 *. self.y';
self.y.der <- self.y';
self.y.pos, self.y', self.up.zin in
cpos := cindex;
if cstate.major then begin
Zls.set cstate.cvec !cpos self.y.pos;
cpos := !cpos + 1;
self.up.zin <- false
end else begin
self.up.zin <- Zls.get_zin cstate.zinvec !zpos;
zpos := !zpos + 1
end;
zpos := zindex;
Zls.set cstate.zoutvec !zpos self.up.zout;
zpos := !zpos + 1;
Zls.set cstate.dvec !cpos self.y.der;
cpos := !cpos + 1;
result in
let reset self =
self.y.pos <- 50.; self.y' <- 0. in
Node { alloc; step; reset } in
machine
let (ball) =
let ball_10 =
let machine_17 cstate_18 =
let machine_17_alloc _ =
cstate_18.cmax <- (+) cstate_18.cmax 2;
cstate_18.zmax <- (+) cstate_18.zmax 1;
{ _up_16 = { zin = false; zout = 1. };
y'_12 = { pos = (-1.); der = 0. };
y_11 = { pos = (-1.); der = 0. } } in
let machine_17_step self _ =
((let cindex_19 = cstate_18.cindex in
let cpos_21 = ref (cindex_19:int) in
let zindex_20 = cstate_18.zindex in
let zpos_22 = ref (zindex_20:int) in
cstate_18.cindex <- (+) cstate_18.cindex 2;
cstate_18.zindex <- (+) cstate_18.zindex 1;
(if cstate_18.major
then
for i_1 = cindex_19 to 1
do Zls.set cstate_18.dvec i_1 0. done
else
((self.y'_12.pos <- Zls.get cstate_18.cvec !cpos_21;
cpos_21 := (+) !cpos_21 1);
(self.y_11.pos <- Zls.get cstate_18.cvec !cpos_21;
cpos_21 := (+) !cpos_21 1)));
(let result_23 =
self._up_16.zout <- (~-.) self.y_11.pos;
self.y'_12.der <- (-9.81);
(let z_13 = self._up_16.zin in
let lx_15 = self.y'_12.pos in
(match z_13 with
| true ->
let v_14 = lx_15 in
self.y'_12.pos <- ( *. ) (-0.8) v_14 | _ -> () );
self.y_11.der <- self.y'_12.pos;
(self.y_11.pos, self.y'_12.pos, z_13)) in
cpos_21 := cindex_19;
(if cstate_18.major
then
(((Zls.set cstate_18.cvec !cpos_21 self.y'_12.pos;
cpos_21 := (+) !cpos_21 1);
(Zls.set cstate_18.cvec !cpos_21 self.y_11.pos;
cpos_21 := (+) !cpos_21 1));
((self._up_16.zin <- false)))
else
(((self._up_16.zin <- Zls.get_zin cstate_18.zinvec
!zpos_22;
zpos_22 := (+) !zpos_22 1));
zpos_22 := zindex_20;
((Zls.set cstate_18.zoutvec !zpos_22 self._up_16.zout;
zpos_22 := (+) !zpos_22 1));
((Zls.set cstate_18.dvec !cpos_21 self.y'_12.der;
cpos_21 := (+) !cpos_21 1);
(Zls.set cstate_18.dvec !cpos_21 self.y_11.der;
cpos_21 := (+) !cpos_21 1)))); result_23)):(float *
float *
bool)) in
let machine_17_reset self =
((self.y_11.pos <- 50.; self.y'_12.pos <- 0.):unit) in
Node { alloc = machine_17_alloc; step = machine_17_step;
reset = machine_17_reset } in
machine_17 in
ball_10