Commit e4ef16a0 authored by David Hauzar's avatar David Hauzar

Storing counter-example model elements related to the term that

triggers VC in Model_parser.model and printing them.
parent be6edaf0
...@@ -144,10 +144,20 @@ module IntMap = Map.Make(struct type t = int let compare = compare end) ...@@ -144,10 +144,20 @@ module IntMap = Map.Make(struct type t = int let compare = compare end)
module StringMap = Map.Make(String) module StringMap = Map.Make(String)
type model_file = model_element list IntMap.t type model_file = model_element list IntMap.t
type model = model_file StringMap.t type model_files = model_file StringMap.t
type model = {
vc_term_loc : Loc.position option;
model_files : model_files;
}
let empty_model = StringMap.empty let empty_model = StringMap.empty
let empty_model_file = IntMap.empty let empty_model_file = IntMap.empty
let is_model_empty model =
model.model_files = empty_model
let default_model = {
vc_term_loc = None;
model_files = empty_model;
}
type model_parser = string -> Printer.printer_mapping -> model type model_parser = string -> Printer.printer_mapping -> model
...@@ -184,7 +194,7 @@ let print_model ...@@ -184,7 +194,7 @@ let print_model
?(me_name_trans = why_name_trans) ?(me_name_trans = why_name_trans)
fmt fmt
model = model =
StringMap.iter (print_model_file fmt me_name_trans) model StringMap.iter (print_model_file fmt me_name_trans) model.model_files
let model_to_string let model_to_string
?(me_name_trans = why_name_trans) ?(me_name_trans = why_name_trans)
...@@ -204,6 +214,19 @@ let get_elements model_file line_number = ...@@ -204,6 +214,19 @@ let get_elements model_file line_number =
with Not_found -> with Not_found ->
[] []
let print_model_vc_term
?(me_name_trans = why_name_trans)
?(sep = "\n")
fmt
model =
match model.vc_term_loc with
| None -> ()
| Some pos ->
let (filename, line_number, _, _) = Loc.get pos in
let model_file = get_model_file model.model_files filename in
let model_elements = get_elements model_file line_number in
print_model_elements ~sep me_name_trans fmt model_elements
let get_padding line = let get_padding line =
try try
let r = Str.regexp " *" in let r = Str.regexp " *" in
...@@ -240,7 +263,7 @@ let interleave_with_source ...@@ -240,7 +263,7 @@ let interleave_with_source
~filename ~filename
~source_code = ~source_code =
try try
let model_file = StringMap.find filename model in let model_file = StringMap.find filename model.model_files in
let lines = Str.split (Str.regexp "^") source_code in let lines = Str.split (Str.regexp "^") source_code in
let (source_code, _) = List.fold_left let (source_code, _) = List.fold_left
(interleave_line (interleave_line
...@@ -290,7 +313,7 @@ let print_model_json ...@@ -290,7 +313,7 @@ let print_model_json
(fun s -> s) (fun s -> s)
(print_model_elements_on_lines_json me_name_to_str) (print_model_elements_on_lines_json me_name_to_str)
fmt fmt
(StringMap.bindings model) (StringMap.bindings model.model_files)
let model_to_string_json let model_to_string_json
?(me_name_trans = why_name_trans) ?(me_name_trans = why_name_trans)
...@@ -359,9 +382,12 @@ match raw_model with ...@@ -359,9 +382,12 @@ match raw_model with
terms_tail terms_tail
model model
let build_model raw_model printer_mapping = let build_model raw_model printer_mapping =
build_model_rec raw_model printer_mapping.queried_terms empty_model let model_files = build_model_rec raw_model printer_mapping.queried_terms empty_model in
{
vc_term_loc = printer_mapping.Printer.vc_term_loc;
model_files = model_files;
}
(* (*
...@@ -399,11 +425,13 @@ let add_first_model_line filename model_file model = ...@@ -399,11 +425,13 @@ let add_first_model_line filename model_file model =
let model_for_positions_and_decls model ~positions = let model_for_positions_and_decls model ~positions =
(* Start with empty model and add locations from model that (* Start with empty model and add locations from model that
are in locations *) are in locations *)
let model_filtered = List.fold_left (add_loc model) empty_model positions in let model_filtered = List.fold_left (add_loc model.model_files) empty_model positions in
(* For each file add mapping corresponding to the first line of the (* For each file add mapping corresponding to the first line of the
counter-example from model to model_filtered. counter-example from model to model_filtered.
This corresponds to function declarations *) This corresponds to function declarations *)
StringMap.fold add_first_model_line model model_filtered let model_filtered = StringMap.fold add_first_model_line model.model_files model_filtered in
{ vc_term_loc = model.vc_term_loc;
model_files = model_filtered }
(* (*
......
...@@ -101,7 +101,8 @@ val create_model_element : ...@@ -101,7 +101,8 @@ val create_model_element :
*) *)
type model type model
val empty_model : model val is_model_empty : model -> bool
val default_model : model
(* (*
*************************************************************** ***************************************************************
...@@ -129,6 +130,20 @@ val model_to_string : ...@@ -129,6 +130,20 @@ val model_to_string :
string string
(** See print_model *) (** See print_model *)
val print_model_vc_term :
?me_name_trans: ((string * model_element_type) -> string) ->
?sep: string ->
Format.formatter ->
model ->
unit
(** Prints counter-example model elements related to term that
triggers VC.
@param sep separator of counter-example model elements
@param me_name_trans see print_model
@model the counter-example model.
*)
val print_model_json : val print_model_json :
?me_name_trans:((string * model_element_type) -> string) -> ?me_name_trans:((string * model_element_type) -> string) ->
Format.formatter -> Format.formatter ->
......
...@@ -30,7 +30,7 @@ type 'a pp = Pp.formatter -> 'a -> unit ...@@ -30,7 +30,7 @@ type 'a pp = Pp.formatter -> 'a -> unit
type printer_mapping = { type printer_mapping = {
lsymbol_m : string -> Term.lsymbol; lsymbol_m : string -> Term.lsymbol;
vc_term : Loc.position option; vc_term_loc : Loc.position option;
queried_terms : Term.term list; queried_terms : Term.term list;
} }
...@@ -53,7 +53,7 @@ exception UnknownPrinter of string ...@@ -53,7 +53,7 @@ exception UnknownPrinter of string
let get_default_printer_mapping = { let get_default_printer_mapping = {
lsymbol_m = (function _ -> raise Not_found); lsymbol_m = (function _ -> raise Not_found);
vc_term = None; vc_term_loc = None;
queried_terms = []; queried_terms = [];
} }
......
...@@ -28,7 +28,7 @@ type 'a pp = Format.formatter -> 'a -> unit ...@@ -28,7 +28,7 @@ type 'a pp = Format.formatter -> 'a -> unit
in the output of the printer to elements of AST in its input. *) in the output of the printer to elements of AST in its input. *)
type printer_mapping = { type printer_mapping = {
lsymbol_m : string -> Term.lsymbol; lsymbol_m : string -> Term.lsymbol;
vc_term : Loc.position option; vc_term_loc : Loc.position option;
(* The position of the term that triggers the VC *) (* The position of the term that triggers the VC *)
queried_terms : Term.term list; queried_terms : Term.term list;
(* The list of terms that were queried for the counter-example (* The list of terms that were queried for the counter-example
......
...@@ -135,7 +135,7 @@ let print_steps fmt s = ...@@ -135,7 +135,7 @@ let print_steps fmt s =
let print_prover_result fmt let print_prover_result fmt
{pr_answer=ans; pr_status=status; pr_output=out; pr_time=t; pr_steps=s; pr_model=m} = {pr_answer=ans; pr_status=status; pr_output=out; pr_time=t; pr_steps=s; pr_model=m} =
fprintf fmt "%a (%.2fs%a)" print_prover_answer ans t print_steps s; fprintf fmt "%a (%.2fs%a)" print_prover_answer ans t print_steps s;
if m <> Model_parser.empty_model then begin if Model_parser.is_model_empty m then begin
fprintf fmt "\nCounter-example model:"; fprintf fmt "\nCounter-example model:";
Model_parser.print_model fmt m Model_parser.print_model fmt m
end; end;
......
...@@ -642,7 +642,7 @@ let update_tabs a = ...@@ -642,7 +642,7 @@ let update_tabs a =
begin begin
match a.S.proof_state with match a.S.proof_state with
| S.Done r -> | S.Done r ->
if r.Call_provers.pr_model <> Model_parser.empty_model then begin if Model_parser.is_model_empty r.Call_provers.pr_model then begin
Model_parser.interleave_with_source Model_parser.interleave_with_source
r.Call_provers.pr_model r.Call_provers.pr_model
~filename:!current_file ~filename:!current_file
......
...@@ -534,7 +534,7 @@ let print_prop_decl cntexample args info fmt k pr f = match k with ...@@ -534,7 +534,7 @@ let print_prop_decl cntexample args info fmt k pr f = match k with
print_info_model cntexample fmt model_list info; print_info_model cntexample fmt model_list info;
args.printer_mapping <- { lsymbol_m = args.printer_mapping.lsymbol_m; args.printer_mapping <- { lsymbol_m = args.printer_mapping.lsymbol_m;
vc_term = vc_term_info.vc_loc; vc_term_loc = vc_term_info.vc_loc;
queried_terms = model_list; } queried_terms = model_list; }
| Plemma| Pskip -> assert false | Plemma| Pskip -> assert false
......
...@@ -1194,7 +1194,7 @@ let load_result r = ...@@ -1194,7 +1194,7 @@ let load_result r =
Call_provers.pr_output = ""; Call_provers.pr_output = "";
Call_provers.pr_status = Unix.WEXITED 0; Call_provers.pr_status = Unix.WEXITED 0;
Call_provers.pr_steps = steps; Call_provers.pr_steps = steps;
Call_provers.pr_model = Model_parser.empty_model Call_provers.pr_model = Model_parser.default_model
} }
| "undone" -> Interrupted | "undone" -> Interrupted
| "unedited" -> Unedited | "unedited" -> Unedited
......
...@@ -294,7 +294,7 @@ let schedule_edition t command filename callback = ...@@ -294,7 +294,7 @@ let schedule_edition t command filename callback =
Call_provers.prp_regexps = []; Call_provers.prp_regexps = [];
Call_provers.prp_timeregexps = []; Call_provers.prp_timeregexps = [];
Call_provers.prp_stepregexps = []; Call_provers.prp_stepregexps = [];
Call_provers.prp_model_parser = fun _ _ -> Model_parser.empty_model Call_provers.prp_model_parser = fun _ _ -> Model_parser.default_model
} in } in
let precall = let precall =
Call_provers.call_on_file ~command ~res_parser ~redirect:false filename ~printer_mapping:Printer.get_default_printer_mapping in Call_provers.call_on_file ~command ~res_parser ~redirect:false filename ~printer_mapping:Printer.get_default_printer_mapping in
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment