diff --git a/src/plugins/eva/utils/summary.mli b/src/plugins/eva/utils/summary.mli index 406c8a7ecbb0070447f89323e457bdb2285ce71d..e434b9da54d3dc7884fda36d024797f716762d69 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 3c0c94383a9ec352ab926375bdd0ca9fe181cfd1..c1950fe4739d0dc603fd81bccb5f5d89786ef237 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 2cb91a776ae2d3146915f6e8853a4bd63684c243..5ed06061c36b5fdea238825e4731597db4f07167 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