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

4 files changed, 119 insertions, 115 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 770b57bf..8b1ce71f 100644
--- a/src/boot/fe/ast.ml
+++ b/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,19 +638,15 @@ 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_vec s -> (fmt ff "vec["; fmt_slot ff s; fmt ff "]")
+  | TY_tup tys -> (fmt ff "tup"; fmt_tys ff tys)
+  | 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 ->
-      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 ff "@]"
+  | TY_rec entries ->
+      fmt ff "@[rec";
+      fmt_ident_tys ff entries;
+      fmt ff "@]"
 
   | TY_param (i, e) -> (fmt_effect ff e;
                         if e <> PURE then fmt ff " ";
@@ -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_mutable ff mut;
-              fmt_mode ff mode;
-              fmt_atom ff atom;
+            fmt_atom ff entries.(i);
           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;;
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 3efd4e2a..5c0a7c65 100644
--- a/src/boot/fe/item.ml
+++ b/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 =
diff --git a/src/boot/fe/parser.ml b/src/boot/fe/parser.ml
index 5df44303..97cf8985 100644
--- a/src/boot/fe/parser.ml
+++ b/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 }
 ;;
 
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index e859d135..25352e5c 100644
--- a/src/boot/fe/pexp.ml
+++ b/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 (slot, ident) = parse_slot_and_ident false ps in
-            (ident, apply_mutability slot mut)
+          let (ty, ident) = parse_ty_and_ident ps in
+            (ident, ty)
         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
-          Ast.TY_tup slots
+        let tys = paren_comma_list parse_ty ps in
+          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)) =
-                        desugar_expr_mode_mut_atom ps pexp
+                      let (stmts, atom) =
+                        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) =
-            desugar_expr_mode_mut_atoms ps args
+          let (arg_stmts, arg_atoms) =
+            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 _ ->
-          raise (err "exterior symbol in initialiser context" ps)
+      | PEXP_exterior arg ->
+          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 _ ->
-          raise (err "mutable keyword in initialiser context" ps)
+      | PEXP_mutable arg ->
+          (* 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