Skip to content
Snippets Groups Projects
Commit 7703145e authored by David Bühler's avatar David Bühler
Browse files

[Eva] Values request: evaluates lvalues using Eva.copy_lvalues.

parent 55e080fa
No related branches found
No related tags found
No related merge requests found
...@@ -231,32 +231,26 @@ end ...@@ -231,32 +231,26 @@ end
module Make (Eva: Analysis.S) : S = struct module Make (Eva: Analysis.S) : S = struct
let eval f state elt = let make_before eval before =
let value, alarms = f state elt in
let alarm = not (Alarmset.is_empty alarms) in
let str = Format.asprintf "%a" (Bottom.pretty Eva.Val.pretty) value in
{ value = str; alarm }
let make_before f before elt =
let before = let before =
match before with match before with
| `Bottom -> Unreachable | `Bottom -> Unreachable
| `Value state -> Evaluation (eval f state elt) | `Value state -> Evaluation (eval state)
in in
{ before; after_instr = None; after_then = None; after_else = None; } { before; after_instr = None; after_then = None; after_else = None; }
let make_callstack stmt f elt = let make_callstack stmt eval =
let before = Eva.get_stmt_state_by_callstack ~after:false stmt in let before = Eva.get_stmt_state_by_callstack ~after:false stmt in
match before with match before with
| (`Bottom | `Top) -> [] | (`Bottom | `Top) -> []
| `Value before -> | `Value before ->
let aux callstack before acc = let aux callstack before acc =
let before_after = make_before f (`Value before) elt in let before_after = make_before eval (`Value before) in
(callstack, before_after) :: acc (callstack, before_after) :: acc
in in
Value_types.Callstack.Hashtbl.fold aux before [] Value_types.Callstack.Hashtbl.fold aux before []
let make_before_after f ~before ~after elt = let make_before_after eval ~before ~after =
match before with match before with
| `Bottom -> | `Bottom ->
{ before = Unreachable; { before = Unreachable;
...@@ -264,12 +258,12 @@ module Make (Eva: Analysis.S) : S = struct ...@@ -264,12 +258,12 @@ module Make (Eva: Analysis.S) : S = struct
after_then = None; after_then = None;
after_else = None; } after_else = None; }
| `Value before -> | `Value before ->
let before = eval f before elt in let before = eval before in
let after_instr = let after_instr =
match after with match after with
| `Bottom -> Some (Reduced Unreachable) | `Bottom -> Some (Reduced Unreachable)
| `Value after -> | `Value after ->
let after = eval f after elt in let after = eval after in
if String.equal before.value after.value if String.equal before.value after.value
then Some Unchanged then Some Unchanged
else Some (Reduced (Evaluation after)) else Some (Reduced (Evaluation after))
...@@ -277,7 +271,7 @@ module Make (Eva: Analysis.S) : S = struct ...@@ -277,7 +271,7 @@ module Make (Eva: Analysis.S) : S = struct
{ before = Evaluation before; { before = Evaluation before;
after_instr; after_then = None; after_else = None; } after_instr; after_then = None; after_else = None; }
let make_instr_callstack stmt f elt = let make_instr_callstack stmt eval =
let before = Eva.get_stmt_state_by_callstack ~after:false stmt in let before = Eva.get_stmt_state_by_callstack ~after:false stmt in
let after = Eva.get_stmt_state_by_callstack ~after:true stmt in let after = Eva.get_stmt_state_by_callstack ~after:true stmt in
match before, after with match before, after with
...@@ -290,38 +284,52 @@ module Make (Eva: Analysis.S) : S = struct ...@@ -290,38 +284,52 @@ module Make (Eva: Analysis.S) : S = struct
try `Value (Value_types.Callstack.Hashtbl.find after callstack) try `Value (Value_types.Callstack.Hashtbl.find after callstack)
with Not_found -> `Bottom with Not_found -> `Bottom
in in
let before_after = make_before_after f ~before ~after elt in let before_after = make_before_after eval ~before ~after in
(callstack, before_after) :: acc (callstack, before_after) :: acc
in in
Value_types.Callstack.Hashtbl.fold aux before [] Value_types.Callstack.Hashtbl.fold aux before []
let make f elt kinstr = let make eval kinstr =
let before = Eva.get_kinstr_state ~after:false kinstr in let before = Eva.get_kinstr_state ~after:false kinstr in
let values, callstack = let values, callstack =
match kinstr with match kinstr with
| Cil_types.Kglobal -> | Cil_types.Kglobal ->
make_before f before elt, None make_before eval before, None
| Cil_types.Kstmt stmt -> | Cil_types.Kstmt stmt ->
match stmt.skind with match stmt.skind with
| Instr _ -> | Instr _ ->
let after = Eva.get_kinstr_state ~after:true kinstr in let after = Eva.get_kinstr_state ~after:true kinstr in
let values = make_before_after f ~before ~after elt in let values = make_before_after eval ~before ~after in
let callstack = make_instr_callstack stmt f elt in let callstack = make_instr_callstack stmt eval in
values, Some callstack values, Some callstack
| _ -> | _ ->
make_before f before elt, make_before eval before, Some (make_callstack stmt eval)
Some (make_callstack stmt f elt)
in in
{ values; callstack; } { values; callstack; }
let evaluate kinstr expr = let evaluate kinstr expr =
make (Eva.eval_expr) expr kinstr let eval state =
let value, alarms = Eva.eval_expr state expr in
let alarm = not (Alarmset.is_empty alarms) in
let str = Format.asprintf "%a" (Bottom.pretty Eva.Val.pretty) value in
{ value = str; alarm }
in
make eval kinstr
let lvaluate kinstr lval = let lvaluate kinstr lval =
let loc = Cil_datatype.Location.unknown in let eval state =
let expr = Cil.new_exp ~loc (Lval lval) in let value, alarms = Eva.copy_lvalue state lval in
make (Eva.eval_expr) expr kinstr let alarm = not (Alarmset.is_empty alarms) in
let flagged_value = match value with
| `Bottom -> Eval.Flagged_Value.bottom
| `Value v -> v
in
let pretty = Eval.Flagged_Value.pretty Eva.Val.pretty in
let str = Format.asprintf "%a" pretty flagged_value in
{ value = str; alarm }
in
make eval kinstr
end end
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment