Skip to content
Snippets Groups Projects
Commit d5659ff0 authored by Thibaut Benjamin's avatar Thibaut Benjamin
Browse files

[e-acsl] prevent generation of empty functions

parent fccd0eda
No related branches found
No related tags found
No related merge requests found
...@@ -272,11 +272,12 @@ let generate_kf ~loc fname env ret_ty params_ty params_ival li = ...@@ -272,11 +272,12 @@ let generate_kf ~loc fname env ret_ty params_ty params_ival li =
(**************************************************************************) (**************************************************************************)
(***************************** Memoization ********************************) (***************************** Memoization ********************************)
(**************************************************************************) (**************************************************************************)
type fgen = (kernel_function, exn) result
(* for each logic_info, associate its possible profiles, i.e. the types of its (* for each logic_info, associate its possible profiles, i.e. the types of its
parameters + the generated varinfo for the function *) parameters + the generated varinfo for the function *)
let memo_tbl: let memo_tbl:
kernel_function Profile.Hashtbl.t Logic_info.Hashtbl.t fgen Profile.Hashtbl.t Logic_info.Hashtbl.t
= Logic_info.Hashtbl.create 7 = Logic_info.Hashtbl.create 7
let reset () = Logic_info.Hashtbl.clear memo_tbl let reset () = Logic_info.Hashtbl.clear memo_tbl
...@@ -292,8 +293,10 @@ let add_generated_functions globals = ...@@ -292,8 +293,10 @@ let add_generated_functions globals =
predicate *) predicate *)
let params = Logic_info.Hashtbl.find memo_tbl li in let params = Logic_info.Hashtbl.find memo_tbl li in
let add_fundecl kf acc = let add_fundecl kf acc =
GFunDecl(Cil.empty_funspec (), Kernel_function.get_vi kf, loc) let nospec = Cil.empty_funspec () in
:: acc match kf with
| Ok kf -> GFunDecl(nospec, Kernel_function.get_vi kf, loc) :: acc
| Error _ -> acc (* Exception has already been signaled *)
in in
aux aux
(Profile.Hashtbl.fold_sorted (Profile.Hashtbl.fold_sorted
...@@ -309,11 +312,13 @@ let add_generated_functions globals = ...@@ -309,11 +312,13 @@ let add_generated_functions globals =
let rev_globals = aux [] globals in let rev_globals = aux [] globals in
(* add the definitions at the end of [globals] *) (* add the definitions at the end of [globals] *)
let add_fundec kf globals = let add_fundec kf globals =
let fundec = let get_fundec kf =
try Kernel_function.get_definition kf try Kernel_function.get_definition kf
with Kernel_function.No_Definition -> assert false with Kernel_function.No_Definition -> assert false
in in
GFun(fundec, Location.unknown) :: globals match kf with
| Ok kf -> GFun(get_fundec kf, Location.unknown) :: globals
| Error _ -> globals
in in
let rev_globals = let rev_globals =
Logic_info.Hashtbl.fold_sorted Logic_info.Hashtbl.fold_sorted
...@@ -337,7 +342,7 @@ let function_to_exp ~loc ?tapp fname env kf li params_ty profile args = ...@@ -337,7 +342,7 @@ let function_to_exp ~loc ?tapp fname env kf li params_ty profile args =
let gen tbl = let gen tbl =
let vi, kf, gen_body = let vi, kf, gen_body =
generate_kf fname ~loc env ret_ty params_ty profile li in generate_kf fname ~loc env ret_ty params_ty profile li in
Profile.Hashtbl.add tbl profile kf; Profile.Hashtbl.add tbl profile (Ok kf);
vi, gen_body vi, gen_body
in in
(* memoise the function's varinfo *) (* memoise the function's varinfo *)
...@@ -346,6 +351,10 @@ let function_to_exp ~loc ?tapp fname env kf li params_ty profile args = ...@@ -346,6 +351,10 @@ let function_to_exp ~loc ?tapp fname env kf li params_ty profile args =
let h = Logic_info.Hashtbl.find memo_tbl li in let h = Logic_info.Hashtbl.find memo_tbl li in
try try
let kf = Profile.Hashtbl.find h profile in let kf = Profile.Hashtbl.find h profile in
let kf = match kf with
| Ok kf -> kf
| Error exn -> raise exn
in
Kernel_function.get_vi kf, Kernel_function.get_vi kf,
(fun () -> ()) (* body generation already planified *) (fun () -> ()) (* body generation already planified *)
with Not_found -> gen h with Not_found -> gen h
...@@ -500,7 +509,13 @@ let app_to_exp ~adata ~loc ?tapp kf env ?eargs li targs = ...@@ -500,7 +509,13 @@ let app_to_exp ~adata ~loc ?tapp kf env ?eargs li targs =
let profile = Profile.make li.l_profile params_ival in let profile = Profile.make li.l_profile params_ival in
let profile = Interval.get_widened_profile profile li in let profile = Interval.get_widened_profile profile li in
let vi, e, env = let vi, e, env =
function_to_exp ~loc ?tapp gen_fname env kf li params_ty profile args try
function_to_exp ~loc ?tapp gen_fname env kf li params_ty profile args
with exn ->
(* Those accesses always succeed *)
let h = Logic_info.Hashtbl.find memo_tbl li in
Profile.Hashtbl.replace h profile (Error exn);
raise exn
in in
vi, e, adata, env vi, e, adata, env
end end
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment