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

feat: no existential types, add hrun

Browse source
This commit is contained in:
Henri Saudubray 2026-03-27 10:53:26 +01:00
parent a41e6b2faa
commit ae1a5cf284
Signed by: hms
GPG key ID: 7065F57ED8856128
3 changed files with 166 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

83
lib/hsim/fill.ml
View file

@ -1,16 +1,14 @@
[@@@warning "-27-50"]
[@@@warning "-27-50-69"]
let todo = assert false
(* Little OCaml reminder *)
type t = { foo : int; bar : int; }
(* Little OCaml reminder: *)
type t = { a : int; b : int; c : int }
let () =
let x = { a = 0; b = 1; c = 2 } in
let y = { x with a = 2 } in
assert (y = { a = 2; b = 1; c = 2 })
let f () =
let baz = { foo = 0; bar = 1 } in
let qux = { baz with foo = 2 } in (* same as "baz", except field "foo" *)
assert (qux = { foo = 2; bar = 1 })
@ -20,22 +18,23 @@ let () =
(** Discrete-time node *)
type ('i, 'o, 'r) dnode =
DNode : {
type ('i, 'o, 'r, 's) dnode =
DNode of {
state : 's; (** current state *)
step : 's -> 'i -> 's * 'o; (** step function *)
reset : 's -> 'r -> 's; (** reset function *)
} -> ('i, 'o, 'r) dnode
}
(** Run a discrete node on a list of inputs *)
let drun (DNode n : ('i, 'o, 'r) dnode) (i : 'i list) : 'o list =
let drun (DNode n : ('i, 'o, 'r, 's) dnode) (i : 'i list) : 'o list =
todo
type time =
float (** [≥ 0.0] *)
@ -75,13 +74,13 @@ type ('y, 'yder) ivp =
(** ODE solver *)
type ('y, 'yder) csolver =
type ('y, 'yder, 's) csolver =
(time, (** requested horizon *)
'y dense, (** solution approximation *)
('y, 'yder) ivp) (** initial value problem *)
dnode
('y, 'yder) ivp, (** initial value problem *)
's) dnode
@ -111,13 +110,12 @@ type ('y, 'zin) zcp =
(** Zero-crossing solver *)
type ('y, 'zin, 'zout) zsolver =
type ('y, 'zin, 'zout, 's) zsolver =
('y dense, (** input value *)
time * 'zout, (** horizon and zero-crossing events *)
('y, 'zin) zcp) (** zero-crossing problem *)
dnode
('y, 'zin) zcp, (** zero-crossing problem *)
's) dnode
@ -131,11 +129,12 @@ type ('y, 'zin, 'zout) zsolver =
(** Full solver (composition of an ODE and zero-crossing solver) *)
type ('y, 'yder, 'zin, 'zout) solver =
type ('y, 'yder, 'zin, 'zout, 's) solver =
(time, (** requested horizon *)
'y dense * 'zout, (** output and zero-crossing events *)
('y, 'yder) ivp * ('y, 'zin) zcp) (** (re)initialization parameters *)
dnode
('y, 'yder) ivp * ('y, 'zin) zcp, (** (re)initialization parameters *)
's) dnode
@ -145,15 +144,15 @@ type ('y, 'yder, 'zin, 'zout) solver =
(** Compose an ODE solver and a zero-crossing solver *)
let build_solver : ('y, 'yder) csolver ->
('y, 'zin, 'zout) zsolver ->
('y, 'yder, 'zin, 'zout) solver
let build_solver : ('y, 'yder, 'cs) csolver ->
('y, 'zin, 'zout, 'zs) zsolver ->
('y, 'yder, 'zin, 'zout, 'cs * 'zs) solver
= fun (DNode cs) (DNode zs) ->
let state = (cs.state, zs.state) in
let step (cstate, zstate) (h : time) =
todo in
let reset (cstate, zstate) (ivp, zcp) =
(cs.reset cstate ivp, zs.reset zstate zcp) in
DNode { state; step; reset }
@ -161,10 +160,9 @@ let build_solver : ('y, 'yder) csolver ->
(** Hybrid (discrete-time and continuous-time) node *)
type ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode =
HNode : {
type ('i, 'o, 'r, 's, 'y, 'yder, 'zin, 'zout) hnode =
HNode of {
state : 's; (** current state *)
step : 's -> 'i -> 's * 'o; (** discrete step function *)
reset : 's -> 'r -> 's; (** reset function *)
@ -175,7 +173,7 @@ type ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode =
cset : 's -> 'y -> 's; (** continuous state setter *)
zset : 's -> 'zout -> 's; (** zero-crossing information setter *)
jump : 's -> bool; (** discrete go-again indicator *)
} -> ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode
}
@ -184,16 +182,16 @@ type ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode =
type mode = D | C
(** Simulation state *)
type ('i, 'o, 'r, 'y) state =
State : {
type ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout, 'ms, 'ss) state =
State of {
solver : (** solver state *)
('y, 'yder, 'zin, 'zout) solver;
('y, 'yder, 'zin, 'zout,'ss) solver;
model : (** model state *)
('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode;
('i, 'o, 'r, 'ms, 'y, 'yder, 'zin, 'zout) hnode;
input : 'i signal; (** current input *)
time : time; (** current time *)
mode : mode; (** current step mode *)
} -> ('i, 'o, 'r, 'y) state
}
@ -234,9 +232,9 @@ let cstep (State ({ model = HNode m; solver = DNode s; _ } as st)) =
(** Simulate a hybrid model with a solver *)
let hsim : ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode ->
('y, 'yder, 'zin, 'zout) solver ->
('i signal, 'o signal, 'r) dnode
let hsim : ('i, 'o, 'r, 'ms, 'y, 'yder, 'zin, 'zout) hnode ->
('y, 'yder, 'zin, 'zout, 'ss) solver ->
('i signal, 'o signal, 'r, _) dnode
= fun model solver ->
let state = State { model; solver; input = None; time = 0.; mode = D } in
let step (State s as st) input = match (input, s.input, s.mode) with
@ -253,9 +251,10 @@ let hsim : ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode ->
(** Run a simulation on a list of inputs *)
let hrun (model : ('i, 'o, 'r, 'y, 'yder, 'zin, 'zout) hnode)
(solver : ('y, 'yder, 'zin, 'zout) solver)
let hrun (model : ('i, 'o, 'r, 'ms, 'y, 'yder, 'zin, 'zout) hnode)
(solver : ('y, 'yder, 'zin, 'zout, 'ss) solver)
(i : 'i dense list) : 'o dense list
= let sim = hsim model solver and i = List.map Option.some i in
let rec step os (DNode sim) i =