diff options
| author | Alasdair | 2020-05-14 10:25:33 +0100 |
|---|---|---|
| committer | Alasdair | 2020-05-14 10:25:33 +0100 |
| commit | a6c52e67303b9180c6925d0538769304883e6cae (patch) | |
| tree | 2eb226c2e76b8c1c3c392a80c8f74929ba154e7a /src/jib/jib_compile.ml | |
| parent | 3f217002bd732d4c408af6bd34fafbb8bdd4404e (diff) | |
| parent | 88fe9754f897d3d96533748c6fc73a2d8da76fec (diff) | |
Merge remote-tracking branch 'origin' into codegen
Diffstat (limited to 'src/jib/jib_compile.ml')
| -rw-r--r-- | src/jib/jib_compile.ml | 15 |
1 files changed, 7 insertions, 8 deletions
diff --git a/src/jib/jib_compile.ml b/src/jib/jib_compile.ml index cd86840b..11bfa2fc 100644 --- a/src/jib/jib_compile.ml +++ b/src/jib/jib_compile.ml @@ -711,8 +711,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) = let ctyp = ctyp_of_typ ctx typ in let aexp_setup, aexp_call, aexp_cleanup = compile_aexp ctx aexp in let try_return_id = ngensym () in - let handled_exception_label = label "handled_exception_" in - let fallthrough_label = label "fallthrough_exception_" in + let post_exception_handlers_label = label "post_exception_handlers_" in let compile_case (apat, guard, body) = let trivial_guard = match guard with | AE_aux (AE_val (AV_lit (L_aux (L_true, _), _)), _, _) @@ -733,19 +732,19 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) = @ [icomment "end guard"] else []) @ body_setup @ [body_call (CL_id (try_return_id, ctyp))] @ body_cleanup @ destructure_cleanup - @ [igoto handled_exception_label] + @ [igoto post_exception_handlers_label] in [iblock case_instrs; ilabel try_label] in assert (ctyp_equal ctyp (ctyp_of_typ ctx typ)); [idecl ctyp try_return_id; itry_block (aexp_setup @ [aexp_call (CL_id (try_return_id, ctyp))] @ aexp_cleanup); - ijump l (V_call (Bnot, [V_id (have_exception, CT_bool)])) handled_exception_label] + ijump l (V_call (Bnot, [V_id (have_exception, CT_bool)])) post_exception_handlers_label; + icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool false, CT_bool))] @ List.concat (List.map compile_case cases) - @ [igoto fallthrough_label; - ilabel handled_exception_label; - icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool false, CT_bool)); - ilabel fallthrough_label], + @ [(* fallthrough *) + icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool true, CT_bool)); + ilabel post_exception_handlers_label], (fun clexp -> icopy l clexp (V_id (try_return_id, ctyp))), [] |