diff options
| -rw-r--r-- | src/boot/me/dwarf.ml | 2 | ||||
| -rw-r--r-- | src/boot/me/layout.ml | 2 | ||||
| -rw-r--r-- | src/boot/me/semant.ml | 62 | ||||
| -rw-r--r-- | src/boot/me/trans.ml | 18 | ||||
| -rw-r--r-- | src/boot/me/transutil.ml | 4 | ||||
| -rw-r--r-- | src/boot/me/typestate.ml | 2 |
6 files changed, 39 insertions, 51 deletions
diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml index f49f450a..7b54de25 100644 --- a/src/boot/me/dwarf.ml +++ b/src/boot/me/dwarf.ml @@ -2463,7 +2463,7 @@ let dwarf_visitor then get_abbrev_code abbrev_formal else get_abbrev_code abbrev_variable in - let resolved_slot = referent_to_slot cx s.id in + let resolved_slot = get_slot cx s.id in let emit_var_die slot_loc = let var_die = SEQ [| diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml index 208dc470..365acbf9 100644 --- a/src/boot/me/layout.ml +++ b/src/boot/me/layout.ml @@ -140,7 +140,7 @@ let layout_visitor (slots:node_id array) : unit = let accum (off,align) id : (size * size) = - let slot = referent_to_slot cx id in + let slot = get_slot cx id in let rt = slot_referent_type cx.ctxt_abi slot in let (elt_size, elt_align) = rty_layout rt in if vregs_ok diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 1e6c462c..182c6811 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -306,18 +306,32 @@ let referent_is_item (cx:ctxt) (id:node_id) : bool = | _ -> false ;; -(* coerce an lval definition id to a slot *) -let referent_to_slot (cx:ctxt) (id:node_id) : Ast.slot = - match Hashtbl.find cx.ctxt_all_defns id with - DEFN_slot slot -> slot - | _ -> bugi cx id "unknown slot" +let rec lval_base_id (lv:Ast.lval) : node_id = + match lv with + Ast.LVAL_base nbi -> nbi.id + | Ast.LVAL_ext (lv, _) -> lval_base_id lv +;; + +let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl = + match htab_search cx.ctxt_all_defns node with + Some (DEFN_item item) -> item + | Some _ -> bugi cx node "defn is not an item" + | None -> bugi cx node "missing defn" +;; + +let get_slot (cx:ctxt) (node:node_id) : Ast.slot = + match htab_search cx.ctxt_all_defns node with + Some (DEFN_slot slot) -> slot + | Some _ -> bugi cx node "defn is not a slot" + | None -> bugi cx node "missing defn" ;; (* coerce an lval reference id to its definition slot *) -let lval_to_slot (cx:ctxt) (id:node_id) : Ast.slot = - match resolve_lval_id cx id with - DEFN_slot slot -> slot - | _ -> bugi cx id "unknown slot" +let lval_base_to_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot identified = + let lid = lval_base_id lval in + let rid = lval_to_referent cx lid in + let slot = get_slot cx rid in + { node = slot; id = rid } ;; let get_stmt_depth (cx:ctxt) (id:node_id) : int = @@ -534,22 +548,6 @@ let rec lval_to_name (lv:Ast.lval) : Ast.name = Ast.NAME_ext (lval_to_name lv, comp) ;; -let rec lval_base_id (lv:Ast.lval) : node_id = - match lv with - Ast.LVAL_base nbi -> nbi.id - | Ast.LVAL_ext (lv, _) -> lval_base_id lv -;; - -let rec lval_base_slot (cx:ctxt) (lv:Ast.lval) : node_id option = - match lv with - Ast.LVAL_base nbi -> - let referent = lval_to_referent cx nbi.id in - if referent_is_slot cx referent - then Some referent - else None - | Ast.LVAL_ext (lv, _) -> lval_base_slot cx lv -;; - let rec lval_slots (cx:ctxt) (lv:Ast.lval) : node_id array = match lv with Ast.LVAL_base nbi -> @@ -1193,20 +1191,6 @@ let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool = | _ -> false ;; -let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl = - match htab_search cx.ctxt_all_defns node with - Some (DEFN_item item) -> item - | Some _ -> bugi cx node "defn is not an item" - | None -> bugi cx node "missing defn" -;; - -let get_slot (cx:ctxt) (node:node_id) : Ast.slot = - match htab_search cx.ctxt_all_defns node with - Some (DEFN_slot slot) -> slot - | Some _ -> bugi cx node "defn is not a slot" - | None -> bugi cx node "missing defn" -;; - let lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty = (* FIXME: The correct definition of this function is just: diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 830cf1ee..9e8cfb14 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -446,7 +446,7 @@ let trans_visitor in let slot_id_referent_type (slot_id:node_id) : Il.referent_ty = - slot_referent_type abi (referent_to_slot cx slot_id) + slot_referent_type abi (get_slot cx slot_id) in let caller_args_cell (args_rty:Il.referent_ty) : Il.cell = @@ -959,12 +959,11 @@ let trans_visitor in trans_slot_lval_ext base_ty base_cell comp - | Ast.LVAL_base nb -> - let slot = lval_to_slot cx nb.id in - let referent = lval_to_referent cx nb.id in - let cell = cell_of_block_slot referent in - let ty = slot_ty slot in - let cell = deref_slot initializing cell slot in + | Ast.LVAL_base _ -> + let sloti = lval_base_to_slot cx lv in + let cell = cell_of_block_slot sloti.id in + let ty = slot_ty sloti.node in + let cell = deref_slot initializing cell sloti.node in deref_ty initializing cell ty in iflog @@ -4173,6 +4172,11 @@ let trans_visitor trans_init_chan dst p end + | Ast.STMT_init_box (dst, src) -> + let sloti = lval_base_to_slot cx dst in + let cell = cell_of_block_slot sloti.id in + trans_init_slot_from_atom CLONE_none cell sloti.node src + | Ast.STMT_block block -> trans_block block diff --git a/src/boot/me/transutil.ml b/src/boot/me/transutil.ml index d7fbb566..9daccd40 100644 --- a/src/boot/me/transutil.ml +++ b/src/boot/me/transutil.ml @@ -153,7 +153,7 @@ let iter_block_slots Hashtbl.iter begin fun key slot_id -> - let slot = referent_to_slot cx slot_id in + let slot = get_slot cx slot_id in fn key slot_id slot end block_slots @@ -180,7 +180,7 @@ let iter_arg_slots begin fun slot_id -> let key = Hashtbl.find cx.ctxt_slot_keys slot_id in - let slot = referent_to_slot cx slot_id in + let slot = get_slot cx slot_id in fn key slot_id slot end ls diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index e0ebe4ee..764fdc96 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -68,7 +68,7 @@ let determine_constr_key if referent_is_slot cx aid then if type_has_state - (slot_ty (referent_to_slot cx aid)) + (slot_ty (get_slot cx aid)) then err (Some aid) "predicate applied to slot of mutable type" else aid |