let rec cfg_block env prev edge_type blk next =
let rec cfg_stmts stmts = match stmts with
| [] -> ()
| [s] -> cfg_stmt env s next
| s1 :: ((s2 :: _) as tl) ->
cfg_stmt env s1 (get_stmt_node env s2 ); cfg_stmts tl
in match blk.bstmts with
| [] -> add_edge env prev edge_type next
| (s :: _) as stmts ->
add_edge env prev edge_type (get_stmt_node env s ); cfg_stmts stmts
and cfg_stmt env s next =
match s.skind with
| Instr _ | Return _ ->
let n = get_stmt_node env s in
add_edge env n Enone next
| Block b ->
let in_blk = get_node env (VblkIn s) in
let out_blk = get_node env (VblkOut s) in
cfg_block env in_blk Enone b out_blk;
add_edge env out_blk Enone next
| UnspecifiedSequence seq ->
let b = Cil.block_from_unspecified_sequence seq in
let in_blk = get_node env (VblkIn s) in
let out_blk = get_node env (VblkOut s) in
cfg_block env in_blk Enone b out_blk;
add_edge env out_blk Enone next
| If (e, b1, b2, _) ->
begin
match b1.bstmts, b2.bstmts with
| [], [] ->
let n = get_stmt_node env s in add_edge env n Enone next
| _, _ ->
let n = get_node env (Vtest (s, e)) in
cfg_block env n Ethen b1 next;
cfg_block env n Eelse b2 next
end
| Loop(_, b, _, _, _) ->
let n = get_stmt_node env s in
cfg_block env n Enone b n
| Break _ | Continue _ | Goto _ ->
begin
let n = get_stmt_node env s in
match s.succs with
| [s'] -> add_edge env n Enone (get_stmt_node env s')
| _ -> failwith "[cfg] jump with more than one successor ?"
end
| Switch _ ->
Extlib.not_yet_implemented "[cfg] switch handling"
| TryExcept _ | TryFinally _ ->
Extlib.not_yet_implemented "[cfg] exception handling"