Convey auto-deref judgments made in typechecker to trans layer; control the decision in one place.

This commit is contained in:
Graydon Hoare 2010-07-01 15:59:29 -07:00
parent 90b36dcd26
commit 9138438620
3 changed files with 35 additions and 3 deletions

View File

@ -91,6 +91,7 @@ type ctxt =
ctxt_slot_is_arg: (node_id,unit) Hashtbl.t;
ctxt_slot_keys: (node_id,Ast.slot_key) Hashtbl.t;
ctxt_node_referenced: (node_id, unit) Hashtbl.t;
ctxt_auto_deref_lval: (node_id, bool) Hashtbl.t;
ctxt_all_item_names: (node_id,Ast.name) Hashtbl.t;
ctxt_all_item_types: (node_id,Ast.ty) Hashtbl.t;
ctxt_all_lval_types: (node_id,Ast.ty) Hashtbl.t;
@ -181,6 +182,7 @@ let new_ctxt sess abi crate =
ctxt_slot_is_arg = Hashtbl.create 0;
ctxt_slot_keys = Hashtbl.create 0;
ctxt_node_referenced = Hashtbl.create 0;
ctxt_auto_deref_lval = Hashtbl.create 0;
ctxt_all_item_names = Hashtbl.create 0;
ctxt_all_item_types = Hashtbl.create 0;
ctxt_all_lval_types = Hashtbl.create 0;

View File

@ -956,7 +956,6 @@ let trans_visitor
based elt_reg
and trans_lval_full
(dctrl:deref_ctrl)
(initializing:bool)
(lv:Ast.lval)
: (Il.cell * Ast.ty) =
@ -970,11 +969,23 @@ let trans_visitor
in
trans_slot_lval_ext initializing base_ty base_cell comp
| Ast.LVAL_base _ ->
| Ast.LVAL_base nbi ->
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
let dctrl =
(* If this fails, type didn't visit the lval, and we
* don't know whether to auto-deref its base. Crashing
* here is best. Compiler bug.
*)
match htab_search cx.ctxt_auto_deref_lval nbi.id with
None ->
bugi cx nbi.id
"Lval without auto-deref info; bad typecheck?"
| Some true -> DEREF_all_boxes
| Some false -> DEREF_none
in
deref_ty dctrl initializing cell ty
in
iflog
@ -1004,7 +1015,7 @@ let trans_visitor
(initializing:bool)
(lv:Ast.lval)
: (Il.cell * Ast.ty) =
trans_lval_full DEREF_none initializing lv
trans_lval_full initializing lv
and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.ty) =
trans_lval_maybe_init true lv

View File

@ -1065,6 +1065,20 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
log cx "lval-base slot tyspec for %a = %s"
Ast.sprintf_lval lval (tyspec_to_str (!tv));
end;
begin
match htab_search
cx.ctxt_auto_deref_lval nbi.id
with
None ->
htab_put cx.ctxt_auto_deref_lval
nbi.id ucx.box_ok
| Some b ->
(* A given source-occurrence of a name-base
* should never change its auto-deref
* nature.
*)
assert (b = ucx.box_ok);
end;
unify_slot ucx slot (Some referent) tv
| _ ->
@ -1210,6 +1224,10 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
let tv = any() in
unify_expr rval_ctx
(Ast.EXPR_binary (binop, Ast.ATOM_lval dst, at)) tv;
(* Force-override the 'auto-deref' judgment that was cached
* in cx.ctxt_auto_deref_lval by preceding unify_expr call.
*)
Hashtbl.replace cx.ctxt_auto_deref_lval (lval_base_id dst) false;
unify_lval lval_ctx dst tv;
| Ast.STMT_call (out, callee, args) ->
@ -1315,6 +1333,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
Hashtbl.iter
(fun _ params -> Array.iter (fun tv -> tv := TYSPEC_all) params)
item_params;
log cx "finished typechecking stmt: %a" Ast.sprintf_stmt stmt;
with
Semant_err (None, msg) ->
raise (Semant_err ((Some stmt.id), msg))