From 3295f2f640cc08b4b4447cc2222151bb8dcab62e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:47:59 +0700 Subject: [PATCH 1/9] A location is a span, because a column cannot draw a squiggle MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Loc.t grows an exclusive end, defaulting to the start, so a location nobody widened is a zero-width span at a point and every existing call site keeps its old meaning. 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. The width assertion is the point of the tests: the field could exist, nothing could fill it, and every underline would be one character long while the feature looked finished. --- lib/loc.ml | 48 +++++++++++++++++++++++++++++++++++++++++------ lib/reader.ml | 34 ++++++++++++++++++++------------- test/test_flan.ml | 32 +++++++++++++++++++++++++++++++ 3 files changed, 95 insertions(+), 19 deletions(-) diff --git a/lib/loc.ml b/lib/loc.ml index 5589e73..4c66be5 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -1,15 +1,51 @@ (** 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; - line : int; (* 1-based *) - col : int; (* 1-based *) + file : string; + line : int; (* 1-based *) + col : int; (* 1-based *) + eline : int; (* 1-based, exclusive end *) + ecol : int; } -let make file line col = { file; line; col } -let unknown = { file = ""; line = 0; col = 0 } +let make file line col = { file; line; col; eline = line; ecol = col } +let unknown = make "" 0 0 + +(** [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 diff --git a/lib/reader.ml b/lib/reader.ml index 7141a99..602d241 100644 --- a/lib/reader.ml +++ b/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 = @@ -99,7 +105,7 @@ let read_string st = | 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 \ *) let read_byte st = @@ -119,7 +125,7 @@ let read_byte st = | n when String.length n = 1 -> Char.code n.[0] | n -> Loc.fail 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,27 @@ let read_number st = in if is_hex then match Int64.of_string_opt text with - | Some i -> Form.make (Form.Int i) loc - | None -> Loc.fail loc "malformed hex literal %s" text + | Some i -> spanned st loc (Form.Int i) + | None -> Loc.fail (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 - | None -> Loc.fail loc "malformed float literal %s" text + | Some f -> spanned st loc (Form.Float f) + | None -> Loc.fail (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 - | None -> Loc.fail loc "malformed integer literal %s" text + | Some i -> spanned st loc (Form.Int i) + | None -> Loc.fail (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.[0] = ':' then begin - if String.length text = 1 then Loc.fail loc "empty keyword"; - Form.make (Form.Kw (String.sub text 1 (String.length text - 1))) loc + if String.length text = 1 then + Loc.fail (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 ─────────────────────────────────────────────────────────── *) @@ -213,7 +220,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; @@ -232,7 +239,8 @@ and read_seq st open_c loc = Loc.fail (here st) "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 = diff --git a/test/test_flan.ml b/test/test_flan.ml index bca099d..48544e3 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -249,6 +249,38 @@ let () = | exception Loc.Error (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; From 86296dd99ae13163ad7b4beee7949fb3fff1064b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:49:44 +0700 Subject: [PATCH 2/9] An error stops being a location and a string MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Loc.Error now carries a diagnostic: a stable kind, a span, notes that each have their own span and severity, and the macro expansion it came from. The notes are the part that was actually missing — "this is wrong here" plus "because of that, over there" is two places and two explanations, and a single string can state only one of them. The compatibility story for the daemon, which was the open question: the single-diagnostic exception stays the single-diagnostic exception. Session and dev evaluate one form and have one failure to report, so they take a location and a message out of it with Loc.summary and are otherwise unchanged. A second exception carries a list, and only a driver that compiles a whole file raises it, so nothing interactive has to know it is there. No message text changed. --- bin/main.ml | 2 +- lib/check.ml | 9 ++--- lib/dev.ml | 6 +-- lib/load.ml | 2 +- lib/loc.ml | 89 +++++++++++++++++++++++++++++++++++++++-- lib/parse.ml | 2 +- lib/session.ml | 6 +-- test/test_acceptance.ml | 12 +++--- test/test_flan.ml | 18 ++++----- test/test_session.ml | 18 ++++----- 10 files changed, 122 insertions(+), 42 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 25b9a04..105efda 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -2,7 +2,7 @@ let with_errors path f = try f () with - | Flan.Loc.Error (loc, msg) -> + | Flan.Loc.Error { Flan.Loc.dloc = loc; dmsg = msg; _ } -> Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg; ignore path; exit 1 diff --git a/lib/check.ml b/lib/check.ml index d22ad87..9032cc7 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -272,12 +272,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.Error - (loc, - Printf.sprintf - "%s cannot see %s: it is a local of the enclosing function, and \ - %s." what name why)) + Loc.failk "check/capture" loc + "%s cannot see %s: it is a local of the enclosing function, and %s." + what name why | _ -> () let scoped ctx f = diff --git a/lib/dev.ml b/lib/dev.ml index 6124f2d..b7c2a88 100644 --- a/lib/dev.ml +++ b/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 () diff --git a/lib/load.ml b/lib/load.ml index 4ed981e..d126e9d 100644 --- a/lib/load.ml +++ b/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. *) diff --git a/lib/loc.ml b/lib/loc.ml index 4c66be5..3559266 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -49,7 +49,90 @@ let width (t : t) = let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col -(** Raised by every stage of the frontend. *) -exception Error of t * string +(* ── Diagnostics ────────────────────────────────────────── -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 = + 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 diff --git a/lib/parse.ml b/lib/parse.ml index 7990985..135d54c 100644 --- a/lib/parse.ml +++ b/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 diff --git a/lib/session.ml b/lib/session.ml index 1d11dea..b9d8561 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -505,7 +505,7 @@ let render_locals ?(origin = "") 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 = "") 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 = "") 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, diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 54fd10b..188432e 100644 --- a/test/test_acceptance.ml +++ b/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" @@ -1206,7 +1206,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" @@ -1567,7 +1567,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 @@ -1578,7 +1578,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" @@ -2004,7 +2004,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; @@ -2034,7 +2034,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); diff --git a/test/test_flan.ml b/test/test_flan.ml index 48544e3..2616797 100644 --- a/test/test_flan.ml +++ b/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,7 +246,7 @@ 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 ───────────────────────────────────────────────────── @@ -305,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; @@ -544,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) @@ -635,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 @@ -647,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 @@ -663,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 @@ -1615,7 +1615,7 @@ 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"); (* ── The acceptance program checks end to end ──────────────────── *) diff --git a/test/test_session.ml b/test/test_session.ml index 94b60e9..8506b63 100644 --- a/test/test_session.ml +++ b/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 From 2f1d20dfc317cb81934beaedbe902835f371aa54 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:51:37 +0700 Subject: [PATCH 3/9] 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") From 2efed1630fc665085b4036ce1e144ecbab86a0e7 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:56:17 +0700 Subject: [PATCH 4/9] The compiler finishes the file before it reports MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A sink collects 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, which is what leaves the interactive path untouched: the daemon checks one form, asks for a sink that is off, and still gets one exception. Two resync points, and both are places the work already had a boundary. In the parser it is a top-level form — the reader found where each declaration ends, so skipping a bad one cannot lose its place, while inside a declaration there is no such landmark and one bad defn stays one error. In the checker it is the two passes: pass one, which builds every name and signature, still stops at the first refusal, because 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. 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. --- bin/main.ml | 18 +++++++++++------- lib/check.ml | 28 +++++++++++++++++++++++----- lib/loc.ml | 43 ++++++++++++++++++++++++++++++++++++++++--- lib/parse.ml | 15 +++++++++++++-- 4 files changed, 87 insertions(+), 17 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 6ee475e..6612f1a 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -3,7 +3,7 @@ (* 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 + 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 @@ -42,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 ~keep_going:true (Flan.Reader.read_file path)) -let checked path = Flan.Check.program (load path).decls +let checked path = Flan.Check.program ~keep_going:true (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 @@ -132,7 +136,7 @@ let () = (fun path -> with_errors path (fun () -> Flan.Reader.read_file path - |> Flan.Parse.program + |> Flan.Parse.program ~keep_going:true |> List.iter (fun d -> print_endline (summarise d)))) files | _ :: "check" :: files when files <> [] -> @@ -286,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 ~keep_going:true l.decls |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize |> print_string)) files @@ -318,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 ~keep_going:true 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 @@ -395,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 ~keep_going:true l.decls in let p, csrcs, lflags = Flan.Reach.link l p in ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe); let code = diff --git a/lib/check.ml b/lib/check.ml index 9032cc7..38458f3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4132,7 +4132,8 @@ 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 = +let program_with_env ?(keep_going = false) (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 @@ -4140,18 +4141,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 globals = List.filter_map (check_global env) decls in + let s = Loc.sink ~on:keep_going 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. *) @@ -4175,7 +4192,8 @@ 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) +let program ?keep_going (decls : Ast.decl list) : Tast.program = + fst (program_with_env ?keep_going decls) (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing diff --git a/lib/loc.ml b/lib/loc.ml index f1a67c4..ebe043e 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -49,12 +49,12 @@ let width (t : t) = let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col -(* ── Diagnostics ────────────────────────────────────────── +(* ── Diagnostics ────────────────────────────────────────── 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 + [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 @@ -101,7 +101,7 @@ type diag = { 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 — + [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 @@ -137,6 +137,43 @@ let fail loc 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 diff --git a/lib/parse.ml b/lib/parse.ml index 135d54c..21dbacd 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -866,14 +866,25 @@ 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 = +(* [keep_going] asks for every bad declaration in the file rather than the + first. The resync point is a top-level form, and it is the only honest one + here: the reader already found where each declaration ends, so skipping a + bad one costs nothing and cannot lose its place. Inside a declaration there + is no such landmark, so one bad [defn] is one error. + + Off by default, because the daemon parses one form at a time and wants one + exception. *) +let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list = (* 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 (* Single-declaration entry point, for tests and the REPL. *) let decl (f : Form.t) : Ast.decl = From e8aeb892824bbe01dc71a3dbbe0c254c5241375e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 07:58:25 +0700 Subject: [PATCH 5/9] An error says which macro it is really about The provenance 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 honest limit, since it would otherwise read as a claim: a macro's expansion has no source of its own to point at, so the note lands on the call site along with the error. What it buys is the reader knowing the code being refused is not the code they wrote. --- lib/loc.ml | 27 ++++++++++++++++++++++++++- lib/macro.ml | 11 +++++++++-- 2 files changed, 35 insertions(+), 3 deletions(-) diff --git a/lib/loc.ml b/lib/loc.ml index ebe043e..6815848 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -20,11 +20,28 @@ type t = { 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; eline = line; ecol = col } +let make file line col = + { file; line; col; eline = line; ecol = col; macro = None } + let unknown = make "" 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. *) @@ -124,6 +141,14 @@ let sort_notes (d : diag) = 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)) diff --git a/lib/macro.ml b/lib/macro.ml index 8ff2627..de18afd 100644 --- a/lib/macro.ml +++ b/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 From 17892852f8c97d2b50b9c81b23c3b49d57bf3257 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 08:02:33 +0700 Subject: [PATCH 6/9] Kinds, and the notes that point at the other place MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A kind is a stable id per error, so a test can assert which error this is without matching on prose and a message can be reworded without breaking anything. The reader's fourteen refusals all have one; in the checker they go on the errors a test names and the handful that are common enough to be worth classifying. Not a hundred of them, because jank has a hundred from being mature and the number is not the feature. The notes are the part that could not be said before. A duplicate definition now points at the second 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 all 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. No message text changed, so every existing needle still means what it meant. The new assertions are on kinds and on note positions, which is the house rule about asserting the reason, made stable. --- lib/check.ml | 111 ++++++++++++++++++++++++++++++++++++++-------- lib/reader.ml | 41 +++++++++++------ test/test_flan.ml | 111 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 230 insertions(+), 33 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 38458f3..d6cf6a0 100644 --- a/lib/check.ml +++ b/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 @@ -495,7 +522,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 @@ -503,7 +530,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 @@ -1013,7 +1040,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)))) @@ -1250,7 +1279,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, @@ -1775,15 +1805,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 - 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.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 @@ -1821,9 +1859,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 = @@ -2002,7 +2047,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) @@ -2050,12 +2100,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 @@ -3624,7 +3677,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 @@ -3703,9 +3756,16 @@ let collect env (decls : Ast.decl list) = match Ast.declared_name d with | None -> () | Some n -> - if Hashtbl.mem claimed n then - fail d.Ast.dloc "%s is defined twice" n; - Hashtbl.add claimed n ()) + (match Hashtbl.find_opt claimed n with + | Some first -> + (* 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 @@ -3966,8 +4026,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 - fail p.Ast.floc "%s has two parameters named %s" fn.Ast.name p.Ast.fname; + if List.mem_assoc p.Ast.fname ctx.scope then begin + 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 = diff --git a/lib/reader.ml b/lib/reader.ml index 602d241..66b2ff0 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -89,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 | '\\' -> @@ -100,7 +100,7 @@ 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 @@ -111,7 +111,7 @@ let read_string st = 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 @@ -123,7 +123,7 @@ 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 spanned st loc (Form.Byte code) @@ -139,23 +139,26 @@ let read_number st = if is_hex then match Int64.of_string_opt text with | Some i -> spanned st loc (Form.Int i) - | None -> Loc.fail (Loc.upto loc (here st)) "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 -> spanned st loc (Form.Float f) - | None -> Loc.fail (Loc.upto loc (here st)) "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 -> spanned st loc (Form.Int i) - | None -> Loc.fail (Loc.upto loc (here st)) "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.upto loc (here st)) "empty keyword"; + 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 spanned st loc (Form.Sym text) @@ -177,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" @@ -189,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 @@ -231,12 +234,22 @@ 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 let items = go [] in diff --git a/test/test_flan.ml b/test/test_flan.ml index 2616797..4a5effc 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1618,6 +1618,117 @@ let () = | 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 ~keep_going:true + (Parse.program ~keep_going:true + (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 ~keep_going:true (read "(defn a)\n(defn b)\n") with + | _ -> check "two bad declarations are refused" false + | exception Loc.Errors ds -> + check "two bad declarations give two errors" (List.length ds = 2)); + + (* One form at a time still raises one, which is what the daemon depends on: + it catches [Loc.Error] and would not see a list. *) + (match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\ + (defn b [] i32 nope2)\n")) with + | _ -> check "without keep_going it still refuses" false + | exception Loc.Errors _ -> + check "without keep_going there is no 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); From 41b60d2e4a086a76f82cdb333cb5d620349ed110 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 08:04:45 +0700 Subject: [PATCH 7/9] The daemon cannot be handed a list by accident MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Loc.Errors is a second exception, and the handlers in the session and the daemon name only Loc.Error — so a list reaching them is an unhandled exception and a dead session, which is the one thing the dev loop exists to prevent. A flag on the function the session already calls left that one label away from happening. Parse.program_all and Check.program_all are separate names, so the session's call site has to be edited by a person for its behaviour to change, and the guarantee stops being a default argument. Placeless diagnostics now sort last rather than first. A wrong main signature is raised against unknown, which is line 0, and sorting on the number alone put it above every error that can actually be clicked. It is a real error and it is not anywhere, so it goes after the ones that are. --- bin/main.ml | 12 ++++++------ lib/check.ml | 22 ++++++++++++++++++---- lib/loc.ml | 16 +++++++++++++++- lib/parse.ml | 28 ++++++++++++++++++++++------ test/test_flan.ml | 15 ++++++++------- 5 files changed, 69 insertions(+), 24 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 6612f1a..f7933e6 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -47,9 +47,9 @@ let summarise (d : Flan.Ast.decl) = asks for the whole list rather than the first thing wrong. *) let load path : Flan.Load.t = Flan.Load.program ~file:path - (Flan.Parse.program ~keep_going:true (Flan.Reader.read_file path)) + (Flan.Parse.program_all (Flan.Reader.read_file path)) -let checked path = Flan.Check.program ~keep_going:true (load path).decls +let checked path = Flan.Check.program_all (load path).decls (* What the source called each parameter, per function. The typed IR refers to locals by slot index and records no names — [Check] has them in its scope @@ -136,7 +136,7 @@ let () = (fun path -> with_errors path (fun () -> Flan.Reader.read_file path - |> Flan.Parse.program ~keep_going:true + |> Flan.Parse.program_all |> List.iter (fun d -> print_endline (summarise d)))) files | _ :: "check" :: files when files <> [] -> @@ -290,7 +290,7 @@ let () = with_errors path (fun () -> let l = load path in let pnames = if debug then param_names l else [] in - Flan.Check.program ~keep_going:true l.decls + Flan.Check.program_all l.decls |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize |> print_string)) files @@ -322,7 +322,7 @@ let () = in with_errors path (fun () -> let l = load path in - let p = Flan.Check.program ~keep_going:true l.decls in + let p = Flan.Check.program_all l.decls in (* The link follows the program, not the import list: a package nothing reachable calls into contributes no C and no linker argument, and its functions are not emitted either. That is what lets one file import @@ -399,7 +399,7 @@ let () = (Printf.sprintf "flan-run-%d" (Unix.getpid ())) in let l = load path in - let p = Flan.Check.program ~keep_going:true l.decls in + let p = Flan.Check.program_all l.decls in let p, csrcs, lflags = Flan.Reach.link l p in ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe); let code = diff --git a/lib/check.ml b/lib/check.ml index d6cf6a0..0500aec 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4205,8 +4205,11 @@ let check_main env = expression typed at a REPL against the program the process is running — and it has to be this one rather than anything rebuilt from declarations, because [program] prepends the prelude and no accumulated AST contains it. *) -let program_with_env ?(keep_going = false) (decls : Ast.decl list) - : Tast.program * env = +(* Separate entry points below rather than a flag on the one the session calls, + for the reason [Parse] gives at the same fork: [Loc.Errors] is a second + exception that the session and the daemon do not catch, so the guarantee + that they never see one should be structural and not a default argument. *) +let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in let decls = Parse.program (Prelude.forms ()) @ decls in (* Before anything is collected: every (declare-c ...) becomes an ordinary @@ -4265,8 +4268,19 @@ let program_with_env ?(keep_going = false) (decls : Ast.decl list) globals; externs; fns; cshim }, env) -let program ?keep_going (decls : Ast.decl list) : Tast.program = - fst (program_with_env ?keep_going decls) +(** The program and the environment, stopping at the first refusal. What a + session needs, and it raises [Loc.Error] and never [Loc.Errors]. *) +let program_with_env (decls : Ast.decl list) : Tast.program * env = + build_program ~keep_going:false decls + +let program (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:false decls) + +(** The same, reporting every declaration whose body it refuses rather than the + first. Raises [Loc.Errors], so only a caller prepared for a list should be + calling it. *) +let program_all (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:true decls) (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing diff --git a/lib/loc.ml b/lib/loc.ml index 6815848..750c8ee 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -314,7 +314,21 @@ let report (d : diag) = prints when it finished the file rather than stopping at the first thing it found. *) let report_all (ds : diag list) = - let ds = List.stable_sort (fun a b -> before a.dloc b.dloc) ds in + (* Source order, with the placeless ones last. A diagnostic the checker + raised against [unknown] — a wrong [main] signature is the one that + happens — has line 0, and sorting on the number alone would put it at the + top of the list, above every error that can actually be clicked. It is a + real error and it is not anywhere, so it goes after the ones that are. *) + let placed (d : diag) = d.dloc.line > 0 in + let ds = + List.stable_sort + (fun a b -> + match (placed a, placed b) with + | true, false -> -1 + | false, true -> 1 + | _ -> before a.dloc b.dloc) + ds + in let n = List.length ds in String.concat "\n" (List.map report ds) ^ Printf.sprintf "\n%d error%s" n (if n = 1 then "" else "s") diff --git a/lib/parse.ml b/lib/parse.ml index 21dbacd..651136a 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -866,15 +866,20 @@ and variant (f : Form.t) : Ast.variant = unknown name, which is wrong but not silent. *) let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) -(* [keep_going] asks for every bad declaration in the file rather than the +(* Two entry points and not one function with a flag, and the reason is the + daemon. [Loc.Errors] is a second exception, and the handlers in the session + and in the daemon name only [Loc.Error] — so a list reaching them would be + an unhandled exception and a dead session, which is the one thing the whole + dev loop exists to prevent. A flag on the function the session already calls + would put that one label away from happening. A separate name cannot: the + session's call site has to be edited by someone for its behaviour to change. + + [keep_going] asks for every bad declaration in the file rather than the first. The resync point is a top-level form, and it is the only honest one here: the reader already found where each declaration ends, so skipping a bad one costs nothing and cannot lose its place. Inside a declaration there - is no such landmark, so one bad [defn] is one error. - - Off by default, because the daemon parses one form at a time and wants one - exception. *) -let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list = + is no such landmark, so one bad [defn] is one error. *) +let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list = (* Quasiquote first and always, because it is pure and needs nothing loaded: it is what turns a macro body into ordinary code, and the prelude's own macros have to parse in a process that has not built a macro module yet. @@ -886,6 +891,17 @@ let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list = Loc.finish s; decls +(** One file, stopping at the first declaration it cannot parse. Raises + [Loc.Error], never [Loc.Errors]. *) +let program (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:false forms + +(** One file, reporting every declaration it cannot parse. Raises [Loc.Errors] + when there was more than nothing wrong, so only a caller prepared for a + list should be calling it. *) +let program_all (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:true forms + (* Single-declaration entry point, for tests and the REPL. *) let decl (f : Form.t) : Ast.decl = temps := 0; diff --git a/test/test_flan.ml b/test/test_flan.ml index 4a5effc..59e1f51 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1685,8 +1685,8 @@ let () = the first and a checker that reported thirty pieces of wreckage would both fail this row. *) (match - Check.program ~keep_going:true - (Parse.program ~keep_going:true + Check.program_all + (Parse.program_all (read "(defn a [] i32 nope1)\n\ (defn b [] i32 nope2)\n\ (defn c [] i32 nope3)\n")) @@ -1699,18 +1699,19 @@ let () = (* The parser resynchronises on a top-level form, so two bad declarations are two errors rather than one. *) - (match Parse.program ~keep_going:true (read "(defn a)\n(defn b)\n") with + (match Parse.program_all (read "(defn a)\n(defn b)\n") with | _ -> check "two bad declarations are refused" false | exception Loc.Errors ds -> check "two bad declarations give two errors" (List.length ds = 2)); - (* One form at a time still raises one, which is what the daemon depends on: - it catches [Loc.Error] and would not see a list. *) + (* [Check.program] is a different function from [Check.program_all], and + that is the guarantee: the session calls this one, it raises one + diagnostic, and nobody can turn it into a list by passing a label. *) (match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\ (defn b [] i32 nope2)\n")) with - | _ -> check "without keep_going it still refuses" false + | _ -> check "Check.program still refuses" false | exception Loc.Errors _ -> - check "without keep_going there is no list" false + check "Check.program never answers with a list" false | exception Loc.Error _ -> ()); (* The first line of a report is exactly the GNU format compilation-mode From a7ea3ef940b9e45294a8354dc062a0a57d74c28a Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 08:06:25 +0700 Subject: [PATCH 8/9] What the error value is, and the three things it deliberately is not MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit BUILT.md gets the design: why the span went into Loc.t rather than beside it, why macro provenance went the same way, why the first line of a report is still the GNU format, and what the daemon sees. NEXT.md item 8 is struck through, with the parts that were not built stated plainly so they do not read as oversights — the reader does not collect, because a paren stream cannot be resynchronised; pass one of the checker does not collect, because thirty unknown-name lines under one wrong signature are the same error thirty times; and there are not a hundred kinds, because the count was never the feature. --- BUILT.md | 140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ NEXT.md | 69 ++++++++++++++------------- 2 files changed, 174 insertions(+), 35 deletions(-) diff --git a/BUILT.md b/BUILT.md index b6b7d8d..4ee2c22 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3897,3 +3897,143 @@ 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 somewhere `next-error` can take you. + +Every part of it degrades to the bare first line. 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 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. diff --git a/NEXT.md b/NEXT.md index 70ec092..4a9cb5c 100644 --- a/NEXT.md +++ b/NEXT.md @@ -862,47 +862,46 @@ 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 — - both need `Loc.Error` to stop being a single location plus a string. +8. ~~**Errors: a structured value with spans and notes, and more than one per compile.**~~ **Built.** See + *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 - the first error aborts the run. The author's workflow is write everything, compile at the end, squash the list — - which cannot work when there is never a list. The *content* of the messages is already good; they state the reason - and name what to write instead. What is missing is structure and volume. + What made it cheap, and is worth knowing before anything else is retrofitted onto locations: **the span went into + `Loc.t` itself**, as an exclusive end defaulting to the start. A location nobody widened is a zero-width span at a + point, so every one of the ~260 refusal sites kept its meaning, only the reader had to learn to fill the end in, + 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 - with unusually good diagnostics and three things worth taking: + **Three things deliberately not built, so they do not read as oversights:** - - **A named `kind` per error** — roughly a hundred, `lex_unterminated_string`, `parse_odd_entries_in_map` — each with - a stable string id. Machine-readable classification with no JSON mode and no prose parsing. - - **A source *span*, not a point.** This is what draws Elm's squiggle: you underline a range. A column number cannot. - - **Notes: an error carries zero or more, each with its own span and its own severity** (info/warning/error), sorted - by position. **This is the actual secret of Elm-quality messages** — "this is wrong *here*" plus "because of *that* - over there", two places highlighted and each explained. One location and one string can never express it. + - **The reader does not collect.** There is no resynchronising a paren stream — after an unclosed bracket nothing + knows whether the next `)` closes this form or the one above it. First error, stop. + - **Pass one of the checker does not collect either.** Signatures are a foundation: a declaration pass one could + not make sense of leaves a hole that pass two reports once per mention, and thirty "unknown name" lines under + one wrong signature are the same error thirty times. Pass two — bodies, where the volume is — collects per + 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. - jank also carries the **macro expansion** an error came from, which this project will want once macros land, and it - is worth building the field now rather than retrofitting it. + **What the daemon sees, which the brief asked to be worked out and stated:** the single-diagnostic exception is + still the single-diagnostic exception. `Session.eval` and the daemon check one form, keep catching `Loc.Error`, + 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. - **Then collect rather than raise:** finish the function, finish the file, report everything found. Error recovery in - a checker is real work — the hard part is resynchronising after a bad form without cascading nonsense — and it is - what the workflow actually needs. + **Left for later, small and independent:** notes on the type-mismatch errors, which are the most common class and + want the *parameter's* declaration as the second place — `env.fns` stores types and not locations today, so that + is a small change to what `collect` records. And a checker error on macro-produced code names the macro but has no + 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. - **No editor work is required.** Flan already prints `file:line:col: message`, the GNU format Emacs's - `compilation-mode` parses with no configuration, so `M-x compile` gives a clickable list and `next-error` free. - Flycheck and a structured JSON report were both considered and are **not** wanted — the workflow is - compile-at-the-end, not live linting. - - **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:** Raised by the author's workflow: write everything, compile at the end, squash - 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. +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 + gave — the 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 From 887aae45eaf780fedc51b3709904e24ba0c9265d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 08:12:49 +0700 Subject: [PATCH 9/9] The next-error claim was inferred, and it is weaker than it read MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit compile.el puts note in the same capture group as info — group 7, level 0 — while warning is group 6, level 1, and compilation-skip-threshold defaults to 1. So next-error walks the errors with no configuration, which is the claim M-x compile rests on and it holds; it steps over the notes until the threshold is 0. They are still parsed, coloured and clickable. 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. The macro expansion field gets the test it was missing, through a real expansion rather than a unit test on either half: the tag is put on by Macro and defaulted into the diagnostic by Loc, and either half alone would pass with the other broken. clamp misused expands into a call to a name that does not exist, so the checker refuses something the author never wrote, which is the case the field is for. --- BUILT.md | 11 ++++++++++- NEXT.md | 9 +++++++++ test/test_acceptance.ml | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 1 deletion(-) diff --git a/BUILT.md b/BUILT.md index 4ee2c22..c37813e 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3974,7 +3974,16 @@ prog.flan:1:1: info: Cursor is declared here, with row, col ``` 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 somewhere `next-error` can take you. +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 ``, the prelude and the REPL have names that are not paths, and a file can change under us between being diff --git a/NEXT.md b/NEXT.md index 4a9cb5c..f2c7709 100644 --- a/NEXT.md +++ b/NEXT.md @@ -885,6 +885,15 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. 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. + + **One claim checked rather than assumed,** and it is weaker than it first reads: `compile.el` groups `note` with + `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. **What the daemon sees, which the brief asked to be worked out and stated:** the single-diagnostic exception is still the single-diagnostic exception. `Session.eval` and the daemon check one form, keep catching `Loc.Error`, diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 188432e..97d4fd2 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1909,6 +1909,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:"" 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