diff options
| author | Alasdair Armstrong | 2018-07-03 19:06:03 +0100 |
|---|---|---|
| committer | Alasdair Armstrong | 2018-07-03 19:08:08 +0100 |
| commit | 53959905b8e4bfd4877c1e052195391d89bdb0d6 (patch) | |
| tree | 7f1717e5d584c9bf384f7d8244b386f2f6599154 /src | |
| parent | c1c51761101cd9313df3b111accb6237e558f0d2 (diff) | |
Fix a bug in foreach loops
We should test before the first iteration in case 'to' starts out as
less than 'from'.
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_backend.ml | 15 |
1 files changed, 7 insertions, 8 deletions
diff --git a/src/c_backend.ml b/src/c_backend.ml index 8a41df67..4335e98e 100644 --- a/src/c_backend.ml +++ b/src/c_backend.ml @@ -1215,6 +1215,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) = in let loop_start_label = label "for_start_" in + let loop_end_label = label "for_end_" in let body_setup, _, body_call, body_cleanup = compile_aexp ctx body in let body_gs = gensym () in @@ -1223,17 +1224,15 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) = @ variable_init step_gs step_setup step_ctyp step_call step_cleanup @ [iblock ([idecl CT_int64 loop_var; icopy (CL_id loop_var) (F_id from_gs, CT_int64); - ilabel loop_start_label; idecl CT_unit body_gs; - iblock (body_setup + iblock ([ilabel loop_start_label] + @ [ijump (F_op (F_id loop_var, (if is_inc then ">" else "<"), F_id to_gs), CT_bool) loop_end_label] + @ body_setup @ [body_call (CL_id body_gs)] @ body_cleanup - @ if is_inc then - [icopy (CL_id loop_var) (F_op (F_id loop_var, "+", F_id step_gs), CT_int64); - ijump (F_op (F_id loop_var, "<=", F_id to_gs), CT_bool) loop_start_label] - else - [icopy (CL_id loop_var) (F_op (F_id loop_var, "-", F_id step_gs), CT_int64); - ijump (F_op (F_id loop_var, ">=", F_id to_gs), CT_bool) loop_start_label])])], + @ [icopy (CL_id loop_var) (F_op (F_id loop_var, (if is_inc then "+" else "-"), F_id step_gs), CT_int64)] + @ [igoto loop_start_label]); + ilabel loop_end_label])], CT_unit, (fun clexp -> icopy clexp unit_fragment), [] |