Initial stab at lowering mutable and exterior into the type system.

src/boot/driver/llvm/glue.ml

@@ -16,8 +16,8 @@ let alt_pipeline sess sem_cx crate =
     [|
       Resolve.process_crate;
       Type.process_crate;
-      Effect.process_crate;
       Typestate.process_crate;
+      Effect.process_crate;
       Loop.process_crate;
       Alias.process_crate;
       Dead.process_crate;

src/boot/driver/main.ml

@@ -316,8 +316,8 @@ let main_pipeline _ =
          exit_if_failed ())
       [| Resolve.process_crate;
          Type.process_crate;
-         Effect.process_crate;
          Typestate.process_crate;
+         Effect.process_crate;
          Loop.process_crate;
          Alias.process_crate;
          Dead.process_crate;

src/boot/fe/ast.ml

@@ -9,11 +9,6 @@
 open Common;;
 open Fmt;;
 
-(*
- * Slot names are given by a dot-separated path within the current
- * module namespace.
- *)
-
 type ident = string
 ;;
 
@@ -70,11 +65,11 @@ and ty =
   | TY_str
 
   | TY_tup of ty_tup
-  | TY_vec of slot
+  | TY_vec of ty
   | TY_rec of ty_rec
 
   (*
-   * Note that ty_idx is only valid inside a slot of a ty_iso group, not
+   * Note that ty_idx is only valid inside a ty of a ty_iso group, not
    * in a general type term.
    *)
   | TY_tag of ty_tag
@@ -93,18 +88,25 @@ and ty =
   | TY_named of name
   | TY_type
 
+  | TY_exterior of ty
+  | TY_mutable of ty
+
   | TY_constrained of (ty * constrs)
 
+(*
+ * FIXME: this should be cleaned up to be a different
+ * type definition. Only args can be by-ref, only locals
+ * can be auto. The structure here is historical.
+ *)
+
 and mode =
-    MODE_exterior
   | MODE_interior
   | MODE_alias
 
 and slot = { slot_mode: mode;
-             slot_mutable: bool;
              slot_ty: ty option; }
 
-and ty_tup = slot array
+and ty_tup = ty array
 
 (* In closed type terms a constraint may refer to components of the term by
  * anchoring off the "formal symbol" '*', which represents "the term this
@@ -147,7 +149,7 @@ and constr =
 
 and constrs = constr array
 
-and ty_rec = (ident * slot) array
+and ty_rec = (ident * ty) array
 
 (* ty_tag is a sum type.
  *
@@ -185,9 +187,9 @@ and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t))
 
 and check_calls = (lval * (atom array)) array
 
-and rec_input = (ident * mode * bool * atom)
+and rec_input = (ident * atom)
 
-and tup_input = (mode * bool * atom)
+and tup_input = atom
 
 and stmt' =
 
@@ -195,10 +197,11 @@ and stmt' =
     STMT_spawn of (lval * domain * lval * (atom array))
   | STMT_init_rec of (lval * (rec_input array) * lval option)
   | STMT_init_tup of (lval * (tup_input array))
-  | STMT_init_vec of (lval * slot * (atom array))
+  | STMT_init_vec of (lval * atom array)
   | STMT_init_str of (lval * string)
   | STMT_init_port of lval
   | STMT_init_chan of (lval * (lval option))
+  | STMT_init_exterior of (lval * atom)
   | STMT_copy of (lval * expr)
   | STMT_copy_binop of (lval * binop * atom)
   | STMT_call of (lval * lval * (atom array))
@@ -516,13 +519,8 @@ and fmt_name (ff:Format.formatter) (n:name) : unit =
         fmt ff ".";
         fmt_name_component ff nc
 
-and fmt_mutable (ff:Format.formatter) (m:bool) : unit =
-  if m
-  then fmt ff "mutable ";
-
 and fmt_mode (ff:Format.formatter) (m:mode) : unit =
   match m with
-      MODE_exterior -> fmt ff "@@"
     | MODE_alias -> fmt ff "&"
     | MODE_interior -> ()
 
@@ -530,10 +528,27 @@ and fmt_slot (ff:Format.formatter) (s:slot) : unit =
   match s.slot_ty with
       None -> fmt ff "auto"
     | Some t ->
-        fmt_mutable ff s.slot_mutable;
         fmt_mode ff s.slot_mode;
         fmt_ty ff t
 
+and fmt_tys
+    (ff:Format.formatter)
+    (tys:ty array)
+    : unit =
+  fmt_bracketed_arr_sep "(" ")" "," fmt_ty ff tys
+
+and fmt_ident_tys
+    (ff:Format.formatter)
+    (entries:(ident * ty) array)
+    : unit =
+  fmt_bracketed_arr_sep "(" ")" ","
+    (fun ff (ident, ty) ->
+       fmt_ty ff ty;
+       fmt ff " ";
+       fmt_ident ff ident)
+    ff
+    entries
+
 and fmt_slots
     (ff:Format.formatter)
     (slots:slot array)
@@ -594,7 +609,7 @@ and fmt_tag (ff:Format.formatter) (ttag:ty_tag) : unit =
            then first := false
            else fmt ff ",@ ");
           fmt_name ff name;
-          fmt_slots ff ttup None
+          fmt_tys ff ttup
       end
       ttag;
     fmt ff "@])@]"
@@ -623,18 +638,14 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
   | TY_char -> fmt ff "char"
   | TY_str -> fmt ff "str"
 
-  | TY_tup slots -> (fmt ff "tup"; fmt_slots ff slots None)
+  | TY_tup tys -> (fmt ff "tup"; fmt_tys ff tys)
-  | TY_vec s -> (fmt ff "vec["; fmt_slot ff s; fmt ff "]")
+  | TY_vec t -> (fmt ff "vec["; fmt_ty ff t; fmt ff "]")
   | TY_chan t -> (fmt ff "chan["; fmt_ty ff t; fmt ff "]")
   | TY_port t -> (fmt ff "port["; fmt_ty ff t; fmt ff "]")
 
-  | TY_rec slots ->
+  | TY_rec entries ->
-      let (idents, slots) =
-        let (idents, slots) = List.split (Array.to_list slots) in
-          (Array.of_list idents, Array.of_list slots)
-      in
       fmt ff "@[rec";
-        fmt_slots ff slots (Some idents);
+      fmt_ident_tys ff entries;
       fmt ff "@]"
 
   | TY_param (i, e) -> (fmt_effect ff e;
@@ -644,6 +655,14 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
   | TY_named n -> fmt_name ff n
   | TY_type -> fmt ff "type"
 
+  | TY_exterior t ->
+      fmt ff "@@";
+      fmt_ty ff t
+
+  | TY_mutable t ->
+      fmt ff "mutable ";
+      fmt_ty ff t
+
   | TY_fn tfn -> fmt_ty_fn ff None tfn
   | TY_task -> fmt ff "task"
   | TY_tag ttag -> fmt_tag ff ttag
@@ -964,7 +983,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           fmt_lval ff lv;
           fmt ff " ";
           fmt_binop ff binop;
-          fmt ff "=";
+          fmt ff "= ";
           fmt_atom ff at;
           fmt ff ";"
 
@@ -999,11 +1018,9 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           do
             if i != 0
             then fmt ff ", ";
-            let (ident, mode, mut, atom) = entries.(i) in
+            let (ident, atom) = entries.(i) in
               fmt_ident ff ident;
               fmt ff " = ";
-              fmt_mutable ff mut;
-              fmt_mode ff mode;
               fmt_atom ff atom;
           done;
           begin
@@ -1015,7 +1032,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           end;
           fmt ff ");"
 
-      | STMT_init_vec (dst, _, atoms) ->
+      | STMT_init_vec (dst, atoms) ->
           fmt_lval ff dst;
           fmt ff " = vec(";
           for i = 0 to (Array.length atoms) - 1
@@ -1033,10 +1050,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           do
             if i != 0
             then fmt ff ", ";
-            let (mode, mut, atom) = entries.(i) in
+            fmt_atom ff entries.(i);
-              fmt_mutable ff mut;
-              fmt_mode ff mode;
-              fmt_atom ff atom;
           done;
           fmt ff ");";
 
@@ -1153,6 +1167,12 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           fmt_lval ff t;
           fmt ff ";"
 
+      | STMT_init_exterior (lv, at) ->
+          fmt_lval ff lv;
+          fmt ff " = @";
+          fmt_atom ff at;
+          fmt ff ";"
+
       | STMT_alt_tag _ -> fmt ff "?stmt_alt_tag?"
       | STMT_alt_type _ -> fmt ff "?stmt_alt_type?"
       | STMT_alt_port _ -> fmt ff "?stmt_alt_port?"
@@ -1321,7 +1341,6 @@ let sprintf_lval_component = sprintf_fmt fmt_lval_component;;
 let sprintf_atom = sprintf_fmt fmt_atom;;
 let sprintf_slot = sprintf_fmt fmt_slot;;
 let sprintf_slot_key = sprintf_fmt fmt_slot_key;;
-let sprintf_mutable = sprintf_fmt fmt_mutable;;
 let sprintf_ty = sprintf_fmt fmt_ty;;
 let sprintf_effect = sprintf_fmt fmt_effect;;
 let sprintf_tag = sprintf_fmt fmt_tag;;

src/boot/fe/item.ml

@@ -128,6 +128,13 @@ and parse_auto_slot_and_init
 and parse_stmts (ps:pstate) : Ast.stmt array =
   let apos = lexpos ps in
 
+  let ensure_mutable slot =
+    match slot.Ast.slot_ty with
+        None -> slot
+      | Some (Ast.TY_mutable _) -> slot
+      | Some t -> { slot with Ast.slot_ty = Some (Ast.TY_mutable t) }
+  in
+
   let rec name_to_lval (apos:pos) (bpos:pos) (name:Ast.name)
       : Ast.lval =
     match name with
@@ -236,7 +243,6 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
                                   Ast.NAME_base (Ast.BASE_ident ident) ->
                                     let slot =
                                       { Ast.slot_mode = Ast.MODE_interior;
-                                        Ast.slot_mutable = false;
                                         Ast.slot_ty = None }
                                     in
                                       Ast.PAT_slot
@@ -456,7 +462,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
           bump ps;
           let (stmts, slot, ident) =
             ctxt "stmt slot" parse_slot_and_ident_and_init ps in
-          let slot = Pexp.apply_mutability slot true in
+          let slot = ensure_mutable slot in
           let bpos = lexpos ps in
           let decl = Ast.DECL_slot (Ast.KEY_ident ident,
                                     (span ps apos bpos slot))
@@ -467,7 +473,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
           bump ps;
           let (stmts, slot, ident) =
             ctxt "stmt slot" parse_auto_slot_and_init ps in
-          let slot = Pexp.apply_mutability slot true in
+          let slot = ensure_mutable slot in
           let bpos = lexpos ps in
           let decl = Ast.DECL_slot (Ast.KEY_ident ident,
                                     (span ps apos bpos slot))
@@ -979,7 +985,9 @@ and expand_tags
                            (ps, "unexpected name type while expanding tag"))
             in
             let header =
-              Array.map (fun slot -> (clone_span ps item slot)) tup
+              Array.map (fun ty -> (clone_span ps item
+                                      { Ast.slot_mode = Ast.MODE_alias;
+                                        Ast.slot_ty = Some ty})) tup
             in
             let tag_item' = Ast.MOD_ITEM_tag (header, ttag, id) in
             let cloned_params =

src/boot/fe/parser.ml

@@ -181,13 +181,11 @@ let err (str:string) (ps:pstate) =
 
 let (slot_nil:Ast.slot) =
   { Ast.slot_mode = Ast.MODE_interior;
-    Ast.slot_mutable = false;
     Ast.slot_ty = Some Ast.TY_nil }
 ;;
 
 let (slot_auto:Ast.slot) =
   { Ast.slot_mode = Ast.MODE_interior;
-    Ast.slot_mutable = true;
     Ast.slot_ty = None }
 ;;
 

src/boot/fe/pexp.ml

@@ -22,7 +22,7 @@ type pexp' =
   | PEXP_bind of (pexp * pexp option array)
   | PEXP_rec of ((Ast.ident * pexp) array * pexp option)
   | PEXP_tup of (pexp array)
-  | PEXP_vec of (Ast.slot * (pexp array))
+  | PEXP_vec of (pexp array)
   | PEXP_port
   | PEXP_chan of (pexp option)
   | PEXP_binop of (Ast.binop * pexp * pexp)
@@ -261,11 +261,10 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
 
     | VEC ->
         bump ps;
-        Ast.TY_vec (bracketed LBRACKET RBRACKET (parse_slot false) ps)
+        Ast.TY_vec (bracketed LBRACKET RBRACKET parse_ty ps)
 
     | IDENT _ -> Ast.TY_named (parse_name ps)
 
-
     | TAG ->
         bump ps;
         let htab = Hashtbl.create 4 in
@@ -273,7 +272,7 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
           let ident = parse_ident ps in
           let tup =
             match peek ps with
-                LPAREN -> paren_comma_list (parse_slot false) ps
+                LPAREN -> paren_comma_list parse_ty ps
               | _ -> raise (err "tag variant missing argument list" ps)
           in
             htab_put htab (Ast.NAME_base (Ast.BASE_ident ident)) tup
@@ -287,9 +286,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
     | REC ->
         bump ps;
         let parse_rec_entry ps =
-          let mut = parse_mutability ps in
+          let (ty, ident) = parse_ty_and_ident ps in
-          let (slot, ident) = parse_slot_and_ident false ps in
+            (ident, ty)
-            (ident, apply_mutability slot mut)
         in
         let entries = paren_comma_list parse_rec_entry ps in
         let labels = Array.map (fun (l, _) -> l) entries in
@@ -300,8 +298,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
 
     | TUP ->
         bump ps;
-        let slots = paren_comma_list (parse_slot false) ps in
+        let tys = paren_comma_list parse_ty ps in
-          Ast.TY_tup slots
+          Ast.TY_tup tys
 
     | MACH m ->
         bump ps;
@@ -333,6 +331,14 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
               | _ -> raise (unexpected ps)
           end
 
+    | AT ->
+        bump ps;
+        Ast.TY_exterior (parse_ty ps)
+
+    | MUTABLE ->
+        bump ps;
+        Ast.TY_mutable (parse_ty ps)
+
     | LPAREN ->
         begin
           bump ps;
@@ -356,21 +362,15 @@ and flag (ps:pstate) (tok:token) : bool =
 and parse_mutability (ps:pstate) : bool =
   flag ps MUTABLE
 
-and apply_mutability (slot:Ast.slot) (mut:bool) : Ast.slot =
-  { slot with Ast.slot_mutable = mut }
-
 and parse_slot (aliases_ok:bool) (ps:pstate) : Ast.slot =
-  let mut = parse_mutability ps in
   let mode =
   match (peek ps, aliases_ok) with
-      (AT, _) -> bump ps; Ast.MODE_exterior
+      (AND, true) -> bump ps; Ast.MODE_alias
-    | (AND, true) -> bump ps; Ast.MODE_alias
     | (AND, false) -> raise (err "alias slot in prohibited context" ps)
     | _ -> Ast.MODE_interior
   in
   let ty = parse_ty ps in
     { Ast.slot_mode = mode;
-      Ast.slot_mutable = mut;
       Ast.slot_ty = Some ty }
 
 and parse_slot_and_ident
@@ -381,6 +381,13 @@ and parse_slot_and_ident
   let ident = ctxt "slot and ident: ident" parse_ident ps in
     (slot, ident)
 
+and parse_ty_and_ident
+    (ps:pstate)
+    : (Ast.ty * Ast.ident) =
+  let ty = ctxt "ty and ident: ty" parse_ty ps in
+  let ident = ctxt "ty and ident: ident" parse_ident ps in
+    (ty, ident)
+
 and parse_slot_and_optional_ignored_ident
     (aliases_ok:bool)
     (ps:pstate)
@@ -494,16 +501,9 @@ and parse_bottom_pexp (ps:pstate) : pexp =
     | VEC ->
         bump ps;
         begin
-          let slot =
-            match peek ps with
-                LBRACKET -> bracketed LBRACKET RBRACKET (parse_slot false) ps
-              | _ -> { Ast.slot_mode = Ast.MODE_interior;
-                       Ast.slot_mutable = false;
-                       Ast.slot_ty = None }
-          in
           let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in
           let bpos = lexpos ps in
-            span ps apos bpos (PEXP_vec (slot, pexps))
+            span ps apos bpos (PEXP_vec pexps)
         end
 
 
@@ -1088,7 +1088,9 @@ and desugar_expr_atom
       | PEXP_call _
       | PEXP_bind _
       | PEXP_spawn _
-      | PEXP_custom _ ->
+      | PEXP_custom _
+      | PEXP_exterior _
+      | PEXP_mutable _ ->
           let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in
           let stmts = desugar_expr_init ps tmp pexp in
             (Array.append [| decl_stmt |] stmts,
@@ -1101,31 +1103,6 @@ and desugar_expr_atom
           let (stmts, lval) = desugar_lval ps pexp in
             (stmts, Ast.ATOM_lval lval)
 
-      | PEXP_exterior _ ->
-          raise (err "exterior symbol in atom context" ps)
-
-      | PEXP_mutable _ ->
-          raise (err "mutable keyword in atom context" ps)
-
-
-and desugar_expr_mode_mut_atom
-    (ps:pstate)
-    (pexp:pexp)
-    : (Ast.stmt array * (Ast.mode * bool * Ast.atom)) =
-  let desugar_inner mode mut e =
-    let (stmts, atom) = desugar_expr_atom ps e in
-      (stmts, (mode, mut, atom))
-  in
-    match pexp.node with
-        PEXP_mutable {node=(PEXP_exterior e); id=_} ->
-          desugar_inner Ast.MODE_exterior true e
-      | PEXP_exterior e ->
-          desugar_inner Ast.MODE_exterior false e
-      | PEXP_mutable e ->
-          desugar_inner Ast.MODE_interior true e
-      | _ ->
-          desugar_inner Ast.MODE_interior false pexp
-
 and desugar_expr_atoms
     (ps:pstate)
     (pexps:pexp array)
@@ -1138,12 +1115,6 @@ and desugar_opt_expr_atoms
     : (Ast.stmt array * Ast.atom option array) =
   arj1st (Array.map (desugar_opt_expr_atom ps) pexps)
 
-and desugar_expr_mode_mut_atoms
-    (ps:pstate)
-    (pexps:pexp array)
-    : (Ast.stmt array * (Ast.mode * bool * Ast.atom) array) =
-  arj1st (Array.map (desugar_expr_mode_mut_atom ps) pexps)
-
 and desugar_expr_init
     (ps:pstate)
     (dst_lval:Ast.lval)
@@ -1253,10 +1224,10 @@ and desugar_expr_init
                 Array.map
                   begin
                     fun (ident, pexp) ->
-                      let (stmts, (mode, mut, atom)) =
+                      let (stmts, atom) =
-                        desugar_expr_mode_mut_atom ps pexp
+                        desugar_expr_atom ps pexp
                       in
-                        (stmts, (ident, mode, mut, atom))
+                        (stmts, (ident, atom))
                   end
                   args
               end
@@ -1278,19 +1249,19 @@ and desugar_expr_init
             end
 
       | PEXP_tup args ->
-          let (arg_stmts, arg_mode_atoms) =
+          let (arg_stmts, arg_atoms) =
-            desugar_expr_mode_mut_atoms ps args
+            desugar_expr_atoms ps args
           in
-          let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_mode_atoms)) in
+          let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_atoms)) in
             aa arg_stmts [| stmt |]
 
       | PEXP_str s ->
           let stmt = ss (Ast.STMT_init_str (dst_lval, s)) in
             [| stmt |]
 
-      | PEXP_vec (slot, args) ->
+      | PEXP_vec args ->
           let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in
-          let stmt = ss (Ast.STMT_init_vec (dst_lval, slot, arg_atoms)) in
+          let stmt = ss (Ast.STMT_init_vec (dst_lval, arg_atoms)) in
             aa arg_stmts [| stmt |]
 
       | PEXP_port ->
@@ -1315,11 +1286,19 @@ and desugar_expr_init
           in
             aa port_stmts [| chan_stmt |]
 
-      | PEXP_exterior _ ->
+      | PEXP_exterior arg ->
-          raise (err "exterior symbol in initialiser context" ps)
+          let (arg_stmts, arg_mode_atom) =
+            desugar_expr_atom ps arg
+          in
+          let stmt = ss (Ast.STMT_init_exterior (dst_lval, arg_mode_atom)) in
+            aa arg_stmts [| stmt |]
 
-      | PEXP_mutable _ ->
+      | PEXP_mutable arg ->
-          raise (err "mutable keyword in initialiser context" ps)
+          (* Initializing a local from a "mutable" atom is the same as
+           * initializing it from an immutable one; all locals are mutable
+           * anyways. So this is just a fall-through.
+           *)
+          desugar_expr_init ps dst_lval arg
 
       | PEXP_custom (n, a, b) ->
           let (arg_stmts, args) = desugar_expr_atoms ps a in

src/boot/me/alias.ml

@@ -67,7 +67,7 @@ let alias_analysis_visitor
           | 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_vec (dst, _) -> alias dst
           | Ast.STMT_init_str (dst, _) -> alias dst
           | Ast.STMT_for_each sfe ->
               let (slot, _) = sfe.Ast.for_each_slot in

src/boot/me/dwarf.ml

@@ -1305,17 +1305,27 @@ let (abbrev_base_type:abbrev) =
 
 let (abbrev_alias_slot:abbrev) =
   (DW_TAG_reference_type, DW_CHILDREN_no,
+   [|
+     (DW_AT_type, DW_FORM_ref_addr);
+   |])
+;;
+
+(* FIXME: Perverse, but given dwarf's vocabulary it seems at least plausible
+ * that a "mutable const type" is a correct way of saying "mutable". Or else we
+ * make up our own. Revisit perhaps.
+ *)
+let (abbrev_mutable_type:abbrev) =
+  (DW_TAG_const_type, DW_CHILDREN_no,
    [|
      (DW_AT_type, DW_FORM_ref_addr);
      (DW_AT_mutable, DW_FORM_flag);
    |])
 ;;
 
-let (abbrev_exterior_slot:abbrev) =
+let (abbrev_exterior_type:abbrev) =
-  (DW_TAG_reference_type, DW_CHILDREN_no,
+  (DW_TAG_pointer_type, DW_CHILDREN_no,
    [|
      (DW_AT_type, DW_FORM_ref_addr);
-     (DW_AT_mutable, DW_FORM_flag);
      (DW_AT_data_location, DW_FORM_block1);
    |])
 ;;
@@ -1332,7 +1342,6 @@ let (abbrev_struct_type_member:abbrev) =
    [|
      (DW_AT_name, DW_FORM_string);
      (DW_AT_type, DW_FORM_ref_addr);
-       (DW_AT_mutable, DW_FORM_flag);
      (DW_AT_data_member_location, DW_FORM_block4);
      (DW_AT_byte_size, DW_FORM_block4)
    |])
@@ -1541,33 +1550,8 @@ let dwarf_visitor
       in
 
         match slot.Ast.slot_mode with
-            Ast.MODE_exterior ->
+          | Ast.MODE_interior ->
-              let fix = new_fixup "exterior DIE" in
+              ref_type_die (slot_ty slot)
-              let body_off =
-                word_sz_int * Abi.exterior_rc_slot_field_body
-              in
-                emit_die (DEF (fix, SEQ [|
-                                 uleb (get_abbrev_code abbrev_exterior_slot);
-                                 (* DW_AT_type: DW_FORM_ref_addr *)
-                                 (ref_type_die (slot_ty slot));
-                                 (* DW_AT_mutable: DW_FORM_flag *)
-                                 BYTE (if slot.Ast.slot_mutable
-                                       then 1 else 0);
-                                 (* DW_AT_data_location: DW_FORM_block1 *)
-                                 (* This is a DWARF expression for moving
-                                    from the address of an exterior
-                                    allocation to the address of its
-                                    body. *)
-                                 dw_form_block1
-                                   [| DW_OP_push_object_address;
-                                      DW_OP_lit body_off;
-                                      DW_OP_plus;
-                                      DW_OP_deref |]
-                               |]));
-                ref_addr_for_fix fix
-
-          (* FIXME (issue #72): encode mutable-ness of interiors. *)
-          | Ast.MODE_interior -> ref_type_die (slot_ty slot)
 
           | Ast.MODE_alias ->
               let fix = new_fixup "alias DIE" in
@@ -1575,8 +1559,6 @@ let dwarf_visitor
                                  uleb (get_abbrev_code abbrev_alias_slot);
                                  (* DW_AT_type: DW_FORM_ref_addr *)
                                  (ref_type_die (slot_ty slot));
-                                 (* DW_AT_mutable: DW_FORM_flag *)
-                                 BYTE (if slot.Ast.slot_mutable then 1 else 0)
                                |]));
                 ref_addr_for_fix fix
 
@@ -1708,15 +1690,13 @@ let dwarf_visitor
           emit_die die;
           Array.iteri
             begin
-              fun i (ident, slot) ->
+              fun i (ident, ty) ->
                 emit_die (SEQ [|
                             uleb (get_abbrev_code abbrev_struct_type_member);
                             (* DW_AT_name: DW_FORM_string *)
                             ZSTRING ident;
                             (* DW_AT_type: DW_FORM_ref_addr *)
-                            (ref_slot_die slot);
+                            (ref_type_die ty);
-                            (* DW_AT_mutable: DW_FORM_flag *)
-                            BYTE (if slot.Ast.slot_mutable then 1 else 0);
                             (* DW_AT_data_member_location: DW_FORM_block4 *)
                             size_block4
                               (Il.get_element_offset word_bits rtys i)
@@ -1904,10 +1884,6 @@ let dwarf_visitor
         unspecified_ptr_with_ref rust_ty (ref_type_die ty)
       in
 
-      let unspecified_ptr_with_ref_slot rust_ty slot =
-        unspecified_ptr_with_ref rust_ty (ref_slot_die slot)
-      in
-
       let unspecified_ptr rust_ty =
         unspecified_ptr_with_ref rust_ty (unspecified_anon_struct ())
       in
@@ -1974,9 +1950,7 @@ let dwarf_visitor
                  (* DW_AT_name: DW_FORM_string *)
                  ZSTRING "tag";
                  (* DW_AT_type: DW_FORM_ref_addr *)
-                 (ref_slot_die (interior_slot Ast.TY_uint));
+                 (ref_type_die Ast.TY_uint);
-                 (* DW_AT_mutable: DW_FORM_flag *)
-                 BYTE 0;
                  (* DW_AT_data_member_location: DW_FORM_block4 *)
                  size_block4
                    (Il.get_element_offset word_bits rtys 0)
@@ -2038,6 +2012,41 @@ let dwarf_visitor
         ref_addr_for_fix (Stack.top iso_stack).(i)
       in
 
+      let exterior_type t =
+        let fix = new_fixup "exterior DIE" in
+        let body_off =
+          word_sz_int * Abi.exterior_rc_slot_field_body
+        in
+          emit_die (DEF (fix, SEQ [|
+                           uleb (get_abbrev_code abbrev_exterior_type);
+                           (* DW_AT_type: DW_FORM_ref_addr *)
+                           (ref_type_die t);
+                           (* DW_AT_data_location: DW_FORM_block1 *)
+                           (* This is a DWARF expression for moving
+                              from the address of an exterior
+                              allocation to the address of its
+                              body. *)
+                           dw_form_block1
+                             [| DW_OP_push_object_address;
+                                DW_OP_lit body_off;
+                                DW_OP_plus;
+                                DW_OP_deref |]
+                         |]));
+          ref_addr_for_fix fix
+      in
+
+      let mutable_type t =
+        let fix = new_fixup "mutable DIE" in
+          emit_die (DEF (fix, SEQ [|
+                           uleb (get_abbrev_code abbrev_mutable_type);
+                           (* DW_AT_type: DW_FORM_ref_addr *)
+                           (ref_type_die t);
+                           (* DW_AT_mutable: DW_FORM_flag *)
+                           BYTE 1;
+                         |]));
+          ref_addr_for_fix fix
+      in
+
         match ty with
             Ast.TY_nil -> unspecified_struct DW_RUST_nil
           | Ast.TY_bool -> base ("bool", DW_ATE_boolean, 1)
@@ -2058,7 +2067,7 @@ let dwarf_visitor
           | Ast.TY_tag ttag -> tag_type None ttag
           | Ast.TY_iso tiso -> iso_type tiso
           | Ast.TY_idx i -> idx_type i
-          | Ast.TY_vec s -> unspecified_ptr_with_ref_slot DW_RUST_vec s
+          | Ast.TY_vec t -> unspecified_ptr_with_ref_ty DW_RUST_vec t
           | Ast.TY_chan t -> unspecified_ptr_with_ref_ty DW_RUST_chan t
           | Ast.TY_port t -> unspecified_ptr_with_ref_ty DW_RUST_port t
           | Ast.TY_task -> unspecified_ptr DW_RUST_task
@@ -2067,6 +2076,8 @@ let dwarf_visitor
           | Ast.TY_native i -> native_ptr_type i
           | Ast.TY_param p -> rust_type_param p
           | Ast.TY_obj ob -> obj_type ob
+          | Ast.TY_mutable t -> mutable_type t
+          | Ast.TY_exterior t -> exterior_type t
           | _ ->
               bug () "unimplemented dwarf encoding for type %a"
                 Ast.sprintf_ty ty
@@ -2893,7 +2904,7 @@ let rec extract_mod_items
 
         | DW_TAG_pointer_type
             when is_rust_type die DW_RUST_vec ->
-            Ast.TY_vec (get_referenced_slot die)
+            Ast.TY_vec (get_referenced_ty die)
 
         | DW_TAG_pointer_type
             when is_rust_type die DW_RUST_type_param ->
@@ -2903,6 +2914,13 @@ let rec extract_mod_items
             when is_rust_type die DW_RUST_native ->
             Ast.TY_native (get_opaque_of (get_native_id die))
 
+        | DW_TAG_pointer_type ->
+            Ast.TY_exterior (get_referenced_ty die)
+
+        | DW_TAG_const_type
+            when ((get_num die DW_AT_mutable) = 1) ->
+            Ast.TY_mutable (get_referenced_ty die)
+
         | DW_TAG_string_type -> Ast.TY_str
 
         | DW_TAG_base_type ->
@@ -2953,13 +2971,13 @@ let rec extract_mod_items
                 assert ((Array.length members) > 0);
                 if is_num_idx (get_name members.(0))
                 then
-                  let slots = Array.map get_referenced_slot members in
+                  let tys = Array.map get_referenced_ty members in
-                    Ast.TY_tup slots
+                    Ast.TY_tup tys
                 else
                   let entries =
                     Array.map
                       (fun member_die -> ((get_name member_die),
-                                          (get_referenced_slot member_die)))
+                                          (get_referenced_ty member_die)))
                       members
                   in
                     Ast.TY_rec entries
@@ -2989,23 +3007,11 @@ let rec extract_mod_items
     match die.die_tag with
         DW_TAG_reference_type ->
           let ty = get_referenced_ty die in
-          let mut = get_flag die DW_AT_mutable in
+            { Ast.slot_mode = Ast.MODE_alias;
-          let mode =
-            (* Exterior slots have a 'data_location' attr. *)
-            match atab_search die.die_attrs DW_AT_data_location with
-                Some _ -> Ast.MODE_exterior
-              | None -> Ast.MODE_alias
-          in
-            { Ast.slot_mode = mode;
-              Ast.slot_mutable = mut;
               Ast.slot_ty = Some ty }
       | _ ->
           let ty = get_ty die in
-            (* FIXME (issue #28): encode mutability of interior slots
-             * properly.
-             *)
             { Ast.slot_mode = Ast.MODE_interior;
-              Ast.slot_mutable = false;
               Ast.slot_ty = Some ty }
 
   and get_referenced_ty die =

src/boot/me/effect.ml

@@ -33,12 +33,18 @@ let mutability_checking_visitor
       | _ -> ()
   in
 
-  let check_write id dst =
+  let check_write s dst =
-    let dst_slot = lval_slot cx dst in
+    let dst_ty = lval_ty cx dst in
-      if (dst_slot.Ast.slot_mutable or
+    let is_mutable =
-            (Hashtbl.mem cx.ctxt_copy_stmt_is_init id))
+      match dst_ty with
+          Ast.TY_mutable _ -> true
+        | _ -> false
+    in
+      if (is_mutable or (Hashtbl.mem cx.ctxt_copy_stmt_is_init s.id))
       then ()
-      else err (Some id) "writing to non-mutable slot"
+      else err (Some s.id)
+        "writing to non-mutable slot of type %a in statement %a"
+        Ast.sprintf_ty dst_ty Ast.sprintf_stmt s
   in
     (* FIXME (issue #75): enforce the no-write-alias-to-immutable-slot
      * rule.
@@ -46,10 +52,10 @@ let mutability_checking_visitor
   let visit_stmt_pre s =
     begin
       match s.node with
-          Ast.STMT_copy (dst, _) -> check_write s.id dst
+          Ast.STMT_copy (dst, _) -> check_write s dst
-        | Ast.STMT_copy_binop (dst, _, _) -> check_write s.id dst
+        | Ast.STMT_copy_binop (dst, _, _) -> check_write s dst
-        | Ast.STMT_call (dst, _, _) -> check_write s.id dst
+        | Ast.STMT_call (dst, _, _) -> check_write s dst
-        | Ast.STMT_recv (dst, _) -> check_write s.id dst
+        | Ast.STMT_recv (dst, _) -> check_write s dst
         | _ -> ()
     end;
     inner.Walk.visit_stmt_pre s
@@ -151,8 +157,7 @@ let function_effect_propagation_visitor
             in
               if lval_is_slot cx fn
               then
-                let t = lval_slot cx fn in
+                lower_to_callee_ty (lval_ty cx fn)
-                  lower_to_callee_ty (slot_ty t)
               else
                 begin
                   let item = lval_item cx fn in

src/boot/me/semant.ml

@@ -582,15 +582,13 @@ let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array =
 ;;
 
 let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array =
-  Array.concat (List.map
+  Array.concat (List.map (atom_slots cx) (Array.to_list az))
-                  (fun (_,_,a) -> atom_slots cx a)
-                  (Array.to_list az))
 ;;
 
 let rec_inputs_slots (cx:ctxt)
     (inputs:Ast.rec_input array) : node_id array =
   Array.concat (List.map
-                  (fun (_, _, _, atom) -> atom_slots cx atom)
+                  (fun (_, atom) -> atom_slots cx atom)
                   (Array.to_list inputs))
 ;;
 
@@ -606,14 +604,27 @@ let expr_slots (cx:ctxt) (e:Ast.expr) : node_id array =
 (* Type extraction. *)
 
 let interior_slot_full mut ty : Ast.slot =
+  let ty =
+    if mut
+    then Ast.TY_mutable ty
+    else ty
+  in
     { Ast.slot_mode = Ast.MODE_interior;
-    Ast.slot_mutable = mut;
       Ast.slot_ty = Some ty }
 ;;
 
 let exterior_slot_full mut ty : Ast.slot =
-  { Ast.slot_mode = Ast.MODE_exterior;
+  let ty =
-    Ast.slot_mutable = mut;
+    match ty with
+        Ast.TY_exterior _ -> ty
+      | _ -> Ast.TY_exterior ty
+  in
+  let ty =
+    if mut
+    then Ast.TY_mutable ty
+    else ty
+  in
+  { Ast.slot_mode = Ast.MODE_interior;
     Ast.slot_ty = Some ty }
 ;;
 
@@ -626,12 +637,13 @@ let exterior_slot ty : Ast.slot = exterior_slot_full false ty
 
 (* General folds of Ast.ty. *)
 
-type ('ty, 'slot, 'slots, 'tag) ty_fold =
+type ('ty, 'tys, 'slot, 'slots, 'tag) ty_fold =
     {
       (* Functions that correspond to interior nodes in Ast.ty. *)
-      ty_fold_slot : (Ast.mode * bool * 'ty) -> 'slot;
+      ty_fold_slot : (Ast.mode * 'ty) -> 'slot;
       ty_fold_slots : ('slot array) -> 'slots;
-      ty_fold_tags : (Ast.name, 'slots) Hashtbl.t -> 'tag;
+      ty_fold_tys : ('ty array) -> 'tys;
+      ty_fold_tags : (Ast.name, 'tys) Hashtbl.t -> 'tag;
 
       (* Functions that correspond to the Ast.ty constructors. *)
       ty_fold_any: unit -> 'ty;
@@ -642,9 +654,9 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold =
       ty_fold_uint : unit -> 'ty;
       ty_fold_char : unit -> 'ty;
       ty_fold_str : unit -> 'ty;
-      ty_fold_tup : 'slots -> 'ty;
+      ty_fold_tup : 'tys -> 'ty;
-      ty_fold_vec : 'slot -> 'ty;
+      ty_fold_vec : 'ty -> 'ty;
-      ty_fold_rec : (Ast.ident * 'slot) array -> 'ty;
+      ty_fold_rec : (Ast.ident * 'ty) array -> 'ty;
       ty_fold_tag : 'tag -> 'ty;
       ty_fold_iso : (int * 'tag array) -> 'ty;
       ty_fold_idx : int -> 'ty;
@@ -659,21 +671,29 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold =
       ty_fold_param : (int * Ast.effect) -> 'ty;
       ty_fold_named : Ast.name -> 'ty;
       ty_fold_type : unit -> 'ty;
+      ty_fold_exterior : 'ty -> 'ty;
+      ty_fold_mutable : 'ty -> 'ty;
       ty_fold_constrained : ('ty * Ast.constrs) -> 'ty }
 ;;
 
-let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
+let rec fold_ty (f:('ty, 'tys, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
   let fold_slot (s:Ast.slot) : 'slot =
     f.ty_fold_slot (s.Ast.slot_mode,
-                    s.Ast.slot_mutable,
                     fold_ty f (slot_ty s))
   in
+
   let fold_slots (slots:Ast.slot array) : 'slots =
     f.ty_fold_slots (Array.map fold_slot slots)
   in
-  let fold_tags (ttag:Ast.ty_tag) : 'tag =
+
-    f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_slots v)))
+  let fold_tys (tys:Ast.ty array) : 'tys =
+    f.ty_fold_tys (Array.map (fold_ty f) tys)
   in
+
+  let fold_tags (ttag:Ast.ty_tag) : 'tag =
+    f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_tys v)))
+  in
+
   let fold_sig tsig =
     (fold_slots tsig.Ast.sig_input_slots,
      tsig.Ast.sig_input_constrs,
@@ -692,12 +712,14 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
   | Ast.TY_char -> f.ty_fold_char ()
   | Ast.TY_str -> f.ty_fold_str ()
 
-  | Ast.TY_tup t -> f.ty_fold_tup (fold_slots t)
+  | Ast.TY_tup t -> f.ty_fold_tup (fold_tys t)
-  | Ast.TY_vec s -> f.ty_fold_vec (fold_slot s)
+  | Ast.TY_vec t -> f.ty_fold_vec (fold_ty f t)
-  | Ast.TY_rec r -> f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_slot v)) r)
+  | Ast.TY_rec r ->
+      f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_ty f v)) r)
 
   | Ast.TY_tag tt -> f.ty_fold_tag (fold_tags tt)
-  | Ast.TY_iso ti -> f.ty_fold_iso (ti.Ast.iso_index,
+  | Ast.TY_iso ti ->
+      f.ty_fold_iso (ti.Ast.iso_index,
                      (Array.map fold_tags ti.Ast.iso_group))
   | Ast.TY_idx i -> f.ty_fold_idx i
 
@@ -713,16 +735,20 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
   | Ast.TY_named n -> f.ty_fold_named n
   | Ast.TY_type -> f.ty_fold_type ()
 
+  | Ast.TY_exterior t -> f.ty_fold_exterior (fold_ty f t)
+  | Ast.TY_mutable t -> f.ty_fold_mutable (fold_ty f t)
+
   | Ast.TY_constrained (t, constrs) ->
       f.ty_fold_constrained (fold_ty f t, constrs)
 
 ;;
 
-type 'a simple_ty_fold = ('a, 'a, 'a, 'a) ty_fold
+type 'a simple_ty_fold = ('a, 'a, 'a, 'a, 'a) ty_fold
 ;;
 
 let ty_fold_default (default:'a) : 'a simple_ty_fold =
-    { ty_fold_slot = (fun _ -> default);
+    { ty_fold_tys = (fun _ -> default);
+      ty_fold_slot = (fun _ -> default);
       ty_fold_slots = (fun _ -> default);
       ty_fold_tags = (fun _ -> default);
       ty_fold_any = (fun _ -> default);
@@ -748,19 +774,22 @@ let ty_fold_default (default:'a) : 'a simple_ty_fold =
       ty_fold_param = (fun _ -> default);
       ty_fold_named = (fun _ -> default);
       ty_fold_type = (fun _ -> default);
+      ty_fold_exterior = (fun _ -> default);
+      ty_fold_mutable = (fun _ -> default);
       ty_fold_constrained = (fun _ -> default) }
 ;;
 
 let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
-    : (Ast.ty, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold =
+    : (Ast.ty, Ast.ty array, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold =
   let rebuild_fn ((islots, constrs, oslot), aux) =
     ({ Ast.sig_input_slots = islots;
        Ast.sig_input_constrs = constrs;
        Ast.sig_output_slot = oslot }, aux)
   in
-  { ty_fold_slot = (fun (mode, mut, t) ->
+    {
+    ty_fold_tys = (fun ts -> ts);
+    ty_fold_slot = (fun (mode, t) ->
                       { Ast.slot_mode = mode;
-                        Ast.slot_mutable = mut;
                         Ast.slot_ty = Some t });
     ty_fold_slots = (fun slots -> slots);
     ty_fold_tags = (fun htab -> htab);
@@ -773,7 +802,7 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
     ty_fold_char = (fun _ -> id Ast.TY_char);
     ty_fold_str = (fun _ -> id Ast.TY_str);
     ty_fold_tup =  (fun slots -> id (Ast.TY_tup slots));
-    ty_fold_vec = (fun slot -> id (Ast.TY_vec slot));
+    ty_fold_vec = (fun t -> id (Ast.TY_vec t));
     ty_fold_rec = (fun entries -> id (Ast.TY_rec entries));
     ty_fold_tag = (fun tag -> id (Ast.TY_tag tag));
     ty_fold_iso = (fun (i, tags) -> id (Ast.TY_iso { Ast.iso_index = i;
@@ -791,6 +820,8 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
     ty_fold_param = (fun (i, mut) -> id (Ast.TY_param (i, mut)));
     ty_fold_named = (fun n -> id (Ast.TY_named n));
     ty_fold_type = (fun _ -> id (Ast.TY_type));
+    ty_fold_exterior = (fun t -> id (Ast.TY_exterior t));
+    ty_fold_mutable = (fun t -> id (Ast.TY_mutable t));
     ty_fold_constrained = (fun (t, constrs) ->
                              id (Ast.TY_constrained (t, constrs))) }
 ;;
@@ -892,7 +923,7 @@ let associative_binary_op_ty_fold
   in
     { base with
         ty_fold_slots = (fun slots -> reduce (Array.to_list slots));
-        ty_fold_slot = (fun (_, _, a) -> a);
+        ty_fold_slot = (fun (_, a) -> a);
         ty_fold_tags = (fun tab -> reduce (htab_vals tab));
         ty_fold_tup = (fun a -> a);
         ty_fold_vec = (fun a -> a);
@@ -957,13 +988,9 @@ let lower_effect_of x y =
 ;;
 
 let type_effect (t:Ast.ty) : Ast.effect =
-  let fold_slot ((*mode*)_, mut, eff) =
+  let fold_mutable _ = Ast.STATE in
-    if mut
-    then lower_effect_of Ast.STATE eff
-    else eff
-  in
   let fold = associative_binary_op_ty_fold Ast.PURE lower_effect_of in
-  let fold = { fold with ty_fold_slot = fold_slot } in
+  let fold = { fold with ty_fold_mutable = fold_mutable } in
     fold_ty fold t
 ;;
 
@@ -1037,15 +1064,15 @@ let check_concrete params thing =
 ;;
 
 
-let project_type_to_slot
+let project_type
     (base_ty:Ast.ty)
     (comp:Ast.lval_component)
-    : Ast.slot =
+    : Ast.ty =
   match (base_ty, comp) with
       (Ast.TY_rec elts, Ast.COMP_named (Ast.COMP_ident id)) ->
         begin
           match atab_search elts id with
-              Some slot -> slot
+              Some ty -> ty
             | None -> err None "unknown record-member '%s'" id
         end
 
@@ -1054,14 +1081,10 @@ let project_type_to_slot
         then elts.(i)
         else err None "out-of-range tuple index %d" i
 
-    | (Ast.TY_vec slot, Ast.COMP_atom _) ->
+    | (Ast.TY_vec ty, Ast.COMP_atom _) -> ty
-        slot
+    | (Ast.TY_str, Ast.COMP_atom _) -> (Ast.TY_mach TY_u8)
-
-    | (Ast.TY_str, Ast.COMP_atom _) ->
-        interior_slot (Ast.TY_mach TY_u8)
-
     | (Ast.TY_obj (_, fns), Ast.COMP_named (Ast.COMP_ident id)) ->
-        interior_slot (Ast.TY_fn (Hashtbl.find fns id))
+        (Ast.TY_fn (Hashtbl.find fns id))
 
     | (_,_) ->
         bug ()
@@ -1070,16 +1093,6 @@ let project_type_to_slot
           Ast.sprintf_ty base_ty Ast.sprintf_lval_component comp
 ;;
 
-
-(* NB: this will fail if lval is not a slot. *)
-let rec lval_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot =
-  match lval with
-      Ast.LVAL_base nb -> lval_to_slot cx nb.id
-    | Ast.LVAL_ext (base, comp) ->
-        let base_ty = slot_ty (lval_slot cx base) in
-          project_type_to_slot base_ty comp
-;;
-
 let exports_permit (view:Ast.mod_view) (ident:Ast.ident) : bool =
   (Hashtbl.mem view.Ast.view_exports Ast.EXPORT_all_decls) ||
     (Hashtbl.mem view.Ast.view_exports (Ast.EXPORT_ident ident))
@@ -1150,6 +1163,10 @@ let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool =
         | _ -> false
 ;;
 
+let lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty =
+  Hashtbl.find cx.ctxt_all_lval_types (lval_base_id lval)
+;;
+
 let lval_is_static (cx:ctxt) (lval:Ast.lval) : bool =
   defn_is_static (resolve_lval cx lval)
 ;;
@@ -1164,7 +1181,7 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool =
     match lval with
         Ast.LVAL_ext (base, _) ->
           begin
-            match slot_ty (lval_slot cx base) with
+            match lval_ty cx base with
                 Ast.TY_obj _ -> true
               | _ -> false
           end
@@ -1172,11 +1189,6 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool =
   else false
 ;;
 
-let rec lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty =
-  let base_id = lval_base_id lval in
-    Hashtbl.find cx.ctxt_all_lval_types base_id
-;;
-
 let rec atom_type (cx:ctxt) (at:Ast.atom) : Ast.ty =
   match at with
       Ast.ATOM_literal {node=(Ast.LIT_int _); id=_} -> Ast.TY_int
@@ -1741,7 +1753,7 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
   let ptr = sp Il.OpaqueTy in
   let rc_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in
   let codeptr = sp Il.CodeTy in
-  let tup ttup = Il.StructTy (Array.map (slot_referent_type abi) ttup) in
+  let tup ttup = Il.StructTy (Array.map (referent_type abi) ttup) in
   let tag ttag =
     let union =
       Il.UnionTy
@@ -1802,6 +1814,11 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
 
       | Ast.TY_native _ -> ptr
 
+      | Ast.TY_exterior t ->
+          sp (Il.StructTy [| word; referent_type abi t |])
+
+      | Ast.TY_mutable t -> referent_type abi t
+
       | Ast.TY_param (i, _) -> Il.ParamTy i
 
       | Ast.TY_named _ -> bug () "named type in referent_type"
@@ -1809,16 +1826,11 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
 
 and slot_referent_type (abi:Abi.abi) (sl:Ast.slot) : Il.referent_ty =
   let s t = Il.ScalarTy t in
-  let v b = Il.ValTy b in
   let p t = Il.AddrTy t in
-  let sv b = s (v b) in
   let sp t = s (p t) in
 
-  let word = sv abi.Abi.abi_word_bits in
-
   let rty = referent_type abi (slot_ty sl) in
     match sl.Ast.slot_mode with
-        Ast.MODE_exterior _ -> sp (Il.StructTy [| word; rty |])
       | Ast.MODE_interior _ -> rty
       | Ast.MODE_alias _ -> sp rty
 ;;
@@ -1940,13 +1952,16 @@ let word_slot (abi:Abi.abi) : Ast.slot =
 
 let alias_slot (ty:Ast.ty) : Ast.slot =
   { Ast.slot_mode = Ast.MODE_alias;
-    Ast.slot_mutable = false;
     Ast.slot_ty = Some ty }
 ;;
 
 let mutable_alias_slot (ty:Ast.ty) : Ast.slot =
+  let ty =
+    match ty with
+        Ast.TY_mutable _ -> ty
+      | _ -> Ast.TY_mutable ty
+  in
     { Ast.slot_mode = Ast.MODE_alias;
-    Ast.slot_mutable = true;
       Ast.slot_ty = Some ty }
 ;;
 
@@ -2002,11 +2017,9 @@ let item_str (cx:ctxt) (id:node_id) : string =
 
 let ty_str (ty:Ast.ty) : string =
   let base = associative_binary_op_ty_fold "" (fun a b -> a ^ b) in
-  let fold_slot (mode,mut,ty) =
+  let fold_slot (mode,ty) =
-    (if mut then "m" else "")
+    (match mode with
-    ^ (match mode with
+         Ast.MODE_alias -> "a"
-           Ast.MODE_exterior -> "e"
-         | Ast.MODE_alias -> "a"
        | Ast.MODE_interior -> "")
     ^ ty
   in
@@ -2080,6 +2093,8 @@ let ty_str (ty:Ast.ty) : string =
          ty_fold_native = (fun _ -> "N");
          ty_fold_param = (fun _ -> "P");
          ty_fold_type = (fun _ -> "Y");
+         ty_fold_mutable = (fun t -> "m" ^ t);
+         ty_fold_exterior = (fun t -> "e" ^ t);
 
          (* FIXME (issue #78): encode obj types. *)
          (* FIXME (issue #78): encode opaque and param numbers. *)

src/boot/me/transutil.ml

@@ -112,8 +112,7 @@ let word_ty_signed_mach (abi:Abi.abi) : ty_mach =
 ;;
 
 
-let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
+let rec ty_mem_ctrl (ty:Ast.ty) : mem_ctrl =
-  let ty = slot_ty slot in
   match ty with
       Ast.TY_port _
     | Ast.TY_chan _
@@ -123,20 +122,27 @@ let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
         if type_has_state ty
         then MEM_gc
         else MEM_rc_opaque
-      | _ ->
+    | Ast.TY_exterior t ->
-          match slot.Ast.slot_mode with
+        if type_has_state t
-              Ast.MODE_exterior _ when type_is_structured ty ->
-                if type_has_state ty
-                then MEM_gc
-                else MEM_rc_struct
-            | Ast.MODE_exterior _ ->
-                if type_has_state ty
         then MEM_gc
+        else
+          if type_is_structured t
+          then MEM_rc_struct
           else MEM_rc_opaque
+    | Ast.TY_mutable t
+    | Ast.TY_constrained (t, _) ->
+        ty_mem_ctrl t
     | _ ->
         MEM_interior
 ;;
 
+let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
+  match slot.Ast.slot_mode with
+      Ast.MODE_alias -> MEM_interior
+    | Ast.MODE_interior ->
+        ty_mem_ctrl (slot_ty slot)
+;;
+
 
 let iter_block_slots
     (cx:Semant.ctxt)
@@ -200,33 +206,33 @@ let next_power_of_two (x:int64) : int64 =
     Int64.add 1L (!xr)
 ;;
 
-let iter_tup_slots
+let iter_tup_parts
     (get_element_ptr:'a -> int -> 'a)
     (dst_ptr:'a)
     (src_ptr:'a)
     (slots:Ast.ty_tup)
-    (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+    (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit)
     (curr_iso:Ast.ty_iso option)
     : unit =
   Array.iteri
     begin
-      fun i slot ->
+      fun i ty ->
         f (get_element_ptr dst_ptr i)
           (get_element_ptr src_ptr i)
-          slot curr_iso
+          ty curr_iso
     end
     slots
 ;;
 
-let iter_rec_slots
+let iter_rec_parts
     (get_element_ptr:'a -> int -> 'a)
     (dst_ptr:'a)
     (src_ptr:'a)
     (entries:Ast.ty_rec)
-    (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+    (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit)
     (curr_iso:Ast.ty_iso option)
     : unit =
-  iter_tup_slots get_element_ptr dst_ptr src_ptr
+  iter_tup_parts get_element_ptr dst_ptr src_ptr
     (Array.map snd entries) f curr_iso
 ;;
 

src/boot/me/type.ml

@@ -33,6 +33,23 @@ type binopsig =
   | BINOPSIG_plus_plus_plus     (* plusable a * plusable a -> plusable a *)
 ;;
 
+
+(* In some instances we will strip off a layer of mutability or exterior-ness,
+ * as trans is willing to transplant and/or overlook mutability / exterior
+ * differences wrt. many operators.
+ * 
+ * Note: there is a secondary mutability-checking pass in effect.ml to ensure
+ * you're not actually mutating the insides of an immutable. That's not the
+ * typechecker's job.
+ *)
+let simplified t =
+  match t with
+      Ast.TY_mutable (Ast.TY_exterior t) -> t
+    | Ast.TY_mutable t -> t
+    | Ast.TY_exterior t -> t
+    | _ -> t
+;;
+
 let rec tyspec_to_str (ts:tyspec) : string =
 
   let fmt = Format.fprintf in
@@ -253,17 +270,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           (dct:dict)
           (fields:Ast.ty_rec)
           : unit =
-        let rec find_slot (query:Ast.ident) i : Ast.slot =
+        let find_ty (query:Ast.ident) : Ast.ty =
-          if i = Array.length fields
+          match atab_search fields query with
-          then fail ()
+              None -> fail()
-          else match fields.(i) with
+            | Some t -> t
-              (ident, slot) ->
-                if ident = query then slot
-                else find_slot query (i + 1)
         in
 
         let check_entry ident tv =
-          unify_slot (find_slot ident 0) None tv
+          unify_ty (find_ty ident) tv
         in
           Hashtbl.iter check_entry dct
       in
@@ -290,18 +304,20 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           | Ast.TY_fn _ | Ast.TY_obj _
           | Ast.TY_param _ | Ast.TY_native _ | Ast.TY_type -> false
           | Ast.TY_named _ -> bug () "unexpected named type"
+          | Ast.TY_exterior ty
+          | Ast.TY_mutable ty
           | Ast.TY_constrained (ty, _) ->
               is_comparable_or_ordered comparable ty
       in
 
       let floating (ty:Ast.ty) : bool =
-        match ty with
+        match simplified ty with
             Ast.TY_mach TY_f32 | Ast.TY_mach TY_f64 -> true
           | _ -> false
       in
 
       let integral (ty:Ast.ty) : bool =
-        match ty with
+        match simplified ty with
             Ast.TY_int | Ast.TY_uint | Ast.TY_mach TY_u8 | Ast.TY_mach TY_u16
           | Ast.TY_mach TY_u32 | Ast.TY_mach TY_u64 | Ast.TY_mach TY_i8
           | Ast.TY_mach TY_i16 | Ast.TY_mach TY_i32
@@ -313,7 +329,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
       let numeric (ty:Ast.ty) : bool = (integral ty) || (floating ty) in
 
       let plusable (ty:Ast.ty) : bool =
-        match ty with
+        match simplified ty with
             Ast.TY_str -> true
           | Ast.TY_vec _ -> true
           | _ -> numeric ty
@@ -369,7 +385,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           | (TYSPEC_collection tv, TYSPEC_resolved (params, ty)) ->
               begin
                 match ty with
-                    Ast.TY_vec slot -> unify_slot slot None tv
+                    Ast.TY_vec ty -> unify_ty ty tv
                   | Ast.TY_str -> unify_ty (Ast.TY_mach TY_u8) tv
                   | _ -> fail ()
               end;
@@ -439,12 +455,12 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           | (TYSPEC_tuple tvs, TYSPEC_resolved (params, ty)) ->
               begin
                 match ty with
-                    Ast.TY_tup (elem_slots:Ast.slot array) ->
+                    Ast.TY_tup (elem_tys:Ast.ty array) ->
-                      if (Array.length elem_slots) < (Array.length tvs)
+                      if (Array.length elem_tys) <> (Array.length tvs)
                       then fail ()
                       else
                         let check_elem i tv =
-                          unify_slot (elem_slots.(i)) None tv
+                          unify_ty (elem_tys.(i)) tv
                         in
                           Array.iteri check_elem tvs
                   | _ -> fail ()
@@ -455,9 +471,9 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           | (TYSPEC_vector tv, TYSPEC_resolved (params, ty)) ->
               begin
                 match ty with
-                    Ast.TY_vec slot ->
+                    Ast.TY_vec ty ->
-                      unify_slot slot None tv;
+                      unify_ty ty tv;
-                      TYSPEC_resolved (params, ty)
+                      TYSPEC_resolved (params, Ast.TY_vec ty)
                   | _ -> fail ()
               end
 
@@ -942,7 +958,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
                 unify_lval' base base_tv;
                 match !(resolve_tyvar base_tv) with
                     TYSPEC_resolved (_, ty) ->
-                      unify_ty (slot_ty (project_type_to_slot ty comp)) tv
+                      unify_ty (project_type ty comp) tv
                   | _ ->
                       ()
 
@@ -981,7 +997,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
         | Ast.STMT_init_rec (lval, fields, Some base) ->
             let dct = Hashtbl.create 10 in
             let tvrec = ref (TYSPEC_record dct) in
-            let add_field (ident, _, _, atom) =
+            let add_field (ident, atom) =
               let tv = ref TYSPEC_all in
                 unify_atom atom tv;
                 Hashtbl.add dct ident tv
@@ -994,7 +1010,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
 
         | Ast.STMT_init_rec (lval, fields, None) ->
             let dct = Hashtbl.create 10 in
-            let add_field (ident, _, _, atom) =
+            let add_field (ident, atom) =
               let tv = ref TYSPEC_all in
                 unify_atom atom tv;
                 Hashtbl.add dct ident tv
@@ -1003,7 +1019,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
               unify_lval lval (ref (TYSPEC_record dct))
 
         | Ast.STMT_init_tup (lval, members) ->
-            let member_to_tv (_, _, atom) =
+            let member_to_tv atom =
               let tv = ref TYSPEC_all in
                 unify_atom atom tv;
                 tv
@@ -1011,7 +1027,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
             let member_tvs = Array.map member_to_tv members in
               unify_lval lval (ref (TYSPEC_tuple member_tvs))
 
-        | Ast.STMT_init_vec (lval, _, atoms) ->
+        | Ast.STMT_init_vec (lval, atoms) ->
             let tv = ref TYSPEC_all in
             let unify_with_tv atom = unify_atom atom tv in
               Array.iter unify_with_tv atoms;
@@ -1181,8 +1197,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
                     Ast.TY_fn (tsig, _) ->
                       begin
                         let vec_str =
-                          interior_slot (Ast.TY_vec
+                          interior_slot (Ast.TY_vec Ast.TY_str)
-                                           (interior_slot Ast.TY_str))
                         in
                           match tsig.Ast.sig_input_slots with
                               [| |] -> ()
@@ -1236,13 +1251,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
                 let tag_tv = ref TYSPEC_all in
                   unify_ty tag_ty tag_tv;
                   unify_tyvars expected tag_tv;
-                  List.iter
+                  List.iter expect
-                    begin
-                      fun slot ->
-                        match slot.Ast.slot_ty with
-                          Some ty -> expect ty
-                          | None -> bug () "no slot type in tag slot tuple"
-                    end
                     (List.rev (Array.to_list tag_ty_tup));
 
           | Ast.PAT_slot (sloti, _) ->
@@ -1336,8 +1345,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
           let defn = Hashtbl.find cx.ctxt_all_defns id in
             match defn with
                 DEFN_slot slot_defn ->
+                  begin
+                    match slot_defn.Ast.slot_ty with
+                        Some _ -> ()
+                      | None ->
                           Hashtbl.replace cx.ctxt_all_defns id
-                    (DEFN_slot { slot_defn with Ast.slot_ty = Some ty })
+                            (DEFN_slot { slot_defn with
+                                           Ast.slot_ty = Some ty })
+                  end
               | _ -> bug () "check_auto_tyvar: no slot defn"
         in
 
@@ -1349,7 +1364,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
                   begin
                     match !(resolve_tyvar tv) with
                         TYSPEC_resolved ([||], ty) ->
-                          (Ast.TY_vec (interior_slot ty))
+                          (Ast.TY_vec ty)
                       | _ ->
                           err (Some id)
                             "unresolved vector-element type in %s (%d)"

src/boot/me/typestate.ml

@@ -419,7 +419,7 @@ let condition_assigning_visitor
               raise_precondition s.id precond;
               raise_postcondition s.id postcond
 
-        | Ast.STMT_init_vec (dst, _, atoms) ->
+        | Ast.STMT_init_vec (dst, atoms) ->
             let precond = slot_inits (atoms_slots cx atoms) in
             let postcond = slot_inits (lval_slots cx dst) in
               raise_precondition s.id precond;
@@ -980,13 +980,19 @@ let lifecycle_visitor
                 if initializing
                 then
                   begin
-                    Hashtbl.add cx.ctxt_copy_stmt_is_init s.id ();
+                    iflog cx
+                      begin
+                        fun _ ->
+                          log cx "noting lval %a init at stmt %a"
+                            Ast.sprintf_lval lv_dst Ast.sprintf_stmt s
+                      end;
+                    Hashtbl.replace cx.ctxt_copy_stmt_is_init s.id ();
                     init_lval lv_dst
                   end;
 
           | Ast.STMT_init_rec (lv_dst, _, _)
           | Ast.STMT_init_tup (lv_dst, _)
-          | Ast.STMT_init_vec (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, _) ->

src/boot/me/walk.ml

@@ -262,7 +262,7 @@ and walk_mod_item
       item
 
 
-and walk_ty_tup v ttup = Array.iter (walk_slot v) ttup
+and walk_ty_tup v ttup = Array.iter (walk_ty v) ttup
 
 and walk_ty_tag v ttag = Hashtbl.iter (fun _ t -> walk_ty_tup v t) ttag
 
@@ -273,8 +273,8 @@ and walk_ty
   let children _ =
     match ty with
         Ast.TY_tup ttup -> walk_ty_tup v ttup
-      | Ast.TY_vec s -> walk_slot v s
+      | Ast.TY_vec s -> walk_ty v s
-      | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_slot v s) trec
+      | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_ty v s) trec
       | Ast.TY_tag ttag -> walk_ty_tag v ttag
       | Ast.TY_iso tiso -> Array.iter (walk_ty_tag v) tiso.Ast.iso_group
       | Ast.TY_fn tfn -> walk_ty_fn v tfn
@@ -301,6 +301,8 @@ and walk_ty
       | Ast.TY_nil -> ()
       | Ast.TY_task -> ()
       | Ast.TY_any -> ()
+      | Ast.TY_exterior m -> walk_ty v m
+      | Ast.TY_mutable m -> walk_ty v m
   in
     walk_bracketed
       v.visit_ty_pre
@@ -448,16 +450,16 @@ and walk_stmt
 
       | Ast.STMT_init_rec (lv, atab, base) ->
           walk_lval v lv;
-          Array.iter (fun (_, _, _, a) -> walk_atom v a) atab;
+          Array.iter (fun (_, a) -> walk_atom v a) atab;
           walk_option (walk_lval v) base;
 
-      | Ast.STMT_init_vec (lv, _, atoms) ->
+      | Ast.STMT_init_vec (lv, atoms) ->
           walk_lval v lv;
           Array.iter (walk_atom v) atoms
 
       | Ast.STMT_init_tup (lv, mut_atoms) ->
           walk_lval v lv;
-          Array.iter (fun (_, _, a) -> walk_atom v a) mut_atoms
+          Array.iter (walk_atom v) mut_atoms
 
       | Ast.STMT_init_str (lv, _) ->
           walk_lval v lv
@@ -469,6 +471,10 @@ and walk_stmt
           walk_option (walk_lval v) port;
           walk_lval v chan;
 
+      | Ast.STMT_init_exterior (dst, src) ->
+          walk_lval v dst;
+          walk_atom v src
+
       | Ast.STMT_for f ->
           walk_stmt_for f