diff --git a/ivette/src/frama-c/plugins/eva/api/general/index.ts b/ivette/src/frama-c/plugins/eva/api/general/index.ts
index 55d8b6b7768e3e1717a91f126b192ce459c819bd..9d3579ba0b302412089088a1a7e96d56ea3a0c79 100644
--- a/ivette/src/frama-c/plugins/eva/api/general/index.ts
+++ b/ivette/src/frama-c/plugins/eva/api/general/index.ts
@@ -580,4 +580,26 @@ export const functionStats: State.Array<
functionStatsData
> = functionStats_internal;
+const getStates_internal: Server.GetRequest<
+ marker,
+ [ string, string, string ][]
+ > = {
+ kind: Server.RqKind.GET,
+ name: 'plugins.eva.general.getStates',
+ input: jMarker,
+ output: Json.jList(
+ Json.jTry(
+ Json.jTriple(
+ Json.jFail(Json.jString,'String expected'),
+ Json.jFail(Json.jString,'String expected'),
+ Json.jFail(Json.jString,'String expected'),
+ ))),
+ signals: [],
+};
+/** Get the domain states about the given marker */
+export const getStates: Server.GetRequest<
+ marker,
+ [ string, string, string ][]
+ >= getStates_internal;
+
/* ------------------------------------- */
diff --git a/src/plugins/value/api/general_requests.ml b/src/plugins/value/api/general_requests.ml
index 8a6068698cb4dc5568e7d35a761ccc781bc291a9..0a981edd2760bf3fd68aaca570a94593e553945a 100644
--- a/src/plugins/value/api/general_requests.ml
+++ b/src/plugins/value/api/general_requests.ml
@@ -261,7 +261,7 @@ let _array =
model
-(* ----- Analysis statistics -------------------------------------------- *)
+(* ----- Analysis statistics ------------------------------------------------ *)
module AlarmCategory = struct
open Server.Data
@@ -470,4 +470,71 @@ let _array =
model
-(**************************************************************************)
+(* ----- Domains states ----------------------------------------------------- *)
+
+let compute_lval_deps request lval =
+ let zone = Results.lval_deps lval request in
+ Locations.Zone.get_bases zone
+
+let compute_expr_deps request expr =
+ let zone = Results.expr_deps expr request in
+ Locations.Zone.get_bases zone
+
+let compute_instr_deps request = function
+ | Set (lval, expr, _) ->
+ Base.SetLattice.join
+ (compute_lval_deps request lval)
+ (compute_expr_deps request expr)
+ | Local_init (vi, AssignInit (SingleInit expr), _) ->
+ Base.SetLattice.join
+ (Base.SetLattice.inject_singleton (Base.of_varinfo vi))
+ (compute_expr_deps request expr)
+ | _ -> Base.SetLattice.empty
+
+let compute_stmt_deps request stmt =
+ match stmt.skind with
+ | Instr (instr) -> compute_instr_deps request instr
+ | If (expr, _, _, _) -> compute_expr_deps request expr
+ | _ -> Base.SetLattice.empty
+
+let compute_marker_deps request = function
+ | Printer_tag.PStmt (_, stmt)
+ | PStmtStart (_, stmt) -> compute_stmt_deps request stmt
+ | PLval (_, _, lval) -> compute_lval_deps request lval
+ | PExp (_, _, expr) -> compute_expr_deps request expr
+ | PVDecl (_, _, vi) -> Base.SetLattice.inject_singleton (Base.of_varinfo vi)
+ | _ -> Base.SetLattice.empty
+
+let get_filtered_state request marker =
+ let bases = compute_marker_deps request marker in
+ match bases with
+ | Base.SetLattice.Top -> Results.print_states request
+ | Base.SetLattice.Set bases ->
+ if Base.Hptset.is_empty bases
+ then []
+ else Results.print_states ~filter:bases request
+
+let get_states marker =
+ let kinstr = Printer_tag.ki_of_localizable marker in
+ match kinstr with
+ | Kglobal -> []
+ | Kstmt stmt ->
+ let states_before = get_filtered_state (Results.before stmt) marker in
+ let states_after = get_filtered_state (Results.after stmt) marker in
+ match states_before, states_after with
+ | [], _ -> List.map (fun (name, after) -> name, "", after) states_after
+ | _, [] -> List.map (fun (name, before) -> name, before, "") states_before
+ | _, _ ->
+ let join (name, before) (name', after) =
+ assert (name = name');
+ name, before, after
+ in
+ List.rev_map2 join states_before states_after
+
+let () = Request.register ~package
+ ~kind:`GET ~name:"getStates"
+ ~descr:(Markdown.plain "Get the domain states about the given marker")
+ ~input:(module Kernel_ast.Marker)
+ ~output:(module Data.Jlist
+ (Data.Jtriple (Data.Jstring) (Data.Jstring) (Data.Jstring)))
+ get_states
diff --git a/src/plugins/value/utils/results.ml b/src/plugins/value/utils/results.ml
index 540bc32142af6c42de9b85c1dbca17bc36ab2504..56935b6b2281b2aaef1ea25d1ccc65ad6624b27c 100644
--- a/src/plugins/value/utils/results.ml
+++ b/src/plugins/value/utils/results.ml
@@ -293,6 +293,26 @@ struct
| Some extract ->
convert (Response.map_join extract Cvalue.Model.join (get req))
+ let print_states ?filter req =
+ let state = Response.map_join (fun x -> x) A.Dom.join (get req) in
+ let print (type s)
+ (key: s Abstract.Domain.key)
+ (module Domain: Abstract_domain.S with type state = s)
+ (state: s) acc =
+ let name = Structure.Key_Domain.name key in
+ let state =
+ match filter with
+ | None -> state
+ | Some bases -> Domain.filter `Print bases state
+ in
+ let str = Format.asprintf "%a" Domain.pretty state in
+ (name, str) :: acc
+ in
+ let polymorphic_fold_fun = A.Dom.{ fold = print } in
+ match state with
+ | `Top | `Bottom -> []
+ | `Value state -> A.Dom.fold polymorphic_fold_fun state []
+
(* Evaluation *)
let eval_lval lval req =
@@ -487,6 +507,10 @@ let get_cvalue_model req =
| Error Bottom -> Cvalue.Model.bottom
| Error (Top | DisabledDomain) -> Cvalue.Model.top
+let print_states ?filter req =
+ let module E = Make () in
+ E.print_states ?filter req
+
(* Depedencies *)
diff --git a/src/plugins/value/utils/results.mli b/src/plugins/value/utils/results.mli
index e6c0678569aa2f5e7077e6780f285ac667560a5f..e18f41a032527bbde86a2c4b4122423e202afb9d 100644
--- a/src/plugins/value/utils/results.mli
+++ b/src/plugins/value/utils/results.mli
@@ -161,6 +161,11 @@ val get_cvalue_model : request -> Cvalue.Model.t
(** Returns the Cvalue model. *)
val get_cvalue_model_result : request -> Cvalue.Model.t result
+(** Returns a textual representation of the internal domain states for the given
+ request. If [filter] is provided, states are filtered on the given bases
+ (for domains that support this feature).
+ Returns a list of pair (name, state) for all available domains. *)
+val print_states: ?filter:Base.Hptset.t -> request -> (string * string) list
(** Dependencies *)