Commit 518e49e6 authored by Julien Signoles's avatar Julien Signoles
Browse files

[e-acsl:lint] lintify dup_functions.ml before rewriting it

parent 221abc36
...@@ -381,4 +381,4 @@ ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/at_with_lscope.ml ...@@ -381,4 +381,4 @@ ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/at_with_lscope.ml
ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/at_with_lscope.mli ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/at_with_lscope.mli
ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/temporal.ml ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/temporal.ml
ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/temporal.mli ML_LINT_KO+=src/plugins/e-acsl/src/code_generator/temporal.mli
ML_LINT_KO+=src/plugins/e-acsl/src/project_initializer/dup_functions.ml
...@@ -45,7 +45,7 @@ end = struct ...@@ -45,7 +45,7 @@ end = struct
end end
let reset () = let reset () =
Kernel_function.Hashtbl.clear fct_tbl; Kernel_function.Hashtbl.clear fct_tbl;
Global.reset (); Global.reset ();
Queue.clear actions Queue.clear actions
...@@ -63,54 +63,54 @@ let dup_funspec tbl bhv spec = ...@@ -63,54 +63,54 @@ let dup_funspec tbl bhv spec =
method !vlogic_info_use li = method !vlogic_info_use li =
if Global.mem_logic_info li then if Global.mem_logic_info li then
Cil.ChangeDoChildrenPost Cil.ChangeDoChildrenPost
({ li with l_var_info = li.l_var_info } (* force a copy *), ({ li with l_var_info = li.l_var_info } (* force a copy *),
Visitor_behavior.Get.logic_info bhv) Visitor_behavior.Get.logic_info bhv)
else else
Cil.JustCopy Cil.JustCopy
method !vterm_offset _ = method !vterm_offset _ =
Cil.DoChildrenPost Cil.DoChildrenPost
(function (function
(* no way to directly visit fieldinfo and model_info uses *) (* no way to directly visit fieldinfo and model_info uses *)
| TField(fi, off) -> TField(Visitor_behavior.Get.fieldinfo bhv fi, off) | TField(fi, off) -> TField(Visitor_behavior.Get.fieldinfo bhv fi, off)
| TModel(mi, off) -> TModel(Visitor_behavior.Get.model_info bhv mi, off) | TModel(mi, off) -> TModel(Visitor_behavior.Get.model_info bhv mi, off)
| off -> off) | off -> off)
method !vlogic_var_use orig_lvi = method !vlogic_var_use orig_lvi =
match orig_lvi.lv_origin with match orig_lvi.lv_origin with
| None -> | None ->
Cil.JustCopy Cil.JustCopy
| Some vi -> | Some vi ->
try try
let new_lvi = let new_lvi =
Cil_datatype.Logic_var.Hashtbl.find already_visited orig_lvi Cil_datatype.Logic_var.Hashtbl.find already_visited orig_lvi
in in
Cil.ChangeTo new_lvi Cil.ChangeTo new_lvi
with Not_found -> with Not_found ->
Cil.ChangeDoChildrenPost Cil.ChangeDoChildrenPost
({ orig_lvi with lv_id = orig_lvi.lv_id } (* force a copy *), ({ orig_lvi with lv_id = orig_lvi.lv_id } (* force a copy *),
fun lvi -> fun lvi ->
(* using [Visitor_behavior.Get.logic_var bhv lvi] is correct only because the (* using [Visitor_behavior.Get.logic_var bhv lvi] is correct only because the
lv_id used to compare the lvi does not change between the lv_id used to compare the lvi does not change between the
original one and this copy *) original one and this copy *)
try try
let new_vi = Cil_datatype.Varinfo.Hashtbl.find tbl vi in let new_vi = Cil_datatype.Varinfo.Hashtbl.find tbl vi in
Cil_datatype.Logic_var.Hashtbl.add Cil_datatype.Logic_var.Hashtbl.add
already_visited orig_lvi lvi; already_visited orig_lvi lvi;
lvi.lv_id <- new_vi.vid; lvi.lv_id <- new_vi.vid;
lvi.lv_name <- new_vi.vname; lvi.lv_name <- new_vi.vname;
lvi.lv_origin <- Some new_vi; lvi.lv_origin <- Some new_vi;
new_vi.vlogic_var_assoc <- Some lvi; new_vi.vlogic_var_assoc <- Some lvi;
lvi lvi
with Not_found -> with Not_found ->
assert vi.vglob; assert vi.vglob;
Visitor_behavior.Get.logic_var bhv lvi) Visitor_behavior.Get.logic_var bhv lvi)
method !videntified_term _ = method !videntified_term _ =
Cil.DoChildrenPost Logic_const.refresh_identified_term Cil.DoChildrenPost Logic_const.refresh_identified_term
method !videntified_predicate _ = method !videntified_predicate _ =
Cil.DoChildrenPost Logic_const.refresh_predicate Cil.DoChildrenPost Logic_const.refresh_predicate
end in end in
Cil.visitCilFunspec o spec Cil.visitCilFunspec o spec
...@@ -187,7 +187,7 @@ let dup_global loc actions spec bhv sound_verdict_vi kf vi new_vi = ...@@ -187,7 +187,7 @@ let dup_global loc actions spec bhv sound_verdict_vi kf vi new_vi =
Globals.Functions.register new_kf; Globals.Functions.register new_kf;
Globals.Functions.replace_by_definition new_spec fundec loc; Globals.Functions.replace_by_definition new_spec fundec loc;
Annotations.register_funspec new_kf) Annotations.register_funspec new_kf)
actions; actions;
Options.feedback ~dkey ~level:2 "function %s" name; Options.feedback ~dkey ~level:2 "function %s" name;
(* remove the specs attached to the previous kf iff it is a definition: (* remove the specs attached to the previous kf iff it is a definition:
it is necessary to keep stable the number of annotations in order to get it is necessary to keep stable the number of annotations in order to get
...@@ -196,24 +196,24 @@ let dup_global loc actions spec bhv sound_verdict_vi kf vi new_vi = ...@@ -196,24 +196,24 @@ let dup_global loc actions spec bhv sound_verdict_vi kf vi new_vi =
if Kernel_function.is_definition kf then begin if Kernel_function.is_definition kf then begin
Queue.add Queue.add
(fun () -> (fun () ->
let bhvs = let bhvs =
Annotations.fold_behaviors (fun e b acc -> (e, b) :: acc) kf [] Annotations.fold_behaviors (fun e b acc -> (e, b) :: acc) kf []
in in
List.iter List.iter
(fun (e, b) -> Annotations.remove_behavior ~force:true e kf b) (fun (e, b) -> Annotations.remove_behavior ~force:true e kf b)
bhvs; bhvs;
Annotations.iter_decreases Annotations.iter_decreases
(fun e _ -> Annotations.remove_decreases e kf) (fun e _ -> Annotations.remove_decreases e kf)
kf; kf;
Annotations.iter_terminates Annotations.iter_terminates
(fun e _ -> Annotations.remove_terminates e kf) (fun e _ -> Annotations.remove_terminates e kf)
kf; kf;
Annotations.iter_complete Annotations.iter_complete
(fun e l -> Annotations.remove_complete e kf l) (fun e l -> Annotations.remove_complete e kf l)
kf; kf;
Annotations.iter_disjoint Annotations.iter_disjoint
(fun e l -> Annotations.remove_disjoint e kf l) (fun e l -> Annotations.remove_disjoint e kf l)
kf) kf)
actions actions
end; end;
GFun(fundec, loc), GFunDecl(new_spec, new_vi, loc) GFun(fundec, loc), GFunDecl(new_spec, new_vi, loc)
...@@ -253,8 +253,8 @@ class dup_functions_visitor prj = object (self) ...@@ -253,8 +253,8 @@ class dup_functions_visitor prj = object (self)
vi vi
method private before_memory_model = match before_memory_model with method private before_memory_model = match before_memory_model with
| Before_gmp | Gmpz | After_gmp -> true | Before_gmp | Gmpz | After_gmp -> true
| Memory_model | Code -> false | Memory_model | Code -> false
method private insert_libc l = method private insert_libc l =
match new_definitions with match new_definitions with
...@@ -297,7 +297,7 @@ class dup_functions_visitor prj = object (self) ...@@ -297,7 +297,7 @@ class dup_functions_visitor prj = object (self)
| _ -> false | _ -> false
method !vglob_aux = function method !vglob_aux = function
| GFunDecl(_, vi, loc) | GFun({ svar = vi }, loc) | GFunDecl(_, vi, loc) | GFun({ svar = vi }, loc)
when (* duplicate a function iff: *) when (* duplicate a function iff: *)
not (Cil_datatype.Varinfo.Hashtbl.mem fct_tbl vi) not (Cil_datatype.Varinfo.Hashtbl.mem fct_tbl vi)
(* it is not already duplicated *) (* it is not already duplicated *)
...@@ -321,89 +321,89 @@ class dup_functions_visitor prj = object (self) ...@@ -321,89 +321,89 @@ class dup_functions_visitor prj = object (self)
&& Functions.check kf && Functions.check kf
(* its annotations must be monitored *))) (* its annotations must be monitored *)))
-> ->
self#next (); self#next ();
let name = Functions.RTL.mk_gen_name vi.vname in let name = Functions.RTL.mk_gen_name vi.vname in
let new_vi = let new_vi =
Project.on prj (Cil.makeGlobalVar name) vi.vtype Project.on prj (Cil.makeGlobalVar name) vi.vtype
in in
Cil_datatype.Varinfo.Hashtbl.add fct_tbl vi new_vi; Cil_datatype.Varinfo.Hashtbl.add fct_tbl vi new_vi;
Cil.DoChildrenPost Cil.DoChildrenPost
(fun l -> match l with (fun l -> match l with
| [ GVarDecl(vi, _) | GFunDecl(_, vi, _) | GFun({ svar = vi }, _) as g ] | [ GVarDecl(vi, _) | GFunDecl(_, vi, _) | GFun({ svar = vi }, _) as g ]
-> ->
(match g with (match g with
| GFunDecl _ -> | GFunDecl _ ->
if not (Kernel_function.is_definition (Extlib.the self#current_kf)) if not (Kernel_function.is_definition (Extlib.the self#current_kf))
&& vi.vname <> "malloc" && vi.vname <> "free" && vi.vname <> "malloc" && vi.vname <> "free"
then then
Options.warning "@[annotating undefined function `%a':@ \ Options.warning "@[annotating undefined function `%a':@ \
the generated program may miss memory instrumentation@ \ the generated program may miss memory instrumentation@ \
if there are memory-related annotations.@]" if there are memory-related annotations.@]"
Printer.pp_varinfo vi Printer.pp_varinfo vi
| GFun _ -> () | GFun _ -> ()
| _ -> assert false); | _ -> assert false);
let tmp = vi.vname in let tmp = vi.vname in
if tmp = Kernel.MainFunction.get () then begin if tmp = Kernel.MainFunction.get () then begin
(* the new function becomes the new main: simply swap the name of both (* the new function becomes the new main: simply swap the name of both
functions *) functions *)
vi.vname <- new_vi.vname; vi.vname <- new_vi.vname;
new_vi.vname <- tmp new_vi.vname <- tmp
end; end;
let kf = let kf =
try try
Globals.Functions.get (Visitor_behavior.Get_orig.varinfo self#behavior vi) Globals.Functions.get (Visitor_behavior.Get_orig.varinfo self#behavior vi)
with Not_found -> with Not_found ->
Options.fatal Options.fatal
"unknown function `%s' while trying to duplicate it" "unknown function `%s' while trying to duplicate it"
vi.vname vi.vname
in in
let spec = Annotations.funspec ~populate:false kf in let spec = Annotations.funspec ~populate:false kf in
let vi_bhv = Visitor_behavior.Get.varinfo self#behavior vi in let vi_bhv = Visitor_behavior.Get.varinfo self#behavior vi in
let new_g, new_decl = let new_g, new_decl =
dup_global dup_global
loc loc
self#get_filling_actions self#get_filling_actions
spec spec
self#behavior self#behavior
sound_verdict_vi sound_verdict_vi
kf kf
vi_bhv vi_bhv
new_vi new_vi
in in
(* postpone the introduction of the new function definition to the (* postpone the introduction of the new function definition to the
end *) end *)
new_definitions <- new_g :: new_definitions; new_definitions <- new_g :: new_definitions;
(* put the declaration before the original function in order to solve (* put the declaration before the original function in order to solve
issue with recursive functions *) issue with recursive functions *)
[ new_decl; g ] [ new_decl; g ]
| _ -> assert false) | _ -> assert false)
| GVarDecl(_, loc) | GFunDecl(_, _, loc) | GFun(_, loc) | GVarDecl(_, loc) | GFunDecl(_, _, loc) | GFun(_, loc)
when Misc.is_library_loc loc -> when Misc.is_library_loc loc ->
(match before_memory_model with (match before_memory_model with
| Before_gmp -> before_memory_model <- Gmpz | Before_gmp -> before_memory_model <- Gmpz
| Gmpz | Memory_model -> () | Gmpz | Memory_model -> ()
| After_gmp -> before_memory_model <- Memory_model | After_gmp -> before_memory_model <- Memory_model
| Code -> () (* still processing the GMP and memory model headers, | Code -> () (* still processing the GMP and memory model headers,
but reading some libc code *)); but reading some libc code *));
Cil.JustCopy Cil.JustCopy
| GVarDecl(vi, _) | GFunDecl(_, vi, _) | GFun({ svar = vi }, _) | GVarDecl(vi, _) | GFunDecl(_, vi, _) | GFun({ svar = vi }, _)
when Misc.is_fc_or_compiler_builtin vi -> when Misc.is_fc_or_compiler_builtin vi ->
self#next (); self#next ();
Cil.JustCopy Cil.JustCopy
| _ -> | _ ->
self#next (); self#next ();
Cil.DoChildren Cil.DoChildren
method !vfile _ = method !vfile _ =
Cil.DoChildrenPost Cil.DoChildrenPost
(fun f -> (fun f ->
match new_definitions with match new_definitions with
| [] -> f | [] -> f
| _ :: _ -> | _ :: _ ->
(* required by the few cases where there is no global tagged as (* required by the few cases where there is no global tagged as
[Code] in the file. *) [Code] in the file. *)
f.globals <- self#insert_libc f.globals; f.globals <- self#insert_libc f.globals;
f) f)
initializer initializer
Project.copy ~selection:(Parameter_state.get_selection ()) prj; Project.copy ~selection:(Parameter_state.get_selection ()) prj;
......
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