From 2f1d20dfc317cb81934beaedbe902835f371aa54 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:51:37 +0700 Subject: [PATCH] The span gets drawn: the source line, with the thing underlined MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 13 +++++- lib/loc.ml | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 131 insertions(+), 2 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 105efda..6ee475e 100644 --- a/bin/main.ml +++ b/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; _ } -> - Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg; + | Flan.Loc.Error d -> + 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 diff --git a/lib/loc.ml b/lib/loc.ml index 3559266..f1a67c4 100644 --- a/lib/loc.ml +++ b/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 [], 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")