method vstmt (s:stmt) =
begin
let infer_widen_variables bl enclosing_loop_info =
(* Look at the if-goto and if-break statements.
The variables of the condition are added to the
widening variable set for this loop.
These variables may control the loop. That may be not the case ! *)
(* Format.printf "Look at widening variables.\n" ; *)
let visitor = new widen_visitor kf widen_hints enclosing_loop_info
in
ignore (Visitor.visitFramacBlock visitor bl);
Cil.SkipChildren
in
begin match s.skind with
| Loop (_, bl, _, _, _) ->
let annot = Annotations.get_all_annotations s in
let l_pragma =
Ast_info.lift_annot_list_func
Logic_utils.extract_loop_pragma annot
in
let widening_stmts = match bl.bstmts with
| [] -> [ s]
| x :: _ -> [ s; x ]
in
(* Look at the loop pragmas *)
let is_pragma_widen_variables = ref false
in let f p =
match p with
| Widen_variables l ->
let f (lv, lt) t =
match t with
| { term_node= TLval (TVar {lv_origin = Some vi}, _)} ->
let vid = Base.create_varinfo vi in
(* Format.printf "Reading user pragma for widening variable: %a.\n"
Base.pretty (Base.Var vi); *)
(vid::lv, lt)
| _ -> (lv, t::lt)
in
begin match List.fold_left f ([], []) l with
| (lv, []) ->
(* the annotation is empty or else,
there are only variables *)
let var_hints =
List.fold_left
(fun s x -> Base.Set.add x s)
Base.Set.empty
lv
in
List.iter
(fun widening_stmt ->
widen_hints :=
Widen_type.add_var_hints
widening_stmt
var_hints
!widen_hints)
widening_stmts;
is_pragma_widen_variables := true
| (_lv, _lt) ->
Kernel.warning ~once:true ~current:true
"could not interpret loop pragma relative to widening variables"
end
| Widen_hints l ->
let f (lv, lnum, lt) t =
match t with
| { term_node=
TLval (TVar { lv_origin = Some vi}, _)} ->
let vid = Base.create_varinfo vi in
(vid::lv, lnum, lt)
| { term_node= TConst (CInt64(v,_,_))} ->
let v = Ival.Widen_Hints.V.of_int64 (My_bigint.to_int64 v)
in (lv, v::lnum, lt)
| _ -> (lv, lnum, t::lt)
in begin match List.fold_left f ([], [], []) l with
| (lv, lnum, []) ->
(* the annotation is emty or else, there are only variables *)
let hints =
List.fold_right Ival.Widen_Hints.add lnum Ival.Widen_Hints.empty
in
List.iter
(fun key ->
List.iter
(fun widening_stmt -> widen_hints :=
Widen_type.add_num_hints (Some(widening_stmt))
(Widen_type.VarKey(key)) hints !widen_hints)
widening_stmts)
lv
| _ ->
Kernel.warning ~once:true ~current:true
"could not interpret loop pragma relative to widening hint"
end
| _ -> ()
in List.iter f l_pragma ;
if not !is_pragma_widen_variables then
let loop =
try Loop.get_loop_stmts kf s
with Loop.No_such_while -> assert false
in
(* There is no Widen_variables pragma for this loop. *)
infer_widen_variables bl (Some (widening_stmts, loop))
else
Cil.DoChildren
| If (exp, bl_then, bl_else, _) ->
begin
match enclosing_loop_info with
| None -> ()
| Some (widening_stmts, loop_stmts) ->
List.iter
(fun bl ->
match bl with
| {bstmts = []} -> ()
| {bstmts =
({skind = Break _; succs = [stmt]}|
{skind = Goto ({contents=stmt},_)})::_}
when not (Stmt.Set.mem stmt loop_stmts) ->
let varinfos = Cil.extract_varinfos_from_exp exp
in let var_hints =
Varinfo.Set.fold
(fun vi lv ->
(*Format.printf "Inferring pragma for widening variable: %a.\n" Base.pretty (Base.Var vi);*)
Base.Set.add (Base.create_varinfo vi) lv)
varinfos
Base.Set.empty
in
List.iter
(fun widening_stmt ->
widen_hints :=
Widen_type.add_var_hints
widening_stmt
var_hints
!widen_hints)
widening_stmts
| _ -> ())
[bl_then ; bl_else]
end;
Cil.DoChildren
| _ ->
Cil.DoChildren
end ;
end