@@ -4138,12 +4138,24 @@ let trans_visitor
4138
4138
4139
4139
let trans_arm arm : quad_idx =
4140
4140
let (pat, block) = arm.node in
4141
- (* Translates the pattern and returns the addresses of the branch
4142
- * instructions, which are taken if the match fails. *)
4143
- let rec trans_pat pat src_cell src_ty =
4141
+
4142
+ (* Translates the pattern and returns the following pair.
4143
+ *
4144
+ * fst: The addresses of the branch instructions that are taken if
4145
+ * the match fails.
4146
+ * snd: The (cell, slot) pairs of any slots bound and initialized
4147
+ * in PAT_slot pattern leaves.
4148
+ *)
4149
+ let rec trans_pat
4150
+ (pat :Ast.pat )
4151
+ (src_cell :Il.cell )
4152
+ (src_ty :Ast.ty )
4153
+ : (quad_idx list) * ((Il.cell * Ast.slot) list) =
4154
+
4144
4155
match pat with
4145
4156
Ast. PAT_lit lit ->
4146
- trans_compare_simple Il. JNE (trans_lit lit) (Il. Cell src_cell)
4157
+ (trans_compare_simple Il. JNE (trans_lit lit) (Il. Cell src_cell),
4158
+ [] )
4147
4159
4148
4160
| Ast. PAT_tag (lval , pats ) ->
4149
4161
let tag_name = tag_ctor_name_to_tag_name (lval_to_name lval) in
@@ -4173,16 +4185,19 @@ let trans_visitor
4173
4185
4174
4186
let tup_cell:Il. cell = get_variant_ptr union_cell tag_number in
4175
4187
4176
- let trans_elem_pat i elem_pat : quad_idx list =
4188
+ let trans_elem_pat i elem_pat
4189
+ : (quad_idx list) * ((Il.cell * Ast.slot) list) =
4177
4190
let elem_cell =
4178
4191
get_element_ptr_dyn_in_current_frame tup_cell i
4179
4192
in
4180
4193
let elem_ty = ty_tup.(i) in
4181
4194
trans_pat elem_pat elem_cell elem_ty
4182
4195
in
4183
4196
4184
- let elem_jumps = Array. mapi trans_elem_pat pats in
4185
- next_jumps @ (List. concat (Array. to_list elem_jumps))
4197
+ let (elem_jumps, bindings) =
4198
+ List. split (Array. to_list (Array. mapi trans_elem_pat pats))
4199
+ in
4200
+ (next_jumps @ (List. concat elem_jumps), List. concat bindings)
4186
4201
4187
4202
| Ast. PAT_slot (dst , _ ) ->
4188
4203
let dst_slot = get_slot cx dst.id in
@@ -4191,14 +4206,24 @@ let trans_visitor
4191
4206
(get_ty_params_of_current_frame() )
4192
4207
CLONE_none dst_cell dst_slot
4193
4208
src_cell src_ty;
4194
- [] (* irrefutable *)
4209
+ ( [] , [(dst_cell, dst_slot)]) (* irrefutable *)
4195
4210
4196
- | Ast. PAT_wild -> [] (* irrefutable *)
4211
+ | Ast. PAT_wild -> ( [] , [] ) (* irrefutable *)
4197
4212
in
4198
4213
4199
4214
let (lval_cell, lval_ty) = trans_lval at.Ast. alt_tag_lval in
4200
- let next_jumps = trans_pat pat lval_cell lval_ty in
4215
+ let ( next_jumps, bindings) = trans_pat pat lval_cell lval_ty in
4201
4216
trans_block block;
4217
+
4218
+ (* Drop any slots we initialized in the leaf slot bindings of
4219
+ * this arm's pattern.
4220
+ *
4221
+ * FIXME: Is `None` really correct to pass as the curr_iso?
4222
+ *)
4223
+ List. iter
4224
+ (fun (cell , slot ) -> drop_slot_in_current_frame cell slot None )
4225
+ bindings;
4226
+
4202
4227
let last_jump = mark() in
4203
4228
emit (Il. jmp Il. JMP Il. CodeNone );
4204
4229
List. iter patch next_jumps;
0 commit comments