| UNSAFE
;;
+type mutability =
+ MUT_mutable
+ | MUT_immutable
+;;
+
type name_base =
BASE_ident of ident
| BASE_temp of temp_id
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' =
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))
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;
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
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 ");";
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 ";"
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)
| 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 =
| 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)
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)
| 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
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)
| 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 ->
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
(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)
+
;;
(*
| 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,
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
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 ->
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 =
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 =
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) ->
| 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
;;
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))
;;
(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
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 ->
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
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
| 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 ->
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 ->
| 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
| 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
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
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;
| 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;
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;
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;
| 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 ->
| 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
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
}
fn main() {
- let point a = rec(x=10, y=11, z=mutable 12);
+ let point a = rec(x=10, y=11, mutable z=12);
let @point b = @a;
check (b.z == 12);
f(b);
}
fn main() {
- let point x = rec(x=10, y=11, z=mutable 12);
+ let point x = rec(x=10, y=11, mutable z=12);
f(x);
check (x.z == 13);
}
projects / rust.git / commitdiff