aboutsummaryrefslogtreecommitdiff
path: root/src/boot/fe
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/fe')
-rw-r--r--src/boot/fe/ast.ml5
-rw-r--r--src/boot/fe/pexp.ml29
2 files changed, 27 insertions, 7 deletions
diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index efbd62ae..8fc952a5 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -199,7 +199,7 @@ and tup_input = (mutability * atom)
and stmt' =
(* lval-assigning stmts. *)
- STMT_spawn of (lval * domain * lval * (atom array))
+ STMT_spawn of (lval * domain * string * lval * (atom array))
| STMT_new_rec of (lval * (rec_input array) * lval option)
| STMT_new_tup of (lval * (tup_input array))
| STMT_new_vec of (lval * mutability * atom array)
@@ -936,10 +936,11 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
fmt ff ";"
end
- | STMT_spawn (dst, domain, fn, args) ->
+ | STMT_spawn (dst, domain, name, fn, args) ->
fmt_lval ff dst;
fmt ff " = spawn ";
fmt_domain ff domain;
+ fmt_str ff ("\"" ^ name ^ "\"");
fmt_lval ff fn;
fmt_atoms ff args;
fmt ff ";";
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index 3e17e0e4..75983c7f 100644
--- a/src/boot/fe/pexp.ml
+++ b/src/boot/fe/pexp.ml
@@ -18,7 +18,7 @@ open Parser;;
type pexp' =
PEXP_call of (pexp * pexp array)
- | PEXP_spawn of (Ast.domain * pexp)
+ | PEXP_spawn of (Ast.domain * string * pexp)
| PEXP_bind of (pexp * pexp option array)
| PEXP_rec of ((Ast.ident * Ast.mutability * pexp) array * pexp option)
| PEXP_tup of ((Ast.mutability * pexp) array)
@@ -558,9 +558,27 @@ and parse_bottom_pexp (ps:pstate) : pexp =
THREAD -> bump ps; Ast.DOMAIN_thread
| _ -> Ast.DOMAIN_local
in
- let pexp = ctxt "spawn [domain] pexp: init call" parse_pexp ps in
+ (* Spawns either have an explicit literal string for the spawned
+ task's name, or the task is named as the entry call
+ expression. *)
+ let explicit_name =
+ match peek ps with
+ LIT_STR s -> bump ps; Some s
+ | _ -> None
+ in
+ let pexp =
+ ctxt "spawn [domain] [name] pexp: init call" parse_pexp ps
+ in
let bpos = lexpos ps in
- span ps apos bpos (PEXP_spawn (domain, pexp))
+ let name =
+ match explicit_name with
+ Some s -> s
+ (* FIXME: string_of_span returns a string like
+ "./driver.rs:10:16 - 11:52", not the actual text at those
+ characters *)
+ | None -> Session.string_of_span { lo = apos; hi = bpos }
+ in
+ span ps apos bpos (PEXP_spawn (domain, name, pexp))
| BIND ->
let apos = lexpos ps in
@@ -1183,7 +1201,7 @@ and desugar_expr_init
let bind_stmt = ss (Ast.STMT_bind (dst_lval, fn_lval, arg_atoms)) in
ac [ fn_stmts; arg_stmts; [| bind_stmt |] ]
- | PEXP_spawn (domain, sub) ->
+ | PEXP_spawn (domain, name, sub) ->
begin
match sub.node with
PEXP_call (fn, args) ->
@@ -1191,7 +1209,8 @@ and desugar_expr_init
let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in
let fn_lval = atom_lval ps fn_atom in
let spawn_stmt =
- ss (Ast.STMT_spawn (dst_lval, domain, fn_lval, arg_atoms))
+ ss (Ast.STMT_spawn
+ (dst_lval, domain, name, fn_lval, arg_atoms))
in
ac [ fn_stmts; arg_stmts; [| spawn_stmt |] ]
| _ -> raise (err "non-call spawn" ps)