let compile_function fdef =
let o_name = Fol_decl.identifier (fdef.l_var_info.lv_name) in
let f_name = "D_" ^ o_name in
let d_name = "Def_" ^ o_name in
let context, profile, env = user_env fdef in
try
let body,filter =
match fdef.l_body with
| LBterm def ->
let v = term env def in Some v , term_filter v
| LBreads xs ->
Wp_parameters.warning ~once:true ~current:false
"Interpreting reads-definition as expressions rather than tsets" ;
List.iter (fun x -> ignore (term env x.it_content)) xs ;
None , all_filter
| LBnone ->
Wp_parameters.warning ~once:true ~current:false
"No definition for '%s' interpreted as reads nothing" o_name ;
None , all_filter
| LBinductive _ ->
Wp_parameters.fatal "Inductive function"
| LBpred _ ->
Wp_parameters.fatal "Function defined by a predicate"
in
let ltyp =
match fdef.l_type with
| Some ltyp -> ltyp
| None -> Wp_parameters.fatal "Function defined with not result type"
in
let t_result = M.tau_of_logic_type ltyp in
let signature = collect_signature profile filter env in
let formals = flatten_formals signature in
let declaration =
f_name , Formula.Function(List.map F.tau_of_var formals,t_result) in
let call_f = F.e_call f_name (List.map F.var formals) in
let definitions =
match body with
| None -> kill_context "compile" context ; []
| Some def ->
let f_axiom = F.p_forall formals
(flush_context "compile" context (F.p_eq call_f def))
in
[ d_name , Formula.Axiom f_axiom ]
in
let guards =
let cond = L.has_type call_f ltyp in
if F.is_true cond then []
else [ f_name ^ "_result" , Formula.Axiom (L.forall formals cond) ]
in
{
d_info = fdef ;
d_callname = f_name ;
d_formals = signature ;
} ,
declaration :: (definitions @ guards)
with err ->
kill_context "compile" context ;
raise err