let rec add_type_to_statement ~env stmt =
let desc =
match stmt.pstmt_t with
PstmtExpr None -> CTTstmtNull
| PstmtExpr (Some e) ->
let e = add_type_to_expr ~env e in
let e = cast_coerce e type_void in
CTTstmtExpr e
| PstmtLabeled (l,s) ->
CTTstmtLabeled (l, add_type_to_statement ~env s)
| PstmtCase_Labeled (v,s) ->
let v = add_type_to_expr ~env v in
let v =
match v.expr_t with
CTTexpConstant (CTTconstInteger v) -> v
| _ -> raise (Type_Error_local "non-constant in case label")
in
CTTstmtCase_Labeled(v,add_type_to_statement ~env s)
| PstmtDefault_Labeled s ->
CTTstmtDefault_Labeled(add_type_to_statement ~env s)
| PstmtCompound(ds,ss) ->
extend_local_frame_env ~env;
let binds = parse_local_declarations ~env ds in
let ss = List.map (add_type_to_statement ~env) ss
in
shrink_local_frame_env ~env;
CTTstmtCompound(binds,ss)
| PstmtIf(e1,s1,s2) ->
let e1 = add_type_to_expr ~env e1 in
let e1 = coerce_to_boolean e1 in
let s1 = add_type_to_statement ~env s1 in
let s2 = Option.map (add_type_to_statement ~env) s2 in
CTTstmtIf(e1,s1,s2)
| PstmtSwitch(e,s) ->
let e = add_type_to_expr ~env e in
ensure_integer e;
let s = add_type_to_statement ~env s in
CTTstmtSwitch(e,s)
| PstmtWhile(e1,s1) ->
let e1 = add_type_to_expr ~env e1 in
let e1 = coerce_to_boolean e1 in
let s1 = add_type_to_statement ~env s1 in
CTTstmtWhile(e1,s1)
| PstmtDoWhile(s1,e1) ->
let s1 = add_type_to_statement ~env s1 in
let e1 = add_type_to_expr ~env e1 in
let e1 = coerce_to_boolean e1 in
CTTstmtDoWhile(s1,e1)
| PstmtFor(e1,e2,e3,s1) ->
let e1 = Option.map (fun e -> cast_coerce (add_type_to_expr ~env e) type_void) e1 in
let e2 = Option.map (fun e -> coerce_to_boolean (add_type_to_expr ~env e)) e2 in
let e3 = Option.map (fun e -> cast_coerce (add_type_to_expr ~env e) type_void) e3 in
let s1 = add_type_to_statement ~env s1 in
CTTstmtFor(e1,e2,e3,s1)
| PstmtGoto(l) -> CTTstmtGoto(l)
| PstmtContinue -> CTTstmtContinue
| PstmtBreak -> CTTstmtBreak
| PstmtReturn(e) ->
let rettype = get_return_type ~env in
match e with
None ->
if rettype.ct_ty <> Tvoid then
raise (Type_Error_local "no return value allowed in void-returning function")
else
CTTstmtReturn(None)
| Some e' ->
if rettype.ct_ty = Tvoid then
raise (Type_Error_local "return value expected")
else
let e' = add_type_to_expr ~env e' in
let e' = assign_coerce e' rettype in
CTTstmtReturn(Some e')
in
{ stmt_t = desc; stmt_pr = { ctt_loc = stmt.pstmt_pr.p_loc } }