let rec fol_field_access s field =
let f, _ = get_field field in
Why_ops.field_access s f field.fcomp.cstruct
and field_name field = Format.sprintf "%s_%s" field.fcomp.cname field.fname
and get_field f =
let field_glob_name = field_name f in
try field_glob_name, Hashtbl.find field_table field_glob_name
with Not_found ->
let is_struct = f.fcomp.cstruct in
let add_field f =
let f_name = field_name f in
Wp_parameters.debug ~level: 3 "[wp-fol] add field %s@." f_name;
Hashtbl.add field_table f_name (Types.mk_field_type f);
add_field_array_length_axiom f
in List.iter add_field f.fcomp.cfields;
let field_type =
try Hashtbl.find field_table field_glob_name
with Not_found -> assert false
in
if is_struct then begin
add_neq_field_axioms f.fcomp;
add_all_field_eq_axiom f.fcomp
end;
field_glob_name, field_type
and add_neq_field_axioms tcomp =
let add_ax f1name f2 =
let f2name, _ = get_field f2 in
let ax = Why_ops.neq_field f1name f2name in
let ax_name = Format.sprintf "ax_field_%s_%s" f1name f2.fname in
add_axiom ax_name ax
in let rec add_list l = match l with
| [] -> ()
| f::tl -> let fname, _ = get_field f in
List.iter (add_ax fname) tl;
add_list tl
in add_list tcomp.cfields
and add_all_field_eq_axiom fcomp =
let ctyp = TComp (fcomp,Cil.empty_size_cache (), []) in
let ltyp = Ctype (ctyp) in
let typ = Types.mk_ctype ctyp in
let s1 = Cil_const.make_logic_var "s1" ltyp in
let s2 = Cil_const.make_logic_var "s2" ltyp in
let s1 = Fol.mk_lvar_variable s1 typ in
let s2 = Fol.mk_lvar_variable s2 typ in
let do_f acc field =
let eq = Fol.papp ("eq", [fol_field_access (Fol.Tvar s1) field;
fol_field_access (Fol.Tvar s2) field])
in Fol.pand (eq, acc)
in
let all_field_eq = List.fold_left do_f Fol.Ptrue fcomp.cfields in
let s1_eq_s2 = Fol.papp ("eq", [Fol.Tvar s1;Fol.Tvar s2]) in
let ax = Fol.pimplies (all_field_eq, s1_eq_s2) in
let ax = Fol.Pforall (s1, Fol.Pforall (s2, ax)) in
let ax_name = Format.sprintf "ax_eq_%s" fcomp.cname in
add_axiom ax_name ax
and add_field_array_length_axiom f =
let s_ctype = TComp (f.fcomp,Cil.empty_size_cache (), []) in
let s_type = Types.mk_ctype (TComp (f.fcomp,Cil.empty_size_cache (), [])) in
let s = Cil_const.make_logic_var "s" (Ctype s_ctype) in
let s = Fol.mk_lvar_variable s s_type in
let s_f = fol_field_access (Fol.Tvar s) f in
match mk_array_length s_f f.ftype with
| Some eq ->
let ax = Fol.Pforall (s, eq) in
let ax_name =
Format.sprintf "ax_array_size_%s_%s" f.fcomp.cname f.fname
in add_axiom ax_name ax
| None -> ()