Implement STMT_init_box in trans, clean up some of the semant table-accessors.

This commit is contained in:
Graydon Hoare 2010-07-01 10:44:27 -07:00
parent 8acb2cf47d
commit a7016ade65
6 changed files with 39 additions and 51 deletions

View File

@ -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 [|

View File

@ -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

View File

@ -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:

View File

@ -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

View File

@ -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

View File

@ -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