let rec copy_stmt
fundec break_continue_must_change label_table calls_tbl stmt
=
let result =
{ labels=[]; sid=0; succs=[]; preds=[]; skind=stmt.skind; ghost=stmt.ghost}
in
let new_labels,label_tbl,sid =
let new_label = fresh () in
let sid = Sid.next () in
let new_acc =
List.fold_left
(fun acc _ -> Stmt.Map.add stmt result acc)
label_table
stmt.labels
in
[ new_label ], new_acc, sid
in
let new_calls_tbl = match stmt.skind with
| Instr(Call _) -> Stmt.Map.add stmt result calls_tbl
| _ -> calls_tbl
in
let new_stmkind,new_label_tbl, new_calls_tbl =
copy_stmtkind
fundec break_continue_must_change label_tbl new_calls_tbl stmt.skind
in
if stmt.labels <> [] then result.labels <- new_labels;
result.sid <-sid;
result.skind <- new_stmkind;
let new_annots =
Annotations.fold_stmt
(fun s (annot,_) acc ->
let new_annot =
let content = match Ast_info.before_after_content annot with
| User a -> User(Logic_const.refresh_code_annotation a)
| AI(c, a) -> AI(c, Logic_const.refresh_code_annotation a)
in
match annot with
| Before _ -> Before content
| After _ -> After content
in
(new_annot, match s with None -> [] | Some s -> [ s ]) :: acc)
stmt
[]
in
List.iter (fun (a, dep) -> Annotations.add result dep a) new_annots;
result, new_label_tbl, new_calls_tbl
and copy_stmtkind
fundec break_continue_must_change label_tbl calls_tbl stkind =
match stkind with
|(Instr _ | Return _ | Goto _) as keep -> keep,label_tbl,calls_tbl
| If (exp,bl1,bl2,loc) ->
CurrentLoc.set loc;
let new_block1,label_tbl,calls_tbl =
copy_block fundec break_continue_must_change label_tbl calls_tbl bl1
in
let new_block2,label_tbl,calls_tbl =
copy_block fundec break_continue_must_change label_tbl calls_tbl bl2
in
If(exp,new_block1,new_block2,loc),label_tbl,calls_tbl
| Loop (a,bl,loc,_,_) ->
CurrentLoc.set loc;
let new_block,label_tbl,calls_tbl =
copy_block
fundec
None
label_tbl
calls_tbl
bl
in
Loop (a,new_block,loc,None,None),label_tbl,calls_tbl
| Block bl ->
let new_block,label_tbl,calls_tbl =
copy_block fundec break_continue_must_change label_tbl calls_tbl bl
in
Block (new_block),label_tbl,calls_tbl
| UnspecifiedSequence seq ->
let change_calls lst calls_tbl =
List.map
(fun x -> ref (Stmt.Map.find !x calls_tbl)) lst
in
let new_seq,label_tbl,calls_tbl =
List.fold_left
(fun (seq,label_tbl,calls_tbl) (stmt,modified,writes,reads,calls) ->
let stmt,label_tbl,calls_tbl =
copy_stmt
fundec break_continue_must_change label_tbl calls_tbl stmt
in
(stmt,modified,writes,reads,change_calls calls calls_tbl)::seq,
label_tbl,calls_tbl)
([],label_tbl,calls_tbl)
seq
in
UnspecifiedSequence (List.rev new_seq),label_tbl,calls_tbl
| Break loc ->
(match break_continue_must_change with
| None -> stkind
| Some (brk_lbl_stmt,_) -> Goto ((ref brk_lbl_stmt),loc)),
label_tbl,
calls_tbl
| Continue loc ->
(match break_continue_must_change with
| None -> stkind
| Some (_,continue_lbl_stmt) ->
Goto ((ref continue_lbl_stmt),loc)),
label_tbl,
calls_tbl
| Switch (e,block,stmts,loc) ->
let new_block,new_label_tbl,calls_tbl =
copy_block fundec None label_tbl calls_tbl block
in
Switch(e,new_block,stmts,loc),new_label_tbl,calls_tbl
| TryFinally _ | TryExcept _ -> assert false
and copy_block fundec break_continue_must_change label_tbl calls_tbl bl =
let new_stmts,label_tbl,calls_tbl =
List.fold_left
(fun (block_l,label_tbl,calls_tbl) v ->
let new_block,label_tbl,calls_tbl =
copy_stmt fundec break_continue_must_change label_tbl calls_tbl v
in
new_block::block_l, label_tbl,calls_tbl)
([],label_tbl,calls_tbl) bl.bstmts
in
let new_locals =
List.map (copy_var ()) bl.blocals
in
fundec.slocals <- fundec.slocals @ new_locals;
let new_block = mkBlock
(List.rev_map
(refresh_vars new_locals bl.blocals)
new_stmts)
in
new_block.blocals <- new_locals;
new_block,label_tbl,calls_tbl