From 4d4fa99b314c78ff50f744beace5f2b62b211df1 Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Fri, 23 Jul 2010 11:37:38 -0700 Subject: Rename STMT_init_* to STMT_new_*; former name was confusing. --- src/boot/me/alias.ml | 8 ++--- src/boot/me/trans.ml | 94 +++++++++++++++++++++--------------------------- src/boot/me/type.ml | 20 +++++------ src/boot/me/typestate.ml | 40 ++++++++++----------- src/boot/me/walk.ml | 14 ++++---- 5 files changed, 82 insertions(+), 94 deletions(-) (limited to 'src/boot/me') 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 -- cgit v1.2.3