The daemon cannot be handed a list by accident

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.

bin/main.ml

@@ -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 =

lib/check.ml

@@ -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)
+(* Separate entry points below rather than a flag on the one the session calls,
-  : Tast.program * env =
+   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 =
+(** The program and the environment, stopping at the first refusal. What a
-  fst (program_with_env ?keep_going decls)
+    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

lib/loc.ml

@@ -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")

lib/parse.ml

@@ -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.
+   is no such landmark, so one bad [defn] is one error. *)
-
+let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list =
-   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 =
   (* 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;

test/test_flan.ml

@@ -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
+     Check.program_all
-       (Parse.program ~keep_going:true
+       (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:
+  (* [Check.program] is a different function from [Check.program_all], and
-     it catches [Loc.Error] and would not see a list. *)
+     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