Commit da802d43 authored by David Hauzar's avatar David Hauzar
Browse files

Not appending "." to names of record fields in counterexamples.

Previously, "." was automatically appended to names stored in
model_trace label when creating variables corresponding to record
fields in eval_match and when projecting record fields in the
transformation intro_projections_counterexmp. Now, this is not done
and "." must be given in model_trace label of the projection or
record field.

The reason is that for SPARK, character different from "." (e.g., "'"
needs to be sometimes appended.
parent 431d1caa
......@@ -53,13 +53,13 @@ module M
(*** In all cases, records are decomposed using match eval ***)
type r = {f "model_trace:field_f" :int; g:bool}
type r = {f "model_trace:.field_f" :int; g:bool}
(* Projection functions *)
function projf_r_f "model_trace:f" (x : r) : int
function projf_r_f "model_trace:.f" (x : r) : int
=
x.f
function projf_r_g "model_trace:g" (x : r) : bool
function projf_r_g "model_trace:.g" (x : r) : bool
=
x.g
meta "inline : no" function projf_r_f
......@@ -106,10 +106,10 @@ module M
(*** Records and maps together ***)
type r_map = {f_map:map bool int; g_bool:bool}
function projf_r_map_f_map "model_trace:f_map" (rec_map : r_map) : map bool int
function projf_r_map_f_map "model_trace:.f_map" (rec_map : r_map) : map bool int
=
rec_map.f_map
function projf_r_map_g "model_trace:g_map" (rec_map : r_map) : bool
function projf_r_map_g "model_trace:.g_map" (rec_map : r_map) : bool
=
rec_map.g_bool
meta "inline : no" function projf_r_map_f_map
......@@ -140,15 +140,15 @@ module M
(*******************************************
** Definitions of projections used below **
*******************************************)
function projfi "model_trace:projfi" (l : int) : int
function projfi "model_trace:.projfi" (l : int) : int
= l
meta "inline : no" function projfi
meta "model_projection" function projfi
function projf1 "model_trace:projf1" (l : int) : bool
function projf1 "model_trace:.projf1" (l : int) : bool
=
l > 0
function projf2 "model_trace:projf2" (l : int) : bool
function projf2 "model_trace:.projf2" (l : int) : bool
=
l <= 0
meta "inline : no" function projf1
......@@ -180,7 +180,7 @@ module M
*********************************)
(* Warning: if definition of the following projections are present,
the proof of everything below will not terminate. *)
function projfl "model_trace:projfl" (l : list int_type) : int
function projfl "model_trace:.projfl" (l : list int_type) : int
=
match l with
| Nil -> 0
......
......@@ -44,6 +44,12 @@ let lab_compare l1 l2 = Pervasives.compare l1.lab_tag l2.lab_tag
(* functions for working with counterexample model labels *)
let model_proj_label = create_label "model_projected"
let model_label = create_label "model"
let remove_model_labels ~labels =
Slab.filter (fun l -> (l <> model_label) && (l <> model_proj_label) ) labels
let is_model_trace_label label =
Strings.has_prefix "model_trace:" label.lab_string
......
......@@ -29,6 +29,9 @@ val create_label : string -> label
(* functions for working with counterexample model labels *)
val remove_model_labels : labels : Slab.t -> Slab.t
(** Returns a copy of labels without labels "model" and "model_projected". *)
val append_to_model_trace_label : labels : Slab.t ->
to_append : string ->
Slab.t
......
......@@ -71,13 +71,12 @@ let rec add_quant kn (vl,tl,f) v =
begin
try
Ident.get_model_trace_string ~labels:pj_ls.ls_name.id_label
with Not_found -> pj_ls.ls_name.id_string
with Not_found -> "."^pj_ls.ls_name.id_string
end
| _ -> ""
) in
let field_str = if field_name = "" then "" else "." ^ field_name in
let label = Ident.append_to_model_element_name
~labels:v.vs_name.id_label ~to_append:(field_str) in
~labels:v.vs_name.id_label ~to_append:(field_name) in
create_vsymbol (id_lab label v.vs_name) (ty_inst s ty) in
let nvl = List.map2 mk_v ls.ls_args pjl in
let t = fs_app ls (List.map t_var nvl) ty in
......
......@@ -106,11 +106,9 @@ let intro_proj_for_ls env map_projs ls_projected =
Parameter applied_proj_f is a set of projection functions already applied to the term *)
let get_record_field_suffix projection =
let proj_name =
try
get_model_element_name ~labels:projection.ls_name.id_label
with Not_found -> "" in
if proj_name = "" then proj_name else "."^proj_name in
try
get_model_element_name ~labels:projection.ls_name.id_label
with Not_found -> "" in
match (Opt.get term.t_ty).ty_node with
| Tyapp (ts, [t_from; t_to]) when ts.ts_name.id_string = "map" -> begin
......
......@@ -316,15 +316,12 @@ let create_model_data ?loc ?context_labels append_to_model_trace =
md_context_labels = context_labels;
}
let model_proj_label = Ident.create_label "model_projected"
let model_label = Ident.create_label "model"
let mk_var id ty md =
let new_labels, loc = match md with
| None ->
(* If there is no model data remove model labels (prevents counter-example
projections of this variable, displaying this variable in counterexample, ...) *)
let new_labels = Slab.filter (fun l -> (l <> model_label) && (l <> model_proj_label) ) id.id_label in
let new_labels = Ident.remove_model_labels ~labels:id.id_label in
(new_labels, None)
| Some md -> begin
(append_to_model_trace_label ~labels:id.id_label ~to_append:("@"^md.md_append_to_model_trace), md.md_loc)
......
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