Skip to content

Commit

Permalink
Make pattern-alt drop the slots it initializes when binding slot patt…
Browse files Browse the repository at this point in the history
…erns. Undoes most of the hackiness in 5e77e78 and replaces it with a more proper fix.
  • Loading branch information
froystig committed Aug 28, 2010
1 parent 6ec8c21 commit 9481907
Show file tree
Hide file tree
Showing 3 changed files with 52 additions and 37 deletions.
5 changes: 3 additions & 2 deletions src/boot/me/resolve.ml
Expand Up @@ -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
Expand Down
38 changes: 11 additions & 27 deletions src/boot/me/trans.ml
Expand Up @@ -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
Expand Down Expand Up @@ -4185,19 +4180,18 @@ 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
let elem_ty = ty_tup.(i) in
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
Expand All @@ -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;
Expand Down
46 changes: 38 additions & 8 deletions src/boot/me/typestate.ml
Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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
Expand Down

0 comments on commit 9481907

Please sign in to comment.