let rec statement s =
let pos = get_stmtLoc s.skind in
CurrentLoc.set pos;
let assert_list =
Annotations.get_filter Logic_utils.is_assert s
@ Annotations.get_filter Logic_utils.is_stmt_invariant s
in
let assert_before,assert_after =
List.partition (function Before _ -> true | After _ -> false) assert_list
in
let assert_before =
List.flatten (List.map ((assert_ pos) $ before_after_content) assert_before)
in
let assert_after =
List.flatten (List.map ((assert_ pos) $ before_after_content) assert_after)
in
let snode = match s.skind with
| Instr i -> instruction i
| Return(Some e,pos) ->
JCPEreturn(expr pos e)
| Return(None,_pos) ->
JCPEreturn(mkexpr (JCPEconst JCCvoid) pos)
| Goto(sref,_pos) ->
let labels = filter_out is_case_label !sref.labels in
assert (not (labels = []));
JCPEgoto(label (List.hd labels))
| Break _pos ->
assert false
| Continue _pos ->
assert false
| If(e,bl1,bl2,pos) ->
JCPEif(boolean_expr pos e,block bl1,block bl2)
| Switch(e,bl,slist,pos) ->
let case_blocks stat_list case_list =
let rec next_case curr_list final_list stat_list case_list =
match stat_list,case_list with
| curr_stat :: rest_stat, curr_case :: rest_case ->
if curr_case.sid = curr_stat.sid then
let add_to_list cond e l = if cond e then e::l else l in
let not_empty_list = function [] -> false | _ -> true in
let final_list =
add_to_list not_empty_list (List.rev curr_list) final_list
in
let curr_list = [curr_stat] in
next_case curr_list final_list rest_stat rest_case
else
let curr_list = curr_stat :: curr_list in
next_case curr_list final_list rest_stat case_list
| [], [] ->
if List.length curr_list <> 0 then
List.rev curr_list :: final_list
else
final_list
| [], _ ->
assert false
| stat_list, [] ->
(List.rev_append curr_list stat_list) :: final_list
in
List.rev (next_case [] [] stat_list case_list)
in
let switch_label = function
| Label _ -> assert false
| Case(e,pos) -> Some(expr pos e)
| Default _ -> None
in
let case = function
| [] -> assert false
| case_stmt :: _ as slist ->
let switch_labels = List.filter is_case_label case_stmt.labels in
let labs = List.map switch_label switch_labels in
let slist = mkexpr (JCPEblock(statement_list slist)) pos in
labs, slist
in
let case_list = List.map case (case_blocks bl.bstmts slist) in
JCPEswitch(expr pos e,case_list)
| Loop (_,bl,_pos,_continue_stmt,_break_stmt) ->
let loop_annot =
Annotations.get_filter Logic_utils.is_loop_annot s
in
let loop_annot =
lift_annot_list_func (List.map (fun x -> x.annot_content)) loop_annot
in
let behs,variant =
List.fold_right
(fun annot (beh,var) ->
match annot with
| AVariant(v,rel) ->
begin
match var with
| None ->
begin
match rel with
| Some _ ->
unsupported "relation in variant"
| None ->
(beh,Some (locate (term v)))
end
| Some _ -> assert false
end
| AInvariant(ids,true,inv) ->
((ids,[locate (pred inv)],[])::beh,var)
| AAssigns(ids,assign) ->
((ids,[],[assign])::beh,var)
| APragma _ -> (beh,var)
| _ -> assert false
)
loop_annot ([],None)
in
let behs = List.map
(fun (beh_names,invs,ass) ->
let beh_names = built_behavior_ids beh_names in
let inv =
match invs with
| [] -> None
| _ -> Some (mkconjunct invs pos)
in
let ass = assigns ass in
(beh_names,inv,ass))
behs
in
JCPEwhile(true_expr,behs,variant,block bl)
| Block bl ->
JCPEblock(statement_list bl.bstmts)
| UnspecifiedSequence seq ->
JCPEblock(statement_list (List.map (fun (x,_,_) -> x) seq))
| TryFinally _ | TryExcept _ -> assert false
in
let labels = filter_out is_case_label s.labels in
let s = mkexpr snode pos in
let s = match assert_before @ s :: assert_after with
| [s] -> s
| slist -> mkexpr (JCPEblock slist) pos
in
List.fold_left (fun s lab -> mkexpr (JCPElabel(label lab,s)) pos) s labels
and statement_list slist = List.rev (List.rev_map statement slist)
and block bl =
match bl.bstmts with
| [] -> mkexpr (JCPEconst JCCvoid) Loc.dummy_position
| [s] -> statement s
| slist -> mkexpr (JCPEblock(statement_list slist)) Loc.dummy_position