Commit 215fea13 authored by Sylvain Dailler's avatar Sylvain Dailler

Treat labels attributes for pretty printing of counterexamples at labels

We now use the information inside attributes to correctly associate a
label to each counterexamples. The information is carried inside
attributes which are preserved/collected during ce transformations and
printing to smt2.
The collection filled during the printing of the task is reused during the
printing of counterexamples to add "at label" where needed.
parent d5ff25e4
...@@ -34,7 +34,7 @@ module M ...@@ -34,7 +34,7 @@ module M
= =
x := { !x with f = 6 }; x := { !x with f = 6 };
!x !x
let record_match_eval_test44 (x : ref r) : r let record_match_eval_test44 (x : ref r) : r
ensures { result.g } ensures { result.g }
= [@vc:sp] = [@vc:sp]
...@@ -85,18 +85,4 @@ module Mutable ...@@ -85,18 +85,4 @@ module Mutable
x.f <- 6; x.f <- 6;
x x
let record_old_test1 (x : r) : unit
ensures { old x.f = x.f}
=
x.f <- 6
let record_at_test2 (x : r) : unit
=
label L in
x.f <- 6;
label M in
x.f <- 12;
assert { x at L = x at M}
end end
module Old
use int.Int
type r = {mutable f : int; mutable g : bool}
val y : r
let record_old_test1 (x : r) : unit
ensures { old (x.f + y.f) = x.f }
=
x.f <- 6
let record_at_test2 (x : r) : unit
=
label L in
x.f <- 6;
label M in
x.f <- 12;
assert { x.f at L = ((x.f + x.f + 1) at M + x.f + y.f)}
let several_hats (x : r): unit
=
label L in
label M in
x.f <- 6;
(* Here, the counterexample variable should mention both M and L *)
assert { x.f at L = x.f at M + 1}
end
\ No newline at end of file
...@@ -346,7 +346,7 @@ let split_model_trace_name mt_name = ...@@ -346,7 +346,7 @@ let split_model_trace_name mt_name =
| first::second::_ -> (first, second) | first::second::_ -> (first, second)
| [] -> ("", "") | [] -> ("", "")
let create_model_element ~name ~value ?location ?term () = let create_model_element ~name ~value ~attrs ?location ?term () =
let (name, type_s) = split_model_trace_name name in let (name, type_s) = split_model_trace_name name in
let me_kind = match type_s with let me_kind = match type_s with
| "result" -> Result | "result" -> Result
...@@ -355,7 +355,7 @@ let create_model_element ~name ~value ?location ?term () = ...@@ -355,7 +355,7 @@ let create_model_element ~name ~value ?location ?term () =
let me_name = { let me_name = {
men_name = name; men_name = name;
men_kind = me_kind; men_kind = me_kind;
men_attrs = match term with | None -> Sattr.empty | Some t -> t.t_attrs; men_attrs = match term with | None -> attrs | Some t -> Sattr.union t.t_attrs attrs;
} in } in
{ {
me_name = me_name; me_name = me_name;
...@@ -407,19 +407,43 @@ type model_parser = string -> Printer.printer_mapping -> model ...@@ -407,19 +407,43 @@ type model_parser = string -> Printer.printer_mapping -> model
type raw_model_parser = type raw_model_parser =
Sstr.t -> ((string * string) list) Mstr.t -> string list -> Sstr.t -> ((string * string) list) Mstr.t -> string list ->
string -> model_element list Ident.Sattr.t Mstr.t -> string -> model_element list
(* (*
*************************************************************** ***************************************************************
** Quering the model ** Quering the model
*************************************************************** ***************************************************************
*) *)
let print_model_element ~print_attrs print_model_value me_name_trans fmt m_element =
(* Adapt name of the model to potential labels applying to it: *)
let apply_location_label ~at_loc ~attrs me_name =
let sats =
Sattr.filter (fun x -> Strings.has_prefix "at" x.attr_string) attrs
in
let _labels_added, me_name =
Sattr.fold (fun attr_at (labels_added, me_name) ->
match Strings.split ':' attr_at.attr_string with
| "at" :: label :: "loc" :: loc_file :: loc_line :: [] ->
let loc_line = int_of_string loc_line in
if at_loc = (Filename.basename loc_file, loc_line) &&
not (Sstr.mem label labels_added)
then
(Sstr.add label labels_added, me_name ^ " at " ^ label)
else
(labels_added, me_name)
| _ -> (labels_added, me_name))
sats (Sstr.empty, me_name)
in
me_name
let print_model_element ~at_loc ~print_attrs print_model_value me_name_trans fmt m_element =
match m_element.me_name.men_kind with match m_element.me_name.men_kind with
| Error_message -> | Error_message ->
fprintf fmt "%s" m_element.me_name.men_name fprintf fmt "%s" m_element.me_name.men_name
| _ -> | _ ->
let me_name = me_name_trans m_element.me_name in let me_name = me_name_trans m_element.me_name in
let attrs = m_element.me_name.men_attrs in
let me_name = apply_location_label ~at_loc ~attrs me_name in
if print_attrs then if print_attrs then
fprintf fmt "%s, [%a] = %a" fprintf fmt "%s, [%a] = %a"
me_name me_name
...@@ -431,10 +455,16 @@ let print_model_element ~print_attrs print_model_value me_name_trans fmt m_eleme ...@@ -431,10 +455,16 @@ let print_model_element ~print_attrs print_model_value me_name_trans fmt m_eleme
me_name me_name
print_model_value m_element.me_value print_model_value m_element.me_value
let print_model_elements ~print_attrs ?(sep = "\n") print_model_value me_name_trans fmt m_elements = let print_model_elements ~at_loc ~print_attrs ?(sep = "\n")
Pp.print_list (fun fmt () -> Pp.string fmt sep) (print_model_element ~print_attrs print_model_value me_name_trans) fmt m_elements print_model_value me_name_trans fmt m_elements
=
Pp.print_list (fun fmt () -> Pp.string fmt sep)
(print_model_element ~at_loc ~print_attrs print_model_value me_name_trans)
fmt m_elements
let print_model_file ~print_attrs ~print_model_value fmt me_name_trans filename model_file = let print_model_file ~print_attrs ~print_model_value fmt
me_name_trans filename model_file
=
(* Relativize does not work on nighly bench: using basename instead. It (* Relativize does not work on nighly bench: using basename instead. It
hides the local paths. *) hides the local paths. *)
let filename = Filename.basename filename in let filename = Filename.basename filename in
...@@ -442,7 +472,7 @@ let print_model_file ~print_attrs ~print_model_value fmt me_name_trans filename ...@@ -442,7 +472,7 @@ let print_model_file ~print_attrs ~print_model_value fmt me_name_trans filename
IntMap.iter IntMap.iter
(fun line m_elements -> (fun line m_elements ->
fprintf fmt "@\nLine %d:@\n" line; fprintf fmt "@\nLine %d:@\n" line;
print_model_elements ~print_attrs print_model_value me_name_trans fmt m_elements) print_model_elements ~at_loc:(filename,line) ~print_attrs print_model_value me_name_trans fmt m_elements)
model_file; model_file;
fprintf fmt "@\n" fprintf fmt "@\n"
...@@ -549,6 +579,7 @@ let add_offset off (loc, a) = ...@@ -549,6 +579,7 @@ let add_offset off (loc, a) =
(Loc.user_position f (l + off) fc lc, a) (Loc.user_position f (l + off) fc lc, a)
let interleave_line let interleave_line
~filename
~print_attrs ~print_attrs
start_comment start_comment
end_comment end_comment
...@@ -566,7 +597,7 @@ let interleave_line ...@@ -566,7 +597,7 @@ let interleave_line
asprintf "%s%s%a%s" asprintf "%s%s%a%s"
(get_padding line) (get_padding line)
start_comment start_comment
(print_model_elements ~print_attrs ~sep:"; " print_model_value_human me_name_trans) model_elements (print_model_elements ~at_loc:(filename,line_number) ~print_attrs ~sep:"; " print_model_value_human me_name_trans) model_elements
end_comment in end_comment in
(* We need to know how many lines will be taken by the counterexample. This (* We need to know how many lines will be taken by the counterexample. This
...@@ -598,8 +629,9 @@ let interleave_with_source ...@@ -598,8 +629,9 @@ let interleave_with_source
the file because they contain extra ".." which cannot be reliably removed the file because they contain extra ".." which cannot be reliably removed
(because of potential symbolic link). So, we use the basename. (because of potential symbolic link). So, we use the basename.
*) *)
let rel_filename = Filename.basename rel_filename in
let model_files = let model_files =
StringMap.filter (fun k _ -> Filename.basename k = Filename.basename rel_filename) StringMap.filter (fun k _ -> Filename.basename k = rel_filename)
model.model_files model.model_files
in in
let model_file = snd (StringMap.choose model_files) in let model_file = snd (StringMap.choose model_files) in
...@@ -609,7 +641,7 @@ let interleave_with_source ...@@ -609,7 +641,7 @@ let interleave_with_source
in in
let (source_code, _, _, _, gen_loc) = let (source_code, _, _, _, gen_loc) =
List.fold_left List.fold_left
(interleave_line ~print_attrs (interleave_line ~filename:rel_filename ~print_attrs
start_comment end_comment me_name_trans model_file) start_comment end_comment me_name_trans model_file)
("", 1, 0, locations, []) ("", 1, 0, locations, [])
(src_lines_up_to_last_cntexmp_el source_code model_file) (src_lines_up_to_last_cntexmp_el source_code model_file)
...@@ -766,12 +798,17 @@ and replace_projection_array const_function a = ...@@ -766,12 +798,17 @@ and replace_projection_array const_function a =
let build_model_rec (raw_model: model_element list) (term_map: Term.term Mstr.t) (model: model_files) = let build_model_rec (raw_model: model_element list) (term_map: Term.term Mstr.t) (model: model_files) =
List.fold_left (fun model raw_element -> List.fold_left (fun model raw_element ->
let raw_element_name = raw_element.me_name.men_name in let raw_element_name = raw_element.me_name.men_name in
let raw_element_value = replace_projection (fun x -> (recover_name term_map x).men_name) raw_element.me_value in let raw_element_value =
replace_projection
(fun x -> (recover_name term_map x).men_name)
raw_element.me_value
in
try try
( (
let t = Mstr.find raw_element_name term_map in let t = Mstr.find raw_element_name term_map in
let attrs = Sattr.union raw_element.me_name.men_attrs t.t_attrs in
let model_element = { let model_element = {
me_name = construct_name (get_model_trace_string ~attrs:t.t_attrs) t.t_attrs; me_name = construct_name (get_model_trace_string ~attrs:t.t_attrs) attrs;
me_value = raw_element_value; me_value = raw_element_value;
me_location = t.t_loc; me_location = t.t_loc;
me_term = Some t; me_term = Some t;
...@@ -887,7 +924,8 @@ let make_mp_from_raw (raw_mp:raw_model_parser) = ...@@ -887,7 +924,8 @@ let make_mp_from_raw (raw_mp:raw_model_parser) =
let list_proj = printer_mapping.list_projections in let list_proj = printer_mapping.list_projections in
let list_records = printer_mapping.list_records in let list_records = printer_mapping.list_records in
let noarg_cons = printer_mapping.noarg_constructors in let noarg_cons = printer_mapping.noarg_constructors in
let raw_model = raw_mp list_proj list_records noarg_cons input in let set_str = printer_mapping.set_str in
let raw_model = raw_mp list_proj list_records noarg_cons set_str input in
build_model raw_model printer_mapping build_model raw_model printer_mapping
let register_model_parser ~desc s p = let register_model_parser ~desc s p =
...@@ -906,4 +944,4 @@ let list_model_parsers () = ...@@ -906,4 +944,4 @@ let list_model_parsers () =
let () = register_model_parser let () = register_model_parser
~desc:"Model@ parser@ with@ no@ output@ (used@ if@ the@ solver@ does@ not@ support@ models." "no_model" ~desc:"Model@ parser@ with@ no@ output@ (used@ if@ the@ solver@ does@ not@ support@ models." "no_model"
(fun _ _ _ _ -> []) (fun _ _ _ _ _ -> [])
...@@ -114,6 +114,7 @@ type model_element = { ...@@ -114,6 +114,7 @@ type model_element = {
val create_model_element : val create_model_element :
name : string -> name : string ->
value : model_value -> value : model_value ->
attrs : Ident.Sattr.t ->
?location : Loc.position -> ?location : Loc.position ->
?term : Term.term -> ?term : Term.term ->
unit -> unit ->
...@@ -333,7 +334,7 @@ type model_parser = string -> Printer.printer_mapping -> model ...@@ -333,7 +334,7 @@ type model_parser = string -> Printer.printer_mapping -> model
type raw_model_parser = type raw_model_parser =
Wstdlib.Sstr.t -> ((string * string) list) Wstdlib.Mstr.t -> Wstdlib.Sstr.t -> ((string * string) list) Wstdlib.Mstr.t ->
string list -> string -> model_element list string list -> Ident.Sattr.t Wstdlib.Mstr.t -> string -> model_element list
(** Parses the input string into model elements. (** Parses the input string into model elements.
[raw_model_parser: proj->record_map->noarg_cons->s->mel] [raw_model_parser: proj->record_map->noarg_cons->s->mel]
[proj]: is the list of projections [proj]: is the list of projections
......
...@@ -37,6 +37,7 @@ type printer_mapping = { ...@@ -37,6 +37,7 @@ type printer_mapping = {
list_projections: Sstr.t; list_projections: Sstr.t;
list_records: ((string * string) list) Mstr.t; list_records: ((string * string) list) Mstr.t;
noarg_constructors: string list; noarg_constructors: string list;
set_str: Sattr.t Mstr.t
} }
type printer_args = { type printer_args = {
...@@ -63,6 +64,7 @@ let get_default_printer_mapping = { ...@@ -63,6 +64,7 @@ let get_default_printer_mapping = {
list_projections = Sstr.empty; list_projections = Sstr.empty;
list_records = Mstr.empty; list_records = Mstr.empty;
noarg_constructors = []; noarg_constructors = [];
set_str = Mstr.empty
} }
let register_printer ~desc s p = let register_printer ~desc s p =
......
...@@ -39,7 +39,11 @@ type printer_mapping = { ...@@ -39,7 +39,11 @@ type printer_mapping = {
list_records: ((string * string) list) Mstr.t; list_records: ((string * string) list) Mstr.t;
(* List of constructors with no arguments that can be confused for variables (* List of constructors with no arguments that can be confused for variables
during parsing. *) during parsing. *)
noarg_constructors: string list noarg_constructors: string list;
(* List of attributes corresponding to a printed constants (that was on the
immediate term, not inside the ident) *)
set_str: Sattr.t Mstr.t
} }
type printer_args = { type printer_args = {
......
...@@ -447,9 +447,14 @@ and convert_z3_array (t: term) : array = ...@@ -447,9 +447,14 @@ and convert_z3_array (t: term) : array =
and convert_record l = and convert_record l =
List.map (fun (f, v) -> f, convert_to_model_value v) l List.map (fun (f, v) -> f, convert_to_model_value v) l
let convert_to_model_element name (t: term) = let convert_to_model_element ~set_str name (t: term) =
let value = convert_to_model_value t in let value = convert_to_model_value t in
Model_parser.create_model_element ~name ~value () let attrs =
match Mstr.find name set_str with
| exception Not_found -> Ident.Sattr.empty
| attrs -> attrs
in
Model_parser.create_model_element ~name ~value ~attrs ()
let default_apply_to_record (list_records: (string list) Mstr.t) let default_apply_to_record (list_records: (string list) Mstr.t)
(noarg_constructors: string list) (t: term) = (noarg_constructors: string list) (t: term) =
...@@ -586,7 +591,7 @@ and convert_tarray_to_array a = ...@@ -586,7 +591,7 @@ and convert_tarray_to_array a =
| TStore (a, t1, t2) -> Store (convert_tarray_to_array a, convert_tterm_to_term t1, convert_tterm_to_term t2) | TStore (a, t1, t2) -> Store (convert_tarray_to_array a, convert_tterm_to_term t1, convert_tterm_to_term t2)
let create_list (projections_list: Sstr.t) (list_records: ((string * string) list) Mstr.t) let create_list (projections_list: Sstr.t) (list_records: ((string * string) list) Mstr.t)
(noarg_constructors: string list) (table: definition Mstr.t) = (noarg_constructors: string list) (set_str: Ident.Sattr.t Mstr.t) (table: definition Mstr.t) =
(* Convert list_records to take replace fields with model_trace when (* Convert list_records to take replace fields with model_trace when
necessary. *) necessary. *)
...@@ -657,7 +662,7 @@ let create_list (projections_list: Sstr.t) (list_records: ((string * string) lis ...@@ -657,7 +662,7 @@ let create_list (projections_list: Sstr.t) (list_records: ((string * string) lis
(* Then converts all variables to raw_model_element *) (* Then converts all variables to raw_model_element *)
Mstr.fold Mstr.fold
(fun key value list_acc -> (fun key value list_acc ->
try (convert_to_model_element key value :: list_acc) try (convert_to_model_element ~set_str key value :: list_acc)
with Not_value when not (Debug.test_flag Debug.stack_trace) -> list_acc with Not_value when not (Debug.test_flag Debug.stack_trace) -> list_acc
| e -> raise e) | e -> raise e)
table table
......
...@@ -26,4 +26,5 @@ val register_apply_to_records: ...@@ -26,4 +26,5 @@ val register_apply_to_records:
(* From the table generated by the parser, build a list of model_element *) (* From the table generated by the parser, build a list of model_element *)
val create_list: val create_list:
Sstr.t -> ((string * string) list) Mstr.t -> string list -> Sstr.t -> ((string * string) list) Mstr.t -> string list ->
Ident.Sattr.t Mstr.t ->
Smt2_model_defs.definition Mstr.t -> Model_parser.model_element list Smt2_model_defs.definition Mstr.t -> Model_parser.model_element list
...@@ -57,9 +57,9 @@ let do_parsing model = ...@@ -57,9 +57,9 @@ let do_parsing model =
l; l;
Wstdlib.Mstr.empty Wstdlib.Mstr.empty
let do_parsing list_proj list_records noarg_constructors model = let do_parsing list_proj list_records noarg_constructors set_str model =
let m = do_parsing model in let m = do_parsing model in
Collect_data_model.create_list list_proj list_records noarg_constructors m Collect_data_model.create_list list_proj list_records noarg_constructors set_str m
(* Parses the model returned by CVC4, Z3 or Alt-ergo. (* Parses the model returned by CVC4, Z3 or Alt-ergo.
Returns the list of pairs term - value *) Returns the list of pairs term - value *)
...@@ -67,7 +67,7 @@ let do_parsing list_proj list_records noarg_constructors model = ...@@ -67,7 +67,7 @@ let do_parsing list_proj list_records noarg_constructors model =
match on "I don't know". But we also need to begin match on "I don't know". But we also need to begin
parsing on a fresh new line ".*" ensures it *) parsing on a fresh new line ".*" ensures it *)
let parse : raw_model_parser = let parse : raw_model_parser =
fun list_proj list_records noarg_constructors input -> fun list_proj list_records noarg_constructors set_str input ->
try try
(* let r = Str.regexp "unknown\\|sat\\|\\(I don't know.*\\)" in (* let r = Str.regexp "unknown\\|sat\\|\\(I don't know.*\\)" in
ignore (Str.search_forward r input 0); ignore (Str.search_forward r input 0);
...@@ -75,7 +75,7 @@ let parse : raw_model_parser = ...@@ -75,7 +75,7 @@ let parse : raw_model_parser =
let nr = Str.regexp "^)+" in let nr = Str.regexp "^)+" in
let res = Str.search_backward nr input (String.length input) in let res = Str.search_backward nr input (String.length input) in
let model_string = String.sub input 0 (res + String.length (Str.matched_string input)) in let model_string = String.sub input 0 (res + String.length (Str.matched_string input)) in
do_parsing list_proj list_records noarg_constructors model_string do_parsing list_proj list_records noarg_constructors set_str model_string
with with
| Not_found -> [] | Not_found -> []
......
...@@ -422,7 +422,8 @@ let print_prop_decl vc_loc args info fmt k pr f = ...@@ -422,7 +422,8 @@ let print_prop_decl vc_loc args info fmt k pr f =
queried_terms = model_list; queried_terms = model_list;
list_projections = info.list_projs; list_projections = info.list_projs;
list_records = Mstr.empty; list_records = Mstr.empty;
noarg_constructors = []}; noarg_constructors = [];
set_str = Mstr.empty};
fprintf fmt "@[<hov 2>goal %a :@ %a@]@\n" fprintf fmt "@[<hov 2>goal %a :@ %a@]@\n"
(print_ident info) pr.pr_name (print_fmla info) f (print_ident info) pr.pr_name (print_fmla info) f
| Plemma -> assert false | Plemma -> assert false
......
...@@ -9,6 +9,7 @@ ...@@ -9,6 +9,7 @@
(* *) (* *)
(********************************************************************) (********************************************************************)
open Wstdlib
open Ident open Ident
open Term open Term
...@@ -93,3 +94,31 @@ let check_exit_vc_term t in_goal info = ...@@ -93,3 +94,31 @@ let check_exit_vc_term t in_goal info =
if in_goal && Sattr.mem Ident.model_vc_attr t.t_attrs then begin if in_goal && Sattr.mem Ident.model_vc_attr t.t_attrs then begin
info.vc_inside <- false; info.vc_inside <- false;
end end
(* This is used to update info_labels of info in the printer. This takes the
label informations present in the term and add a location to help pretty
printing the counterexamples.
*)
let update_info_labels lsname cur_attrs t ls =
let cur_l =
match Mstr.find lsname cur_attrs with
| exception Not_found -> Sattr.empty
| s -> s
in
let updated_attr_labels =
(* Change attributes labels with "at:" to located
"at:[label]:loc:filename:line" *)
Sattr.fold (fun attr acc ->
if Strings.has_prefix "at:" attr.attr_string then
let (f, l, _, _) =
match t.t_loc with
| None -> Loc.get (Opt.get_def Loc.dummy_position ls.ls_name.id_loc)
| Some loc -> Loc.get loc
in
let attr = create_attribute (attr.attr_string ^ ":loc:" ^ f ^ ":" ^ (string_of_int l)) in
Sattr.add attr acc
else
acc
) (Sattr.union t.t_attrs ls.ls_name.id_attrs) cur_l
in
Mstr.add lsname updated_attr_labels cur_attrs
...@@ -9,6 +9,8 @@ ...@@ -9,6 +9,8 @@
(* *) (* *)
(********************************************************************) (********************************************************************)
open Wstdlib
open Ident
open Term open Term
(* Information about the term that triggers VC. *) (* Information about the term that triggers VC. *)
...@@ -42,3 +44,6 @@ val model_trace_for_postcondition: ...@@ -42,3 +44,6 @@ val model_trace_for_postcondition:
val check_enter_vc_term: Term.term -> bool -> vc_term_info -> unit val check_enter_vc_term: Term.term -> bool -> vc_term_info -> unit
val check_exit_vc_term: Term.term -> bool -> vc_term_info -> unit val check_exit_vc_term: Term.term -> bool -> vc_term_info -> unit
val update_info_labels: string -> Sattr.t Mstr.t -> Term.term ->
Term.lsymbol -> Sattr.t Mstr.t
...@@ -142,6 +142,7 @@ type info = { ...@@ -142,6 +142,7 @@ type info = {
info_cntexample: bool; info_cntexample: bool;
info_incremental: bool; info_incremental: bool;
info_set_incremental: bool; info_set_incremental: bool;
mutable info_labels: Sattr.t Mstr.t;
mutable incr_list: (prsymbol * term) list; mutable incr_list: (prsymbol * term) list;
} }
...@@ -256,18 +257,23 @@ let rec print_term info fmt t = ...@@ -256,18 +257,23 @@ let rec print_term info fmt t =
(print_type info) t fmt tl (print_type info) t fmt tl
| None -> begin match tl with (* for cvc3 wich doesn't accept (toto ) *) | None -> begin match tl with (* for cvc3 wich doesn't accept (toto ) *)
| [] -> | [] ->
let vc_term_info = info.info_vc_term in
if vc_term_info.vc_inside then begin let str_ls = sprintf "%a" (print_ident info) ls.ls_name in
match vc_term_info.vc_loc with let cur_var = info.info_labels in
| None -> () let new_var = update_info_labels str_ls cur_var t ls in
| Some loc -> let () = info.info_labels <- new_var in
let vc_term_info = info.info_vc_term in
if vc_term_info.vc_inside then begin
match vc_term_info.vc_loc with
| None -> ()
| Some loc ->
let attrs = (* match vc_term_info.vc_func_name with let attrs = (* match vc_term_info.vc_func_name with
| None -> *) | None -> *)
ls.ls_name.id_attrs ls.ls_name.id_attrs
(* | Some _ -> (* | Some _ ->
model_trace_for_postcondition ~attrs:ls.ls_name.id_attrs info.info_vc_term model_trace_for_postcondition ~attrs:ls.ls_name.id_attrs info.info_vc_term
*) *)
in in
let _t_check_pos = t_attr_set ~loc attrs t in let _t_check_pos = t_attr_set ~loc attrs t in
(* TODO: temporarily disable collecting variables inside the term triggering VC *) (* TODO: temporarily disable collecting variables inside the term triggering VC *)
(*info.info_model <- add_model_element t_check_pos info.info_model;*) (*info.info_model <- add_model_element t_check_pos info.info_model;*)
...@@ -325,7 +331,8 @@ and print_fmla info fmt f = ...@@ -325,7 +331,8 @@ and print_fmla info fmt f =
| Some s -> syntax_arguments_typed s (print_term info) | Some s -> syntax_arguments_typed s (print_term info)
(print_type info) f fmt tl (print_type info) f fmt tl
| None -> begin match tl with (* for cvc3 wich doesn't accept (toto ) *) | None -> begin match tl with (* for cvc3 wich doesn't accept (toto ) *)
| [] -> print_ident info fmt ls.ls_name | [] ->
print_ident info fmt ls.ls_name
| _ -> fprintf fmt "(%a@ %a)" | _ -> fprintf fmt "(%a@ %a)"
(print_ident info) ls.ls_name (print_ident info) ls.ls_name
(print_list space (print_term info)) tl (print_list space (print_term info)) tl
...@@ -572,7 +579,9 @@ let print_prop_decl vc_loc args info fmt k pr f = match k with ...@@ -572,7 +579,9 @@ let print_prop_decl vc_loc args info fmt k pr f = match k with
queried_terms = model_list; queried_terms = model_list;
list_projections = info.list_projs; list_projections = info.list_projs;
Printer.list_records = info.list_records; Printer.list_records = info.list_records;
noarg_constructors = info.noarg_constructors} noarg_constructors = info.noarg_constructors;
set_str = info.info_labels;
}
| Plemma -> assert false | Plemma -> assert false
let print_constructor_decl info fmt (ls,args) = let print_constructor_decl info fmt (ls,args) =
...@@ -712,6 +721,7 @@ let print_task version args ?old:_ fmt task = ...@@ -712,6 +721,7 @@ let print_task version args ?old:_ fmt task =
(* info_set_incremental add the incremental option to the header. It is not (* info_set_incremental add the incremental option to the header. It is not
needed for some provers needed for some provers
*) *)
info_labels = Mstr.empty;
info_set_incremental = not need_push && incremental; info_set_incremental = not need_push && incremental;
incr_list = []; incr_list = [];
} }
......
...@@ -130,6 +130,12 @@ let rec do_intro info vc_loc vc_map vc_var t = ...@@ -130,6 +130,12 @@ let rec do_intro info vc_loc vc_map vc_var t =
in in
let const_name = ls.id_string^"_vc_constant" in let const_name = ls.id_string^"_vc_constant" in
let axiom_name = ls.id_string^"_vc_axiom" in let axiom_name = ls.id_string^"_vc_axiom" in
let labels_attr =
Sattr.filter (fun x ->
Strings.has_prefix "at:" x.attr_string)
t.t_attrs
in
let const_attr = Sattr.union const_attr labels_attr in
(* Create a new id here to check the couple name, location. *) (* Create a new id here to check the couple name, location. *)
let id_new = Ident.id_user ~attrs:const_attr const_name loc in let id_new = Ident.id_user ~attrs:const_attr const_name loc in
(* The following check is used to avoid duplication of (* The following check is used to avoid duplication of
......
...@@ -34,7 +34,8 @@ let prepare_for_counterexmp2 env task = ...@@ -34,7 +34,8 @@ let prepare_for_counterexmp2 env task =
Debug.dprintf debug "Get ce@."; Debug.dprintf debug "Get ce@.";
let comp_trans = Trans.seq [ let comp_trans = Trans.seq [
Intro_vc_vars_counterexmp.intro_vc_vars_counterexmp;