An error is a span with notes, and a run reports more than one

BUILT.md

@@ -4046,3 +4046,152 @@ composite renderer and ghost text want the same form, for different reasons. `fl
 things ghost text would need — overlay invalidation as the buffer is edited, and a rule for a watch inside a loop,
 which the buffer sidesteps by showing the last value written and which inline has no obvious answer that does not
 become the query UI this design exists to avoid.
+
+## An error is a value, and there is more than one of them
+
+`lib/loc.ml` used to carry a point and a message, and `Loc.Error` was the frontend's one exception, so the first
+error ended the run. The author's workflow is write everything, compile at the end, work through the list — which
+cannot happen when there is never a list. The messages themselves were already good; they state the reason and name
+what to write instead, and **none of them changed**. What was missing was structure and volume.
+
+### The location is a span
+
+`Loc.t` grew an exclusive end, defaulting to the start. That is the whole trick: a location nobody widened is a
+zero-width span at a point, so every call site that existed before means exactly what it meant, and `Loc.to_string`
+still prints `file:line:col`. Only the reader knows where a form ends, so only the reader fills them in — one helper
+in the one place that holds both ends, which is why nothing above `Reader` had to learn a span exists. `Form`, `Ast`
+and `Tast` were not touched and did not need to be.
+
+A column number cannot draw an underline and a span can. That is what the field is for and it is the only reason it
+is there.
+
+### The error itself
+
+```ocaml
+type diag = {
+  kind      : string;               (* "reader/unclosed", stable *)
+  dloc      : t;                    (* the primary span *)
+  dmsg      : string;
+  notes     : note list;            (* each with its own span and severity *)
+  expansion : (string * t) option;  (* the macro it came out of *)
+}
+exception Error  of diag
+exception Errors of diag list
+```
+
+Three parts, each buying something the old pair could not express.
+
+**`kind`** is a stable id. It classifies with no prose parsed, so a message can be reworded without breaking anything
+that depends on *which* error this is. The reader's fourteen refusals all carry one; in the checker they go on the
+errors a test names and the handful common enough to be worth classifying. **Not a hundred of them.** jank has about
+a hundred because it is mature, and the count is not the feature — with 163 refusal sites in `check.ml` alone,
+minting an id for each would be a sweep that never ends and that nothing reads.
+
+**`notes`** are the part that was actually missing, and they are the secret of an Elm-quality message. Each carries
+its own span and its own severity, so an error says "this is wrong *here*" **and** "because of *that*, over there",
+and points at both. One location and one string can only ever state one of the two. What has them today:
+
+- a name defined twice points at the second, because that is the one to delete, and notes the first;
+- a duplicate parameter and a duplicate field do the same;
+- an unknown field, an unknown struct and a non-exhaustive `match` note the *declaration* and list what is actually
+  there, so the reader's next move arrives with the question instead of after it;
+- the reader's unclosed bracket is the clearest case — the error sits on the bracket, because that is where the fix
+  goes, and the note sits where the file ran out, because that is the surprise. A mismatched closer is the mirror of
+  it: the wrong closer is where the mistake reads, and the opener is what makes it wrong, and neither alone says
+  which bracket to change.
+
+**`expansion`** names the macro an error is really about. It rides on the *location*, not on the form, because the
+location is the thing that already travels: `Expand.unmarshal` stamps the call site onto every node a macro answers
+with, and that stamp goes on through the AST and the typed IR untouched. Tagging it there means an error raised
+anywhere downstream can name the macro with **no field added to `Form`, to `Ast` or to `Tast`**. Outermost wins — the
+macro the author wrote is the one worth naming, not whatever it expanded into on the way down.
+
+### The squiggle
+
+The first line of an entry is exactly `file:line:col: message`, which is the GNU format `compilation-mode` parses
+with no configuration. That is the whole of the editor story: once more than one comes out, `M-x compile` gives a
+clickable list and `next-error` walks it. Everything under the first line is indented, and `compilation-mode` ignores
+indented continuation lines, so the underline is free:
+
+```
+prog.flan:6:3: Cursor has no field pos
+  6 |   (.pos c))
+    |   ^^^^^^^^
+prog.flan:1:1: info: Cursor is declared here, with row, col
+  1 | (defstruct Cursor
+    | -----------------
+```
+
+A note gets an **entry of its own** rather than being folded into the error's block. That is gcc's shape and it is the
+point of notes having locations at all: the second place becomes a place the compilation buffer knows about.
+
+**Stated at its true strength, because it was checked rather than assumed** (`compile.el`, Emacs 30.2). The `gnu`
+entry in `compilation-error-regexp-alist-alist` puts `Note`/`note` in the *same capture group* as `Info`/`info` —
+group 7, level 0 — while `warning` is group 6, level 1. `compilation-skip-threshold` defaults to **1**, "skip
+anything less than warning". So: **errors** are navigable with `next-error` out of the box, which is the claim that
+matters and the one `M-x compile` rests on. **Notes** are parsed, coloured and clickable, and `next-error` steps over
+them until `compilation-skip-threshold` is 0. Renaming the label from `info:` to `note:` does not change that — same
+group. Labelling notes `warning:` *would* make them navigable at the default, and is refused: a note is not a
+warning, and a compile whose only complaint is an error would start reporting warnings that are not warnings.
+
+Every part of it degrades to the bare first line. A location the checker invented has line 0 and a file called
+`<unknown>`, the prelude and the REPL have names that are not paths, and a file can change under us between being
+read and being blamed. An error printer that can raise is worse than one that prints less. Placeless diagnostics sort
+*last*: a wrong `main` signature is raised against `unknown`, and sorting on the line number alone put it above every
+error that could actually be clicked.
+
+The source cache in `loc.ml` is process-lifetime, which is right for `flan build` — a fresh process per run. The
+daemon is long-lived and never calls `report`; the interactive path draws no squiggle, it takes a location and a
+message. `Loc.forget_sources` exists for the day that changes.
+
+### Collecting, and where it stops
+
+A sink holds what a pass found so the pass can go on to the next thing. It is switched on by the caller, not by the
+code that raises. Two resync points, and both are places the work already had a boundary:
+
+- **In the parser, a top-level form.** 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` stays
+  one error.
+- **In the checker, the two passes.** Pass one — which builds every name, type and signature — **still stops at the
+  first refusal**, and that is deliberate rather than unfinished. A signature it could not make sense of leaves a hole
+  that pass two would report once per mention; thirty "unknown name" lines under one wrong signature are not thirty
+  errors, they are the same one. Pass two is where the volume is and where collecting pays, and by then every
+  signature is sound, so a body that fails cannot make the next body fail. That is what makes a declaration a resync
+  point needing no resynchronising.
+
+**The reader does not collect at all.** There is no resynchronising a paren stream: after an unclosed bracket the
+reader has no way to know whether the next `)` closes the form it is in or the one above it, and guessing produces a
+file-shaped pile of nonsense. First error, stop. That is a decision, not an omission.
+
+### What the daemon sees, which was the open question
+
+Changing the error type without touching `dev.ml` and `session.ml` needed a compatible way to get one location and
+one message out. The answer is that **the single-diagnostic exception is still the single-diagnostic exception**.
+`Session.eval` and the daemon evaluate one form and have one failure to report; they keep catching `Loc.Error` and
+take the pair out of it with `Loc.summary`. Only a driver that compiles a whole file raises `Loc.Errors`.
+
+That guarantee is **structural and not conventional**. `Parse.program` / `Check.program` stop at the first refusal;
+`Parse.program_all` / `Check.program_all` collect. Two names rather than one function with a `~keep_going` label,
+because `Loc.Errors` is a second exception that the session's handlers do not name — a list reaching them would be an
+unhandled exception and a dead session, which is the one thing the dev loop exists to prevent. With a label that was
+one keystroke away at a call site the session already uses. With two names, somebody has to edit the session.
+
+### What it looks like
+
+```
+$ flan check bad.flan
+bad.flan:2:8: unknown name bogus
+  2 |   (+ a bogus))
+    |        ^^^^^
+bad.flan:5:8: unknown name nope
+  5 |   (- a nope))
+    |        ^^^^
+bad.flan:8:3: unknown function mystery
+  8 |   (mystery 1 2))
+    |   ^^^^^^^^^^^^^
+3 errors
+```
+
+**No editor work was needed and none was done.** Flycheck and a structured JSON report were both considered and are
+not wanted: the workflow is compile-at-the-end, not live linting, and the GNU first line already buys the clickable
+list.

NEXT.md

@@ -921,47 +921,55 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them.
    because `check_dotimes` folds the step into the body and a `continue` branching to the header would skip it and
    hang.
 
-8. **Errors: a structured value with spans and notes, and more than one per compile.** One piece of work, not two —
+8. ~~**Errors: a structured value with spans and notes, and more than one per compile.**~~ **Built.** See
-   both need `Loc.Error` to stop being a single location plus a string.
+   *An error is a value, and there is more than one of them* in [`BUILT.md`](BUILT.md). `Loc.Error` carries a
+   `diag` — a stable `kind`, a *span*, `notes` that each have their own span and severity, and the macro expansion
+   the error came out of — and `flan check`/`flan build` print the source line with the offending span underlined,
+   in the GNU format `compilation-mode` already parses. No editor work was needed and none was done.
 
-   **Today:** `lib/loc.ml` carries a point location and a message, and `Loc.Error` is the frontend's *one* exception, so
+   What made it cheap, and is worth knowing before anything else is retrofitted onto locations: **the span went into
-   the first error aborts the run. The author's workflow is write everything, compile at the end, squash the list —
+   `Loc.t` itself**, as an exclusive end defaulting to the start. A location nobody widened is a zero-width span at a
-   which cannot work when there is never a list. The *content* of the messages is already good; they state the reason
+   point, so every one of the ~260 refusal sites kept its meaning, only the reader had to learn to fill the end in,
-   and name what to write instead. What is missing is structure and volume.
+   and `Form`, `Ast` and `Tast` were not touched. **Macro provenance went the same way** — a `macro : string option`
+   on the location — because `Expand.unmarshal` already stamps the call site onto every node a macro produces, so the
+   tag travels to the checker for free.
 
-   **jank is the model** (`~/Repositories/jank`, `compiler+runtime/include/cpp/jank/error.hpp`). It is a Lisp on LLVM
+   **Three things deliberately not built, so they do not read as oversights:**
-   with unusually good diagnostics and three things worth taking:
 
-   - **A named `kind` per error** — roughly a hundred, `lex_unterminated_string`, `parse_odd_entries_in_map` — each with
+   - **The reader does not collect.** There is no resynchronising a paren stream — after an unclosed bracket nothing
-     a stable string id. Machine-readable classification with no JSON mode and no prose parsing.
+     knows whether the next `)` closes this form or the one above it. First error, stop.
-   - **A source *span*, not a point.** This is what draws Elm's squiggle: you underline a range. A column number cannot.
+   - **Pass one of the checker does not collect either.** Signatures are a foundation: a declaration pass one could
-   - **Notes: an error carries zero or more, each with its own span and its own severity** (info/warning/error), sorted
+     not make sense of leaves a hole that pass two reports once per mention, and thirty "unknown name" lines under
-     by position. **This is the actual secret of Elm-quality messages** — "this is wrong *here*" plus "because of *that*
+     one wrong signature are the same error thirty times. Pass two — bodies, where the volume is — collects per
-     over there", two places highlighted and each explained. One location and one string can never express it.
+     declaration.
+   - **There are not a hundred kinds.** The reader's fourteen have them and the checker's have them where a test
+     asserts on one; `check.ml` alone has 163 refusal sites and minting an id for each is a sweep nothing reads.
+   - **`Load` and `Shim` do not collect.** They sit between the two collecting phases and still stop at the first
+     refusal, for pass one's reason: an import that could not be resolved leaves a hole the checker would report
+     once per use.
 
-   jank also carries the **macro expansion** an error came from, which this project will want once macros land, and it
+   **One claim checked rather than assumed,** and it is weaker than it first reads: `compile.el` groups `note` with
-   is worth building the field now rather than retrofitting it.
+   `info` at level 0, and `compilation-skip-threshold` defaults to 1, so `next-error` walks the **errors** with no
+   configuration — that part holds — but steps over the notes unless the threshold is set to 0. The notes are still
+   parsed, coloured and clickable. Labelling them `warning:` would make them navigable and is refused: a note is not
+   a warning.
 
-   **Then collect rather than raise:** finish the function, finish the file, report everything found. Error recovery in
+   **What the daemon sees, which the brief asked to be worked out and stated:** the single-diagnostic exception is
-   a checker is real work — the hard part is resynchronising after a bad form without cascading nonsense — and it is
+   still the single-diagnostic exception. `Session.eval` and the daemon check one form, keep catching `Loc.Error`,
-   what the workflow actually needs.
+   and take a location and a message out with `Loc.summary`; `dev.ml` and `session.ml` needed nothing but the
+   pattern rewrite. The list is a second exception, `Loc.Errors`, raised only by `Parse.program_all` /
+   `Check.program_all` — **separate names rather than a `~keep_going` flag**, so a list cannot reach a handler that
+   does not name it without somebody editing the session.
 
-   **No editor work is required.** Flan already prints `file:line:col: message`, the GNU format Emacs's
+   **Left for later, small and independent:** notes on the type-mismatch errors, which are the most common class and
-   `compilation-mode` parses with no configuration, so `M-x compile` gives a clickable list and `next-error` free.
+   want the *parameter's* declaration as the second place — `env.fns` stores types and not locations today, so that
-   Flycheck and a structured JSON report were both considered and are **not** wanted — the workflow is
+   is a small change to what `collect` records. And a checker error on macro-produced code names the macro but has no
-   compile-at-the-end, not live linting.
+   separate location to point at, because the expansion has no source of its own; the note lands on the call site
+   beside the error, which tells the reader the code being refused is not the code they wrote and no more than that.
 
-   **Cannot run beside the current lanes**: it touches every file that raises, which is the whole frontend.
+8b. ~~**The old entry, kept for its one extra fact.**~~ **Subsumed by 8, and it was right about the tooling:** no
-
+   editor work was needed and none was done. Flycheck and a structured JSON report stay refused for the reason it
-8b. **The old entry, kept for its one extra fact:** Raised by the author's workflow: write everything, compile at the end, squash
+   gave — the workflow is compile-at-the-end, not live linting.
-   the list. That does not work today — `Loc.Error` is the frontend's **one** exception, so the first error aborts the
-   run and you get them one at a time, which is exactly the loop that workflow exists to avoid.
-
-   The fix is in the checker, not in tooling: collect errors and carry on — finish the function, finish the file,
-   report everything found. **No editor work is needed once that exists.** Flan already prints `file:line:col: message`,
-   which is the GNU format Emacs's `compilation-mode` parses with no configuration, so `M-x compile` gives a clickable
-   list and `next-error` for free. Flycheck and a structured JSON report were both considered and are **not** wanted:
-   the author's workflow is compile-at-the-end, not live linting.
 
 9. **Signature generations and stale-caller warnings.** The biggest remaining hole in "you never restart the program" —
    a changed signature is still refused rather than versioned. Last because it is the largest and nothing else waits on

bin/main.ml

@@ -1,9 +1,18 @@
 (* flan — milestone 2 driver. *)
 
+(* Both error channels, in the one place that prints them. A single refusal
+   still exits 1 and still opens with [file:line:col: message]; a driver that
+   got to the end of the file hands over everything it found, sorted, with a
+   count after it. Nothing here parses the message — the squiggle comes from
+   the span and the classification from the kind. *)
 let with_errors path f =
   try f () with
-  | Flan.Loc.Error (loc, msg) ->
+  | Flan.Loc.Error d ->
-    Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg;
+    prerr_endline (Flan.Loc.report d);
+    ignore path;
+    exit 1
+  | Flan.Loc.Errors ds ->
+    prerr_endline (Flan.Loc.report_all ds);
     ignore path;
     exit 1
 
@@ -33,10 +42,14 @@ let summarise (d : Flan.Ast.decl) =
 (* Every path past [parse] goes through [Load]: an import is resolved into the
    declarations it stands for, and the package's C shim and linker arguments
    come back with them. *)
+(* Every driver here is the batch case, which is the one the workflow is: write
+   everything, compile at the end, work through the list. So every one of them
+   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 (Flan.Reader.read_file path))
+  Flan.Load.program ~file:path
+    (Flan.Parse.program_all (Flan.Reader.read_file path))
 
-let checked path = Flan.Check.program (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
@@ -123,7 +136,7 @@ let () =
       (fun path ->
          with_errors path (fun () ->
            Flan.Reader.read_file path
-           |> Flan.Parse.program
+           |> Flan.Parse.program_all
            |> List.iter (fun d -> print_endline (summarise d))))
       files
   | _ :: "check" :: files when files <> [] ->
@@ -277,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 l.decls
+           Flan.Check.program_all l.decls
            |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize
            |> print_string))
       files
@@ -309,7 +322,7 @@ let () =
     in
     with_errors path (fun () ->
       let l = load path in
-      let p = Flan.Check.program 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
@@ -386,7 +399,7 @@ let () =
           (Printf.sprintf "flan-run-%d" (Unix.getpid ()))
       in
       let l = load path in
-      let p = Flan.Check.program 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

@@ -89,6 +89,33 @@ let new_env () = {
   lifted = [];
 }
 
+(* Where a named type was declared, and what it has, as a note.
+
+   This is the second half of the two-place messages: a refusal that says
+   [Cursor has no field pos] is true, and the reader's next move is always to
+   go and look at Cursor. Attaching the declaration's location and its actual
+   field names means the answer arrives with the question, and [next-error]
+   will take you there because a note prints as an entry of its own. Empty when
+   the name is not one this environment placed, so it degrades to the message
+   alone rather than to a wrong pointer. *)
+let declared_note env name =
+  match Hashtbl.find_opt env.locs name with
+  | None -> []
+  | Some at ->
+    let names =
+      match Hashtbl.find_opt env.structs name with
+      | Some s -> List.map (fun (f : Tast.field) -> f.Tast.fname) s.Tast.fields
+      | None ->
+        (match Hashtbl.find_opt env.unions name with
+         | Some u -> List.map (fun (c : Tast.variant) -> c.Tast.vname) u.Tast.cases
+         | None -> [])
+    in
+    let what =
+      if names = [] then name ^ " is declared here"
+      else name ^ " is declared here, with " ^ String.concat ", " names
+    in
+    [ Loc.note at what ]
+
 (* What a [break] or a [continue] may be talking about, innermost first.
 
    [Lloop] is a loop it is lexically inside, carrying its label if it was given
@@ -272,12 +299,9 @@ let captured ctx loc name =
         "an fn is lifted into a function of its own and is handed nothing but \
          its parameters. Pass it in, or use a global"
     in
-    raise
+    Loc.failk "check/capture" loc
-      (Loc.Error
+      "%s cannot see %s: it is a local of the enclosing function, and %s."
-         (loc,
+      what name why
-          Printf.sprintf
-            "%s cannot see %s: it is a local of the enclosing function, and \
-             %s." what name why))
   | _ -> ()
 
 let scoped ctx f =
@@ -514,7 +538,7 @@ and resolve_name env ~seen loc n =
          below would otherwise report [f65] as unimplemented generics and send
          you to plan.org instead of to the character you mistyped. *)
       | _ when near_miss env n <> None ->
-        fail loc "unknown type %s — did you mean %s?" n
+        Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n
           (Option.get (near_miss env n))
       (* Lowercase is a type variable, Capitalized is concrete — no sigil
          (plan.org, Types). A variable parses, but nothing at milestone 2 can
@@ -522,7 +546,7 @@ and resolve_name env ~seen loc n =
       | _ when n <> "" && n.[0] = Char.lowercase_ascii n.[0] ->
         unimplemented loc
           (Printf.sprintf "generic code over the type variable %s" n) 5
-      | _ -> fail loc "unknown type %s" n
+      | _ -> Loc.failk "check/unknown-type" loc "unknown type %s" n
 
 and array_len env loc = function
   | Ast.Lint n -> n
@@ -1032,7 +1056,9 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
     let target, sname = struct_target ctx target in
     let s = Hashtbl.find ctx.env.structs sname in
     (match Tast.field_index s name with
-     | None -> fail loc "%s has no field %s" sname name
+     | None ->
+       Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
+         "%s has no field %s" sname name
      | Some i ->
        let fty = (List.nth s.Tast.fields i).Tast.fty in
        expect loc ~want (mk loc fty (Tast.Field (target, i))))
@@ -1269,7 +1295,8 @@ and var ctx loc ~want name =
                   and pass that" name;
              expect loc ~want
                (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name)))
-           | None -> captured ctx loc name; fail loc "unknown name %s" name)
+           | None -> captured ctx loc name;
+         Loc.failk "check/unknown-name" loc "unknown name %s" name)
 
 (* Reading a move-only local. Every read is a move unless the site said it was
    a borrow, which is the conservative direction: passing one to a function,
@@ -1794,15 +1821,23 @@ and check_struct ctx ~want loc name kvs =
            "%s is a union, and a union value names the case as well as the \
             type — write (%s.%s {.field value ...}) for one of %s"
            name name (first_case_name ctx.env name) (case_list ctx.env name)
-       else fail loc "unknown struct %s" name)
+       else
+         Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
+           "unknown struct %s" name)
   | Some s ->
     let seen = Hashtbl.create 8 in
     List.iter
       (fun (k, (v : Ast.expr)) ->
-         if Hashtbl.mem seen k then
+         (match Hashtbl.find_opt seen k with
-           fail v.Ast.loc "field %s is given twice" k;
+          | Some (first : Ast.expr) ->
+            Loc.failk "check/duplicate-field" v.Ast.loc
+              ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
+              "field %s is given twice" k
+          | None -> ());
          if Tast.field_index s k = None then
-           fail v.Ast.loc "%s has no field %s" name k;
+           Loc.failk "check/unknown-field" v.Ast.loc
+             ~notes:(declared_note ctx.env name)
+             "%s has no field %s" name k;
          Hashtbl.add seen k v)
       kvs;
     (* Omitted fields are zeroed — ZII, the same rule as a declaration with no
@@ -1840,9 +1875,16 @@ and check_case ctx ~want loc uname (c : Tast.variant) kvs =
   let seen = Hashtbl.create 8 in
   List.iter
     (fun (k, (v : Ast.expr)) ->
-       if Hashtbl.mem seen k then fail v.Ast.loc "field %s is given twice" k;
+       (match Hashtbl.find_opt seen k with
+        | Some (first : Ast.expr) ->
+          Loc.failk "check/duplicate-field" v.Ast.loc
+            ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ]
+            "field %s is given twice" k
+        | None -> ());
        if Tast.vfield_index c k = None then
-         fail v.Ast.loc "%s has no field %s" full k;
+         Loc.failk "check/unknown-field" v.Ast.loc
+           ~notes:(declared_note ctx.env uname)
+           "%s has no field %s" full k;
        Hashtbl.add seen k v)
     kvs;
   let fields =
@@ -2021,7 +2063,12 @@ and check_match ctx ?want loc scrutinee arms =
         u.Tast.cases
   in
   if not !saw_wild && missing <> [] then
-    fail loc
+    (* The union's declaration, because that is where the case list this match
+       failed to cover actually lives, and because adding a case there is what
+       makes a match non-exhaustive in the first place. *)
+    Loc.failk "check/non-exhaustive-match" loc
+      ~notes:(match subject with `Union u -> declared_note ctx.env u.Tast.uname
+                               | _ -> [])
       "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \
        the rest"
       (String.concat ", " missing)
@@ -2069,12 +2116,15 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t =
        match Hashtbl.find_opt ctx.env.globals name with
        | Some (_, true) -> fail loc "%s is a constant" name
        | Some (ty, false) -> Tast.Pglobal name, ty
-       | None -> captured ctx loc name; fail loc "unknown name %s" name)
+       | None -> captured ctx loc name;
+         Loc.failk "check/unknown-name" loc "unknown name %s" name)
   | Ast.Pfield (target, name) ->
     let target, sname = struct_target ctx target in
     let s = Hashtbl.find ctx.env.structs sname in
     (match Tast.field_index s name with
-     | None -> fail loc "%s has no field %s" sname name
+     | None ->
+       Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname)
+         "%s has no field %s" sname name
      | Some i -> Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty)
   | Ast.Pindex (target, idx) ->
     let target = borrowed ctx target (fun () -> check ctx target) in
@@ -3927,7 +3977,7 @@ and named_call ctx ~want loc name args =
       else if String.contains name '/' then
         unimplemented loc
           (Printf.sprintf "the call %s into an imported package" name) 4
-      else fail loc "unknown function %s" name
+      else Loc.failk "check/unknown-function" loc "unknown function %s" name
 
 and is_cast name =
   Types.ikind_of_name name <> None || Types.fkind_of_name name <> None
@@ -4006,9 +4056,16 @@ let collect env (decls : Ast.decl list) =
        match Ast.declared_name d with
        | None -> ()
        | Some n ->
-         if Hashtbl.mem claimed n then
+         (match Hashtbl.find_opt claimed n with
-           fail d.Ast.dloc "%s is defined twice" n;
+          | Some first ->
-         Hashtbl.add claimed n ())
+            (* The second one is the error, because it is the one to delete;
+               the first is the note, because without it the message is a
+               claim the reader has to go and verify. *)
+            Loc.failk "check/defined-twice" d.Ast.dloc
+              ~notes:[ Loc.note first (n ^ " is already defined here") ]
+              "%s is defined twice" n
+          | None -> ());
+         Hashtbl.add claimed n d.Ast.dloc)
     decls;
   (* Names first, so a struct may mention one declared below it. *)
   List.iter
@@ -4269,8 +4326,21 @@ let check_fn env (fn : Ast.fn) : Tast.fn =
                 owner = fn.Ast.name } in
   List.iter2
     (fun (p : Ast.field) ty ->
-       if List.mem_assoc p.Ast.fname ctx.scope then
+       if List.mem_assoc p.Ast.fname ctx.scope then begin
-         fail p.Ast.floc "%s has two parameters named %s" fn.Ast.name p.Ast.fname;
+         let first =
+           List.find_opt
+             (fun (q : Ast.field) -> q.Ast.fname = p.Ast.fname)
+             fn.Ast.params
+         in
+         let notes =
+           match first with
+           | Some q when q != p ->
+             [ Loc.note q.Ast.floc ("the first " ^ p.Ast.fname ^ " is here") ]
+           | _ -> []
+         in
+         Loc.failk "check/duplicate-parameter" p.Ast.floc ~notes
+           "%s has two parameters named %s" fn.Ast.name p.Ast.fname
+       end;
        ignore (bind ctx p.Ast.fname ty ~assignable:false))
     fn.Ast.params params;
   let body =
@@ -4435,7 +4505,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 (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
@@ -4443,18 +4517,34 @@ let program_with_env (decls : Ast.decl list) : Tast.program * env =
      flattening comes back to be compiled into the build. Nothing below this
      line knows the form exists. *)
   let decls, cshim = Shim.expand decls in
+  (* Pass one, and it stops at the first thing it refuses. That is not
+     laziness: every name, type and signature in the file comes from here, so a
+     declaration this pass could not make sense of leaves a hole that pass two
+     would report once per mention. A wrong signature is one error; the thirty
+     "unknown name" lines under it are not errors, they are the same one.
+
+     Pass two is where the volume is, and it is where collecting pays. By the
+     time it runs every signature is sound, so a body that fails to check
+     cannot make the next body fail — which is what makes a declaration a
+     resync point that needs no resynchronising. *)
   collect env decls;
   check_finite env;
-  check_main env;
+  let s = Loc.sink ~on:keep_going in
-  let globals = List.filter_map (check_global env) decls in
+  ignore (Loc.caught s (fun () -> check_main env));
+  let globals =
+    List.filter_map
+      (fun d -> Option.join (Loc.caught s (fun () -> check_global env d)))
+      decls
+  in
   let fns =
     List.filter_map
       (fun (d : Ast.decl) ->
          match d.Ast.d with
-         | Ast.Defn fn -> Some (check_fn env fn)
+         | Ast.Defn fn -> Loc.caught s (fun () -> check_fn env fn)
          | _ -> None)
       decls
   in
+  Loc.finish s;
   (* The handler clauses lifted out along the way. They are ordinary functions
      from here down; nothing in the backend knows they were written inside
      something else. *)
@@ -4478,7 +4568,19 @@ let program_with_env (decls : Ast.decl list) : Tast.program * env =
      globals; externs; fns; cshim },
    env)
 
-let program (decls : Ast.decl list) : Tast.program = fst (program_with_env 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

lib/dev.ml

@@ -464,7 +464,7 @@ let eval t ~code ~origin =
               ("cannot reach the program on " ^ t.agent ^ ": "
                ^ Unix.error_message e))
        | exception Failure m -> error m)
-    | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg
+    | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
 
 (* Redefining a name installs a body; evaluating an expression has no name to
    install into, so the module carries a thunk the agent runs once. The value
@@ -503,7 +503,7 @@ let eval_expr t ~code ~origin =
           | exception Unix.Unix_error (e, _, _) ->
             error ("cannot reach the program: " ^ Unix.error_message e))
        | exception Failure m -> error m)
-    | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg
+    | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
 
 let describe t =
   ok
@@ -1779,7 +1779,7 @@ let serve t fd =
       let op, reply =
         match Wire.parse src with
         | req -> (Wire.string_field req "op", handle t req)
-        | exception Loc.Error (_, m) -> (None, error ("bad request: " ^ m))
+        | exception Loc.Error { Loc.dmsg = m; _ } -> (None, error ("bad request: " ^ m))
       in
       Wire.send fd (with_output t (with_break t reply));
       if op = Some "close" then true else go ()

lib/load.ml

@@ -63,7 +63,7 @@ and pkg = { alias : string; dir : string; owns : string list;
                import. See [Cimport]. *)
             phidden : (string * string) list }
 
-let fail loc fmt = Printf.ksprintf (fun m -> raise (Loc.Error (loc, m))) fmt
+let fail loc fmt = Printf.ksprintf (fun m -> Loc.raise_diag (Loc.diag loc m)) fmt
 
 (* "vendor:raylib" -> the collection "vendor" and the subpath "raylib". A path
    with no colon is relative to the importing file's own directory. *)

lib/loc.ml

@@ -1,19 +1,334 @@
 (** Source locations. Every form carries one: error messages, the step debugger
     and nREPL's find-definition all need them, and retrofitting locations onto a
-    reader is far worse than carrying them from the start. *)
+    reader is far worse than carrying them from the start.
+
+    A location is a *span*, not a point. The start is what [file:line:col]
+    prints and what every consumer that wants one place uses; the end is what
+    lets an error underline the thing it is about. A column number cannot draw
+    a squiggle and a span can, which is the whole reason the two extra fields
+    are here.
+
+    The end is *exclusive* and defaults to the start, so a location nobody
+    widened is a zero-width span at a point and every old call site keeps its
+    old meaning. Only the reader knows where a form ends, so only the reader
+    fills these in; a location the checker invents for a node with no syntax
+    stays a point. *)
 
 type t = {
-  file : string;
+  file  : string;
-  line : int;  (* 1-based *)
+  line  : int;  (* 1-based *)
-  col  : int;  (* 1-based *)
+  col   : int;  (* 1-based *)
+  eline : int;  (* 1-based, exclusive end *)
+  ecol  : int;
+  (* The macro whose expansion produced whatever is at this position, if one
+     did. It rides on the location rather than on the form because the location
+     is the thing that already travels: [Expand.unmarshal] stamps the call
+     site onto every node a macro answers with, and that stamp goes on through
+     the AST and the typed IR untouched. Tagging it here means an error raised
+     anywhere downstream can say which macro it is really about, with no field
+     added to Form, to Ast or to Tast. *)
+  macro : string option;
 }
 
-let make file line col = { file; line; col }
+let make file line col =
-let unknown = { file = "<unknown>"; line = 0; col = 0 }
+  { file; line; col; eline = line; ecol = col; macro = None }
+
+let unknown = make "<unknown>" 0 0
+
+(** Tag a location as coming out of [name]'s expansion, unless it already names
+    a macro. Already-tagged wins because the tag is applied outermost-last: the
+    macro the author actually wrote is the one worth naming, not whatever it
+    expanded into on the way. *)
+let from_macro name (t : t) =
+  match t.macro with None -> { t with macro = Some name } | Some _ -> t
+
+(** [upto start stop] is [start] widened to end where [stop] begins. A [stop]
+    that is not after [start], or is in another file, leaves it alone: a span
+    that runs backwards would draw nonsense. *)
+let upto (start : t) (stop : t) =
+  if
+    stop.file = start.file
+    && (stop.line > start.line
+        || (stop.line = start.line && stop.col > start.col))
+  then { start with eline = stop.line; ecol = stop.col }
+  else start
+
+(** True when the span covers more than its first line. The underline is drawn
+    on the start line either way — a form that spans twenty lines is pointed
+    at, not boxed — so this is what tells the renderer to run the underline to
+    the end of that line rather than to [ecol]. *)
+let multiline (t : t) = t.eline > t.line
+
+(** How many columns to underline on the start line, or [None] when the span
+    was never widened and there is nothing but a point to draw. *)
+let width (t : t) =
+  if t.eline = t.line && t.ecol > t.col then Some (t.ecol - t.col) else None
 
 let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col
 
-(** Raised by every stage of the frontend. *)
+(* ── Diagnostics ──────────────────────────────────────────
-exception Error of t * string
 
-let fail loc fmt = Printf.ksprintf (fun msg -> raise (Error (loc, msg))) fmt
+   An error is a value rather than a location and a string, and the three parts
+   that make it one each buy something the pair could not express.
+
+   [kind] is a stable id — ["reader/unterminated-string"]. It classifies
+   without any prose being parsed, so a message may be reworded freely and a
+   test that asserts on *which* error this is keeps holding. It is not a
+   replacement for the message: the messages here already state the reason and
+   name what to write instead, and none of them changed.
+
+   [dloc] is a span, so a report can underline the thing it is about.
+
+   [notes] are the part that makes a message good. Each carries its own span
+   and its own severity, so an error can say "this is wrong *here*" and
+   "because of *that*, over there" and point at both. One string can only ever
+   state one of the two, which is why volume of messages was never the whole
+   of what was missing.
+
+   [expansion] names the macro call an error came from. A form a macro produced
+   carries the call site's location, so without this the report would point at
+   the call and say nothing about the code not being what was written there. It
+   is filled in for errors raised *during* expansion; a checker error on a form
+   a macro produced gets the call site's location without the macro's name,
+   which is a limitation and not a claim. *)
+
+type severity = Info | Warning | Err
+
+let severity_str = function
+  | Info -> "info"
+  | Warning -> "warning"
+  | Err -> "error"
+
+type note = {
+  nmsg : string;
+  nloc : t;
+  nsev : severity;
+}
+
+type diag = {
+  kind      : string;               (* stable id, never printed as the reason *)
+  dloc      : t;                    (* the primary span *)
+  dmsg      : string;
+  notes     : note list;            (* in source order *)
+  expansion : (string * t) option;  (* macro name, and its call site *)
+}
+
+(** Raised by every stage of the frontend, one diagnostic at a time.
+
+    This is still the single-error channel, and that is deliberate: the daemon
+    and [Session.eval] evaluate *one* form and have one failure to report, so
+    they keep catching this and take a location and a message out of it with
+    [summary]. Only the batch drivers — the ones that compile a whole file —
+    raise the list below, and nothing interactive has to know it exists. *)
+exception Error of diag
+
+(** Raised by a driver that finished the file before reporting. Never empty,
+    and never raised by a path that checks a single form. *)
+exception Errors of diag list
+
+(** The one location and one message a caller with a single line to print gets
+    out of a diagnostic. Notes are dropped here on purpose. *)
+let summary (d : diag) = (d.dloc, d.dmsg)
+
+let before (a : t) (b : t) =
+  if a.line <> b.line then compare a.line b.line else compare a.col b.col
+
+(* Notes in source order, as jank sorts them: a reader follows a message that
+   walks down the file and loses one that jumps about. *)
+let sort_notes (d : diag) =
+  { d with notes = List.stable_sort (fun x y -> before x.nloc y.nloc) d.notes }
+
+let note ?(sev = Info) loc msg = { nmsg = msg; nloc = loc; nsev = sev }
+
+let diag ?(kind = "error") ?(notes = []) ?expansion loc msg =
+  (* The location already knows whether it came out of a macro, so an error
+     does not have to be raised anywhere special to say so. An explicit
+     [expansion] still wins, for the one caller that knows better. *)
+  let expansion =
+    match expansion with
+    | Some _ as e -> e
+    | None -> (match loc.macro with Some m -> Some (m, loc) | None -> None)
+  in
+  sort_notes { kind; dloc = loc; dmsg = msg; notes; expansion }
+
+let raise_diag d = raise (Error (sort_notes d))
+
+(** The plain refusal: a span and a reason, with the generic kind. Every call
+    site that existed before spans is one of these and says exactly what it
+    said. [failk] is the same thing with a kind, notes and an expansion. *)
+let fail loc fmt =
+  Printf.ksprintf (fun msg -> raise_diag (diag loc msg)) fmt
+
+let failk ?notes ?expansion kind loc fmt =
+  Printf.ksprintf (fun msg -> raise_diag (diag ~kind ?notes ?expansion loc msg)) fmt
+
+(* ── Collecting ─────────────────────────────────────────────────────
+
+   A sink holds what a pass found, so the pass can carry on to the next thing
+   rather than stop at the first. It is switched on by the caller and not by
+   the code that raises, which is what keeps the interactive path exactly as it
+   was: the daemon checks one form and wants one exception, so it asks for a
+   sink that is off, every [caught] re-raises, and nothing downstream ever sees
+   a list.
+
+   A sink that is on is finished at a *phase* boundary and nowhere else. That
+   is the whole of the resynchronisation story and it is deliberately crude:
+   the hard part of recovery is not recording the error, it is not cascading
+   afterwards, and a phase run on a foundation the phase before it already
+   refused reports wreckage. Three real errors beat thirty of which
+   twenty-seven are consequences of the first. *)
+
+type sink = { on : bool; mutable found : diag list }
+
+let sink ~on = { on; found = [] }
+
+(** Run [f]. With the sink off this is [Some (f ())] and an error propagates as
+    it always did. With it on, an error is recorded and the answer is [None],
+    so the caller drops this one item and goes on to the next. *)
+let caught s f =
+  if not s.on then Some (f ())
+  else
+    match f () with
+    | x -> Some x
+    | exception Error d -> s.found <- d :: s.found; None
+
+let any s = s.found <> []
+
+(** Raise everything found, in the order it was found, or return if the pass
+    was clean. *)
+let finish s =
+  match List.rev s.found with [] -> () | ds -> raise (Errors ds)
+
+(* ── Reporting ──────────────────────────────────────────────────────
+
+   The first line of every entry is exactly [file:line:col: message], which is
+   the GNU format Emacs's compilation-mode parses with no configuration. That
+   is the whole of the editor story: once more than one of these comes out,
+   [M-x compile] gives a clickable list and [next-error] walks it. Everything
+   below the first line is indented, and compilation-mode ignores indented
+   continuation lines, so the squiggle costs nothing there.
+
+   A note gets its own [file:line:col: note: ...] entry rather than being
+   folded into the error's block, which is what gcc does and is the point of
+   notes having locations at all: the second place is somewhere [next-error]
+   can take you.
+
+   Everything degrades to the first line alone. A location the checker invented
+   has line 0 and a file called [<unknown>], the prelude and the REPL have
+   names that are not paths, and a file may have changed under us since it was
+   read — in every one of those the message still prints and nothing raises out
+   of the error printer, which would turn a diagnostic into a crash. *)
+
+let source_cache : (string, string array option) Hashtbl.t = Hashtbl.create 8
+
+let lines_of file =
+  match Hashtbl.find_opt source_cache file with
+  | Some v -> v
+  | None ->
+    let v =
+      match open_in_bin file with
+      | exception _ -> None
+      | ic ->
+        Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () ->
+          match really_input_string ic (in_channel_length ic) with
+          | exception _ -> None
+          | s -> Some (Array.of_list (String.split_on_char '\n' s)))
+    in
+    Hashtbl.replace source_cache file v;
+    v
+
+let forget_sources () = Hashtbl.reset source_cache
+
+let source_line (t : t) =
+  if t.line <= 0 then None
+  else
+    match lines_of t.file with
+    | None -> None
+    | Some ls when t.line <= Array.length ls ->
+      let l = ls.(t.line - 1) in
+      (* A file written on Windows leaves the carriage return in the line, and
+         it would print as a stray column. *)
+      let n = String.length l in
+      Some (if n > 0 && l.[n - 1] = '\r' then String.sub l 0 (n - 1) else l)
+    | Some _ -> None
+
+(* The gutter is as wide as the widest line number printed, so the bars line
+   up. Four digits covers every file anyone will write by hand and the rest
+   simply gets a wider gutter. *)
+let gutter n = String.length (string_of_int n)
+
+(** The source line with the span underlined beneath it, or [None] when there
+    is no source to show. Tabs in the prefix are copied into the underline
+    rather than counted as one column, which is the only way the caret lands
+    under the right character in a file that uses them. *)
+let squiggle ?(mark = '^') (t : t) =
+  match source_line t with
+  | None -> None
+  | Some text ->
+    let n = String.length text in
+    let start = max 0 (min (t.col - 1) n) in
+    let stop =
+      if multiline t then n
+      else match width t with
+        | Some w -> min n (start + w)
+        | None -> min n (start + 1)
+    in
+    let stop = max stop (min n (start + 1)) in
+    let pad = Buffer.create 16 in
+    for i = 0 to start - 1 do
+      Buffer.add_char pad (if text.[i] = '\t' then '\t' else ' ')
+    done;
+    let bar = String.make (max 1 (stop - start)) mark in
+    let g = gutter t.line in
+    Some
+      (Printf.sprintf "  %*d | %s\n  %*s | %s%s" g t.line text g ""
+         (Buffer.contents pad) bar)
+
+let entry ?(mark = '^') ?(label = "") (t : t) msg =
+  let head = Printf.sprintf "%s: %s%s" (to_string t) label msg in
+  match squiggle ~mark t with
+  | None -> head
+  | Some s -> head ^ "\n" ^ s
+
+(** One diagnostic, rendered. The error, then its notes in source order, then
+    the macro call it was expanded from if it was. No trailing newline. *)
+let report (d : diag) =
+  let d = sort_notes d in
+  let parts = ref [ entry d.dloc d.dmsg ] in
+  List.iter
+    (fun n ->
+       let mark = match n.nsev with Info -> '-' | Warning -> '~' | Err -> '^' in
+       parts :=
+         entry ~mark ~label:(severity_str n.nsev ^ ": ") n.nloc n.nmsg :: !parts)
+    d.notes;
+  (match d.expansion with
+   | None -> ()
+   | Some (name, at) ->
+     parts :=
+       entry ~mark:'-' ~label:"note: " at
+         (Printf.sprintf "expanded from the macro %s" name)
+       :: !parts);
+  String.concat "\n" (List.rev !parts)
+
+(** Every diagnostic of a run, in source order, with a count. What a driver
+    prints when it finished the file rather than stopping at the first thing
+    it found. *)
+let report_all (ds : diag list) =
+  (* 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/macro.ml

@@ -176,7 +176,12 @@ let rec expand_form (l : loaded) (f : Form.t) : Form.t =
   match f.Form.v with
   | Form.List ({ Form.v = Form.Sym n; _ } :: args) when List.mem_assoc n l.fns ->
     let args = List.map (expand_form l) args in
-    settle l n loc (Expand.call ~loc (List.assoc n l.fns) args) fuel
+    (* The call site, tagged with the macro it is a call to. [Expand.unmarshal]
+       stamps this onto every node the macro answers with, so from here down
+       every form it produced knows where it came from and an error on one of
+       them can say so. *)
+    let from = Loc.from_macro n loc in
+    settle l n loc (Expand.call ~loc:from (List.assoc n l.fns) args) fuel
   | Form.List xs -> Form.make (Form.List (List.map (expand_form l) xs)) loc
   | Form.Vec xs -> Form.make (Form.Vec (List.map (expand_form l) xs)) loc
   | Form.Map xs -> Form.make (Form.Map (List.map (expand_form l) xs)) loc
@@ -193,7 +198,9 @@ and settle l first loc (f : Form.t) left =
         first fuel
     else begin
       let args = List.map (expand_form l) args in
-      settle l first loc (Expand.call ~loc (List.assoc m l.fns) args) (left - 1)
+      let from = Loc.from_macro m loc in
+      settle l first loc (Expand.call ~loc:from (List.assoc m l.fns) args)
+        (left - 1)
     end
   (* Settled at the head. The rest of it may still hold macro calls — a cond
      expands to an if whose else-branch is another cond — so the ordinary walk

lib/parse.ml

@@ -736,7 +736,7 @@ let rec decl (f : Form.t) : Ast.decl =
           would be true and unhelpful. *)
        let rty =
          try texpr ret with
-         | Loc.Error (loc, msg) ->
+         | Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
            Loc.fail loc
              "%s. This is the return type, which every defn states -- a \
               function that returns nothing writes ()" msg
@@ -866,14 +866,41 @@ 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)
 
-let program (forms : Form.t list) : Ast.decl list =
+(* 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. *)
+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.
      Then expansion, which may need one. *)
   let forms = !expander (List.map Expand.quasiquote forms) in
   temps := 0;
-  List.map decl forms
+  let s = Loc.sink ~on:keep_going in
+  let decls = List.filter_map (fun f -> Loc.caught s (fun () -> decl f)) forms in
+  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 =

lib/reader.ml

@@ -39,6 +39,12 @@ type state = {
 let of_string ~file src = { src; file; pos = 0; line = 1; col = 1 }
 
 let here st = Loc.make st.file st.line st.col
+
+(* A form's location is the span it occupies, so every reader below takes the
+   location it started at and closes it where the cursor now is. Doing it here,
+   in the one place that knows both ends, is why nothing above [Reader] has to
+   know a span exists. *)
+let spanned st loc v = Form.make v (Loc.upto loc (here st))
 let at_end st = st.pos >= String.length st.src
 let peek st = if at_end st then '\000' else st.src.[st.pos]
 let peek2 st =
@@ -83,7 +89,7 @@ let read_string st =
   advance st;  (* opening quote *)
   let buf = Buffer.create 16 in
   let rec go () =
-    if at_end st then Loc.fail loc "unterminated string"
+    if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string"
     else match peek st with
       | '"'  -> advance st
       | '\\' ->
@@ -94,18 +100,18 @@ let read_string st =
           (match c with
            | 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r'
            | '\\' -> '\\' | '"' -> '"' | '0' -> '\000'
-           | c -> Loc.fail loc "unknown string escape \\%c" c);
+           | c -> Loc.failk "reader/unknown-string-escape" loc "unknown string escape \\%c" c);
         go ()
       | c -> advance st; Buffer.add_char buf c; go ()
   in
   go ();
-  Form.make (Form.Str (Buffer.contents buf)) loc
+  spanned st loc (Form.Str (Buffer.contents buf))
 
 (* \space \tab \newline \return \nul, or \<any single char> *)
 let read_byte st =
   let loc = here st in
   advance st;  (* backslash *)
-  if at_end st then Loc.fail loc "expected a character after \\";
+  if at_end st then Loc.failk "reader/incomplete-character" loc "expected a character after \\";
   let first = peek st in
   advance st;
   let rest = take_while st (fun c -> not (is_delimiter c)) in
@@ -117,9 +123,9 @@ let read_byte st =
     | "return"  -> 13
     | "nul"     -> 0
     | n when String.length n = 1 -> Char.code n.[0]
-    | n -> Loc.fail loc "unknown character literal \\%s" n
+    | n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n
   in
-  Form.make (Form.Byte code) loc
+  spanned st loc (Form.Byte code)
 
 (* A token that started with a digit, or with '-'/'+' followed by a digit. *)
 let read_number st =
@@ -132,26 +138,30 @@ let read_number st =
   in
   if is_hex then
     match Int64.of_string_opt text with
-    | Some i -> Form.make (Form.Int i) loc
+    | Some i -> spanned st loc (Form.Int i)
-    | None -> Loc.fail loc "malformed hex literal %s" text
+    | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
+        "malformed hex literal %s" text
   else if String.contains text '.' || String.contains text 'e' then
     match float_of_string_opt text with
-    | Some f -> Form.make (Form.Float f) loc
+    | Some f -> spanned st loc (Form.Float f)
-    | None -> Loc.fail loc "malformed float literal %s" text
+    | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
+        "malformed float literal %s" text
   else
     match Int64.of_string_opt text with
-    | Some i -> Form.make (Form.Int i) loc
+    | Some i -> spanned st loc (Form.Int i)
-    | None -> Loc.fail loc "malformed integer literal %s" text
+    | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
+        "malformed integer literal %s" text
 
 let read_symbol_or_keyword st =
   let loc = here st in
   let text = take_while st (fun c -> not (is_delimiter c)) in
-  if text = "" then Loc.fail loc "unexpected character %C" (peek st);
+  if text = "" then Loc.failk "reader/unexpected-character" loc "unexpected character %C" (peek st);
   if text.[0] = ':' then begin
-    if String.length text = 1 then Loc.fail loc "empty keyword";
+    if String.length text = 1 then
-    Form.make (Form.Kw (String.sub text 1 (String.length text - 1))) loc
+      Loc.failk "reader/empty-keyword" (Loc.upto loc (here st)) "empty keyword";
+    spanned st loc (Form.Kw (String.sub text 1 (String.length text - 1)))
   end else
-    Form.make (Form.Sym text) loc
+    spanned st loc (Form.Sym text)
 
 (* ── Forms ─────────────────────────────────────────────────────────── *)
 
@@ -170,9 +180,9 @@ let rec read_form st =
   skip_ignorable st;
   let loc = here st in
   match peek st with
-  | '\000' -> Loc.fail loc "unexpected end of input"
+  | '\000' -> Loc.failk "reader/unexpected-eof" loc "unexpected end of input"
   | '(' | '[' | '{' as open_c -> read_seq st open_c loc
-  | ')' | ']' | '}' as c -> Loc.fail loc "unbalanced %C" c
+  | ')' | ']' | '}' as c -> Loc.failk "reader/unbalanced" loc "unbalanced %C" c
   | '"' -> read_string st
   | '\\' -> read_byte st
   | '\'' -> read_sugar st loc "quote"
@@ -182,7 +192,7 @@ let rec read_form st =
     if peek st = '@' then (advance st; read_wrapped st loc "unquote-splicing")
     else read_wrapped st loc "unquote"
   | '^' ->
-    Loc.fail loc "metadata (^) is not supported yet"
+    Loc.failk "reader/metadata" loc "metadata (^) is not supported yet"
 
   | c when is_digit c -> read_number st
   | ('-' | '+') when is_digit (peek2 st) -> read_number st
@@ -213,7 +223,7 @@ and read_sugar st loc name = advance st; read_wrapped st loc name
 
 and read_wrapped st loc name =
   let inner = read_form st in
-  Form.make (Form.List [ Form.make (Form.Sym name) loc; inner ]) loc
+  spanned st loc (Form.List [ Form.make (Form.Sym name) loc; inner ])
 
 and read_seq st open_c loc =
   advance st;
@@ -224,15 +234,26 @@ and read_seq st open_c loc =
        sequence would try to read a form and find [)]. *)
     skip_ignorable st;
     if at_end st then
-      Loc.fail loc "unclosed %C, expected %C" open_c want
+      (* Two places, and the second is the one that is usually news. The error
+         is at the bracket that is still open, because that is where the fix
+         goes; the note is where the file ran out, because that is how far the
+         reader got believing the form was still being written. *)
+      Loc.failk "reader/unclosed" loc
+        ~notes:[ Loc.note (here st) "the input ends here, still inside it" ]
+        "unclosed %C, expected %C" open_c want
     else
       let c = peek st in
       if c = want then (advance st; List.rev acc)
       else if c = ')' || c = ']' || c = '}' then
-        Loc.fail (here st) "expected %C to close %C, found %C" want open_c c
+        (* The wrong closer is where the mistake reads, and the opener is what
+           makes it wrong. Neither alone says which bracket to change. *)
+        Loc.failk "reader/mismatched-closer" (here st)
+          ~notes:[ Loc.note loc (Printf.sprintf "%C is opened here" open_c) ]
+          "expected %C to close %C, found %C" want open_c c
       else go (read_form st :: acc)
   in
-  Form.make (wrap open_c (go [])) loc
+  let items = go [] in
+  spanned st loc (wrap open_c items)
 
 (** All top-level forms in a source string. *)
 let read_all ~file src =

lib/session.ml

@@ -505,7 +505,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
       Some
         ((lit (name ^ "\t" ^ Types.to_string ty ^ "\t") :: parts)
          @ [ lit ("\t" ^ string_of_int i ^ "\n") ])
-    | exception Loc.Error (_, why) ->
+    | exception Loc.Error { Loc.dmsg = why; _ } ->
       (* A type the structural printer has no arm for — a map, a function
          value, a type variable. Named, with the reason, rather than left out
          of the list: a local that is missing and a local that could not be
@@ -794,7 +794,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
        | Error why -> Error (name ^ path_text path ^ ": " ^ why)
        | Ok v ->
          (match Render.render c 0 v with
-          | exception Loc.Error (_, why) -> Error (name ^ path_text path ^ ": " ^ why)
+          | exception Loc.Error { Loc.dmsg = why; _ } -> Error (name ^ path_text path ^ ": " ^ why)
           | parts ->
             let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
             t.thunks <- t.thunks + 1;
@@ -875,7 +875,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
       Some
         ((lit (g.Tast.gname ^ "\t" ^ Types.to_string g.Tast.gty ^ "\t") :: parts)
          @ [ lit "\n" ])
-    | exception Loc.Error (_, why) ->
+    | exception Loc.Error { Loc.dmsg = why; _ } ->
       (* A type the structural printer has no arm for. Named with its reason
          rather than left out, for [render_locals]'s reason: a global that is
          missing and a global that could not be printed are different facts,

test/test_acceptance.ml

@@ -367,7 +367,7 @@ let () =
       | _ ->
         incr failures;
         Printf.printf "FAIL  %s\n        it was accepted\n" name
-      | exception Loc.Error (_, m) ->
+      | exception Loc.Error { Loc.dmsg = m; _ } ->
         if not (contains m needle) then begin
           incr failures;
           Printf.printf "FAIL  %s\n        said: %S\n     wanted: %S in it\n"
@@ -1241,7 +1241,7 @@ let () =
       | () ->
         incr failures;
         Printf.printf "FAIL  %s\n        it was accepted\n" name
-      | exception Loc.Error (_, m) ->
+      | exception Loc.Error { Loc.dmsg = m; _ } ->
         if not (contains m needle) then begin
           incr failures;
           Printf.printf "FAIL  %s\n        said: %S\n     wanted: %S in it\n"
@@ -1602,7 +1602,7 @@ ERR@7 unexpected token: not the kind the caller was reading
                  name n
              end)
           needles
-      | exception Loc.Error (_, m) ->
+      | exception Loc.Error { Loc.dmsg = m; _ } ->
         incr failures;
         Printf.printf "FAIL  %s\n        refused: %s\n" name m
     in
@@ -1613,7 +1613,7 @@ ERR@7 unexpected token: not the kind the caller was reading
       | _ ->
         incr failures;
         Printf.printf "FAIL  %s: accepted, and it should not have been\n" name
-      | exception Loc.Error (_, m) ->
+      | exception Loc.Error { Loc.dmsg = m; _ } ->
         if not (contains m fragment) then begin
           incr failures;
           Printf.printf "FAIL  %s\n        reason: %S\n  wanted to contain: %S\n"
@@ -1944,6 +1944,41 @@ ERR@7 unexpected token: not the kind the caller was reading
     outputs ~opt:"-O0" "unless, now a prelude macro, -O0"
       "programs/macro-unless.flan" unless_out;
 
+    (* An error on code a macro produced says which macro, and it has to be
+       asserted through a real expansion: the tag is put on by [Macro] and
+       defaulted into the diagnostic by [Loc], and a unit test on either half
+       alone would pass with the other one broken.
+
+       [clamp] with the wrong number of arguments expands into a call to a name
+       that does not exist, on purpose -- that is how a prelude macro reports a
+       misuse. So the checker refuses a name the author never wrote, which is
+       exactly the case the field exists for. *)
+    (let src = "(defn f [] i32 (clamp 1 2))\n(defn main [] i32 0)\n" in
+     match
+       Check.program (Parse.program (Reader.read_all ~file:"<expansion>" src))
+     with
+     | _ ->
+       incr failures;
+       print_endline "FAIL  an error in an expansion is refused"
+     | exception Loc.Error d ->
+       (match d.Loc.expansion with
+        | Some (name, _) when name = "clamp" -> ()
+        | Some (name, _) ->
+          incr failures;
+          Printf.printf "FAIL  an error in an expansion names the wrong macro: %s\n"
+            name
+        | None ->
+          incr failures;
+          Printf.printf
+            "FAIL  an error in an expansion names no macro\n        error: %s\n"
+            d.Loc.dmsg);
+       (* And it reaches the printed report, which is the only part a reader
+          ever sees. *)
+       if not (contains (Loc.report d) "expanded from the macro clamp") then begin
+         incr failures;
+         print_endline "FAIL  the report does not say which macro"
+       end);
+
     (* The two ways expansion does not terminate, and they are different
        failures. A ring is a compile-order problem -- each body calls the other
        while the other is being compiled -- and there is no order, so it is
@@ -2039,7 +2074,7 @@ ERR@7 unexpected token: not the kind the caller was reading
      | _ ->
        incr failures;
        Printf.printf "FAIL  %s\n        it was accepted\n" name
-     | exception Loc.Error (_, m) ->
+     | exception Loc.Error { Loc.dmsg = m; _ } ->
        if not (contains m "needs a byte-level encoder that does not exist")
        then begin
          incr failures;
@@ -2069,7 +2104,7 @@ ERR@7 unexpected token: not the kind the caller was reading
                    (defn main [] i32 (match g A 0 (B x) x))")))
      with
      | _ -> ()
-     | exception Loc.Error (_, m) ->
+     | exception Loc.Error { Loc.dmsg = m; _ } ->
        incr failures;
        Printf.printf "FAIL  %s\n        refused: %S\n" name m);
 

test/test_flan.ml

@@ -55,7 +55,7 @@ let reads name src expected =
       Printf.printf "FAIL  %s\n        src: %s\n        got: %s\n    wanted: %s\n"
         name src got expected
     end
-  | exception Loc.Error (loc, msg) ->
+  | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
     incr failures;
     Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
       name src (Loc.to_string loc) msg
@@ -73,7 +73,7 @@ let rejects ?needle name src =
   | exception Watchdog.Timeout ->
     incr failures;
     Printf.printf "FAIL  %s: the reader did not return\n" name
-  | exception Loc.Error (_, msg) ->
+  | exception Loc.Error { Loc.dmsg = msg; _ } ->
     (match needle with
      | Some n when not (contains msg n) ->
        incr failures;
@@ -246,9 +246,41 @@ let () =
 
   (match read ~file:"f.flan" "(f\n  bad" with
    | _ -> check "unclosed reports opening loc" false
-   | exception Loc.Error (loc, _) ->
+   | exception Loc.Error { Loc.dloc = loc; _ } ->
      check "unclosed reports opening loc" (loc.line = 1 && loc.col = 1));
 
+  (* ── Spans ─────────────────────────────────────────────────────
+     A location ends where the form ends, which is what an underline needs
+     and what a column number cannot give. Asserted on the width rather than
+     on the end column alone: a span that never got widened is zero wide, and
+     that is the failure mode worth catching — the field would exist, nothing
+     would fill it, and every squiggle would be one character long. *)
+  (match read ~file:"f.flan" "(foo bar)" with
+   | [ l ] ->
+     check "span covers the list" (Loc.width l.loc = Some 9);
+     (match l.Form.v with
+      | Form.List [ head; arg ] ->
+        check "span covers the head symbol" (Loc.width head.loc = Some 3);
+        check "span covers the argument"    (Loc.width arg.loc = Some 3);
+        check "span starts at the symbol"   (arg.loc.col = 6)
+      | _ -> check "span: two elements" false)
+   | _ -> check "span: one form" false);
+
+  (match read ~file:"f.flan" "\"hi\" 42 :kw" with
+   | [ s; n; k ] ->
+     check "span covers a string with its quotes" (Loc.width s.loc = Some 4);
+     check "span covers a number" (Loc.width n.loc = Some 2);
+     check "span covers a keyword with its colon" (Loc.width k.loc = Some 3)
+   | _ -> check "span: three atoms" false);
+
+  (* A form that runs over a line end has no width on its first line, and says
+     so rather than reporting a negative one. *)
+  (match read ~file:"f.flan" "(a\n b)" with
+   | [ l ] ->
+     check "multi-line span is flagged" (Loc.multiline l.loc);
+     check "multi-line span has no single-line width" (Loc.width l.loc = None)
+   | _ -> check "span: one multi-line form" false);
+
   if !failures = 0 then print_endline "reader: all tests passed"
   else begin
     Printf.printf "\n%d failure(s)\n" !failures;
@@ -273,7 +305,7 @@ let parse_decl src =
 let parse_rejects ?needle name src =
   match read src |> Parse.program with
   | _ -> incr failures; Printf.printf "FAIL  %s: expected a parse error\n" name
-  | exception Loc.Error (_, msg) ->
+  | exception Loc.Error { Loc.dmsg = msg; _ } ->
     (match needle with
      | Some n when not (contains msg n) ->
        incr failures;
@@ -512,7 +544,7 @@ let () =
     (fun path ->
        match read_file path |> Parse.program with
        | _ -> ()
-       | exception Loc.Error (loc, msg) ->
+       | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
          incr failures;
          Printf.printf "FAIL  %s does not parse: %s: %s\n"
            path (Loc.to_string loc) msg)
@@ -603,7 +635,7 @@ let infers name src expected =
            name src got expected
        end
      | None -> incr failures; Printf.printf "FAIL  %s: no probe\n" name)
-  | exception Loc.Error (loc, msg) ->
+  | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
     incr failures;
     Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
       name src (Loc.to_string loc) msg
@@ -615,7 +647,7 @@ let infers name src expected =
 let accepts name src =
   match checked src with
   | _ -> ()
-  | exception Loc.Error (loc, msg) ->
+  | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } ->
     incr failures;
     Printf.printf "FAIL  %s\n        src: %s\n      error: %s: %s\n"
       name src (Loc.to_string loc) msg
@@ -631,7 +663,7 @@ let rejects_check name ?needle src =
   | _ ->
     incr failures;
     Printf.printf "FAIL  %s: expected a type error\n        src: %s\n" name src
-  | exception Loc.Error (_, msg) ->
+  | exception Loc.Error { Loc.dmsg = msg; _ } ->
     (match needle with
      | Some n
        when not
@@ -1610,9 +1642,121 @@ let () =
   check "a prelude macro calling a macro is refused by name"
     (match Macro.reduce ring with
      | _ -> false
-     | exception Loc.Error (_, m) ->
+     | exception Loc.Error { Loc.dmsg = m; _ } ->
        contains m "the prelude macro n calls a macro");
 
+  (* ── Diagnostics: kind, notes, and more than one ───────────────
+     The house rule is that a test asserts the *reason* a thing is refused. A
+     kind is that assertion made stable: the message may be reworded and the
+     row still holds, and a row that matches on a kind is saying something a
+     substring match on prose could only approximate. The messages themselves
+     are unchanged, so every existing needle still means what it meant. *)
+
+  let diag_of src =
+    match checked src with
+    | _ -> None
+    | exception Loc.Error d -> Some d
+  in
+  let kind_is name src k =
+    check name (match diag_of src with Some d -> d.Loc.kind = k | None -> false)
+  in
+  kind_is "unknown name has a kind"
+    "(defn f [] i32 nope)" "check/unknown-name";
+  kind_is "unknown field has a kind"
+    "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" "check/unknown-field";
+  kind_is "a name defined twice has a kind"
+    "(defn f [] i32 1)\n(defn f [] i32 2)" "check/defined-twice";
+
+  (* The note is the half a location and a string could never carry: the
+     *other* place, with its own span and its own explanation. *)
+  (match diag_of "(defn f [] i32 1)\n(defn f [] i32 2)" with
+   | Some d ->
+     check "defined twice points at the second"  (d.Loc.dloc.Loc.line = 2);
+     (match d.Loc.notes with
+      | [ n ] ->
+        check "and notes the first"      (n.Loc.nloc.Loc.line = 1);
+        check "and says what it is"      (contains n.Loc.nmsg "already defined")
+      | ns -> check "defined twice has one note" (ns = []))
+   | None -> check "defined twice is refused" false);
+
+  (match diag_of "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" with
+   | Some d ->
+     (match d.Loc.notes with
+      | [ n ] ->
+        check "an unknown field notes the declaration"
+          (n.Loc.nloc.Loc.line = 1);
+        check "and lists the fields there" (contains n.Loc.nmsg "with a")
+      | _ -> check "an unknown field has one note" false)
+   | None -> check "an unknown field is refused" false);
+
+  (* The reader's own two-place error. The bracket that is open is the error
+     and the end of input is the note, because the fix goes at the first and
+     the surprise is at the second. *)
+  (match read "(f\n  bad" with
+   | _ -> check "unclosed is refused" false
+   | exception Loc.Error d ->
+     check "unclosed has a kind" (d.Loc.kind = "reader/unclosed");
+     check "unclosed notes where the input ran out"
+       (match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.line = 2 | _ -> false));
+
+  (match read "(f x]" with
+   | _ -> check "a mismatched closer is refused" false
+   | exception Loc.Error d ->
+     check "a mismatched closer has a kind"
+       (d.Loc.kind = "reader/mismatched-closer");
+     check "and notes the opener"
+       (match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.col = 1 | _ -> false));
+
+  (* More than one per run, which is the point of the whole batch. Three bad
+     bodies, three diagnostics, and the count is exact: a checker that reported
+     the first and a checker that reported thirty pieces of wreckage would both
+     fail this row. *)
+  (match
+     Check.program_all
+       (Parse.program_all
+          (read "(defn a [] i32 nope1)\n\
+                 (defn b [] i32 nope2)\n\
+                 (defn c [] i32 nope3)\n"))
+   with
+   | _ -> check "three bad bodies are refused" false
+   | exception Loc.Errors ds ->
+     check "three bad bodies give three errors" (List.length ds = 3);
+     check "and they are in source order"
+       (List.map (fun (d : Loc.diag) -> d.Loc.dloc.Loc.line) ds = [ 1; 2; 3 ]));
+
+  (* The parser resynchronises on a top-level form, so two bad declarations are
+     two errors rather than one. *)
+  (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));
+
+  (* [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 "Check.program still refuses" false
+   | exception Loc.Errors _ ->
+     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
+     parses, and the squiggle is on an indented line under it, which that mode
+     ignores. Both halves are load-bearing and neither is visible from the
+     message alone. *)
+  (match diag_of "(defn f [] i32 nope)" with
+   | Some d ->
+     let lines = String.split_on_char '\n' (Loc.report d) in
+     (match lines with
+      | head :: rest ->
+        check "the first line is file:line:col: message"
+          (head = Loc.to_string d.Loc.dloc ^ ": " ^ d.Loc.dmsg);
+        check "and the rest is indented"
+          (List.for_all (fun l -> l = "" || l.[0] = ' ') rest)
+      | [] -> check "a report has a first line" false)
+   | None -> check "a report needs a diagnostic" false);
+
   (* ── The acceptance program checks end to end ──────────────────── *)
   accepts "calc-me.flan type checks"
     (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);

test/test_session.ml

@@ -31,7 +31,7 @@ let refuses ?(file = "programs/reload.flan") name src reason =
   let t, _ = Session.create ~file () in
   match Session.eval t src with
   | _ -> fail "%s was accepted" name
-  | exception Loc.Error (_, msg) ->
+  | exception Loc.Error { Loc.dmsg = msg; _ } ->
     if not (has msg reason) then
       fail "%s\n        said: %S\n     wanted it to mention: %S" name msg reason
 
@@ -128,7 +128,7 @@ let () =
    | exception Loc.Error _ -> ());
   (match Session.eval t "(defn bump [] i64 (set counter (+ counter 6)) counter)" with
    | c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover"
-   | exception Loc.Error (_, m) -> fail "the session was poisoned by a typo: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "the session was poisoned by a typo: %s" m);
 
   (* A declaration the program already has, with no body and no new storage,
      is accepted and has nothing to send. Building a module for it would report
@@ -136,7 +136,7 @@ let () =
      program a reload it did not need. *)
   (match Session.eval t "(defvar counter i64)" with
    | c -> if c.Session.installs then fail "an empty change claimed to install"
-   | exception Loc.Error (_, m) -> fail "redeclaring a var unchanged: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "redeclaring a var unchanged: %s" m);
 
   (* A constant that is only ever read at run time is just bytes in the
      program's memory. A dev build emits it as a mutable global and the module
@@ -148,7 +148,7 @@ let () =
        fail "a changed run-time constant had nothing to install";
      if not (has c.Session.ir "store [2 x i32]") then
        fail "a changed run-time constant published no new value"
-   | exception Loc.Error (_, m) -> fail "changing a run-time constant: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing a run-time constant: %s" m);
   (* And in a dev build its storage is writable, where a release build keeps
      it immutable and gets all the folding back. *)
   let host = checked_program "programs/reload.flan" in
@@ -174,7 +174,7 @@ let () =
   (* And once added, it is part of the session: a later form can use it. *)
   (match Session.eval t "(defn use-fresh [] i64 (set fresh 4) fresh)" with
    | _ -> ()
-   | exception Loc.Error (_, m) -> fail "a name added earlier was forgotten: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "a name added earlier was forgotten: %s" m);
 
   (* A file with imports, re-evaluated whole — the C-c C-k case. The session
       keeps the *expanded* declarations, so the package's names are replaced in
@@ -192,7 +192,7 @@ let () =
    | c ->
      if not (List.mem "game-draw" c.Session.fns) then
        fail "reloading sand.flan did not include its own functions"
-   | exception Loc.Error (_, m) ->
+   | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "reloading a file with imports failed: %s" m);
 
   (* A form typed into a file that is *imported as a package* has to be
@@ -211,7 +211,7 @@ let () =
      if c.Session.fns <> [ "agent/poll" ] then
        fail "a form from a package file reported %s, wanted agent/poll"
          (String.concat " " c.Session.fns)
-   | exception Loc.Error (_, m) -> fail "redefining agent/poll: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining agent/poll: %s" m);
   (* A package that is a single file, which is what sand.flan is to the
      headless driver. The file being edited *is* the package rather than a
      member of a directory, so matching on the directory alone would answer
@@ -223,7 +223,7 @@ let () =
      if c.Session.fns <> [ "sand/step" ] then
        fail "a form from a single-file package reported %s, wanted sand/step"
          (String.concat " " c.Session.fns)
-   | exception Loc.Error (_, m) -> fail "redefining sand/step: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining sand/step: %s" m);
 
   (* And a file that is not a package keeps its names as written. *)
   (match Session.eval ~origin:"../sand.flan" t "(defn game-draw [] () (do))" with
@@ -231,7 +231,7 @@ let () =
      if c.Session.fns <> [ "game-draw" ] then
        fail "a form from the program's own file reported %s"
          (String.concat " " c.Session.fns)
-   | exception Loc.Error (_, m) -> fail "redefining game-draw: %s" m);
+   | exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining game-draw: %s" m);
 
   (* An expression's thunk leaves nothing behind, and the module says so, which
      is what lets the agent unload it: nothing may point into its text