diff --git a/BUILT.md b/BUILT.md index efe3ffb..a66685b 100644 --- a/BUILT.md +++ b/BUILT.md @@ -4046,3 +4046,152 @@ composite renderer and ghost text want the same form, for different reasons. `fl things ghost text would need — overlay invalidation as the buffer is edited, and a rule for a watch inside a loop, which the buffer sidesteps by showing the last value written and which inline has no obvious answer that does not become the query UI this design exists to avoid. + +## An error is a value, and there is more than one of them + +`lib/loc.ml` used to carry a point and a message, and `Loc.Error` was the frontend's one exception, so the first +error ended the run. The author's workflow is write everything, compile at the end, work through the list — which +cannot happen when there is never a list. The messages themselves were already good; they state the reason and name +what to write instead, and **none of them changed**. What was missing was structure and volume. + +### The location is a span + +`Loc.t` grew an exclusive end, defaulting to the start. That is the whole trick: a location nobody widened is a +zero-width span at a point, so every call site that existed before means exactly what it meant, and `Loc.to_string` +still prints `file:line:col`. Only the reader knows where a form ends, so only the reader fills them in — one helper +in the one place that holds both ends, which is why nothing above `Reader` had to learn a span exists. `Form`, `Ast` +and `Tast` were not touched and did not need to be. + +A column number cannot draw an underline and a span can. That is what the field is for and it is the only reason it +is there. + +### The error itself + +```ocaml +type diag = { + kind : string; (* "reader/unclosed", stable *) + dloc : t; (* the primary span *) + dmsg : string; + notes : note list; (* each with its own span and severity *) + expansion : (string * t) option; (* the macro it came out of *) +} +exception Error of diag +exception Errors of diag list +``` + +Three parts, each buying something the old pair could not express. + +**`kind`** is a stable id. It classifies with no prose parsed, so a message can be reworded without breaking anything +that depends on *which* error this is. The reader's fourteen refusals all carry one; in the checker they go on the +errors a test names and the handful common enough to be worth classifying. **Not a hundred of them.** jank has about +a hundred because it is mature, and the count is not the feature — with 163 refusal sites in `check.ml` alone, +minting an id for each would be a sweep that never ends and that nothing reads. + +**`notes`** are the part that was actually missing, and they are the secret of an Elm-quality message. Each carries +its own span and its own severity, so an error says "this is wrong *here*" **and** "because of *that*, over there", +and points at both. One location and one string can only ever state one of the two. What has them today: + +- a name defined twice points at the second, because that is the one to delete, and notes the first; +- a duplicate parameter and a duplicate field do the same; +- an unknown field, an unknown struct and a non-exhaustive `match` note the *declaration* and list what is actually + there, so the reader's next move arrives with the question instead of after it; +- the reader's unclosed bracket is the clearest case — the error sits on the bracket, because that is where the fix + goes, and the note sits where the file ran out, because that is the surprise. A mismatched closer is the mirror of + it: the wrong closer is where the mistake reads, and the opener is what makes it wrong, and neither alone says + which bracket to change. + +**`expansion`** names the macro an error is really about. It rides on the *location*, not on the form, because the +location is the thing that already travels: `Expand.unmarshal` stamps the call site onto every node a macro answers +with, and that stamp goes on through the AST and the typed IR untouched. Tagging it there means an error raised +anywhere downstream can name the macro with **no field added to `Form`, to `Ast` or to `Tast`**. Outermost wins — the +macro the author wrote is the one worth naming, not whatever it expanded into on the way down. + +### The squiggle + +The first line of an entry is exactly `file:line:col: message`, which is the GNU format `compilation-mode` parses +with no configuration. That is the whole of the editor story: once more than one comes out, `M-x compile` gives a +clickable list and `next-error` walks it. Everything under the first line is indented, and `compilation-mode` ignores +indented continuation lines, so the underline is free: + +``` +prog.flan:6:3: Cursor has no field pos + 6 | (.pos c)) + | ^^^^^^^^ +prog.flan:1:1: info: Cursor is declared here, with row, col + 1 | (defstruct Cursor + | ----------------- +``` + +A note gets an **entry of its own** rather than being folded into the error's block. That is gcc's shape and it is the +point of notes having locations at all: the second place becomes a place the compilation buffer knows about. + +**Stated at its true strength, because it was checked rather than assumed** (`compile.el`, Emacs 30.2). The `gnu` +entry in `compilation-error-regexp-alist-alist` puts `Note`/`note` in the *same capture group* as `Info`/`info` — +group 7, level 0 — while `warning` is group 6, level 1. `compilation-skip-threshold` defaults to **1**, "skip +anything less than warning". So: **errors** are navigable with `next-error` out of the box, which is the claim that +matters and the one `M-x compile` rests on. **Notes** are parsed, coloured and clickable, and `next-error` steps over +them until `compilation-skip-threshold` is 0. Renaming the label from `info:` to `note:` does not change that — same +group. Labelling notes `warning:` *would* make them navigable at the default, and is refused: a note is not a +warning, and a compile whose only complaint is an error would start reporting warnings that are not warnings. + +Every part of it degrades to the bare first line. A location the checker invented has line 0 and a file called +``, 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 186b466..5f22367 100644 --- a/NEXT.md +++ b/NEXT.md @@ -921,47 +921,55 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. because `check_dotimes` folds the step into the body and a `continue` branching to the header would skip it and hang. -8. **Errors: a structured value with spans and notes, and more than one per compile.** One piece of work, not two — - 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. + - **`Load` and `Shim` do not collect.** They sit between the two collecting phases and still stop at the first + refusal, for pass one's reason: an import that could not be resolved leaves a hole the checker would report + once per use. - jank also carries the **macro expansion** an error came from, which this project will want once macros land, and it - is worth building the field now rather than retrofitting it. + **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. - **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. + **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. - **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. + **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. - **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 diff --git a/bin/main.ml b/bin/main.ml index 25b9a04..f7933e6 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 (loc, 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 @@ -33,10 +42,14 @@ let summarise (d : Flan.Ast.decl) = (* Every path past [parse] goes through [Load]: an import is resolved into the declarations it stands for, and the package's C shim and linker arguments come back with them. *) +(* Every driver here is the batch case, which is the one the workflow is: write + everything, compile at the end, work through the list. So every one of them + asks for the whole list rather than the first thing wrong. *) let load path : Flan.Load.t = - Flan.Load.program ~file:path (Flan.Parse.program (Flan.Reader.read_file path)) + Flan.Load.program ~file:path + (Flan.Parse.program_all (Flan.Reader.read_file path)) -let checked path = Flan.Check.program (load path).decls +let checked path = Flan.Check.program_all (load path).decls (* What the source called each parameter, per function. The typed IR refers to locals by slot index and records no names — [Check] has them in its scope @@ -123,7 +136,7 @@ let () = (fun path -> with_errors path (fun () -> Flan.Reader.read_file path - |> Flan.Parse.program + |> Flan.Parse.program_all |> List.iter (fun d -> print_endline (summarise d)))) files | _ :: "check" :: files when files <> [] -> @@ -277,7 +290,7 @@ let () = with_errors path (fun () -> let l = load path in let pnames = if debug then param_names l else [] in - Flan.Check.program l.decls + Flan.Check.program_all l.decls |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize |> print_string)) files @@ -309,7 +322,7 @@ let () = in with_errors path (fun () -> let l = load path in - let p = Flan.Check.program l.decls in + let p = Flan.Check.program_all l.decls in (* The link follows the program, not the import list: a package nothing reachable calls into contributes no C and no linker argument, and its functions are not emitted either. That is what lets one file import @@ -386,7 +399,7 @@ let () = (Printf.sprintf "flan-run-%d" (Unix.getpid ())) in let l = load path in - let p = Flan.Check.program l.decls in + let p = Flan.Check.program_all l.decls in let p, csrcs, lflags = Flan.Reach.link l p in ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe); let code = diff --git a/lib/check.ml b/lib/check.ml index 2a55843..2061a37 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 @@ -272,12 +299,9 @@ let captured ctx loc name = "an fn is lifted into a function of its own and is handed nothing but \ its parameters. Pass it in, or use a global" in - raise - (Loc.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 = @@ -514,7 +538,7 @@ and resolve_name env ~seen loc n = below would otherwise report [f65] as unimplemented generics and send you to plan.org instead of to the character you mistyped. *) | _ when near_miss env n <> None -> - fail loc "unknown type %s — did you mean %s?" n + Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n (Option.get (near_miss env n)) (* Lowercase is a type variable, Capitalized is concrete — no sigil (plan.org, Types). A variable parses, but nothing at milestone 2 can @@ -522,7 +546,7 @@ and resolve_name env ~seen loc n = | _ when n <> "" && n.[0] = Char.lowercase_ascii n.[0] -> unimplemented loc (Printf.sprintf "generic code over the type variable %s" n) 5 - | _ -> fail loc "unknown type %s" n + | _ -> Loc.failk "check/unknown-type" loc "unknown type %s" n and array_len env loc = function | Ast.Lint n -> n @@ -1032,7 +1056,9 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = let target, sname = struct_target ctx target in let s = Hashtbl.find ctx.env.structs sname in (match Tast.field_index s name with - | None -> fail loc "%s has no field %s" sname name + | None -> + Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname) + "%s has no field %s" sname name | Some i -> let fty = (List.nth s.Tast.fields i).Tast.fty in expect loc ~want (mk loc fty (Tast.Field (target, i)))) @@ -1269,7 +1295,8 @@ and var ctx loc ~want name = and pass that" name; expect loc ~want (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name))) - | None -> captured ctx loc name; fail loc "unknown name %s" name) + | None -> captured ctx loc name; + Loc.failk "check/unknown-name" loc "unknown name %s" name) (* Reading a move-only local. Every read is a move unless the site said it was a borrow, which is the conservative direction: passing one to a function, @@ -1794,15 +1821,23 @@ and check_struct ctx ~want loc name kvs = "%s is a union, and a union value names the case as well as the \ type — write (%s.%s {.field value ...}) for one of %s" name name (first_case_name ctx.env name) (case_list ctx.env name) - else fail loc "unknown struct %s" name) + else + Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name) + "unknown struct %s" name) | Some s -> let seen = Hashtbl.create 8 in List.iter (fun (k, (v : Ast.expr)) -> - if Hashtbl.mem seen k then - 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 @@ -1840,9 +1875,16 @@ and check_case ctx ~want loc uname (c : Tast.variant) kvs = let seen = Hashtbl.create 8 in List.iter (fun (k, (v : Ast.expr)) -> - if Hashtbl.mem seen k then fail v.Ast.loc "field %s is given twice" k; + (match Hashtbl.find_opt seen k with + | Some (first : Ast.expr) -> + Loc.failk "check/duplicate-field" v.Ast.loc + ~notes:[ Loc.note first.Ast.loc (k ^ " is given here first") ] + "field %s is given twice" k + | None -> ()); if Tast.vfield_index c k = None then - fail v.Ast.loc "%s has no field %s" full k; + Loc.failk "check/unknown-field" v.Ast.loc + ~notes:(declared_note ctx.env uname) + "%s has no field %s" full k; Hashtbl.add seen k v) kvs; let fields = @@ -2021,7 +2063,12 @@ and check_match ctx ?want loc scrutinee arms = u.Tast.cases in if not !saw_wild && missing <> [] then - fail loc + (* The union's declaration, because that is where the case list this match + failed to cover actually lives, and because adding a case there is what + makes a match non-exhaustive in the first place. *) + Loc.failk "check/non-exhaustive-match" loc + ~notes:(match subject with `Union u -> declared_note ctx.env u.Tast.uname + | _ -> []) "this match is not exhaustive — %s %s no arm. Add %s, or a _ arm for \ the rest" (String.concat ", " missing) @@ -2069,12 +2116,15 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = match Hashtbl.find_opt ctx.env.globals name with | Some (_, true) -> fail loc "%s is a constant" name | Some (ty, false) -> Tast.Pglobal name, ty - | None -> captured ctx loc name; fail loc "unknown name %s" name) + | None -> captured ctx loc name; + Loc.failk "check/unknown-name" loc "unknown name %s" name) | Ast.Pfield (target, name) -> let target, sname = struct_target ctx target in let s = Hashtbl.find ctx.env.structs sname in (match Tast.field_index s name with - | None -> fail loc "%s has no field %s" sname name + | None -> + Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname) + "%s has no field %s" sname name | Some i -> Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty) | Ast.Pindex (target, idx) -> let target = borrowed ctx target (fun () -> check ctx target) in @@ -3927,7 +3977,7 @@ and named_call ctx ~want loc name args = else if String.contains name '/' then unimplemented loc (Printf.sprintf "the call %s into an imported package" name) 4 - else fail loc "unknown function %s" name + else Loc.failk "check/unknown-function" loc "unknown function %s" name and is_cast name = Types.ikind_of_name name <> None || Types.fkind_of_name name <> None @@ -4006,9 +4056,16 @@ let collect env (decls : Ast.decl list) = match Ast.declared_name d with | None -> () | Some n -> - if Hashtbl.mem claimed n then - 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 @@ -4269,8 +4326,21 @@ let check_fn env (fn : Ast.fn) : Tast.fn = owner = fn.Ast.name } in List.iter2 (fun (p : Ast.field) ty -> - if List.mem_assoc p.Ast.fname ctx.scope then - 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 = @@ -4435,7 +4505,11 @@ let check_main env = expression typed at a REPL against the program the process is running — and it has to be this one rather than anything rebuilt from declarations, because [program] prepends the prelude and no accumulated AST contains it. *) -let program_with_env (decls : Ast.decl list) : Tast.program * env = +(* Separate entry points below rather than a flag on the one the session calls, + for the reason [Parse] gives at the same fork: [Loc.Errors] is a second + exception that the session and the daemon do not catch, so the guarantee + that they never see one should be structural and not a default argument. *) +let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in let decls = Parse.program (Prelude.forms ()) @ decls in (* Before anything is collected: every (declare-c ...) becomes an ordinary @@ -4443,18 +4517,34 @@ let program_with_env (decls : Ast.decl list) : Tast.program * env = flattening comes back to be compiled into the build. Nothing below this line knows the form exists. *) let decls, cshim = Shim.expand decls in + (* Pass one, and it stops at the first thing it refuses. That is not + laziness: every name, type and signature in the file comes from here, so a + declaration this pass could not make sense of leaves a hole that pass two + would report once per mention. A wrong signature is one error; the thirty + "unknown name" lines under it are not errors, they are the same one. + + Pass two is where the volume is, and it is where collecting pays. By the + time it runs every signature is sound, so a body that fails to check + cannot make the next body fail — which is what makes a declaration a + resync point that needs no resynchronising. *) collect env decls; check_finite env; - check_main env; - let 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. *) @@ -4478,7 +4568,19 @@ let program_with_env (decls : Ast.decl list) : Tast.program * env = globals; externs; fns; cshim }, env) -let program (decls : Ast.decl list) : Tast.program = fst (program_with_env decls) +(** The program and the environment, stopping at the first refusal. What a + session needs, and it raises [Loc.Error] and never [Loc.Errors]. *) +let program_with_env (decls : Ast.decl list) : Tast.program * env = + build_program ~keep_going:false decls + +let program (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:false decls) + +(** The same, reporting every declaration whose body it refuses rather than the + first. Raises [Loc.Errors], so only a caller prepared for a list should be + calling it. *) +let program_all (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:true decls) (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing 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 5589e73..750c8ee 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -1,19 +1,334 @@ (** Source locations. Every form carries one: error messages, the step debugger and nREPL's find-definition all need them, and retrofitting locations onto a - reader is far worse than carrying them from the start. *) + reader is far worse than carrying them from the start. + + A location is a *span*, not a point. The start is what [file:line:col] + prints and what every consumer that wants one place uses; the end is what + lets an error underline the thing it is about. A column number cannot draw + a squiggle and a span can, which is the whole reason the two extra fields + are here. + + The end is *exclusive* and defaults to the start, so a location nobody + widened is a zero-width span at a point and every old call site keeps its + old meaning. Only the reader knows where a form ends, so only the reader + fills these in; a location the checker invents for a node with no syntax + stays a point. *) type t = { - file : string; - 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; + (* The macro whose expansion produced whatever is at this position, if one + did. It rides on the location rather than on the form because the location + is the thing that already travels: [Expand.unmarshal] stamps the call + site onto every node a macro answers with, and that stamp goes on through + the AST and the typed IR untouched. Tagging it here means an error raised + anywhere downstream can say which macro it is really about, with no field + added to Form, to Ast or to Tast. *) + macro : string option; } -let make file line col = { file; line; col } -let unknown = { file = ""; line = 0; col = 0 } +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. *) +let upto (start : t) (stop : t) = + if + stop.file = start.file + && (stop.line > start.line + || (stop.line = start.line && stop.col > start.col)) + then { start with eline = stop.line; ecol = stop.col } + else start + +(** True when the span covers more than its first line. The underline is drawn + on the start line either way — a form that spans twenty lines is pointed + at, not boxed — so this is what tells the renderer to run the underline to + the end of that line rather than to [ecol]. *) +let multiline (t : t) = t.eline > t.line + +(** How many columns to underline on the start line, or [None] when the span + was never widened and there is nothing but a point to draw. *) +let width (t : t) = + if t.eline = t.line && t.ecol > t.col then Some (t.ecol - t.col) else None let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col -(** Raised by every stage of the frontend. *) -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 = + (* The location already knows whether it came out of a macro, so an error + does not have to be raised anywhere special to say so. An explicit + [expansion] still wins, for the one caller that knows better. *) + let expansion = + match expansion with + | Some _ as e -> e + | None -> (match loc.macro with Some m -> Some (m, loc) | None -> None) + in + sort_notes { kind; dloc = loc; dmsg = msg; notes; expansion } + +let raise_diag d = raise (Error (sort_notes d)) + +(** The plain refusal: a span and a reason, with the generic kind. Every call + site that existed before spans is one of these and says exactly what it + said. [failk] is the same thing with a kind, notes and an expansion. *) +let fail loc fmt = + Printf.ksprintf (fun msg -> raise_diag (diag loc msg)) fmt + +let failk ?notes ?expansion kind loc fmt = + Printf.ksprintf (fun msg -> raise_diag (diag ~kind ?notes ?expansion loc msg)) fmt + +(* ── Collecting ───────────────────────────────────────────────────── + + A sink holds what a pass found, so the pass can carry on to the next thing + rather than stop at the first. It is switched on by the caller and not by + the code that raises, which is what keeps the interactive path exactly as it + was: the daemon checks one form and wants one exception, so it asks for a + sink that is off, every [caught] re-raises, and nothing downstream ever sees + a list. + + A sink that is on is finished at a *phase* boundary and nowhere else. That + is the whole of the resynchronisation story and it is deliberately crude: + the hard part of recovery is not recording the error, it is not cascading + afterwards, and a phase run on a foundation the phase before it already + refused reports wreckage. Three real errors beat thirty of which + twenty-seven are consequences of the first. *) + +type sink = { on : bool; mutable found : diag list } + +let sink ~on = { on; found = [] } + +(** Run [f]. With the sink off this is [Some (f ())] and an error propagates as + it always did. With it on, an error is recorded and the answer is [None], + so the caller drops this one item and goes on to the next. *) +let caught s f = + if not s.on then Some (f ()) + else + match f () with + | x -> Some x + | exception Error d -> s.found <- d :: s.found; None + +let any s = s.found <> [] + +(** Raise everything found, in the order it was found, or return if the pass + was clean. *) +let finish s = + match List.rev s.found with [] -> () | ds -> raise (Errors ds) + +(* ── Reporting ────────────────────────────────────────────────────── + + The first line of every entry is exactly [file:line:col: message], which is + the GNU format Emacs's compilation-mode parses with no configuration. That + is the whole of the editor story: once more than one of these comes out, + [M-x compile] gives a clickable list and [next-error] walks it. Everything + below the first line is indented, and compilation-mode ignores indented + continuation lines, so the squiggle costs nothing there. + + A note gets its own [file:line:col: note: ...] entry rather than being + folded into the error's block, which is what gcc does and is the point of + notes having locations at all: the second place is somewhere [next-error] + can take you. + + Everything degrades to the first line alone. A location the checker invented + has line 0 and a file called [], the prelude and the REPL have + names that are not paths, and a file may have changed under us since it was + read — in every one of those the message still prints and nothing raises out + of the error printer, which would turn a diagnostic into a crash. *) + +let source_cache : (string, string array option) Hashtbl.t = Hashtbl.create 8 + +let lines_of file = + match Hashtbl.find_opt source_cache file with + | Some v -> v + | None -> + let v = + match open_in_bin file with + | exception _ -> None + | ic -> + Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () -> + match really_input_string ic (in_channel_length ic) with + | exception _ -> None + | s -> Some (Array.of_list (String.split_on_char '\n' s))) + in + Hashtbl.replace source_cache file v; + v + +let forget_sources () = Hashtbl.reset source_cache + +let source_line (t : t) = + if t.line <= 0 then None + else + match lines_of t.file with + | None -> None + | Some ls when t.line <= Array.length ls -> + let l = ls.(t.line - 1) in + (* A file written on Windows leaves the carriage return in the line, and + it would print as a stray column. *) + let n = String.length l in + Some (if n > 0 && l.[n - 1] = '\r' then String.sub l 0 (n - 1) else l) + | Some _ -> None + +(* The gutter is as wide as the widest line number printed, so the bars line + up. Four digits covers every file anyone will write by hand and the rest + simply gets a wider gutter. *) +let gutter n = String.length (string_of_int n) + +(** The source line with the span underlined beneath it, or [None] when there + is no source to show. Tabs in the prefix are copied into the underline + rather than counted as one column, which is the only way the caret lands + under the right character in a file that uses them. *) +let squiggle ?(mark = '^') (t : t) = + match source_line t with + | None -> None + | Some text -> + let n = String.length text in + let start = max 0 (min (t.col - 1) n) in + let stop = + if multiline t then n + else match width t with + | Some w -> min n (start + w) + | None -> min n (start + 1) + in + let stop = max stop (min n (start + 1)) in + let pad = Buffer.create 16 in + for i = 0 to start - 1 do + Buffer.add_char pad (if text.[i] = '\t' then '\t' else ' ') + done; + let bar = String.make (max 1 (stop - start)) mark in + let g = gutter t.line in + Some + (Printf.sprintf " %*d | %s\n %*s | %s%s" g t.line text g "" + (Buffer.contents pad) bar) + +let entry ?(mark = '^') ?(label = "") (t : t) msg = + let head = Printf.sprintf "%s: %s%s" (to_string t) label msg in + match squiggle ~mark t with + | None -> head + | Some s -> head ^ "\n" ^ s + +(** One diagnostic, rendered. The error, then its notes in source order, then + the macro call it was expanded from if it was. No trailing newline. *) +let report (d : diag) = + let d = sort_notes d in + let parts = ref [ entry d.dloc d.dmsg ] in + List.iter + (fun n -> + let mark = match n.nsev with Info -> '-' | Warning -> '~' | Err -> '^' in + parts := + entry ~mark ~label:(severity_str n.nsev ^ ": ") n.nloc n.nmsg :: !parts) + d.notes; + (match d.expansion with + | None -> () + | Some (name, at) -> + parts := + entry ~mark:'-' ~label:"note: " at + (Printf.sprintf "expanded from the macro %s" name) + :: !parts); + String.concat "\n" (List.rev !parts) + +(** Every diagnostic of a run, in source order, with a count. What a driver + prints when it finished the file rather than stopping at the first thing + it found. *) +let report_all (ds : diag list) = + (* Source order, with the placeless ones last. A diagnostic the checker + raised against [unknown] — a wrong [main] signature is the one that + happens — has line 0, and sorting on the number alone would put it at the + top of the list, above every error that can actually be clicked. It is a + real error and it is not anywhere, so it goes after the ones that are. *) + let placed (d : diag) = d.dloc.line > 0 in + let ds = + List.stable_sort + (fun a b -> + match (placed a, placed b) with + | true, false -> -1 + | false, true -> 1 + | _ -> before a.dloc b.dloc) + ds + in + let n = List.length ds in + String.concat "\n" (List.map report ds) + ^ Printf.sprintf "\n%d error%s" n (if n = 1 then "" else "s") 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 diff --git a/lib/parse.ml b/lib/parse.ml index 7990985..651136a 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 @@ -866,14 +866,41 @@ and variant (f : Form.t) : Ast.variant = unknown name, which is wrong but not silent. *) let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) -let program (forms : Form.t list) : Ast.decl list = +(* Two entry points and not one function with a flag, and the reason is the + daemon. [Loc.Errors] is a second exception, and the handlers in the session + and in the daemon name only [Loc.Error] — so a list reaching them would be + an unhandled exception and a dead session, which is the one thing the whole + dev loop exists to prevent. A flag on the function the session already calls + would put that one label away from happening. A separate name cannot: the + session's call site has to be edited by someone for its behaviour to change. + + [keep_going] asks for every bad declaration in the file rather than the + first. The resync point is a top-level form, and it is the only honest one + here: the reader already found where each declaration ends, so skipping a + bad one costs nothing and cannot lose its place. Inside a declaration there + is no such landmark, so one bad [defn] is one error. *) +let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list = (* Quasiquote first and always, because it is pure and needs nothing loaded: it is what turns a macro body into ordinary code, and the prelude's own macros have to parse in a process that has not built a macro module yet. Then expansion, which may need one. *) let forms = !expander (List.map Expand.quasiquote forms) in temps := 0; - List.map decl forms + let s = Loc.sink ~on:keep_going in + let decls = List.filter_map (fun f -> Loc.caught s (fun () -> decl f)) forms in + Loc.finish s; + decls + +(** One file, stopping at the first declaration it cannot parse. Raises + [Loc.Error], never [Loc.Errors]. *) +let program (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:false forms + +(** One file, reporting every declaration it cannot parse. Raises [Loc.Errors] + when there was more than nothing wrong, so only a caller prepared for a + list should be calling it. *) +let program_all (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:true forms (* Single-declaration entry point, for tests and the REPL. *) let decl (f : Form.t) : Ast.decl = diff --git a/lib/reader.ml b/lib/reader.ml index 7141a99..66b2ff0 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 = @@ -83,7 +89,7 @@ let read_string st = advance st; (* opening quote *) let buf = Buffer.create 16 in let rec go () = - if at_end st then Loc.fail loc "unterminated string" + if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string" else match peek st with | '"' -> advance st | '\\' -> @@ -94,18 +100,18 @@ let read_string st = (match c with | 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r' | '\\' -> '\\' | '"' -> '"' | '0' -> '\000' - | c -> Loc.fail loc "unknown string escape \\%c" c); + | c -> Loc.failk "reader/unknown-string-escape" loc "unknown string escape \\%c" c); go () | c -> advance st; Buffer.add_char buf c; go () in go (); - Form.make (Form.Str (Buffer.contents buf)) loc + spanned st loc (Form.Str (Buffer.contents buf)) (* \space \tab \newline \return \nul, or \ *) let read_byte st = let loc = here st in advance st; (* backslash *) - if at_end st then Loc.fail loc "expected a character after \\"; + if at_end st then Loc.failk "reader/incomplete-character" loc "expected a character after \\"; let first = peek st in advance st; let rest = take_while st (fun c -> not (is_delimiter c)) in @@ -117,9 +123,9 @@ let read_byte st = | "return" -> 13 | "nul" -> 0 | n when String.length n = 1 -> Char.code n.[0] - | n -> Loc.fail loc "unknown character literal \\%s" n + | n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n in - Form.make (Form.Byte code) loc + spanned st loc (Form.Byte code) (* A token that started with a digit, or with '-'/'+' followed by a digit. *) let read_number st = @@ -132,26 +138,30 @@ let read_number st = in if is_hex then match Int64.of_string_opt text with - | Some i -> Form.make (Form.Int i) loc - | None -> Loc.fail loc "malformed hex literal %s" text + | Some i -> spanned st loc (Form.Int i) + | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st)) + "malformed hex literal %s" text else if String.contains text '.' || String.contains text 'e' then match float_of_string_opt text with - | Some f -> Form.make (Form.Float f) loc - | None -> Loc.fail loc "malformed float literal %s" text + | Some f -> spanned st loc (Form.Float f) + | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st)) + "malformed float literal %s" text else match Int64.of_string_opt text with - | Some i -> Form.make (Form.Int i) loc - | None -> Loc.fail loc "malformed integer literal %s" text + | Some i -> spanned st loc (Form.Int i) + | None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st)) + "malformed integer literal %s" text let read_symbol_or_keyword st = let loc = here st in let text = take_while st (fun c -> not (is_delimiter c)) in - if text = "" then Loc.fail loc "unexpected character %C" (peek st); + if text = "" then Loc.failk "reader/unexpected-character" loc "unexpected character %C" (peek st); if text.[0] = ':' then begin - if String.length text = 1 then Loc.fail loc "empty keyword"; - Form.make (Form.Kw (String.sub text 1 (String.length text - 1))) loc + if String.length text = 1 then + Loc.failk "reader/empty-keyword" (Loc.upto loc (here st)) "empty keyword"; + spanned st loc (Form.Kw (String.sub text 1 (String.length text - 1))) end else - Form.make (Form.Sym text) loc + spanned st loc (Form.Sym text) (* ── Forms ─────────────────────────────────────────────────────────── *) @@ -170,9 +180,9 @@ let rec read_form st = skip_ignorable st; let loc = here st in match peek st with - | '\000' -> Loc.fail loc "unexpected end of input" + | '\000' -> Loc.failk "reader/unexpected-eof" loc "unexpected end of input" | '(' | '[' | '{' as open_c -> read_seq st open_c loc - | ')' | ']' | '}' as c -> Loc.fail loc "unbalanced %C" c + | ')' | ']' | '}' as c -> Loc.failk "reader/unbalanced" loc "unbalanced %C" c | '"' -> read_string st | '\\' -> read_byte st | '\'' -> read_sugar st loc "quote" @@ -182,7 +192,7 @@ let rec read_form st = if peek st = '@' then (advance st; read_wrapped st loc "unquote-splicing") else read_wrapped st loc "unquote" | '^' -> - Loc.fail loc "metadata (^) is not supported yet" + Loc.failk "reader/metadata" loc "metadata (^) is not supported yet" | c when is_digit c -> read_number st | ('-' | '+') when is_digit (peek2 st) -> read_number st @@ -213,7 +223,7 @@ and read_sugar st loc name = advance st; read_wrapped st loc name and read_wrapped st loc name = let inner = read_form st in - Form.make (Form.List [ Form.make (Form.Sym name) loc; inner ]) loc + spanned st loc (Form.List [ Form.make (Form.Sym name) loc; inner ]) and read_seq st open_c loc = advance st; @@ -224,15 +234,26 @@ and read_seq st open_c loc = sequence would try to read a form and find [)]. *) skip_ignorable st; if at_end st then - Loc.fail loc "unclosed %C, expected %C" open_c want + (* Two places, and the second is the one that is usually news. The error + is at the bracket that is still open, because that is where the fix + goes; the note is where the file ran out, because that is how far the + reader got believing the form was still being written. *) + Loc.failk "reader/unclosed" loc + ~notes:[ Loc.note (here st) "the input ends here, still inside it" ] + "unclosed %C, expected %C" open_c want else let c = peek st in if c = want then (advance st; List.rev acc) else if c = ')' || c = ']' || c = '}' then - Loc.fail (here st) "expected %C to close %C, found %C" want open_c c + (* The wrong closer is where the mistake reads, and the opener is what + makes it wrong. Neither alone says which bracket to change. *) + Loc.failk "reader/mismatched-closer" (here st) + ~notes:[ Loc.note loc (Printf.sprintf "%C is opened here" open_c) ] + "expected %C to close %C, found %C" want open_c c else go (read_form st :: acc) in - Form.make (wrap open_c (go [])) loc + let items = go [] in + spanned st loc (wrap open_c items) (** All top-level forms in a source string. *) let read_all ~file src = 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 15d2ead..1a4406f 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" @@ -1241,7 +1241,7 @@ let () = | () -> incr failures; Printf.printf "FAIL %s\n it was accepted\n" name - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> if not (contains m needle) then begin incr failures; Printf.printf "FAIL %s\n said: %S\n wanted: %S in it\n" @@ -1602,7 +1602,7 @@ ERR@7 unexpected token: not the kind the caller was reading name n end) needles - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> incr failures; Printf.printf "FAIL %s\n refused: %s\n" name m in @@ -1613,7 +1613,7 @@ ERR@7 unexpected token: not the kind the caller was reading | _ -> incr failures; Printf.printf "FAIL %s: accepted, and it should not have been\n" name - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> if not (contains m fragment) then begin incr failures; Printf.printf "FAIL %s\n reason: %S\n wanted to contain: %S\n" @@ -1944,6 +1944,41 @@ ERR@7 unexpected token: not the kind the caller was reading outputs ~opt:"-O0" "unless, now a prelude macro, -O0" "programs/macro-unless.flan" unless_out; + (* An error on code a macro produced says which macro, and it has to be + asserted through a real expansion: the tag is put on by [Macro] and + defaulted into the diagnostic by [Loc], and a unit test on either half + alone would pass with the other one broken. + + [clamp] with the wrong number of arguments expands into a call to a name + that does not exist, on purpose -- that is how a prelude macro reports a + misuse. So the checker refuses a name the author never wrote, which is + exactly the case the field exists for. *) + (let src = "(defn f [] i32 (clamp 1 2))\n(defn main [] i32 0)\n" in + match + Check.program (Parse.program (Reader.read_all ~file:"" src)) + with + | _ -> + incr failures; + print_endline "FAIL an error in an expansion is refused" + | exception Loc.Error d -> + (match d.Loc.expansion with + | Some (name, _) when name = "clamp" -> () + | Some (name, _) -> + incr failures; + Printf.printf "FAIL an error in an expansion names the wrong macro: %s\n" + name + | None -> + incr failures; + Printf.printf + "FAIL an error in an expansion names no macro\n error: %s\n" + d.Loc.dmsg); + (* And it reaches the printed report, which is the only part a reader + ever sees. *) + if not (contains (Loc.report d) "expanded from the macro clamp") then begin + incr failures; + print_endline "FAIL the report does not say which macro" + end); + (* The two ways expansion does not terminate, and they are different failures. A ring is a compile-order problem -- each body calls the other while the other is being compiled -- and there is no order, so it is @@ -2039,7 +2074,7 @@ ERR@7 unexpected token: not the kind the caller was reading | _ -> incr failures; Printf.printf "FAIL %s\n it was accepted\n" name - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> if not (contains m "needs a byte-level encoder that does not exist") then begin incr failures; @@ -2069,7 +2104,7 @@ ERR@7 unexpected token: not the kind the caller was reading (defn main [] i32 (match g A 0 (B x) x))"))) with | _ -> () - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> incr failures; Printf.printf "FAIL %s\n refused: %S\n" name m); diff --git a/test/test_flan.ml b/test/test_flan.ml index d040cea..ee61f04 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,9 +246,41 @@ let () = (match read ~file:"f.flan" "(f\n bad" with | _ -> check "unclosed reports opening loc" false - | exception Loc.Error (loc, _) -> + | exception Loc.Error { Loc.dloc = loc; _ } -> check "unclosed reports opening loc" (loc.line = 1 && loc.col = 1)); + (* ── Spans ───────────────────────────────────────────────────── + A location ends where the form ends, which is what an underline needs + and what a column number cannot give. Asserted on the width rather than + on the end column alone: a span that never got widened is zero wide, and + that is the failure mode worth catching — the field would exist, nothing + would fill it, and every squiggle would be one character long. *) + (match read ~file:"f.flan" "(foo bar)" with + | [ l ] -> + check "span covers the list" (Loc.width l.loc = Some 9); + (match l.Form.v with + | Form.List [ head; arg ] -> + check "span covers the head symbol" (Loc.width head.loc = Some 3); + check "span covers the argument" (Loc.width arg.loc = Some 3); + check "span starts at the symbol" (arg.loc.col = 6) + | _ -> check "span: two elements" false) + | _ -> check "span: one form" false); + + (match read ~file:"f.flan" "\"hi\" 42 :kw" with + | [ s; n; k ] -> + check "span covers a string with its quotes" (Loc.width s.loc = Some 4); + check "span covers a number" (Loc.width n.loc = Some 2); + check "span covers a keyword with its colon" (Loc.width k.loc = Some 3) + | _ -> check "span: three atoms" false); + + (* A form that runs over a line end has no width on its first line, and says + so rather than reporting a negative one. *) + (match read ~file:"f.flan" "(a\n b)" with + | [ l ] -> + check "multi-line span is flagged" (Loc.multiline l.loc); + check "multi-line span has no single-line width" (Loc.width l.loc = None) + | _ -> check "span: one multi-line form" false); + if !failures = 0 then print_endline "reader: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures; @@ -273,7 +305,7 @@ let parse_decl src = let parse_rejects ?needle name src = match read src |> Parse.program with | _ -> incr failures; Printf.printf "FAIL %s: expected a parse error\n" name - | exception Loc.Error (_, msg) -> + | exception Loc.Error { Loc.dmsg = msg; _ } -> (match needle with | Some n when not (contains msg n) -> incr failures; @@ -512,7 +544,7 @@ let () = (fun path -> match read_file path |> Parse.program with | _ -> () - | exception Loc.Error (loc, msg) -> + | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } -> incr failures; Printf.printf "FAIL %s does not parse: %s: %s\n" path (Loc.to_string loc) msg) @@ -603,7 +635,7 @@ let infers name src expected = name src got expected end | None -> incr failures; Printf.printf "FAIL %s: no probe\n" name) - | exception Loc.Error (loc, msg) -> + | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } -> incr failures; Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n" name src (Loc.to_string loc) msg @@ -615,7 +647,7 @@ let infers name src expected = let accepts name src = match checked src with | _ -> () - | exception Loc.Error (loc, msg) -> + | exception Loc.Error { Loc.dloc = loc; dmsg = msg; _ } -> incr failures; Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n" name src (Loc.to_string loc) msg @@ -631,7 +663,7 @@ let rejects_check name ?needle src = | _ -> incr failures; Printf.printf "FAIL %s: expected a type error\n src: %s\n" name src - | exception Loc.Error (_, msg) -> + | exception Loc.Error { Loc.dmsg = msg; _ } -> (match needle with | Some n when not @@ -1610,9 +1642,121 @@ let () = check "a prelude macro calling a macro is refused by name" (match Macro.reduce ring with | _ -> false - | exception Loc.Error (_, m) -> + | exception Loc.Error { Loc.dmsg = m; _ } -> contains m "the prelude macro n calls a macro"); + (* ── Diagnostics: kind, notes, and more than one ─────────────── + The house rule is that a test asserts the *reason* a thing is refused. A + kind is that assertion made stable: the message may be reworded and the + row still holds, and a row that matches on a kind is saying something a + substring match on prose could only approximate. The messages themselves + are unchanged, so every existing needle still means what it meant. *) + + let diag_of src = + match checked src with + | _ -> None + | exception Loc.Error d -> Some d + in + let kind_is name src k = + check name (match diag_of src with Some d -> d.Loc.kind = k | None -> false) + in + kind_is "unknown name has a kind" + "(defn f [] i32 nope)" "check/unknown-name"; + kind_is "unknown field has a kind" + "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" "check/unknown-field"; + kind_is "a name defined twice has a kind" + "(defn f [] i32 1)\n(defn f [] i32 2)" "check/defined-twice"; + + (* The note is the half a location and a string could never carry: the + *other* place, with its own span and its own explanation. *) + (match diag_of "(defn f [] i32 1)\n(defn f [] i32 2)" with + | Some d -> + check "defined twice points at the second" (d.Loc.dloc.Loc.line = 2); + (match d.Loc.notes with + | [ n ] -> + check "and notes the first" (n.Loc.nloc.Loc.line = 1); + check "and says what it is" (contains n.Loc.nmsg "already defined") + | ns -> check "defined twice has one note" (ns = [])) + | None -> check "defined twice is refused" false); + + (match diag_of "(defstruct S [a i32])\n(defn f [s S] i32 (.b s))" with + | Some d -> + (match d.Loc.notes with + | [ n ] -> + check "an unknown field notes the declaration" + (n.Loc.nloc.Loc.line = 1); + check "and lists the fields there" (contains n.Loc.nmsg "with a") + | _ -> check "an unknown field has one note" false) + | None -> check "an unknown field is refused" false); + + (* The reader's own two-place error. The bracket that is open is the error + and the end of input is the note, because the fix goes at the first and + the surprise is at the second. *) + (match read "(f\n bad" with + | _ -> check "unclosed is refused" false + | exception Loc.Error d -> + check "unclosed has a kind" (d.Loc.kind = "reader/unclosed"); + check "unclosed notes where the input ran out" + (match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.line = 2 | _ -> false)); + + (match read "(f x]" with + | _ -> check "a mismatched closer is refused" false + | exception Loc.Error d -> + check "a mismatched closer has a kind" + (d.Loc.kind = "reader/mismatched-closer"); + check "and notes the opener" + (match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.col = 1 | _ -> false)); + + (* More than one per run, which is the point of the whole batch. Three bad + bodies, three diagnostics, and the count is exact: a checker that reported + the first and a checker that reported thirty pieces of wreckage would both + fail this row. *) + (match + Check.program_all + (Parse.program_all + (read "(defn a [] i32 nope1)\n\ + (defn b [] i32 nope2)\n\ + (defn c [] i32 nope3)\n")) + with + | _ -> check "three bad bodies are refused" false + | exception Loc.Errors ds -> + check "three bad bodies give three errors" (List.length ds = 3); + check "and they are in source order" + (List.map (fun (d : Loc.diag) -> d.Loc.dloc.Loc.line) ds = [ 1; 2; 3 ])); + + (* The parser resynchronises on a top-level form, so two bad declarations are + two errors rather than one. *) + (match Parse.program_all (read "(defn a)\n(defn b)\n") with + | _ -> check "two bad declarations are refused" false + | exception Loc.Errors ds -> + check "two bad declarations give two errors" (List.length ds = 2)); + + (* [Check.program] is a different function from [Check.program_all], and + that is the guarantee: the session calls this one, it raises one + diagnostic, and nobody can turn it into a list by passing a label. *) + (match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\ + (defn b [] i32 nope2)\n")) with + | _ -> check "Check.program still refuses" false + | exception Loc.Errors _ -> + check "Check.program never answers with a list" false + | exception Loc.Error _ -> ()); + + (* The first line of a report is exactly the GNU format compilation-mode + parses, and the squiggle is on an indented line under it, which that mode + ignores. Both halves are load-bearing and neither is visible from the + message alone. *) + (match diag_of "(defn f [] i32 nope)" with + | Some d -> + let lines = String.split_on_char '\n' (Loc.report d) in + (match lines with + | head :: rest -> + check "the first line is file:line:col: message" + (head = Loc.to_string d.Loc.dloc ^ ": " ^ d.Loc.dmsg); + check "and the rest is indented" + (List.for_all (fun l -> l = "" || l.[0] = ' ') rest) + | [] -> check "a report has a first line" false) + | None -> check "a report needs a diagnostic" false); + (* ── The acceptance program checks end to end ──────────────────── *) accepts "calc-me.flan type checks" (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all); 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