Make pattern-alt drop the slots it initializes when binding slot patterns. Undoes most of the hackiness in 5e77e784f006e36c06252d9beccbd7893eddac73 and replaces it with a more proper fix.

3 files changed, 52 insertions, 37 deletions

diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index 25eb544a..9e234a8f 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -122,9 +122,10 @@ let stmt_collecting_visitor
                     htab_put slots key slot_id;
                     htab_put cx.ctxt_slot_keys slot_id key
                 | Ast.PAT_tag (_, pats) -> Array.iter (resolve_pat block) pats
-                | Ast.PAT_lit _ | Ast.PAT_wild -> ()
+                | Ast.PAT_lit _
+                | Ast.PAT_wild -> ()
             in
-            Array.iter (fun { node = (p, b) } -> resolve_pat b p) arms
+              Array.iter (fun { node = (p, b) } -> resolve_pat b p) arms
         | _ -> ()
     end;
     inner.Walk.visit_stmt_pre stmt
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index edb86294..385db253 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -4139,23 +4139,18 @@ let trans_visitor
     let trans_arm arm : quad_idx =
       let (pat, block) = arm.node in
 
-      (* Translates the pattern and returns the following pair.
-       *
-       *   fst: The addresses of the branch instructions that are taken if
-       *        the match fails.
-       *   snd: The (cell, slot) pairs of any slots bound and initialized
-       *        in PAT_slot pattern leaves.
+      (* Translates the pattern and returns the addresses of the branch
+       * instructions that are taken if the match fails.
        *)
       let rec trans_pat
           (pat:Ast.pat)
           (src_cell:Il.cell)
           (src_ty:Ast.ty)
-          : (quad_idx list) * ((Il.cell * Ast.slot) list) =
+          : quad_idx list =
 
         match pat with
             Ast.PAT_lit lit ->
-              (trans_compare_simple Il.JNE (trans_lit lit) (Il.Cell src_cell),
-               [])
+              trans_compare_simple Il.JNE (trans_lit lit) (Il.Cell src_cell)
 
           | Ast.PAT_tag (lval, pats) ->
               let tag_name = tag_ctor_name_to_tag_name (lval_to_name lval) in
@@ -4185,8 +4180,7 @@ let trans_visitor
 
               let tup_cell:Il.cell = get_variant_ptr union_cell tag_number in
 
-              let trans_elem_pat i elem_pat
-                  : (quad_idx list) * ((Il.cell * Ast.slot) list) =
+              let trans_elem_pat i elem_pat : quad_idx list =
                 let elem_cell =
                   get_element_ptr_dyn_in_current_frame tup_cell i
                 in
@@ -4194,10 +4188,10 @@ let trans_visitor
                   trans_pat elem_pat elem_cell elem_ty
               in
 
-              let (elem_jumps, bindings) =
-                List.split (Array.to_list (Array.mapi trans_elem_pat pats))
+              let elem_jumps =
+                List.concat (Array.to_list (Array.mapi trans_elem_pat pats))
               in
-                (next_jumps @ (List.concat elem_jumps), List.concat bindings)
+                next_jumps @ elem_jumps
 
           | Ast.PAT_slot (dst, _) ->
               let dst_slot = get_slot cx dst.id in
@@ -4206,24 +4200,14 @@ let trans_visitor
                   (get_ty_params_of_current_frame())
                   CLONE_none dst_cell dst_slot
                   src_cell src_ty;
-                ([], [(dst_cell, dst_slot)])   (* irrefutable *)
+                []                 (* irrefutable *)
 
-          | Ast.PAT_wild -> ([], [])           (* irrefutable *)
+          | Ast.PAT_wild -> []     (* irrefutable *)
       in
 
       let (lval_cell, lval_ty) = trans_lval at.Ast.alt_tag_lval in
-      let (next_jumps, bindings) = trans_pat pat lval_cell lval_ty in
+      let next_jumps = trans_pat pat lval_cell lval_ty in
         trans_block block;
-
-        (* Drop any slots we initialized in the leaf slot bindings of
-         * this arm's pattern.
-         *
-         * FIXME: Is `None` really correct to pass as the curr_iso?
-         *)
-        List.iter
-          (fun (cell, slot) -> drop_slot_in_current_frame cell slot None)
-          bindings;
-
         let last_jump = mark() in
           emit (Il.jmp Il.JMP Il.CodeNone);
           List.iter patch next_jumps;
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index 536a8ba2..4d65c809 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -1297,7 +1297,7 @@ let lifecycle_visitor
   let (live_block_slots:(node_id, unit) Hashtbl.t) = Hashtbl.create 0 in
   let (frame_blocks:frame_block_slots_stack) = Stack.create () in
 
-  let (implicit_init_block_slots:(node_id,node_id) Hashtbl.t) =
+  let (implicit_init_block_slots:(node_id,node_id list) Hashtbl.t) =
     Hashtbl.create 0
   in
 
@@ -1315,9 +1315,12 @@ let lifecycle_visitor
     begin
       match htab_search implicit_init_block_slots b.id with
           None -> ()
-        | Some slot ->
-            push_slot slot;
-            mark_slot_live slot
+        | Some slots ->
+            List.iter
+              (fun slot ->
+                 push_slot slot;
+                 mark_slot_live slot)
+              slots
     end;
     inner.Walk.visit_block_pre b
   in
@@ -1425,7 +1428,7 @@ let lifecycle_visitor
               Hashtbl.replace cx.ctxt_stmt_is_init s.id ();
               htab_put implicit_init_block_slots
                 f.Ast.for_body.id
-                (fst f.Ast.for_slot).id
+                [ (fst f.Ast.for_slot).id ]
 
           | Ast.STMT_for_each f ->
               log cx "noting implicit init for slot %d in for_each-block %d"
@@ -1434,9 +1437,36 @@ let lifecycle_visitor
               Hashtbl.replace cx.ctxt_stmt_is_init s.id ();
               htab_put implicit_init_block_slots
                 f.Ast.for_each_body.id
-                (fst f.Ast.for_each_slot).id
-
-
+                [ (fst f.Ast.for_each_slot).id ]
+
+          | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+              let note_slot block slot_id =
+                log cx
+                  "noting implicit init for slot %d in pattern-alt block %d"
+                  (int_of_node slot_id)
+                  (int_of_node block.id);
+              in
+              let rec all_pat_slot_ids block pat =
+                match pat with
+                    Ast.PAT_slot ({ id = slot_id }, _) ->
+                      [ slot_id ]
+                  | Ast.PAT_tag (_, pats) ->
+                      List.concat
+                        (Array.to_list
+                           (Array.map (all_pat_slot_ids block) pats))
+                  | Ast.PAT_lit _
+                  | Ast.PAT_wild -> []
+              in
+                Array.iter
+                  begin
+                    fun { node = (pat, block) } ->
+                      let slot_ids = all_pat_slot_ids block pat in
+                        List.iter (note_slot block) slot_ids;
+                        htab_put implicit_init_block_slots
+                          block.id
+                          slot_ids
+                  end
+                  arms
           | _ -> ()
     end;
     inner.Walk.visit_stmt_pre s