diff options
Diffstat (limited to 'src/boot/fe/pexp.ml')
| -rw-r--r-- | src/boot/fe/pexp.ml | 79 |
1 files changed, 49 insertions, 30 deletions
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml index fb2d91a0..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 @@ -817,11 +835,33 @@ and parse_or_pexp (ps:pstate) : pexp = step lhs +and parse_as_pexp (ps:pstate) : pexp = + let apos = lexpos ps in + let pexp = ctxt "as pexp" parse_or_pexp ps in + let rec step accum = + match peek ps with + AS -> + bump ps; + let tapos = lexpos ps in + let t = parse_ty ps in + let bpos = lexpos ps in + let t = span ps tapos bpos t in + let node = + span ps apos bpos + (PEXP_unop ((Ast.UNOP_cast t), accum)) + in + step node + + | _ -> accum + in + step pexp + + and parse_relational_pexp (ps:pstate) : pexp = let name = "relational pexp" in let apos = lexpos ps in - let lhs = ctxt (name ^ " lhs") parse_or_pexp ps in - let build = binop_build ps name apos parse_or_pexp in + let lhs = ctxt (name ^ " lhs") parse_as_pexp ps in + let build = binop_build ps name apos parse_as_pexp in let rec step accum = match peek ps with LT -> build accum step Ast.BINOP_lt @@ -883,30 +923,8 @@ and parse_oror_pexp (ps:pstate) : pexp = step lhs -and parse_as_pexp (ps:pstate) : pexp = - let apos = lexpos ps in - let pexp = ctxt "as pexp" parse_oror_pexp ps in - let rec step accum = - match peek ps with - AS -> - bump ps; - let tapos = lexpos ps in - let t = parse_ty ps in - let bpos = lexpos ps in - let t = span ps tapos bpos t in - let node = - span ps apos bpos - (PEXP_unop ((Ast.UNOP_cast t), accum)) - in - step node - - | _ -> accum - in - step pexp - - and parse_pexp (ps:pstate) : pexp = - parse_as_pexp ps + parse_oror_pexp ps and parse_mutable_and_pexp (ps:pstate) : (Ast.mutability * pexp) = let mutability = parse_mutability 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) |