aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/fe/ast.ml5
-rw-r--r--src/boot/fe/pexp.ml29
-rw-r--r--src/boot/me/alias.ml2
-rw-r--r--src/boot/me/effect.ml2
-rw-r--r--src/boot/me/layout.ml2
-rw-r--r--src/boot/me/trans.ml11
-rw-r--r--src/boot/me/type.ml2
-rw-r--r--src/boot/me/typestate.ml4
-rw-r--r--src/boot/me/walk.ml2
9 files changed, 41 insertions, 18 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)
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml
index 94d34fb2..27575324 100644
--- a/src/boot/me/alias.ml
+++ b/src/boot/me/alias.ml
@@ -59,7 +59,7 @@ let alias_analysis_visitor
* survive 'into' a sub-block (those formed during iteration)
* need to be handled in this module. *)
Ast.STMT_call (dst, callee, args)
- | Ast.STMT_spawn (dst, _, callee, args)
+ | Ast.STMT_spawn (dst, _, _, callee, args)
-> alias_call_args dst callee args
| Ast.STMT_send (_, src) -> alias src
diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml
index 79868def..73797409 100644
--- a/src/boot/me/effect.ml
+++ b/src/boot/me/effect.ml
@@ -62,7 +62,7 @@ let mutability_checking_visitor
match s.node with
Ast.STMT_copy (lv_dst, _)
| Ast.STMT_call (lv_dst, _, _)
- | Ast.STMT_spawn (lv_dst, _, _, _)
+ | Ast.STMT_spawn (lv_dst, _, _, _, _)
| Ast.STMT_recv (lv_dst, _)
| Ast.STMT_bind (lv_dst, _, _)
| Ast.STMT_new_rec (lv_dst, _, _)
diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml
index a9358795..1df37f0f 100644
--- a/src/boot/me/layout.ml
+++ b/src/boot/me/layout.ml
@@ -400,7 +400,7 @@ let layout_visitor
let callees =
match s.node with
Ast.STMT_call (_, lv, _)
- | Ast.STMT_spawn (_, _, lv, _) -> [| lv |]
+ | Ast.STMT_spawn (_, _, _, lv, _) -> [| lv |]
| Ast.STMT_check (_, calls) -> Array.map (fun (lv, _) -> lv) calls
| _ -> [| |]
in
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index b708bb26..01a89c56 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -2128,10 +2128,12 @@ let trans_visitor
((*initializing*)_:bool)
(dst:Ast.lval)
(domain:Ast.domain)
+ (name:string)
(fn_lval:Ast.lval)
(args:Ast.atom array)
: unit =
let (task_cell, _) = trans_lval_init dst in
+ let runtime_name = trans_static_string name in
let (fptr_operand, fn_ty) = trans_callee fn_lval in
(*let fn_ty_params = [| |] in*)
let _ =
@@ -2165,7 +2167,7 @@ let trans_visitor
match domain with
Ast.DOMAIN_thread ->
begin
- trans_upcall "upcall_new_thread" new_task [| |];
+ trans_upcall "upcall_new_thread" new_task [| runtime_name |];
copy_fn_args false true (CLONE_all new_task) call;
trans_upcall "upcall_start_thread" task_cell
[|
@@ -2177,7 +2179,7 @@ let trans_visitor
end
| _ ->
begin
- trans_upcall "upcall_new_task" new_task [| |];
+ trans_upcall "upcall_new_task" new_task [| runtime_name |];
copy_fn_args false true (CLONE_chan new_task) call;
trans_upcall "upcall_start_task" task_cell
[|
@@ -4496,8 +4498,9 @@ let trans_visitor
| Ast.STMT_send (chan,src) ->
trans_send chan src
- | Ast.STMT_spawn (dst, domain, plv, args) ->
- trans_spawn (maybe_init stmt.id "spawn" dst) dst domain plv args
+ | Ast.STMT_spawn (dst, domain, name, plv, args) ->
+ trans_spawn (maybe_init stmt.id "spawn" dst) dst
+ domain name plv args
| Ast.STMT_recv (dst, chan) ->
trans_recv (maybe_init stmt.id "recv" dst) dst chan
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 23210ea1..b2d5a622 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -692,7 +692,7 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
and check_stmt (stmt:Ast.stmt) : unit =
check_ret stmt;
match stmt.Common.node with
- Ast.STMT_spawn (dst, _, callee, args) ->
+ Ast.STMT_spawn (dst, _, _, callee, args) ->
infer_lval Ast.TY_task dst;
demand Ast.TY_nil (check_fn callee args)
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index baf4a543..20702990 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -664,7 +664,7 @@ let condition_assigning_visitor
let precond = Array.append dst_init src_init in
raise_pre_post_cond s.id precond;
- | Ast.STMT_spawn (dst, _, lv, args)
+ | Ast.STMT_spawn (dst, _, _, lv, args)
| Ast.STMT_call (dst, lv, args) ->
raise_dst_init_precond_if_writing_through s.id dst;
visit_callable_pre s.id (lval_slots cx dst) lv args
@@ -1350,7 +1350,7 @@ let lifecycle_visitor
match s.node with
Ast.STMT_copy (lv_dst, _)
| Ast.STMT_call (lv_dst, _, _)
- | Ast.STMT_spawn (lv_dst, _, _, _)
+ | Ast.STMT_spawn (lv_dst, _, _, _, _)
| Ast.STMT_recv (lv_dst, _)
| Ast.STMT_bind (lv_dst, _, _)
| Ast.STMT_new_rec (lv_dst, _, _)
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index 0e65406a..cadfd66b 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -451,7 +451,7 @@ and walk_stmt
walk_lval v f;
Array.iter (walk_opt_atom v) az
- | Ast.STMT_spawn (dst,_,p,az) ->
+ | Ast.STMT_spawn (dst,_,_,p,az) ->
walk_lval v dst;
walk_lval v p;
Array.iter (walk_atom v) az
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-11 23:07:24 +0000