let replace_label stmt =
let current_switch = ref [] in
let rec continue environment stmt = match stmt.stmt_t with
CTTstmtNull -> []
| CTTstmtExpr e ->
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
[st]
| CTTstmtLabeled( s, stmt ) -> make_il0 (IL0stmtLabel s)::continue environment stmt
| CTTstmtCase_Labeled( n, stmt ) ->
let s = make_label() in
current_switch := ( CASE n, s )::!current_switch;
make_il0 (IL0stmtLabel s)::continue environment stmt
| CTTstmtDefault_Labeled stmt ->
let s = make_label() in
current_switch := ( DEFAULT, s )::!current_switch;
make_il0 (IL0stmtLabel s)::continue environment stmt
| CTTstmtCompound( declaration_list, stmt_list ) ->
let declaration_list = List.map translate_declaration declaration_list in
let rec map_flatten f = function
[] -> []
| stmt::l -> (f stmt)@(map_flatten f l)
in
(map_flatten replace_label_localdecl declaration_list)
@(map_flatten (continue environment) stmt_list)
| CTTstmtIf( e, stmt1, None ) ->
let s = make_label() in
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
st :: make_il0 (IL0stmtIf(IFNOT, v, s ))::(continue environment stmt1)@[make_il0 (IL0stmtLabel s)]
| CTTstmtIf( e, stmt1, Some stmt2 ) ->
let s1, s2 = make_label(), make_label() in
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
st :: make_il0 (IL0stmtIf(IFNOT, v, s1 ))
::(continue environment stmt1)
@[make_il0 (IL0stmtGoto s2); make_il0 (IL0stmtLabel s1)]
@(continue environment stmt2)
@[make_il0 (IL0stmtLabel s2)]
| CTTstmtSwitch( e, stmt ) ->
let s = make_label() in
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
let environment = ( BREAK, s )::environment in
let outer_switch = !current_switch in
current_switch := [];
let stmt = continue environment stmt in
let result = st::make_il0 (IL0stmtSwitch( v, !current_switch ))::stmt
@[make_il0 (IL0stmtLabel s)] in
current_switch := outer_switch;
result
| CTTstmtWhile( e, stmt ) ->
let s1, s2 = make_label(), make_label() in
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
let environment = ( BREAK, s2 )::( CONTINUE, s1 )::environment in
make_il0 (IL0stmtLabel s1)
:: st
::make_il0 (IL0stmtIf(IFNOT, v, s2 ))
::(continue environment stmt)
@[make_il0 (IL0stmtGoto s1); make_il0 (IL0stmtLabel s2)]
| CTTstmtDoWhile( stmt, e ) ->
let e = Cttm_abstree.translate e in
let s1, s2 = make_label(), make_label() in
let v, st = translate_mexpr e in
let environment = ( BREAK, s2 )::( CONTINUE, s1 )::environment in
make_il0 (IL0stmtLabel s1)
::(continue environment stmt)
@[st]@[make_il0 (IL0stmtIf(IFTRUE, v, s1 )); make_il0 (IL0stmtLabel s2)]
| CTTstmtFor( e1, e2, e3, stmt ) ->
let translate_mexpr_option = function
None -> -1, []
| Some e ->
let e, s = translate_mexpr (Cttm_abstree.translate e) in
e, [s]
in
let s1, s2, s3 = make_label(), make_label(), make_label() in
let v1, st1 = translate_mexpr_option e1 in
let v2, st2 = translate_mexpr_option e2 in
let v3, st3 = translate_mexpr_option e3 in
let environment = ( BREAK, s3 )::( CONTINUE, s2 )::environment in
st1
@[make_il0 (IL0stmtLabel s1)]
@(match e2 with
Some e ->
st2 @ [make_il0 (IL0stmtIf(IFNOT, v2, s3 ))]
| None ->
[])
@(continue environment stmt)
@[make_il0 (IL0stmtLabel s2)]
@ st3
@[make_il0 (IL0stmtGoto s1); make_il0 (IL0stmtLabel s3)]
| CTTstmtGoto s -> [make_il0 (IL0stmtGoto s)]
| CTTstmtContinue ->
let s =
try
List.assoc CONTINUE environment
with Not_found ->
print_string "continue statement not within a loop\n";
raise Error
in
[make_il0 (IL0stmtGoto s)]
| CTTstmtBreak ->
let s =
try
List.assoc BREAK environment
with Not_found ->
print_string "break statement not within a loop\n";
raise Error
in
[make_il0 (IL0stmtGoto s)]
| CTTstmtReturn None ->
[make_il0 (IL0stmtReturn None)]
| CTTstmtReturn (Some e) ->
let e = Cttm_abstree.translate e in
let v, st = translate_mexpr e in
st :: [make_il0 (IL0stmtReturn (Some v))]
in
enclose_sequence (continue [] stmt)