JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 08:14:20 +07:00
commit 6891592d79
14 changed files with 961 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
BUILT.md
View File

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

76
NEXT.md
View File

@ -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

29
bin/main.ml
View File

@ -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 =

162
lib/check.ml
View File

@ -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

6
lib/dev.ml
View File

@ -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 ()

2
lib/load.ml
View File

@ -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. *)

333
lib/loc.ml
View File

@ -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 = "<unknown>"; line = 0; col = 0 }
let make file line col =
{ file; line; col; eline = line; ecol = col; macro = None }
let unknown = make "<unknown>" 0 0
(** Tag a location as coming out of [name]'s expansion, unless it already names
a macro. Already-tagged wins because the tag is applied outermost-last: the
macro the author actually wrote is the one worth naming, not whatever it
expanded into on the way. *)
let from_macro name (t : t) =
match t.macro with None -> { t with macro = Some name } | Some _ -> t
(** [upto start stop] is [start] widened to end where [stop] begins. A [stop]
that is not after [start], or is in another file, leaves it alone: a span
that runs backwards would draw nonsense. *)
let upto (start : t) (stop : t) =
if
stop.file = start.file
&& (stop.line > start.line
|| (stop.line = start.line && stop.col > start.col))
then { start with eline = stop.line; ecol = stop.col }
else start
(** True when the span covers more than its first line. The underline is drawn
on the start line either way — a form that spans twenty lines is pointed
at, not boxed — so this is what tells the renderer to run the underline to
the end of that line rather than to [ecol]. *)
let multiline (t : t) = t.eline > t.line
(** How many columns to underline on the start line, or [None] when the span
was never widened and there is nothing but a point to draw. *)
let width (t : t) =
if t.eline = t.line && t.ecol > t.col then Some (t.ecol - t.col) else None
let to_string t = Printf.sprintf "%s:%d:%d" t.file t.line t.col
(** Raised by every stage of the frontend. *)
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 [<unknown>], the prelude and the REPL have
names that are not paths, and a file may have changed under us since it was
read — in every one of those the message still prints and nothing raises out
of the error printer, which would turn a diagnostic into a crash. *)
let source_cache : (string, string array option) Hashtbl.t = Hashtbl.create 8
let lines_of file =
match Hashtbl.find_opt source_cache file with
| Some v -> v
| None ->
let v =
match open_in_bin file with
| exception _ -> None
| ic ->
Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () ->
match really_input_string ic (in_channel_length ic) with
| exception _ -> None
| s -> Some (Array.of_list (String.split_on_char '\n' s)))
in
Hashtbl.replace source_cache file v;
v
let forget_sources () = Hashtbl.reset source_cache
let source_line (t : t) =
if t.line <= 0 then None
else
match lines_of t.file with
| None -> None
| Some ls when t.line <= Array.length ls ->
let l = ls.(t.line - 1) in
(* A file written on Windows leaves the carriage return in the line, and
it would print as a stray column. *)
let n = String.length l in
Some (if n > 0 && l.[n - 1] = '\r' then String.sub l 0 (n - 1) else l)
| Some _ -> None
(* The gutter is as wide as the widest line number printed, so the bars line
up. Four digits covers every file anyone will write by hand and the rest
simply gets a wider gutter. *)
let gutter n = String.length (string_of_int n)
(** The source line with the span underlined beneath it, or [None] when there
is no source to show. Tabs in the prefix are copied into the underline
rather than counted as one column, which is the only way the caret lands
under the right character in a file that uses them. *)
let squiggle ?(mark = '^') (t : t) =
match source_line t with
| None -> None
| Some text ->
let n = String.length text in
let start = max 0 (min (t.col - 1) n) in
let stop =
if multiline t then n
else match width t with
| Some w -> min n (start + w)
| None -> min n (start + 1)
in
let stop = max stop (min n (start + 1)) in
let pad = Buffer.create 16 in
for i = 0 to start - 1 do
Buffer.add_char pad (if text.[i] = '\t' then '\t' else ' ')
done;
let bar = String.make (max 1 (stop - start)) mark in
let g = gutter t.line in
Some
(Printf.sprintf " %*d | %s\n %*s | %s%s" g t.line text g ""
(Buffer.contents pad) bar)
let entry ?(mark = '^') ?(label = "") (t : t) msg =
let head = Printf.sprintf "%s: %s%s" (to_string t) label msg in
match squiggle ~mark t with
| None -> head
| Some s -> head ^ "\n" ^ s
(** One diagnostic, rendered. The error, then its notes in source order, then
the macro call it was expanded from if it was. No trailing newline. *)
let report (d : diag) =
let d = sort_notes d in
let parts = ref [ entry d.dloc d.dmsg ] in
List.iter
(fun n ->
let mark = match n.nsev with Info -> '-' | Warning -> '~' | Err -> '^' in
parts :=
entry ~mark ~label:(severity_str n.nsev ^ ": ") n.nloc n.nmsg :: !parts)
d.notes;
(match d.expansion with
| None -> ()
| Some (name, at) ->
parts :=
entry ~mark:'-' ~label:"note: " at
(Printf.sprintf "expanded from the macro %s" name)
:: !parts);
String.concat "\n" (List.rev !parts)
(** Every diagnostic of a run, in source order, with a count. What a driver
prints when it finished the file rather than stopping at the first thing
it found. *)
let report_all (ds : diag list) =
(* Source order, with the placeless ones last. A diagnostic the checker
raised against [unknown] — a wrong [main] signature is the one that
happens — has line 0, and sorting on the number alone would put it at the
top of the list, above every error that can actually be clicked. It is a
real error and it is not anywhere, so it goes after the ones that are. *)
let placed (d : diag) = d.dloc.line > 0 in
let ds =
List.stable_sort
(fun a b ->
match (placed a, placed b) with
| true, false -> -1
| false, true -> 1
| _ -> before a.dloc b.dloc)
ds
in
let n = List.length ds in
String.concat "\n" (List.map report ds)
^ Printf.sprintf "\n%d error%s" n (if n = 1 then "" else "s")

11
lib/macro.ml
View File

@ -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

33
lib/parse.ml
View File

@ -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 =

67
lib/reader.ml
View File

@ -39,6 +39,12 @@ type state = {
let of_string ~file src = { src; file; pos = 0; line = 1; col = 1 }
let here st = Loc.make st.file st.line st.col
(* A form's location is the span it occupies, so every reader below takes the
location it started at and closes it where the cursor now is. Doing it here,
in the one place that knows both ends, is why nothing above [Reader] has to
know a span exists. *)
let spanned st loc v = Form.make v (Loc.upto loc (here st))
let at_end st = st.pos >= String.length st.src
let peek st = if at_end st then '\000' else st.src.[st.pos]
let peek2 st =
@ -83,7 +89,7 @@ let read_string st =
advance st; (* opening quote *)
let buf = Buffer.create 16 in
let rec go () =
if at_end st then Loc.fail loc "unterminated string"
if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string"
else match peek st with
| '"' -> advance st
| '\\' ->
@ -94,18 +100,18 @@ let read_string st =
(match c with
| 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r'
| '\\' -> '\\' | '"' -> '"' | '0' -> '\000'
| c -> Loc.fail loc "unknown string escape \\%c" c);
| c -> Loc.failk "reader/unknown-string-escape" loc "unknown string escape \\%c" c);
go ()
| c -> advance st; Buffer.add_char buf c; go ()
in
go ();
Form.make (Form.Str (Buffer.contents buf)) loc
spanned st loc (Form.Str (Buffer.contents buf))
(* \space \tab \newline \return \nul, or \<any single char> *)
let read_byte st =
let loc = here st in
advance st; (* backslash *)
if at_end st then Loc.fail loc "expected a character after \\";
if at_end st then Loc.failk "reader/incomplete-character" loc "expected a character after \\";
let first = peek st in
advance st;
let rest = take_while st (fun c -> not (is_delimiter c)) in
@ -117,9 +123,9 @@ let read_byte st =
| "return" -> 13
| "nul" -> 0
| n when String.length n = 1 -> Char.code n.[0]
| n -> Loc.fail loc "unknown character literal \\%s" n
| n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n
in
Form.make (Form.Byte code) loc
spanned st loc (Form.Byte code)
(* A token that started with a digit, or with '-'/'+' followed by a digit. *)
let read_number st =
@ -132,26 +138,30 @@ let read_number st =
in
if is_hex then
match Int64.of_string_opt text with
| Some i -> Form.make (Form.Int i) loc
| 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 =

6
lib/session.ml
View File

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

47
test/test_acceptance.ml
View File

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

162
test/test_flan.ml
View File

@ -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);

18
test/test_session.ml
View File

@ -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