Make mutability no longer a type constructor

9 files changed, 103 insertions, 73 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 31138a51962..0f61eec4e6f 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -35,6 +35,11 @@ type effect =
   | UNSAFE
 ;;
 
+type mutability =
+    MUT_mutable
+  | MUT_immutable
+;;
+
 type name_base =
     BASE_ident of ident
   | BASE_temp of temp_id
@@ -187,9 +192,9 @@ and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t))
 
 and check_calls = (lval * (atom array)) array
 
-and rec_input = (ident * atom)
+and rec_input = (ident * mutability * atom)
 
-and tup_input = atom
+and tup_input = (mutability * atom)
 
 and stmt' =
 
@@ -197,11 +202,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 * atom array)
+  | STMT_init_vec of (lval * mutability * atom array)
   | STMT_init_str of (lval * string)
   | STMT_init_port of lval
   | STMT_init_chan of (lval * (lval option))
-  | STMT_init_box of (lval * atom)
+  | STMT_init_box of (lval * mutability * atom)
   | STMT_copy of (lval * expr)
   | STMT_copy_binop of (lval * binop * atom)
   | STMT_call of (lval * lval * (atom array))
@@ -1018,7 +1023,8 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           do
             if i != 0
             then fmt ff ", ";
-            let (ident, atom) = entries.(i) in
+            let (ident, mutability, atom) = entries.(i) in
+              if mutability = MUT_mutable then fmt ff "mutable ";
               fmt_ident ff ident;
               fmt ff " = ";
               fmt_atom ff atom;
@@ -1032,9 +1038,11 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           end;
           fmt ff ");"
 
-      | STMT_init_vec (dst, atoms) ->
+      | STMT_init_vec (dst, mutability, atoms) ->
           fmt_lval ff dst;
-          fmt ff " = vec(";
+          fmt ff " = vec";
+          if mutability = MUT_mutable then fmt ff "[mutable]";
+          fmt ff "(";
           for i = 0 to (Array.length atoms) - 1
           do
             if i != 0
@@ -1050,7 +1058,9 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           do
             if i != 0
             then fmt ff ", ";
-            fmt_atom ff entries.(i);
+            let (mutability, atom) = entries.(i) in
+            if mutability = MUT_mutable then fmt ff "mutable ";
+            fmt_atom ff atom;
           done;
           fmt ff ");";
 
@@ -1166,9 +1176,10 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           fmt_lval ff t;
           fmt ff ";"
 
-      | STMT_init_box (lv, at) ->
+      | STMT_init_box (lv, mutability, at) ->
           fmt_lval ff lv;
           fmt ff " = @@";
+          if mutability = MUT_mutable then fmt ff " mutable ";
           fmt_atom ff at;
           fmt ff ";"
 
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index 14065466fb8..27ec881077e 100644
--- a/src/boot/fe/pexp.ml
+++ b/src/boot/fe/pexp.ml
@@ -20,9 +20,9 @@ type pexp' =
     PEXP_call of (pexp * pexp array)
   | PEXP_spawn of (Ast.domain * 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 (pexp array)
+  | PEXP_rec of ((Ast.ident * Ast.mutability * pexp) array * pexp option)
+  | PEXP_tup of ((Ast.mutability * pexp) array)
+  | PEXP_vec of Ast.mutability * (pexp array)
   | PEXP_port
   | PEXP_chan of (pexp option)
   | PEXP_binop of (Ast.binop * pexp * pexp)
@@ -32,8 +32,7 @@ type pexp' =
   | PEXP_lval of plval
   | PEXP_lit of Ast.lit
   | PEXP_str of string
-  | PEXP_mutable of pexp
-  | PEXP_box of pexp
+  | PEXP_box of Ast.mutability * pexp
   | PEXP_custom of Ast.name * (pexp array) * (string option)
 
 and plval =
@@ -177,6 +176,11 @@ and parse_effect (ps:pstate) : Ast.effect =
     | UNSAFE -> bump ps; Ast.UNSAFE
     | _ -> Ast.PURE
 
+and parse_mutability (ps:pstate) : Ast.mutability =
+  match peek ps with
+      MUTABLE -> bump ps; Ast.MUT_mutable
+    | _ -> Ast.MUT_immutable
+
 and parse_ty_fn
     (effect:Ast.effect)
     (ps:pstate)
@@ -421,13 +425,14 @@ and parse_ty (ps:pstate) : Ast.ty =
   parse_constrained_ty ps
 
 
-and parse_rec_input (ps:pstate) : (Ast.ident * pexp) =
+and parse_rec_input (ps:pstate) : (Ast.ident * Ast.mutability * pexp) =
+  let mutability = parse_mutability ps in
   let lab = (ctxt "rec input: label" parse_ident ps) in
     match peek ps with
         EQ ->
           bump ps;
           let pexp = ctxt "rec input: expr" parse_pexp ps in
-            (lab, pexp)
+            (lab, mutability, pexp)
       | _ -> raise (unexpected ps)
 
 
@@ -439,7 +444,7 @@ and parse_rec_body (ps:pstate) : pexp' = (*((Ast.ident * pexp) array) =*)
       | WITH -> raise (err "empty record extension" ps)
       | _ ->
           let inputs = one_or_more COMMA parse_rec_input ps in
-          let labels = Array.map (fun (l, _) -> l) inputs in
+          let labels = Array.map (fun (l, _, _) -> l) inputs in
             begin
               check_dup_rec_labels ps labels;
               match peek ps with
@@ -472,21 +477,18 @@ and parse_bottom_pexp (ps:pstate) : pexp =
   let apos = lexpos ps in
   match peek ps with
 
-      MUTABLE ->
-        bump ps;
-        let inner = parse_pexp ps in
-        let bpos = lexpos ps in
-          span ps apos bpos (PEXP_mutable inner)
-
-    | AT ->
+      AT ->
         bump ps;
+        let mutability = parse_mutability ps in
         let inner = parse_pexp ps in
         let bpos = lexpos ps in
-          span ps apos bpos (PEXP_box inner)
+          span ps apos bpos (PEXP_box (mutability, inner))
 
     | TUP ->
         bump ps;
-        let pexps = ctxt "paren pexps(s)" (rstr false parse_pexp_list) ps in
+        let pexps =
+          ctxt "paren pexps(s)" (rstr false parse_mutable_and_pexp_list) ps
+        in
         let bpos = lexpos ps in
           span ps apos bpos (PEXP_tup pexps)
 
@@ -498,11 +500,18 @@ and parse_bottom_pexp (ps:pstate) : pexp =
 
     | VEC ->
         bump ps;
-        begin
-          let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in
-          let bpos = lexpos ps in
-            span ps apos bpos (PEXP_vec pexps)
-        end
+        let mutability =
+          match peek ps with
+              LBRACKET ->
+                bump ps;
+                expect ps MUTABLE;
+                expect ps RBRACKET;
+                Ast.MUT_mutable
+            | _ -> Ast.MUT_immutable
+        in
+        let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in
+        let bpos = lexpos ps in
+          span ps apos bpos (PEXP_vec (mutability, pexps))
 
 
     | LIT_STR s ->
@@ -947,6 +956,9 @@ and parse_as_pexp (ps:pstate) : pexp =
 and parse_pexp (ps:pstate) : pexp =
   parse_as_pexp ps
 
+and parse_mutable_and_pexp (ps:pstate) : (Ast.mutability * pexp) =
+  let mutability = parse_mutability ps in
+  (mutability, parse_as_pexp ps)
 
 and parse_pexp_list (ps:pstate) : pexp array =
   match peek ps with
@@ -955,6 +967,13 @@ and parse_pexp_list (ps:pstate) : pexp array =
           (ctxt "pexp list" parse_pexp) ps
     | _ -> raise (unexpected ps)
 
+and parse_mutable_and_pexp_list (ps:pstate) : (Ast.mutability * pexp) array =
+  match peek ps with
+      LPAREN ->
+        bracketed_zero_or_more LPAREN RPAREN (Some COMMA)
+          (ctxt "mutable-and-pexp list" parse_mutable_and_pexp) ps
+    | _ -> raise (unexpected ps)
+
 ;;
 
 (* 
@@ -1099,8 +1118,7 @@ and desugar_expr_atom
       | PEXP_bind _
       | PEXP_spawn _
       | PEXP_custom _
-      | PEXP_box _
-      | PEXP_mutable _ ->
+      | PEXP_box _ ->
           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,
@@ -1233,11 +1251,11 @@ and desugar_expr_init
               begin
                 Array.map
                   begin
-                    fun (ident, pexp) ->
+                    fun (ident, mutability, pexp) ->
                       let (stmts, atom) =
                         desugar_expr_atom ps pexp
                       in
-                        (stmts, (ident, atom))
+                        (stmts, (ident, mutability, atom))
                   end
                   args
               end
@@ -1259,19 +1277,24 @@ and desugar_expr_init
             end
 
       | PEXP_tup args ->
+          let muts = Array.to_list (Array.map fst args) in
           let (arg_stmts, arg_atoms) =
-            desugar_expr_atoms ps args
+            desugar_expr_atoms ps (Array.map snd args)
           in
-          let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_atoms)) in
+          let arg_atoms = Array.to_list arg_atoms in
+          let tup_args = Array.of_list (List.combine muts arg_atoms) in
+          let stmt = ss (Ast.STMT_init_tup (dst_lval, tup_args)) in
             aa arg_stmts [| stmt |]
 
       | PEXP_str s ->
           let stmt = ss (Ast.STMT_init_str (dst_lval, s)) in
             [| stmt |]
 
-      | PEXP_vec args ->
+      | PEXP_vec (mutability, args) ->
           let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in
-          let stmt = ss (Ast.STMT_init_vec (dst_lval, arg_atoms)) in
+          let stmt =
+            ss (Ast.STMT_init_vec (dst_lval, mutability, arg_atoms))
+          in
             aa arg_stmts [| stmt |]
 
       | PEXP_port ->
@@ -1296,20 +1319,15 @@ and desugar_expr_init
           in
             aa port_stmts [| chan_stmt |]
 
-      | PEXP_box arg ->
+      | PEXP_box (mutability, arg) ->
           let (arg_stmts, arg_mode_atom) =
             desugar_expr_atom ps arg
           in
-          let stmt = ss (Ast.STMT_init_box (dst_lval, arg_mode_atom)) in
+          let stmt =
+            ss (Ast.STMT_init_box (dst_lval, mutability, arg_mode_atom))
+          in
             aa arg_stmts [| stmt |]
 
-      | 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
           let stmts =
diff --git a/src/boot/llvm/lltrans.ml b/src/boot/llvm/lltrans.ml
index a7daa371314..1f268fa1d9a 100644
--- a/src/boot/llvm/lltrans.ml
+++ b/src/boot/llvm/lltrans.ml
@@ -761,10 +761,10 @@ let trans_crate
             let trans_tail () = trans_tail_with_builder llbuilder in
 
             match head.node with
-                Ast.STMT_init_tup (dest, atoms) ->
+                Ast.STMT_init_tup (dest, elems) ->
                   let zero = const_i32 0 in
                   let lldest = trans_lval dest in
-                  let trans_tup_atom idx atom =
+                  let trans_tup_elem idx (_, atom) =
                     let indices = [| zero; const_i32 idx |] in
                     let gep_id = anon_llid "init_tup_gep" in
                     let ptr =
@@ -772,7 +772,7 @@ let trans_crate
                     in
                     ignore (Llvm.build_store (trans_atom atom) ptr llbuilder)
                   in
-                  Array.iteri trans_tup_atom atoms;
+                  Array.iteri trans_tup_elem elems;
                   trans_tail ()
 
               | Ast.STMT_copy (dest, src) ->
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml
index f8b82c122b4..148f12497f3 100644
--- a/src/boot/me/alias.ml
+++ b/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
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 7b18a5bc402..434fb025c01 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -583,13 +583,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 (atom_slots cx) (Array.to_list az))
+  Array.concat (List.map (atom_slots cx) (Array.to_list (Array.map snd 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))
 ;;
 
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 6d5678d3ad3..46329a1082e 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -3244,13 +3244,13 @@ let trans_visitor
       (dst:Il.cell)
       (dst_tys:Ast.ty array)
       (trec:Ast.ty_rec)
-      (atab:(Ast.ident * Ast.atom) array)
+      (atab:(Ast.ident * Ast.mutability * Ast.atom) array)
       (base:Ast.lval)
       : unit =
     Array.iteri
       begin
         fun i (fml_ident, _) ->
-          let fml_entry _ (act_ident, atom) =
+          let fml_entry _ (act_ident, _, atom) =
             if act_ident = fml_ident then Some atom else None
           in
           let dst_ty = dst_tys.(i) in
@@ -4315,7 +4315,7 @@ let trans_visitor
             begin
               match base with
                   None ->
-                    let atoms = Array.map snd atab in
+                    let atoms = Array.map (fun (_, _, atom) -> atom) atab in
                       trans_init_structural_from_atoms
                         dst_cell dst_tys atoms
                 | Some base_lval ->
@@ -4323,7 +4323,7 @@ let trans_visitor
                       dst_cell dst_tys trec atab base_lval
             end
 
-      | Ast.STMT_init_tup (dst, atoms) ->
+      | Ast.STMT_init_tup (dst, elems) ->
           let (slot_cell, ty) = trans_lval_init dst in
           let dst_tys =
             match ty with
@@ -4332,6 +4332,7 @@ let trans_visitor
                   bugi cx stmt.id
                     "non-tup destination type in stmt_init_tup"
           in
+          let atoms = Array.map snd elems in
           let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in
             trans_init_structural_from_atoms dst_cell dst_tys atoms
 
@@ -4339,7 +4340,7 @@ let trans_visitor
       | Ast.STMT_init_str (dst, s) ->
           trans_init_str dst s
 
-      | Ast.STMT_init_vec (dst, atoms) ->
+      | Ast.STMT_init_vec (dst, _, atoms) ->
           trans_init_vec dst atoms
 
       | Ast.STMT_init_port dst ->
@@ -4357,7 +4358,7 @@ let trans_visitor
                   trans_init_chan dst p
           end
 
-      | Ast.STMT_init_box (dst, src) ->
+      | Ast.STMT_init_box (dst, _, src) ->
           trans_init_box dst src
 
       | Ast.STMT_block block ->
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 9110743bf8b..4557070808f 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -1144,7 +1144,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
         | Ast.STMT_init_rec (dst, 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 = any() in
                 unify_atom arg_pass_ctx atom tv;
                 Hashtbl.add dct ident tv
@@ -1157,7 +1157,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
 
         | Ast.STMT_init_rec (dst, fields, None) ->
             let dct = Hashtbl.create 10 in
-            let add_field (ident, atom) =
+            let add_field (ident, _, atom) =
               let tv = any() in
                 unify_atom arg_pass_ctx atom tv;
                 Hashtbl.add dct ident tv
@@ -1166,7 +1166,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
               unify_lval init_ctx dst (ref (TYSPEC_record dct))
 
         | Ast.STMT_init_tup (dst, members) ->
-            let member_to_tv atom =
+            let member_to_tv (_, atom) =
               let tv = any() in
                 unify_atom arg_pass_ctx atom tv;
                 tv
@@ -1174,7 +1174,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
             let member_tvs = Array.map member_to_tv members in
               unify_lval init_ctx dst (ref (TYSPEC_tuple member_tvs))
 
-        | Ast.STMT_init_vec (dst, atoms) ->
+        | Ast.STMT_init_vec (dst, _, atoms) ->
             let tv = any() in
             let unify_with_tv atom = unify_atom arg_pass_ctx atom tv in
               Array.iter unify_with_tv atoms;
@@ -1304,7 +1304,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
         | Ast.STMT_join lval ->
             unify_lval rval_ctx lval (ty Ast.TY_task);
 
-        | Ast.STMT_init_box (dst, v) ->
+        | Ast.STMT_init_box (dst, _, v) ->
             let in_tv = any() in
             let tv = ref (TYSPEC_mutable (ref (TYSPEC_box in_tv))) in
               unify_lval strict_ctx dst tv;
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index b935864f6f1..cca548b8bf1 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -434,7 +434,7 @@ let condition_assigning_visitor
               raise_pre_post_cond 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_pre_post_cond s.id precond;
@@ -454,7 +454,7 @@ let condition_assigning_visitor
               raise_pre_post_cond s.id precond;
               raise_postcondition s.id postcond
 
-        | Ast.STMT_init_box (dst, src) ->
+        | Ast.STMT_init_box (dst, _, src) ->
             let precond = slot_inits (atom_slots cx src) in
             let postcond = slot_inits (lval_slots cx dst) in
               raise_pre_post_cond s.id precond;
@@ -1106,11 +1106,11 @@ let lifecycle_visitor
 
           | 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, _)
-          | Ast.STMT_init_box (lv_dst, _) ->
+          | Ast.STMT_init_box (lv_dst, _, _) ->
               init_lval lv_dst
 
           | Ast.STMT_for f ->
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index bb774c018d8..fac44170d70 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -386,16 +386,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 (walk_atom v) mut_atoms
+          Array.iter (fun (_, atom) -> walk_atom v atom) mut_atoms
 
       | Ast.STMT_init_str (lv, _) ->
           walk_lval v lv
@@ -407,7 +407,7 @@ and walk_stmt
           walk_option (walk_lval v) port;
           walk_lval v chan;
 
-      | Ast.STMT_init_box (dst, src) ->
+      | Ast.STMT_init_box (dst, _, src) ->
           walk_lval v dst;
           walk_atom v src