From 27e1982a729cec11191c3ee833fae836fac1d056 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20B=C3=BChler?= <david.buhler@cea.fr>
Date: Tue, 25 Jun 2024 09:49:48 +0200
Subject: [PATCH] [Server] States: fixes use of signal hooks from
 state_builder.

Uses add_hook_on_update to also synchronize when the project library changes
the state.
---
 src/plugins/eva/utils/summary.mli |  5 +++++
 src/plugins/server/states.ml      | 24 +++++++++++++++++-------
 src/plugins/server/states.mli     |  6 ++++++
 3 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/src/plugins/eva/utils/summary.mli b/src/plugins/eva/utils/summary.mli
index 406c8a7ecbb..e434b9da54d 100644
--- a/src/plugins/eva/utils/summary.mli
+++ b/src/plugins/eva/utils/summary.mli
@@ -81,6 +81,11 @@ sig
   (** Set a hook on function statistics computation *)
   val add_hook_on_change:
     ((key, data) State_builder.hashtbl_event -> unit) -> unit
+
+  module Datatype: Datatype.S
+
+  (** Set a hook on statistics changes by the project library *)
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 (** Compute analysis statistics. *)
diff --git a/src/plugins/server/states.ml b/src/plugins/server/states.ml
index 3c0c94383a9..c1950fe4739 100644
--- a/src/plugins/server/states.ml
+++ b/src/plugins/server/states.ml
@@ -69,15 +69,18 @@ module type Value = sig
   type data
   val get: unit -> data
   val add_hook_on_change: (data -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 let register_framac_value (type a) ~package ~name ~descr
     ~(output : a Request.output)
     (state : (module Value with type data = a)) =
   let module State = (val state) in
-  register_value ~package ~name ~descr ~output
-    ~get:State.get
-    ~add_hook:State.add_hook_on_change ()
+  let signal = register_value ~package ~name ~descr ~output ~get:State.get () in
+  register_hook signal State.add_hook_on_change ;
+  register_hook signal State.add_hook_on_update ;
+  signal
 
 (* -------------------------------------------------------------------------- *)
 (* --- States                                                             --- *)
@@ -110,15 +113,19 @@ module type State = sig
   val set: data -> unit
   val get: unit -> data
   val add_hook_on_change: (data -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 let register_framac_state (type a) ~package ~name ~descr
     ~(data : a data)
     (state : (module State with type data = a)) =
   let module State = (val state) in
-  register_state ~package ~name ~descr ~data
-    ~get:State.get ~set:State.set
-    ~add_hook:State.add_hook_on_change ()
+  let get, set = State.(get, set) in
+  let signal = register_state ~package ~name ~descr ~data ~get ~set () in
+  register_hook signal State.add_hook_on_change ;
+  register_hook signal State.add_hook_on_update ;
+  signal
 
 (* -------------------------------------------------------------------------- *)
 (* --- Model Signature                                                    --- *)
@@ -430,6 +437,8 @@ module type TableState = sig
   val iter: (key -> data -> unit) -> unit
   val add_hook_on_change:
     ((key, data) State_builder.hashtbl_event -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 let register_framac_array (type key) (type data) ~package ~name ~descr ~key
@@ -447,7 +456,8 @@ let register_framac_array (type key) (type data) ~package ~name ~descr ~key
     | Remove k -> remove_key array (key k)
     | Clear -> reload array
   in
-  install_hook array.signal handle_event (Table.add_hook_on_change);
+  install_hook array.signal handle_event Table.add_hook_on_change;
+  install_hook array.signal (fun _ -> reload array) Table.add_hook_on_update;
   array
 
 (* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/server/states.mli b/src/plugins/server/states.mli
index 2cb91a776ae..5ed06061c36 100644
--- a/src/plugins/server/states.mli
+++ b/src/plugins/server/states.mli
@@ -56,6 +56,8 @@ module type Value = sig
   type data
   val get: unit -> data
   val add_hook_on_change: (data -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 (** Same as [register_value] but takes a [State_builder.Ref] module as
@@ -97,6 +99,8 @@ module type State = sig
   val set: data -> unit
   val get: unit -> data
   val add_hook_on_change: (data -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 (** Same as [register_state] but takes a [State_builder.Ref] module as
@@ -194,6 +198,8 @@ module type TableState = sig
   val iter: (key -> data -> unit) -> unit
   val add_hook_on_change:
     ((key, data) State_builder.hashtbl_event -> unit) -> unit
+  module Datatype: Datatype.S
+  val add_hook_on_update: (Datatype.t -> unit) -> unit
 end
 
 (** Same as [register_array] but takes a [State_builder.Hashtbl] module as
-- 
GitLab