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

3 files changed, 35 insertions, 3 deletions

diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 21e55193..a2a132b2 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -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;
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 2f8c9a7f..fd651003 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -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
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 36f5d3a3..c0b16e70 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -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))