aboutsummaryrefslogtreecommitdiff
path: root/src/boot/fe
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/fe')
-rw-r--r--src/boot/fe/ast.ml61
-rw-r--r--src/boot/fe/item.ml15
-rw-r--r--src/boot/fe/pexp.ml96
3 files changed, 114 insertions, 58 deletions
diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index f3991e9b..0f61eec4 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))
@@ -283,7 +288,7 @@ and stmt_for_each =
and stmt_for =
{
for_slot: (slot identified * ident);
- for_seq: ((stmt array) * lval);
+ for_seq: lval;
for_body: block;
}
@@ -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 ");";
@@ -1098,7 +1108,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
| STMT_for sfor ->
let (slot, ident) = sfor.for_slot in
- let (stmts, lval) = sfor.for_seq in
+ let lval = sfor.for_seq in
begin
fmt_obox ff;
fmt ff "for (";
@@ -1106,7 +1116,6 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
fmt ff " ";
fmt_ident ff ident;
fmt ff " in ";
- fmt_stmts ff stmts;
fmt_lval ff lval;
fmt ff ") ";
fmt_obr ff;
@@ -1167,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 ";"
@@ -1339,6 +1349,33 @@ and fmt_crate (ff:Format.formatter) (c:crate) : unit =
let (view,items) = c.node.crate_items in
fmt_mod_view ff view;
fmt_mod_items ff items
+;;
+
+let ty_children (ty:ty) : ty array =
+ let children_of_ty_tag ty_tag = Array.concat (htab_vals ty_tag) in
+ let children_of_ty_fn ty_fn =
+ let (ty_sig, _) = ty_fn in
+ let in_slots = ty_sig.sig_input_slots in
+ let slots = Array.append in_slots [| ty_sig.sig_output_slot |] in
+ arr_filter_some (Array.map (fun slot -> slot.slot_ty) slots)
+ in
+ match ty with
+ TY_tup tys -> tys
+ | TY_vec ty' | TY_chan ty' | TY_port ty' | TY_box ty' | TY_mutable ty'
+ | TY_constrained (ty', _) ->
+ [| ty' |]
+ | TY_rec fields -> Array.map snd fields
+ | TY_tag ty_tag -> children_of_ty_tag ty_tag
+ | TY_iso ty_iso ->
+ children_of_ty_tag (ty_iso.iso_group.(ty_iso.iso_index))
+ | TY_fn ty_fn -> children_of_ty_fn ty_fn
+ | TY_obj (_, methods) ->
+ Array.concat (List.map children_of_ty_fn (htab_vals methods))
+ | TY_any | TY_nil | TY_bool | TY_mach _ | TY_int | TY_uint | TY_char
+ | TY_str | TY_idx _ | TY_task | TY_native _ | TY_param _
+ | TY_named _ | TY_type ->
+ [| |]
+;;
let sprintf_expr = sprintf_fmt fmt_expr;;
let sprintf_name = sprintf_fmt fmt_name;;
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 87604cb0..d0042ebf 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -369,17 +369,18 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
let inner ps =
let slot = (parse_identified_slot_and_ident false ps) in
let _ = (expect ps IN) in
- let lval = (parse_lval ps) in
- (slot, lval) in
- let (slot, seq) =
+ (slot, (parse_lval ps))
+ in
+ let (slot, (stmts, lval)) =
ctxt "stmts: for head" (bracketed LPAREN RPAREN inner) ps
in
let body_block = ctxt "stmts: for body" parse_block ps in
let bpos = lexpos ps in
- [| span ps apos bpos
- (Ast.STMT_for
+ Array.append stmts
+ [| span ps apos bpos
+ (Ast.STMT_for
{ Ast.for_slot = slot;
- Ast.for_seq = seq;
+ Ast.for_seq = lval;
Ast.for_body = body_block; }) |]
end
@@ -498,7 +499,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
expect ps SEMI;
spans ps stmts apos (Ast.STMT_join lval)
- | MOD | OBJ | TYPE | FN | USE | NATIVE ->
+ | IO | STATE | UNSAFE | MOD | OBJ | TYPE | FN | USE | NATIVE ->
let (ident, item) = ctxt "stmt: decl" parse_mod_item ps in
let decl = Ast.DECL_mod_item (ident, item) in
let stmts = expand_tags_to_stmts ps item in
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index 14065466..27ec8810 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 =
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-25 21:00:24 +0000