From 0f2ab9a0af30a3d40f601f56c46a5255424c3383 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20B=C3=BChler?= <david.buhler@cea.fr>
Date: Tue, 22 Feb 2022 12:19:37 +0100
Subject: [PATCH] [Eva] Analysis: all functions [get_*_state] return
or_top_bottom type.
These functions uses the analysis status to return `Top or `Bottom if needed.
---
src/plugins/value/engine/analysis.ml | 56 ++++++++++++---------
src/plugins/value/engine/analysis.mli | 6 +--
src/plugins/value/gui_files/register_gui.ml | 2 +-
src/plugins/value/utils/results.ml | 2 +
4 files changed, 38 insertions(+), 28 deletions(-)
diff --git a/src/plugins/value/engine/analysis.ml b/src/plugins/value/engine/analysis.ml
index 9b43b96fa2f..eb872274dc2 100644
--- a/src/plugins/value/engine/analysis.ml
+++ b/src/plugins/value/engine/analysis.ml
@@ -28,6 +28,15 @@ type computation_state = Self.computation_state =
let current_computation_state = Self.current_computation_state
let register_computation_hook = Self.register_computation_hook
let is_computed = Self.is_computed
+let self = Self.state
+
+type results = Function_calls.results = Complete | Partial | NoResults
+type status = Function_calls.analysis_status =
+ Unreachable | SpecUsed | Builtin of string | Analyzed of results
+let status = Function_calls.analysis_status
+
+let use_spec_instead_of_definition =
+ Function_calls.use_spec_instead_of_definition ?recursion_depth:None
let save_results kf =
try Function_calls.save_results (Kernel_function.get_definition kf)
@@ -38,13 +47,13 @@ module type Results = sig
type value
type location
- val get_global_state: unit -> state or_bottom
- val get_stmt_state : after:bool -> stmt -> state or_bottom
+ val get_global_state: unit -> state or_top_bottom
+ val get_stmt_state : after:bool -> stmt -> state or_top_bottom
val get_stmt_state_by_callstack:
?selection:callstack list ->
after:bool -> stmt -> state Value_types.Callstack.Hashtbl.t or_top_bottom
val get_initial_state:
- kernel_function -> state or_bottom
+ kernel_function -> state or_top_bottom
val get_initial_state_by_callstack:
?selection:callstack list ->
kernel_function -> state Value_types.Callstack.Hashtbl.t or_top_bottom
@@ -82,22 +91,31 @@ module Make (Abstract: Abstractions.S) = struct
include Abstract
include Compute_functions.Make (Abstract)
+ let find stmt f =
+ let kf = Kernel_function.find_englobing_kf stmt in
+ match status kf with
+ | Unreachable -> `Bottom
+ | Analyzed NoResults | SpecUsed | Builtin _ -> `Top
+ | Analyzed (Complete | Partial) -> f stmt
+
let get_stmt_state ~after stmt =
- let fundec = Kernel_function.(get_definition (find_englobing_kf stmt)) in
- if Mark_noresults.should_memorize_function fundec && is_computed ()
- then Abstract.Dom.Store.get_stmt_state ~after stmt
- else `Value Abstract.Dom.top
+ find stmt (Dom.Store.get_stmt_state ~after :> stmt -> Dom.t or_top_bottom)
- let get_global_state = Abstract.Dom.Store.get_global_state
+ let get_stmt_state_by_callstack ?selection ~after stmt =
+ find stmt (Abstract.Dom.Store.get_stmt_state_by_callstack ?selection ~after)
- let get_stmt_state_by_callstack =
- Abstract.Dom.Store.get_stmt_state_by_callstack
+ let get_global_state () =
+ (Abstract.Dom.Store.get_global_state () :> Dom.t or_top_bottom)
- let get_initial_state =
- Abstract.Dom.Store.get_initial_state
+ let get_initial_state kf =
+ if Function_calls.is_called kf
+ then (Abstract.Dom.Store.get_initial_state kf :> Dom.t or_top_bottom)
+ else `Bottom
- let get_initial_state_by_callstack =
- Abstract.Dom.Store.get_initial_state_by_callstack
+ let get_initial_state_by_callstack ?selection kf =
+ if Function_calls.is_called kf
+ then Abstract.Dom.Store.get_initial_state_by_callstack ?selection kf
+ else `Bottom
let eval_expr state expr = Eval.evaluate state expr >>=: snd
@@ -205,13 +223,3 @@ let () =
Project.register_after_set_current_hook
~user_only:true (fun _ -> reset_analyzer ());
Project.register_after_global_load_hook reset_analyzer
-
-let self = Self.state
-
-type results = Function_calls.results = Complete | Partial | NoResults
-type status = Function_calls.analysis_status =
- Unreachable | SpecUsed | Builtin of string | Analyzed of results
-let status = Function_calls.analysis_status
-
-let use_spec_instead_of_definition =
- Function_calls.use_spec_instead_of_definition ?recursion_depth:None
diff --git a/src/plugins/value/engine/analysis.mli b/src/plugins/value/engine/analysis.mli
index 98c2201b905..bfaa372cc3a 100644
--- a/src/plugins/value/engine/analysis.mli
+++ b/src/plugins/value/engine/analysis.mli
@@ -28,13 +28,13 @@ module type Results = sig
type value
type location
- val get_global_state: unit -> state or_bottom
- val get_stmt_state : after:bool -> stmt -> state or_bottom
+ val get_global_state: unit -> state or_top_bottom
+ val get_stmt_state : after:bool -> stmt -> state or_top_bottom
val get_stmt_state_by_callstack:
?selection:callstack list ->
after:bool -> stmt -> state Value_types.Callstack.Hashtbl.t or_top_bottom
val get_initial_state:
- kernel_function -> state or_bottom
+ kernel_function -> state or_top_bottom
val get_initial_state_by_callstack:
?selection:callstack list ->
kernel_function -> state Value_types.Callstack.Hashtbl.t or_top_bottom
diff --git a/src/plugins/value/gui_files/register_gui.ml b/src/plugins/value/gui_files/register_gui.ml
index 1b1e29838b3..e99b3d3ea02 100644
--- a/src/plugins/value/gui_files/register_gui.ml
+++ b/src/plugins/value/gui_files/register_gui.ml
@@ -528,7 +528,7 @@ module Select (Eval: Eval) = struct
| Kstmt stmt -> Eval.Analysis.get_stmt_state ~after:false stmt
in
match state with
- | `Bottom -> ()
+ | `Bottom | `Top -> ()
| `Value state ->
let funs, _ = Eval.Analysis.eval_function_exp state e in
match funs with
diff --git a/src/plugins/value/utils/results.ml b/src/plugins/value/utils/results.ml
index ca379c399f9..dc59df6779d 100644
--- a/src/plugins/value/utils/results.ml
+++ b/src/plugins/value/utils/results.ml
@@ -110,11 +110,13 @@ struct
let consolidated =
function
| `Bottom -> Bottom
+ | `Top -> Top
| `Value state -> Consolidated state
let singleton cs =
function
| `Bottom -> Bottom
+ | `Top -> Top
| `Value state -> ByCallstack [cs,state]
let by_callstack : request ->
--
GitLab