method vstmt_aux s = match s.skind with
| Loop _ ->
let annot = Annotations.get_all_annotations s in
let pragmas =
Ast_info.lift_annot_list_func Logic_utils.extract_loop_pragma annot
in
let filter (b,_ as elt) p =
match (b,p) with
| false, Unroll_level {term_node=TConst (CInt64(v,_,_))} ->
true, Int64.to_int v
| true, Unroll_level _ ->
ignore (CilE.warn_once "ignoring unrolling directive (directive already defined)");
elt
| _, _ ->
elt
in
let (_, number) = List.fold_left filter (false, times) pragmas in
let f s = match s.skind with
| Loop(_,block,loc,_,_) ->
CurrentLoc.set loc;
let break_label = fresh () in
let break_lbl_stmt = mkEmptyStmt () in
break_lbl_stmt.labels <- [break_label];
break_lbl_stmt.sid <- Cil.Sid.next ();
let mk_continue () =
let continue_label = fresh () in
let continue_lbl_stmt = mkEmptyStmt () in
continue_lbl_stmt.labels <- [continue_label] ;
continue_lbl_stmt.sid <- Cil.Sid.next ();
continue_lbl_stmt
in
let current_continue = ref (mk_continue ()) in
let new_stmts = ref [s] in
for i=0 to number-1 do
new_stmts:=!current_continue::!new_stmts;
let new_block, label_tbl,_calls_tbl =
copy_block
(Extlib.the self#current_func)
(Some (break_lbl_stmt,!current_continue))
Stmt.Map.empty
Stmt.Map.empty
block
in
let updated_block = CilE.update_gotos label_tbl new_block in
current_continue := mk_continue ();
(match updated_block.blocals with
[] -> new_stmts:= updated_block.bstmts @ !new_stmts;
| _ ->
new_stmts:= mkStmt (Block updated_block) :: !new_stmts);
done;
let new_stmt = match !new_stmts with
[ s ] -> s
| l ->
let new_stmts = l @ [break_lbl_stmt] in
let new_block = mkBlock new_stmts in
mkStmt (Block new_block)
in new_stmt
| _ -> assert false
in
ChangeDoChildrenPost (s, f)
| _ -> DoChildren