The span gets drawn: the source line, with the thing underlined

The first line of an entry is still exactly file:line:col: message, because
that is the GNU format compilation-mode already parses and the whole of the
editor story. Everything under it is indented, which compilation-mode
ignores, so the underline is free. A note gets an entry of its own rather
than being folded into the error's block — that is what makes the second
place somewhere next-error can go, and is the reason notes carry locations.

Every part of it degrades to the bare first line: a location the checker
invented has line 0, 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.

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 { Flan.Loc.dloc = loc; dmsg = 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
 

lib/loc.ml

@@ -136,3 +136,123 @@ let fail loc fmt =
 
 let failk ?notes ?expansion kind loc fmt =
   Printf.ksprintf (fun msg -> raise_diag (diag ~kind ?notes ?expansion loc msg)) fmt
+
+(* ── 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) =
+  let ds = List.stable_sort (fun a b -> 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")