JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The daemon cannot be handed a list by accident

Browse Source 
Loc.Errors is a second exception, and the handlers in the session and the
daemon name only Loc.Error — so a list reaching them is an unhandled
exception and a dead session, which is the one thing the dev loop exists to
prevent. A flag on the function the session already calls left that one
label away from happening. Parse.program_all and Check.program_all are
separate names, so the session's call site has to be edited by a person for
its behaviour to change, and the guarantee stops being a default argument.

Placeless diagnostics now sort last rather than first. A wrong main signature
is raised against unknown, which is line 0, and sorting on the number alone
put it above every error that can actually be clicked. It is a real error and
it is not anywhere, so it goes after the ones that are.
This commit is contained in:
Joseph Ferano 2026-09-13 08:04:45 +07:00
parent 17892852f8
commit 41b60d2e4a
5 changed files with 69 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
bin/main.ml
View File

@ -47,9 +47,9 @@ let summarise (d : Flan.Ast.decl) =
asks for the whole list rather than the first thing wrong. *)
let load path : Flan.Load.t =
Flan.Load.program ~file:path
(Flan.Parse.program ~keep_going:true (Flan.Reader.read_file path))
(Flan.Parse.program_all (Flan.Reader.read_file path))
let checked path = Flan.Check.program ~keep_going:true (load path).decls
let checked path = Flan.Check.program_all (load path).decls
(* What the source called each parameter, per function. The typed IR refers to
locals by slot index and records no names — [Check] has them in its scope
@ -136,7 +136,7 @@ let () =
(fun path ->
with_errors path (fun () ->
Flan.Reader.read_file path
|> Flan.Parse.program ~keep_going:true
|> Flan.Parse.program_all
|> List.iter (fun d -> print_endline (summarise d))))
files
| _ :: "check" :: files when files <> [] ->
@ -290,7 +290,7 @@ let () =
with_errors path (fun () ->
let l = load path in
let pnames = if debug then param_names l else [] in
Flan.Check.program ~keep_going:true l.decls
Flan.Check.program_all l.decls
|> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize
|> print_string))
files
@ -322,7 +322,7 @@ let () =
in
with_errors path (fun () ->
let l = load path in
let p = Flan.Check.program ~keep_going:true l.decls in
let p = Flan.Check.program_all l.decls in
(* The link follows the program, not the import list: a package nothing
reachable calls into contributes no C and no linker argument, and its
functions are not emitted either. That is what lets one file import
@ -399,7 +399,7 @@ let () =
(Printf.sprintf "flan-run-%d" (Unix.getpid ()))
in
let l = load path in
let p = Flan.Check.program ~keep_going:true l.decls in
let p = Flan.Check.program_all l.decls in
let p, csrcs, lflags = Flan.Reach.link l p in
ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe);
let code =

22
lib/check.ml
View File

@ -4205,8 +4205,11 @@ let check_main env =
expression typed at a REPL against the program the process is running — and
it has to be this one rather than anything rebuilt from declarations,
because [program] prepends the prelude and no accumulated AST contains it. *)
let program_with_env ?(keep_going = false) (decls : Ast.decl list)
: Tast.program * env =
(* Separate entry points below rather than a flag on the one the session calls,
for the reason [Parse] gives at the same fork: [Loc.Errors] is a second
exception that the session and the daemon do not catch, so the guarantee
that they never see one should be structural and not a default argument. *)
let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
let env = new_env () in
let decls = Parse.program (Prelude.forms ()) @ decls in
(* Before anything is collected: every (declare-c ...) becomes an ordinary
@ -4265,8 +4268,19 @@ let program_with_env ?(keep_going = false) (decls : Ast.decl list)
globals; externs; fns; cshim },
env)
let program ?keep_going (decls : Ast.decl list) : Tast.program =
fst (program_with_env ?keep_going decls)
(** The program and the environment, stopping at the first refusal. What a
session needs, and it raises [Loc.Error] and never [Loc.Errors]. *)
let program_with_env (decls : Ast.decl list) : Tast.program * env =
build_program ~keep_going:false decls
let program (decls : Ast.decl list) : Tast.program =
fst (build_program ~keep_going:false decls)
(** The same, reporting every declaration whose body it refuses rather than the
first. Raises [Loc.Errors], so only a caller prepared for a list should be
calling it. *)
let program_all (decls : Ast.decl list) : Tast.program =
fst (build_program ~keep_going:true decls)
(* One expression, checked against a program that is already running. The
frame is empty — a REPL expression has no parameters and no enclosing

16
lib/loc.ml
View File

@ -314,7 +314,21 @@ let report (d : diag) =
prints when it finished the file rather than stopping at the first thing
it found. *)
let report_all (ds : diag list) =
let ds = List.stable_sort (fun a b -> before a.dloc b.dloc) ds in
(* Source order, with the placeless ones last. A diagnostic the checker
raised against [unknown] — a wrong [main] signature is the one that
happens — has line 0, and sorting on the number alone would put it at the
top of the list, above every error that can actually be clicked. It is a
real error and it is not anywhere, so it goes after the ones that are. *)
let placed (d : diag) = d.dloc.line > 0 in
let ds =
List.stable_sort
(fun a b ->
match (placed a, placed b) with
| true, false -> -1
| false, true -> 1
| _ -> before a.dloc b.dloc)
ds
in
let n = List.length ds in
String.concat "\n" (List.map report ds)
^ Printf.sprintf "\n%d error%s" n (if n = 1 then "" else "s")

28
lib/parse.ml
View File

@ -866,15 +866,20 @@ and variant (f : Form.t) : Ast.variant =
unknown name, which is wrong but not silent. *)
let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs)
(* [keep_going] asks for every bad declaration in the file rather than the
(* Two entry points and not one function with a flag, and the reason is the
daemon. [Loc.Errors] is a second exception, and the handlers in the session
and in the daemon name only [Loc.Error] — so a list reaching them would be
an unhandled exception and a dead session, which is the one thing the whole
dev loop exists to prevent. A flag on the function the session already calls
would put that one label away from happening. A separate name cannot: the
session's call site has to be edited by someone for its behaviour to change.
[keep_going] asks for every bad declaration in the file rather than the
first. The resync point is a top-level form, and it is the only honest one
here: the reader already found where each declaration ends, so skipping a
bad one costs nothing and cannot lose its place. Inside a declaration there
is no such landmark, so one bad [defn] is one error.
Off by default, because the daemon parses one form at a time and wants one
exception. *)
let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list =
is no such landmark, so one bad [defn] is one error. *)
let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list =
(* Quasiquote first and always, because it is pure and needs nothing loaded:
it is what turns a macro body into ordinary code, and the prelude's own
macros have to parse in a process that has not built a macro module yet.
@ -886,6 +891,17 @@ let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list =
Loc.finish s;
decls
(** One file, stopping at the first declaration it cannot parse. Raises
[Loc.Error], never [Loc.Errors]. *)
let program (forms : Form.t list) : Ast.decl list =
parse_forms ~keep_going:false forms
(** One file, reporting every declaration it cannot parse. Raises [Loc.Errors]
when there was more than nothing wrong, so only a caller prepared for a
list should be calling it. *)
let program_all (forms : Form.t list) : Ast.decl list =
parse_forms ~keep_going:true forms
(* Single-declaration entry point, for tests and the REPL. *)
let decl (f : Form.t) : Ast.decl =
temps := 0;

15
test/test_flan.ml
View File

@ -1685,8 +1685,8 @@ let () =
the first and a checker that reported thirty pieces of wreckage would both
fail this row. *)
(match
Check.program ~keep_going:true
(Parse.program ~keep_going:true
Check.program_all
(Parse.program_all
(read "(defn a [] i32 nope1)\n\
(defn b [] i32 nope2)\n\
(defn c [] i32 nope3)\n"))
@ -1699,18 +1699,19 @@ let () =
(* The parser resynchronises on a top-level form, so two bad declarations are
two errors rather than one. *)
(match Parse.program ~keep_going:true (read "(defn a)\n(defn b)\n") with
(match Parse.program_all (read "(defn a)\n(defn b)\n") with
| _ -> check "two bad declarations are refused" false
| exception Loc.Errors ds ->
check "two bad declarations give two errors" (List.length ds = 2));
(* One form at a time still raises one, which is what the daemon depends on:
it catches [Loc.Error] and would not see a list. *)
(* [Check.program] is a different function from [Check.program_all], and
that is the guarantee: the session calls this one, it raises one
diagnostic, and nobody can turn it into a list by passing a label. *)
(match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\
(defn b [] i32 nope2)\n")) with
| _ -> check "without keep_going it still refuses" false
| _ -> check "Check.program still refuses" false
| exception Loc.Errors _ ->
check "without keep_going there is no list" false
check "Check.program never answers with a list" false
| exception Loc.Error _ -> ());
(* The first line of a report is exactly the GNU format compilation-mode