aboutsummaryrefslogtreecommitdiff
path: root/src/boot/me
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/me')
-rw-r--r--src/boot/me/alias.ml8
-rw-r--r--src/boot/me/trans.ml94
-rw-r--r--src/boot/me/type.ml20
-rw-r--r--src/boot/me/typestate.ml40
-rw-r--r--src/boot/me/walk.ml14
5 files changed, 82 insertions, 94 deletions
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml
index 148f1249..a038030e 100644
--- a/src/boot/me/alias.ml
+++ b/src/boot/me/alias.ml
@@ -65,10 +65,10 @@ let alias_analysis_visitor
| Ast.STMT_send (_, src) -> alias src
| Ast.STMT_recv (dst, _) -> alias dst
- | Ast.STMT_init_port (dst) -> alias dst
- | Ast.STMT_init_chan (dst, _) -> alias dst
- | Ast.STMT_init_vec (dst, _, _) -> alias dst
- | Ast.STMT_init_str (dst, _) -> alias dst
+ | Ast.STMT_new_port (dst) -> alias dst
+ | Ast.STMT_new_chan (dst, _) -> alias dst
+ | Ast.STMT_new_vec (dst, _, _) -> alias dst
+ | Ast.STMT_new_str (dst, _) -> alias dst
| Ast.STMT_for_each sfe ->
let (slot, _) = sfe.Ast.for_each_slot in
alias_slot slot.id
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 78a3257e..3948fbd6 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -1250,15 +1250,16 @@ let trans_visitor
(sorted_htab_keys fns))
end
- and trans_init_str (initializing:bool) (dst:Ast.lval) (s:string) : unit =
+ and drop_existing_if_not_init init cell ty =
+ if not init
+ then drop_ty_in_current_frame cell ty
+
+ and trans_new_str (initializing:bool) (dst:Ast.lval) (s:string) : unit =
(* Include null byte. *)
let init_sz = Int64.of_int ((String.length s) + 1) in
let static = trans_static_string s in
let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
- let _ =
- if not initializing
- then drop_ty_in_current_frame dst_cell dst_ty
- in
+ drop_existing_if_not_init initializing dst_cell dst_ty;
trans_upcall "upcall_new_str" dst_cell [| static; imm init_sz |]
and trans_lit (lit:Ast.lit) : Il.operand =
@@ -2236,32 +2237,26 @@ let trans_visitor
trans_atom (Ast.ATOM_lval chan) |];
end
- and trans_init_port (initializing:bool) (dst:Ast.lval) : unit =
+ and trans_new_port (initializing:bool) (dst:Ast.lval) : unit =
let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
- let _ =
- if not initializing
- then drop_ty_in_current_frame dst_cell dst_ty
- in
let unit_ty = match dst_ty with
Ast.TY_port t -> t
| _ -> bug () "init dst of port-init has non-port type"
in
let unit_sz = ty_sz abi unit_ty in
+ drop_existing_if_not_init initializing dst_cell dst_ty;
trans_upcall "upcall_new_port" dst_cell [| imm unit_sz |]
and trans_del_port (port:Il.cell) : unit =
trans_void_upcall "upcall_del_port" [| Il.Cell port |]
- and trans_init_chan
+ and trans_new_chan
(initializing:bool)
(dst:Ast.lval)
(port:Ast.lval)
: unit =
let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
- let _ =
- if not initializing
- then drop_ty_in_current_frame dst_cell dst_ty
- in
+ drop_existing_if_not_init initializing dst_cell dst_ty;
trans_upcall "upcall_new_chan" dst_cell
[| trans_atom (Ast.ATOM_lval port) |]
@@ -2285,16 +2280,12 @@ let trans_visitor
* part out for reuse in string code.
*)
- and trans_init_vec
+ and trans_new_vec
(initializing:bool)
(dst:Ast.lval)
(atoms:Ast.atom array)
: unit =
let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
- let _ =
- if not initializing
- then drop_ty_in_current_frame dst_cell dst_ty
- in
let gc_ctrl =
if (ty_mem_ctrl dst_ty) = MEM_gc
then Il.Cell (get_tydesc None dst_ty)
@@ -2306,6 +2297,7 @@ let trans_visitor
in
let fill = next_vreg_cell word_sty in
let unit_sz = ty_sz_in_current_frame unit_ty in
+ drop_existing_if_not_init initializing dst_cell dst_ty;
umul fill unit_sz (imm (Int64.of_int (Array.length atoms)));
trans_upcall "upcall_new_vec" dst_cell [| Il.Cell fill; gc_ctrl |];
let vec = deref dst_cell in
@@ -2327,7 +2319,7 @@ let trans_visitor
mov (get_element_ptr vec Abi.vec_elt_fill) (Il.Cell fill);
- and trans_init_box
+ and trans_new_box
(initializing:bool)
(dst:Ast.lval)
(src:Ast.atom)
@@ -2337,8 +2329,7 @@ let trans_visitor
let src_ty = simplified_ty (atom_type cx src) in
let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
let _ =
- if not initializing
- then drop_ty_in_current_frame dst_cell dst_ty
+ drop_existing_if_not_init initializing dst_cell dst_ty
in
let dst_ty = strip_mutable_or_constrained_ty dst_ty in
let (dst_cell, dst_ty) =
@@ -3395,7 +3386,7 @@ let trans_visitor
end
atoms
- and trans_init_rec_update
+ and trans_new_rec_update
(dst:Il.cell)
(dst_tys:Ast.ty array)
(trec:Ast.ty_rec)
@@ -4496,60 +4487,57 @@ let trans_visitor
| _ -> bug () "Binding unexpected lval."
end
- | Ast.STMT_init_rec (dst, atab, base) ->
- let init = maybe_init stmt.id "rec-init" dst in
- let (dst_cell, ty) = trans_lval_maybe_init init dst in
+ | Ast.STMT_new_rec (dst, atab, base) ->
+ let init = maybe_init stmt.id "new rec" dst in
+ let (dst_cell, dst_ty) = trans_lval_maybe_init init dst in
let (trec, dst_tys) =
- match ty with
+ match dst_ty with
Ast.TY_rec trec -> (trec, Array.map snd trec)
| _ ->
bugi cx stmt.id
- "non-rec destination type in stmt_init_rec"
+ "non-rec destination type in stmt_new_rec"
in
begin
+ drop_existing_if_not_init init dst_cell dst_ty;
match base with
None ->
let atoms = Array.map (fun (_, _, atom) -> atom) atab in
trans_init_structural_from_atoms
dst_cell dst_tys atoms
| Some base_lval ->
- trans_init_rec_update
+ trans_new_rec_update
dst_cell dst_tys trec atab base_lval
end
- | Ast.STMT_init_tup (dst, elems) ->
- let init = maybe_init stmt.id "tup-init" dst in
+ | Ast.STMT_new_tup (dst, elems) ->
+ let init = maybe_init stmt.id "new tup" dst in
let (dst_cell, dst_ty) = trans_lval_maybe_init init dst in
- let _ =
- if not init
- then drop_ty_in_current_frame dst_cell dst_ty
- in
let dst_tys =
match dst_ty with
Ast.TY_tup ttup -> ttup
| _ ->
bugi cx stmt.id
- "non-tup destination type in stmt_init_tup"
+ "non-tup destination type in stmt_new_tup"
in
let atoms = Array.map snd elems in
- let (dst_cell, _) = deref_ty DEREF_none init dst_cell dst_ty in
+ drop_existing_if_not_init init dst_cell dst_ty;
trans_init_structural_from_atoms dst_cell dst_tys atoms
- | Ast.STMT_init_str (dst, s) ->
- let init = maybe_init stmt.id "str-init" dst in
- trans_init_str init dst s
+ | Ast.STMT_new_str (dst, s) ->
+ let init = maybe_init stmt.id "new str" dst in
+ trans_new_str init dst s
- | Ast.STMT_init_vec (dst, _, atoms) ->
- let init = maybe_init stmt.id "vec-init" dst in
- trans_init_vec init dst atoms
+ | Ast.STMT_new_vec (dst, _, atoms) ->
+ let init = maybe_init stmt.id "new vec" dst in
+ trans_new_vec init dst atoms
- | Ast.STMT_init_port dst ->
- let init = maybe_init stmt.id "port-init" dst in
- trans_init_port init dst
+ | Ast.STMT_new_port dst ->
+ let init = maybe_init stmt.id "new port" dst in
+ trans_new_port init dst
- | Ast.STMT_init_chan (dst, port) ->
- let init = maybe_init stmt.id "chan-init" dst in
+ | Ast.STMT_new_chan (dst, port) ->
+ let init = maybe_init stmt.id "new chan" dst in
begin
match port with
None ->
@@ -4558,12 +4546,12 @@ let trans_visitor
in
mov dst_cell imm_false
| Some p ->
- trans_init_chan init dst p
+ trans_new_chan init dst p
end
- | Ast.STMT_init_box (dst, _, src) ->
- let init = maybe_init stmt.id "box-init" dst in
- trans_init_box init dst src
+ | Ast.STMT_new_box (dst, _, src) ->
+ let init = maybe_init stmt.id "new box" dst in
+ trans_new_box init dst src
| Ast.STMT_block block ->
trans_block block
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 45651ab0..0cc6fdd7 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -646,7 +646,7 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
infer_lval Ast.TY_task dst;
demand Ast.TY_nil (check_fn callee args)
- | Ast.STMT_init_rec (dst, fields, Some base) ->
+ | Ast.STMT_new_rec (dst, fields, Some base) ->
let ty = check_lval base in
let ty_rec = demand_rec ty in
let field_tys = Hashtbl.create (Array.length ty_rec) in
@@ -664,41 +664,41 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
Array.iter check_field fields;
infer_lval ty dst
- | Ast.STMT_init_rec (dst, fields, None) ->
+ | Ast.STMT_new_rec (dst, fields, None) ->
let check_field (name, mut, atom) =
(name, maybe_mutable mut (check_atom atom))
in
let ty = Ast.TY_rec (Array.map check_field fields) in
infer_lval ty dst
- | Ast.STMT_init_tup (dst, members) ->
+ | Ast.STMT_new_tup (dst, members) ->
let check_member (mut, atom) =
maybe_mutable mut (check_atom atom)
in
let ty = Ast.TY_tup (Array.map check_member members) in
infer_lval ty dst
- | Ast.STMT_init_vec (dst, mut, [| |]) ->
+ | Ast.STMT_new_vec (dst, mut, [| |]) ->
(* no inference allowed here *)
let lval_ty = check_lval ~mut:Ast.MUT_mutable dst in
ignore (demand_vec_with_mutability mut lval_ty)
- | Ast.STMT_init_vec (dst, mut, elems) ->
+ | Ast.STMT_new_vec (dst, mut, elems) ->
let atom_ty = demand_all (Array.map check_atom elems) in
let ty = Ast.TY_vec (maybe_mutable mut atom_ty) in
infer_lval ty dst
- | Ast.STMT_init_str (dst, _) -> infer_lval Ast.TY_str dst
+ | Ast.STMT_new_str (dst, _) -> infer_lval Ast.TY_str dst
- | Ast.STMT_init_port _ -> () (* we can't actually typecheck this *)
+ | Ast.STMT_new_port _ -> () (* we can't actually typecheck this *)
- | Ast.STMT_init_chan (dst, Some port) ->
+ | Ast.STMT_new_chan (dst, Some port) ->
let ty = Ast.TY_chan (demand_port (check_lval port)) in
infer_lval ty dst
- | Ast.STMT_init_chan (_, None) -> () (* can't check this either *)
+ | Ast.STMT_new_chan (_, None) -> () (* can't check this either *)
- | Ast.STMT_init_box (dst, mut, src) ->
+ | Ast.STMT_new_box (dst, mut, src) ->
let ty = Ast.TY_box (maybe_mutable mut (check_atom src)) in
infer_lval ty dst
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index cca548b8..83651a94 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -411,7 +411,7 @@ let condition_assigning_visitor
in
raise_pre_post_cond s.id precond;
- | Ast.STMT_init_rec (dst, entries, base) ->
+ | Ast.STMT_new_rec (dst, entries, base) ->
let base_slots =
begin
match base with
@@ -426,7 +426,7 @@ let condition_assigning_visitor
raise_pre_post_cond s.id precond;
raise_postcondition s.id postcond
- | Ast.STMT_init_tup (dst, modes_atoms) ->
+ | Ast.STMT_new_tup (dst, modes_atoms) ->
let precond = slot_inits
(tup_inputs_slots cx modes_atoms)
in
@@ -434,27 +434,27 @@ let condition_assigning_visitor
raise_pre_post_cond s.id precond;
raise_postcondition s.id postcond
- | Ast.STMT_init_vec (dst, _, atoms) ->
+ | Ast.STMT_new_vec (dst, _, atoms) ->
let precond = slot_inits (atoms_slots cx atoms) in
let postcond = slot_inits (lval_slots cx dst) in
raise_pre_post_cond s.id precond;
raise_postcondition s.id postcond
- | Ast.STMT_init_str (dst, _) ->
+ | Ast.STMT_new_str (dst, _) ->
let postcond = slot_inits (lval_slots cx dst) in
raise_postcondition s.id postcond
- | Ast.STMT_init_port dst ->
+ | Ast.STMT_new_port dst ->
let postcond = slot_inits (lval_slots cx dst) in
raise_postcondition s.id postcond
- | Ast.STMT_init_chan (dst, port) ->
+ | Ast.STMT_new_chan (dst, port) ->
let precond = slot_inits (lval_option_slots cx port) in
let postcond = slot_inits (lval_slots cx dst) in
raise_pre_post_cond s.id precond;
raise_postcondition s.id postcond
- | Ast.STMT_init_box (dst, _, src) ->
+ | Ast.STMT_new_box (dst, _, src) ->
let precond = slot_inits (atom_slots cx src) in
let postcond = slot_inits (lval_slots cx dst) in
raise_pre_post_cond s.id precond;
@@ -999,7 +999,7 @@ let lifecycle_visitor
Stack.push sl (Stack.top block_slots)
in
- let mark_slot_init sl =
+ let mark_slot_live sl =
Hashtbl.replace live_block_slots sl ()
in
@@ -1011,7 +1011,7 @@ let lifecycle_visitor
None -> ()
| Some slot ->
push_slot slot;
- mark_slot_init slot
+ mark_slot_live slot
end;
inner.Walk.visit_block_pre b
in
@@ -1065,9 +1065,9 @@ let lifecycle_visitor
let visit_stmt_pre s =
begin
- let init_lval lv_dst =
+ let mark_lval_live lv_dst =
let dst_slots = lval_slots cx lv_dst in
- Array.iter mark_slot_init dst_slots;
+ Array.iter mark_slot_live dst_slots;
in
match s.node with
Ast.STMT_copy (lv_dst, _)
@@ -1098,20 +1098,20 @@ let lifecycle_visitor
Ast.sprintf_lval lv_dst Ast.sprintf_stmt s
end;
Hashtbl.replace cx.ctxt_copy_stmt_is_init s.id ();
- init_lval lv_dst
+ mark_lval_live lv_dst
end;
| Ast.STMT_decl (Ast.DECL_slot (_, sloti)) ->
push_slot sloti.id
- | Ast.STMT_init_rec (lv_dst, _, _)
- | Ast.STMT_init_tup (lv_dst, _)
- | Ast.STMT_init_vec (lv_dst, _, _)
- | Ast.STMT_init_str (lv_dst, _)
- | Ast.STMT_init_port lv_dst
- | Ast.STMT_init_chan (lv_dst, _)
- | Ast.STMT_init_box (lv_dst, _, _) ->
- init_lval lv_dst
+ | Ast.STMT_new_rec (lv_dst, _, _)
+ | Ast.STMT_new_tup (lv_dst, _)
+ | Ast.STMT_new_vec (lv_dst, _, _)
+ | Ast.STMT_new_str (lv_dst, _)
+ | Ast.STMT_new_port lv_dst
+ | Ast.STMT_new_chan (lv_dst, _)
+ | Ast.STMT_new_box (lv_dst, _, _) ->
+ mark_lval_live lv_dst
| Ast.STMT_for f ->
log cx "noting implicit init for slot %d in for-block %d"
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index acdb9371..0e65406a 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -384,30 +384,30 @@ and walk_stmt
Ast.STMT_log a ->
walk_atom v a
- | Ast.STMT_init_rec (lv, atab, base) ->
+ | Ast.STMT_new_rec (lv, atab, base) ->
walk_lval v lv;
Array.iter (fun (_, _, a) -> walk_atom v a) atab;
walk_option (walk_lval v) base;
- | Ast.STMT_init_vec (lv, _, atoms) ->
+ | Ast.STMT_new_vec (lv, _, atoms) ->
walk_lval v lv;
Array.iter (walk_atom v) atoms
- | Ast.STMT_init_tup (lv, mut_atoms) ->
+ | Ast.STMT_new_tup (lv, mut_atoms) ->
walk_lval v lv;
Array.iter (fun (_, atom) -> walk_atom v atom) mut_atoms
- | Ast.STMT_init_str (lv, _) ->
+ | Ast.STMT_new_str (lv, _) ->
walk_lval v lv
- | Ast.STMT_init_port lv ->
+ | Ast.STMT_new_port lv ->
walk_lval v lv
- | Ast.STMT_init_chan (chan,port) ->
+ | Ast.STMT_new_chan (chan,port) ->
walk_option (walk_lval v) port;
walk_lval v chan;
- | Ast.STMT_init_box (dst, _, src) ->
+ | Ast.STMT_new_box (dst, _, src) ->
walk_lval v dst;
walk_atom v src
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-12 02:10:37 +0000