diff --git a/FIX.org b/FIX.org index 3d0e193..fb8b629 100644 --- a/FIX.org +++ b/FIX.org @@ -1978,3 +1978,66 @@ message at a *new* site — check_fn's empty-body refusal — and rewrote none. parse.ml edits are structural: a dropped guard in ~when~, a dropped guard in ~fn~, a new arm at the top of ~dmap~. Expect a rebase, not a conflict of intent. + +* The diagnostics pass, 2026-09-20 + +Worked from ~docs/DIAGNOSTICS-AUDIT.md~, which is tracked as of this lane's +first commit. Graded against the contract the audit sets out: show the code +with the caret, say what was understood, say what conflicts, name the fix. + +** Reached +Worst-20 ranks 1, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, +and the runtime half of 2. All four defvar follow-ups. Two from the author's +dogfooding notes in DISCUSS.org: the foreign-spelling list, which answers +~int~ with ~i32~ instead of a lecture about type variables, and the +two-element ~defconst~ whose bracketed type read as an array literal. + +** Not reached, each with the reason + +*** Rank 8: ~unhandled Boom~ has no location +Not a copy of the dyn-trap work, and the difference is the calling +convention. ~flan_error~ takes five integer arguments — the type id, the +condition, the channel, and the name as ptr+len — which is rdi through r8. +A ~(loc, loclen)~ pair makes seven, past x86-64's six argument registers, so +~lib/x86.ml~ would need stack-argument passing at a call site whose own +comment two hundred lines up says "the channel lands in r9 and the register +file is exactly full". The dyn entry points took the pair without any of +that because none of them was near the limit. + +The rest of rank 8 — the condition's field values, and the handlers that +were in scope — is separate work again and has no ABI question in it. + +The audit's gap 4 names a dev-side half of this: ~flan_trap_hook~ hands +control to a session that is in-process with the compiler and *can* read the +source, so a real caret at runtime belongs in ~lib/dev.ml~. That file is +another lane's and the audit already wrote it up as a hand-off. + +*** Rank 20: the fn-literal arity message +Re-read and judged already satisfying. The audit asks it to name the +parameter list it was measured against; it prints the whole ~(Fn [T ...] R)~, +which is that list. Left alone rather than churned. + +*** ~trap_oom~ in flan_dyn.c +The other three trap printers took the location pair. This one is reached +from ~gc_alloc~, which has no site to be given: every allocation path in the +file would have had to carry one for a sentence that is about the host +refusing memory rather than about the program. ~trap_range~ has the pair and +every caller passes NULL, so giving ~at~, ~set-at~ and ~push~ a site later is +a call-site change and not another round of signature churn. + +*** The audit's structural gaps 3, 5 and 6 +Printing the stable ~kind~ at the end of the first line, the +"understood / conflicted" clause order as a writing rule, and non-cascading +multiple errors through ~Loc.sink~. Each needs a decision from the author +rather than work, which is what the audit says about them too. + +** Two behaviour changes, not only wording +~(defn idx [v i] dyn v)~ was *refused* and now compiles as two dyn +parameters. The rule is the digits: this language sizes its machine types in +the name, so a typo keeps them — ~f65~, ~i33~ — and a parameter called ~i~ or +~n~ has none. ~pair_params~'s own comment says that is what the feature is. + +A ~defn~ whose name is a builtin's is still not refused. The builtin still +wins every call and the definition is still unreachable; what changed is that +the arity message says so and notes the definition. Refusing the shadowing is +a language decision and was left to the author. diff --git a/docs/DIAGNOSTICS-AUDIT.md b/docs/DIAGNOSTICS-AUDIT.md new file mode 100644 index 0000000..d1c138b --- /dev/null +++ b/docs/DIAGNOSTICS-AUDIT.md @@ -0,0 +1,225 @@ +# Diagnostics audit — Flan against Elm + +Read-only audit, 2026-09-20. Feeds the fix pass that starts once the two live +lanes merge. Untracked on purpose: this is a worklist, not a spec. + +## The contract being graded against + +Elm's, plus this repo's own two additions: + +- **(S) Show / locate** — the exact code, a caret, at the *most specific* span. +- **(U) Understood vs conflicted** — say what the compiler took the code to + mean, and what that collides with. +- **(F) Fix by name** — name the thing to write instead, not the category. +- **(R) Register** — plain language. FIX.org's literary voice is banned here. + +Grades are per-dimension letters. A = Elm-class, B = good with one gap, +C = states the fact and stops, D = misleading or actively unhelpful. + +## The machinery that already exists (lib/loc.ml) + +Worth stating up front, because most of the worklist below is *underuse*, not +absence. + +- Spans, not points (`Loc.t` carries `eline`/`ecol`), and `squiggle` draws a + multi-column underline from them. +- **Secondary notes with their own locations and severities** (`Loc.note`, + rendered by `report` as their own `file:line:col: info:` entry, marked `-` + rather than `^`, sorted into source order). This is Elm's "this here… but + that there" and it is fully built. +- `kind` — a stable id per diagnostic (`"check/unknown-field"`), deliberately + never printed. +- `expansion` — names the macro a form came out of, automatically, off the + location. +- GNU `file:line:col:` first line, so `M-x compile` and `next-error` work. + +What it does **not** have: any notion of "expected because of *that* +signature" beyond a free-form note; anything a runtime trap can use (the +runtime has only preformatted loc strings, no access to source text). + +--- + +## The worst 20, ranked by (badness × how often a user hits it) + +| # | Message | Site | Trigger (one-liner) | S | U | F | R | Fix direction | +|---|---------|------|---------------------|---|---|---|---|---------------| +| 1 | `unknown name p.x` | check.ml:2732, 4046 | `(defstruct P [x i32])` then `p.x` anywhere | B | D | D | C | The dot-infix habit from C/Go/Odin. The checker can see the head `p` is bound and is a struct with field `x` — split on `.`, and say "field access is written `(.x p)`". The repo's own comment in examples/core-2d-camera.flan:20 writes `camera.rotation` in prose while the code is `(.rotation camera)`, so the author trips it too. | +| 2 | `dyn +: int and text, and it takes two numbers — (+ 3 "hi")` | flan_dyn.c:724 (`trap2`), :734 (`trap1`), :746 (`trap_range`), :814 (`trap_oom`) | `(defn add [x y] dyn (+ x y))` + `(add 3 "hi")`, then `flan run` | D | B | D | B | **No location at all** — no file, no line, nothing. In a dynamic-first language these *are* the type errors. flan_rt.c's bounds and arith traps already take an emitter-threaded `(loc, loclen)` pair, so the ABI precedent exists; the dyn entry points simply were never given one. Highest-leverage runtime fix. | +| 3 | `expected i32, found string` | check.ml:1866 (`expect`), 6292 (call args) | `(defn add [a i32 b i32] i32 …)` + `(add 1 "two")` | B | C | D | A | The most-hit message in the compiler. Caret is right; it never says *which* argument of *which* function, and never points at the parameter that wanted it. Elm's whole hallmark. `Loc.note` on the `Ast.field`'s `floc` is a five-line change: "the 2nd argument of `add`" + "`b` is declared `i32` here". | +| 4 | `unknown function prinltn` / `unknown name n` | check.ml:6259, 2732 | `(prinltn "hi")` | B | C | D | B | No did-you-mean, although `near_miss` (check.ml:670) is written, tested and wired — to **types only**. Point it at `env.fns`, `env.globals` and the local scope. Cheapest structural win on the list. | +| 5 | `expected bool, found i32` | check.ml:1866 via `check_truthy` (3596) | `(let [x 1] (if x …))` | A | C | D | A | Caret is exactly right (the `check_truthy` loc work paid off). But the message never states Flan's truthiness rule — bool or dyn, nothing else — and never names the fix (`(not= x 0)`). Special-case the condition position. | +| 6 | `binding 5 has no value — let takes name/value pairs` | parse.ml:670 | `(let [x i32 5] …)` | C | D | D | B | A type annotation in `let` is the single most natural thing for someone arriving from a typed language, and `let` has none. The message reads as if the user miscounted. Detect "middle form names a type" and say so: "`let` bindings take no type annotation — write `[x 5]`". | +| 7 | `get takes 2 arguments, given 1` against the **user's own** `(defn get [p P] …)` | check.ml:5296 (builtin dispatch) + 6233 | `(defn get [p P] i32 …)` + `(get p)` | D | D | D | B | A user defn whose name collides with a builtin is silently shadowed, and then the arity refusal is measured against the *builtin*, pointing at the user's call. Either refuse the shadowing definition at its `dloc` with a note, or report the arity against the definition the user can see. | +| 8 | `unhandled Boom` | flan_rt.c:646 | `(defstruct Boom [why i32])` + `(error (Boom {.why 7}))`, `flan run` | D | C | D | B | Three words. No location (not even the `error` site, which the emitter knows), no field values, no list of the handlers that were in scope. The condition system is a headline feature and this is its failure mode. | +| 9 | `the collection nosuch: is a directory named nosuch somewhere above /…/. , and there is none` | load.ml:120 | `(import zz "nosuch:thing")` | B | C | C | D | Reads as an assertion immediately contradicted. Also emits a bare `/.` on the path. Rewrite as a plain statement of the search ("no directory named `nosuch` between here and the root") and list what collections *were* found. | +| 10 | `and`'s last operand gets the previous operand's caret | parse.ml `shortcircuit`, via check.ml:3632 | `(println (and true true (vec-new i32)))` | D | B | C | A | Already diagnosed in FIX.org:1036 with three rejected fixes; the accepted one — `check_if` preferring the arm that is not a compiler temp when choosing which to blame — is a check.ml change nobody owned. This pass owns check.ml. | +| 11 | `unterminated string` | reader.ml:92 | `(println "oops` | C | C | C | A | Caret is one column on the opening quote, and there is **no** "the input ends here" note — unlike `reader/unclosed` (241) and `reader/mismatched-closer` (250), which both have one. Copy their shape. | +| 12 | `unknown type i — did you mean i8? A parameter with no type is dyn, so this would otherwise be read as a second parameter called i` | check.ml:850 | `(defn idx [v i] dyn …)` | A | B | C | C | Locates and explains well, but the did-you-mean fires on a *lowercase* name the user plainly meant as a parameter, so the suggestion is a false accusation. Suppress `near_miss` when the name is lowercase and in a parameter vector; lead with the dyn-parameter reading instead. | +| 13 | `expected a type, found 1. This is the return type, which every defn states -- a function that returns nothing writes ()` | parse.ml:1156 | `(defn f [x i32] (+ x 1))` | C | B | B | C | Says the fix, which is good. Two warts: the caret lands on the `1` deep inside the body rather than on the position where the return type belongs; and the literal `--` where the house uses `—` everywhere else. | +| 14 | `f64 is not a struct, so it has no fields` | check.ml:4028 | `(match s (Circle c) (.r c))` — single-field case binds the payload directly | B | C | D | A | The user wrote what looks like a destructuring pattern and got a type fact. Say what the pattern bound (`c` is the payload, an `f64`) and that the field is already in hand. | +| 15 | `% is a constant` | check.ml:4043 | `(defconst k 3)` + `(set k 4)` | A | C | D | A | Four words. Needs a `Loc.note` at the `defconst` and the named fix (`defvar`). `no_container_defconst` (7447) already shows how the house writes this well — imitate it. | +| 16 | `% is a parameter, and parameters are not assignable places (spec-memory.md) — bind a local with let` | check.ml:4037 | `(defn f [x i32] i32 (set x 1) x)` | A | B | B | C | Names the fix. Register wart: a diagnostic should not cite a spec filename at the user; put the rule in words and drop `(spec-memory.md)`. Same for `(plan.org, Types)` at 4609/4614 and `(see plan.org)` at 423. | +| 17 | `% is not implemented yet — milestone %d (see plan.org)` | check.ml:423 (`unimplemented`), used widely | `(Result i32 string)` in a type position | B | B | D | D | Sends the user to a planning document. Say what is missing in one clause and what to write in the meantime, or nothing. | +| 18 | `% takes numbers, found string` | check.ml:4219 (`binary`) | `(+ "a" "b")` | C | B | C | A | Caret covers the whole form rather than the offending operand — the exact "whole form vs operand" regression class this repo already fixed once in `check_truthy`. The operand's `Tast.eloc` is right there. Also: no mention of `str-cat`/the concatenation route, which is what the user wanted. | +| 19 | `expanding this declaration produced %d of them` / `expanding this expression produced %d forms, and an expression is one` | parse.ml:1541, 1569 | a `defmacro` returning two forms | B | C | D | C | "of them" has no antecedent. The `expansion` field on the diagnostic can name the macro automatically; use it, and suggest `do`. | +| 20 | `this fn has %d parameters and %s was wanted here` / `nothing here says what this fn's parameters are` | check.ml:2801, 2809 | passing an `fn` literal where no signature is in view | B | B | C | A | Correct and readable; the arity one should note the parameter list it was measured against, which is the one thing the reader cannot see from the caret. | + +### Also seen, not ranked + +- `an index is an i32, and %s is wider — write (i32 …), because …` (4113) is + **fine** — S/U/F/R ≈ A/A/A/B, listed only so the fix pass does not touch it. +- The `--warn-memory` / `check/no-gc` sites (8566, 8723) are warnings rather + than refusals and were not exercised; they build `Loc.diag` directly and + carry no notes. + +--- + +## The house's best — imitate these, not just Elm + +These are internal precedent and they already satisfy the contract. The fix +pass should copy **their shape**, so the corpus converges on one voice. + +**1. Unknown field, with the declaration shown.** check.ml:3706 / 2433 / +3793, via `declared_note` (169). This is the model. + +``` +v6.flan:3:23: P has no field z + 3 | (let [p (P {.x 1 .z 9})] (println (.x p)))) + | ^ +v6.flan:1:1: info: P is declared here, with x + 1 | (defstruct P [x i32]) + | --------------------- +``` + +Primary span on the exact offending key; secondary span on the declaration; +the available names enumerated. All four dimensions, in five lines. + +**2. Non-exhaustive match.** check.ml:3983. + +``` +w4.flan:3:3: this match is not exhaustive — Shape.Tri has no arm. Add it, or a _ arm for the rest + 3 | (match s + | ^^^^^^^^ +w4.flan:1:1: info: Shape is declared here, with Circle, Square, Tri +``` + +Names the missing case *and* both fixes, with the declaration alongside. +Elm-class. + +**3. The defconst pair**, landed 2026-09-20. `const_defconst_init` (7527) +and `no_container_defconst` (7447). No secondary span, but the prose does the +whole contract: what was understood ("the constant `n` is computed"), what it +conflicts with ("a defconst is what the linker writes into the image and has +nowhere to run"), and two named ways out (`defvar`, or a folded literal). The +best *prose-only* message in the tree. + +**4. The dyn view-lifetime refusal.** `view_not_permanent` (1570). Explains +the rule, gives the one shape that does work (`defvar g …`), and enumerates +what is refused. Borderline long — it is the closest thing in the tree to the +banned essay register, and a fix pass should cut it by a third rather than +lengthen anything toward it. + +**5. Reader's unclosed / mismatched-closer.** reader.ml:241, 250. The only +two-span diagnostics outside check.ml, and both are right: + +``` +u4.flan:2:25: expected ')' to close '(', found ']' +u4.flan:2:12: info: '(' is opened here +``` + +**6. `flan_arith_fail`'s overflow sentence** (flan_rt.c:911). A runtime trap +that explains *why* one pair of operands overflows a division. Good register, +good detail — it just lacks nothing except company. + +--- + +## Structural gaps — things Elm does that no Flan message does + +**1. Two-span "this here… but that there" as a habit, not an exception.** +*Not absent — underused.* `Loc.note` is fully built and rendered, and roughly +eight of ~250 sites use it (`check/duplicate-field`, `check/unknown-field`, +`check/defined-twice`, `check/duplicate-parameter`, +`parse/enum-autoincrement-collision`, `reader/unclosed`, +`reader/mismatched-closer`, `check/non-exhaustive-match`). **Feasible today, +no machinery needed** — the gap is that `expect` (1866) and the call-argument +path (6292) don't have the wanting-side location threaded to them. `Ast.field` +already carries `floc`; the defn record is reachable from the call site. This +is the single highest-value structural change and it is plumbing, not design. + +**2. Did-you-mean on anything but types.** `near_miss` (670) is a real +one-edit matcher with a real candidate set, wired at exactly one call site +(771). **Feasible today**: the candidate sets for functions, globals and +locals are all in `ctx.env` / the scope stack at the raise points +(check.ml:6259, 2732, 4046). Field names are already gathered by +`declared_note`, so field-typo suggestions are nearly free too. + +**3. Error titles / anchors / doc links.** Elm prints `-- TYPE MISMATCH ---` +and links a hint page. Flan has the ingredient — every diagnostic carries a +stable `kind` — and loc.ml:109 says explicitly that it is "never printed as +the reason". **Feasible today** at zero cost: print it as a trailing +`[check/unknown-field]` or route it to a docs anchor. Needs a decision, not +work. (Caveat: the first line is load-bearing for compilation-mode, so the id +belongs at the end of the line or on an indented continuation.) + +**4. Any caret at all at runtime.** Runtime traps carry a preformatted +`file:line:col` string and nothing else — flan_rt.c has no access to the +source text, and flan_dyn.c has not even the string. **Partly feasible**: the +`flan_trap_hook` (flan_rt.c:598) already hands control to the dev session, +which *is* in-process with the compiler and can read the file. Rendering a +squiggle there is the natural home — but dev.ml belongs to another lane, so +this is a hand-off, not a row in this pass. The cheap half — threading a loc +into flan_dyn.c's four trap functions — is entirely within this pass. + +**5. "What I understood" as structure rather than prose.** No message in the +tree separates the two halves the way Elm's body does ("This function expects +… / But you gave it …"). The good ones (defconst, view-lifetime) achieve it +with a paragraph. **Feasible as convention**, not machinery: the `diag` +record has `dmsg` plus notes and nothing between, so the shape would have to +be a writing rule — "first clause is what was read, second clause is the +collision, last clause names the fix" — enforced by review rather than types. + +**6. Multiple errors without cascade.** `Loc.sink` exists and finishes at +phase boundaries only, which loc.ml:178 admits is "deliberately crude". Not +graded here (no program was written to exercise cascade), but it is the +remaining Elm behaviour with machinery that only half exists. + +--- + +## Register notes for the fix pass + +- **Never cite a repo file at the user.** `(spec-memory.md)`, `(plan.org, + Types)`, `(see plan.org)` appear in at least six messages. Say the rule. +- **One dash convention.** parse.ml:1156 uses `--`; every other message uses + `—`. +- **"%s of them" / "this one"** — pronouns with no antecedent once the + message is read cold. parse.ml:1541 is the clearest case. +- **Length.** The tree's long messages are mostly *earning* their length + (defconst, runaway-instantiation, predicate-not-carried). The one to watch + is `view_not_permanent`, which is a paragraph with a subordinate clause + nested three deep. The rule the repo wants — plain language, no essay + register — bites there and nowhere else so far. + +--- + +## Coverage — honest statement + +- **Harvested**: every `Loc.fail` / `Loc.failk` / `Loc.diag` / `Loc.note` + call site in lib/check.ml, lib/parse.ml, lib/reader.ml and lib/load.ml — + roughly 250 sites — plus every `fprintf(stderr, …)` trap in + runtime/flan_rt.c and runtime/flan_dyn.c. +- **Rendered by hand**: about 30 messages, by writing the triggering program + and running `_build/default/bin/main.exe check` or `run` on it, and reading + the full output including carets and secondary lines. Scratch programs are + in the session scratchpad, not the repo. +- **Graded from source only**: the remaining ~220. Their S grade is inferred + from which location value they are raised against, which is reliable for + "is it the operand or the whole form" only where the code makes it obvious. + Treat those as provisional. +- **Out of scope**: lib/emit.ml, lib/x86.ml, lib/cimport.ml, lib/session.ml + and lib/macro.ml internals; the wasm32 and JS backends; anything printed by + `flan dev`'s break loop. +- **Not touched**: lib/dev.ml, which belongs to another lane. Gap 4's dev-side + half is written up as a hand-off for that reason. +- **Not exercised**: the `--warn-memory` warning path, macro-expansion + diagnostics with a non-trivial `expansion` chain, and multi-error cascade + behaviour through `Loc.sink`. diff --git a/lib/check.ml b/lib/check.ml index 02c6fce..86e44b9 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -39,6 +39,14 @@ type binding = { slot : int; bty : Types.t; assignable : bool; (* locals are places; parameters are not — spec-memory *) + (* Where the name came from, in words, when that is worth saying in a + refusal about it. Set by the match-arm path and nowhere else: a case + pattern binds the case's fields positionally, so [(Circle c)] over a + one-field case binds [c] to an [f64] and the reach for [(.r c)] gets a + type fact about [f64] instead of the one sentence that helps, which is + that the field is already in hand. [None] everywhere else, and a refusal + with [None] says exactly what it said before. *) + bwhat : string option; } type env = { @@ -79,7 +87,24 @@ type env = { the symbol and nothing else. *) extern_locs : (string, Loc.t) Hashtbl.t; fns : (string, Types.t list * Types.t) Hashtbl.t; + (* The parameter vector as it was *written*, by function name: the names and + the locations [fns] threw away when it resolved the types. Nothing needs + it to compile; it exists so that a refusal at a call argument can point + at the parameter that wanted the other type, which is the second half of + every message in Elm and was the one thing the reader could not see from + the caret. Missing for a foreign [declare] and for a generic copy, and a + missing entry degrades to the message alone rather than to a wrong + pointer — [declared_note]'s rule. *) + fparams : (string, Ast.field list) Hashtbl.t; + (* And where the defn was written, for the same reason: a refusal about a + function can show it. Kept apart from [fparams] because a foreign + [declare] has a location and no parameter vector worth showing. *) + fn_locs : (string, Loc.t) Hashtbl.t; globals : (string, Types.t * bool) Hashtbl.t; (* type, is a constant *) + (* Where each global was declared, so a refusal about one can show it. A + second table rather than a third field, because every other reader of + [globals] wants the type and the constness and nothing else. *) + global_locs : (string, Loc.t) Hashtbl.t; (* Functions the checker made up: a handler-bind clause is lifted into one, because a handler is called from wherever the signal was and cannot be a branch in the function that established it. *) @@ -145,7 +170,10 @@ let new_env () = { externs = Hashtbl.create 32; extern_locs = Hashtbl.create 32; fns = Hashtbl.create 32; + fparams = Hashtbl.create 32; + fn_locs = Hashtbl.create 32; globals = Hashtbl.create 16; + global_locs = Hashtbl.create 16; lifted = []; generics = Hashtbl.create 8; gsigs = Hashtbl.create 8; @@ -187,6 +215,78 @@ let declared_note env name = in [ Loc.note at what ] +(* One edit apart: a substitution, an insertion, a deletion, or a transposition + of neighbours. Bounded at one, because two edits is no longer a typo, it is + a guess. Hoisted out of [near_miss] so that the did-you-mean over *values* — + function names, globals, locals — matches on exactly the same rule the one + over types has always matched on, rather than on a second one that would + drift. *) +let one_edit a b = + let la = String.length a and lb = String.length b in + if abs (la - lb) > 1 then false + else begin + (* Walk both until they diverge, then require the tails to match with the + single edit applied. *) + let i = ref 0 in + while !i < la && !i < lb && a.[!i] = b.[!i] do incr i done; + let ta s k = String.sub s k (String.length s - k) in + if la = lb then + !i < la + && (ta a (!i + 1) = ta b (!i + 1) + (* stirng/string: two neighbours swapped. *) + || (!i + 1 < la && a.[!i] = b.[!i + 1] && a.[!i + 1] = b.[!i] + && ta a (!i + 2) = ta b (!i + 2))) + else if la < lb then ta a !i = ta b (!i + 1) + else ta a (!i + 1) = ta b !i + end + +(* The same question asked of a candidate list the caller assembles, which for + a value position is the function table, the globals and whatever is in + scope — and nothing from the type tables, because a name written where a + value goes was not a mistyped struct. *) +let nearest cands n = List.find_opt (fun c -> c <> n && one_edit n c) cands + +(* What the last language called it. [int] is two edits from [i32] and so is + outside [one_edit]'s net, which is right — two edits is a guess — but the + name is not a guess at all: it is what C, Java, Go and Python spell the + default integer, and somebody writing it here has not mistyped anything, + they have not yet learned that this language sizes its integers in the + name. Without this list [int] falls through to the lowercase arm of + [resolve_name] and is reported as generic code over a type variable, which + is a sentence about a feature the reader was not reaching for. + + Short on purpose, and only names with one honest answer. [char] is not + here: C's is a byte, Java's is a UTF-16 unit and Rust's is a scalar value, + and this language has [u8] and rune functions, so there is nothing to + translate it to in three words. Nor [void]: it is a return type and the + answer there is the shape [()], which is [parse]'s message to give and not + this one's. Nor [usize] and [size_t]: the honest answer is "as wide as a + pointer on this target", which is [u64] on x86-64 and [u32] on wasm32, and + a message that named one of them would be wrong half the time on a tree + that builds both. A name goes on this list when the answer does not depend + on anything. *) +let foreign_spelling = function + | "int" | "integer" -> Some "i32" + | "uint" | "unsigned" -> Some "u32" + | "long" -> Some "i64" + | "ulong" -> Some "u64" + | "short" -> Some "i16" + | "ushort" -> Some "u16" + | "byte" -> Some "u8" + | "float" -> Some "f32" + | "double" -> Some "f64" + | "boolean" -> Some "bool" + | "str" -> Some "string" + | _ -> None + +(* The builtin names, for the did-you-mean at a call — [prinltn] is a typo for + [println], and [println] is not in any table the checker keeps, it is an arm + of the call dispatch. The full [builtins] table is a long way below this + point and carries a signature and a sentence per entry for eldoc; a forward + reference to its names is cheaper than moving it or writing the list twice + and letting the two drift. Filled once, immediately after that table. *) +let builtin_names : string list ref = ref [] + (* 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 @@ -354,7 +454,7 @@ let fresh_slot ?name ctx ty = variables properly means emitting a [!DILexicalBlock] per [Let] and moving the [llvm.dbg.declare]s out of the entry block to the binding sites, which needs block structure this IR does not carry. *) -let bind ctx name bty ~assignable = +let bind ctx ?what name bty ~assignable = let taken n = List.exists (fun s -> s = Some n) ctx.slot_names in let name' = if not (taken name) then name @@ -368,7 +468,7 @@ let bind ctx name bty ~assignable = let slot = fresh_slot ~name:name' ctx bty in (* [ctx.scope] keeps the *source* name: the suffix is a debug-info artifact and resolving [v] must still find the innermost binding. *) - ctx.scope <- (name, { slot; bty; assignable }) :: ctx.scope; + ctx.scope <- (name, { slot; bty; assignable; bwhat = what }) :: ctx.scope; slot let lookup ctx name = List.assoc_opt name ctx.scope @@ -420,7 +520,10 @@ let branch ctx f = (* ── Type resolution ───────────────────────────────────────────────── *) let unimplemented loc what milestone = - fail loc "%s is not implemented yet — milestone %d (see plan.org)" + (* No repo filename in a message. Somebody meeting this wants to know that + the thing is not there yet and roughly how far off it is; where the + schedule is written down is the compiler's business, not theirs. *) + fail loc "%s is not implemented yet — it is milestone %d work" what milestone (* ── where predicates ────────────────────────────────────────────────── @@ -668,25 +771,6 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = deletion or a transposition of neighbours. Bounded at one, because two edits is no longer a typo, it is a guess. *) and near_miss env ?(also = []) n = - let one_edit a b = - let la = String.length a and lb = String.length b in - if abs (la - lb) > 1 then false - else begin - (* Walk both until they diverge, then require the tails to match with the - single edit applied. *) - let i = ref 0 in - while !i < la && !i < lb && a.[!i] = b.[!i] do incr i done; - let ta s k = String.sub s k (String.length s - k) in - if la = lb then - !i < la - && (ta a (!i + 1) = ta b (!i + 1) - (* stirng/string: two neighbours swapped. *) - || (!i + 1 < la && a.[!i] = b.[!i + 1] && a.[!i + 1] = b.[!i] - && ta a (!i + 2) = ta b (!i + 2))) - else if la < lb then ta a !i = ta b (!i + 1) - else ta a (!i + 1) = ta b !i - end - in (* [also] widens the candidate list past the types, and exactly one caller passes it: the defvar whose third element has to be a type *or* a value, whose suggestion is worth nothing if it can only ever name a type. *) @@ -771,6 +855,9 @@ and resolve_name env ~seen loc n = (* A typo in a primitive is lowercase too, and the type-variable rule below would otherwise report [f65] as unimplemented generics and send you to plan.org instead of to the character you mistyped. *) + | _ when foreign_spelling n <> None -> + Loc.failk "check/unknown-type" loc "unknown type %s — Flan spells it %s" + n (Option.get (foreign_spelling n)) | _ when near_miss env n <> None -> Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n (Option.get (near_miss env n)) @@ -849,7 +936,22 @@ let is_type_name env n = that it was meant to be one. That case is the feature working as specified, and it is the residual the parent owns. *) let dyn_param_or_typo env n loc = - match near_miss env n with + (* [(defn idx [v i] dyn ...)] is two dyn parameters, and [i] is one edit + from [i8], so the did-you-mean used to accuse a perfectly ordinary + parameter name of being a mistyped type. What separates the two is the + digits: this language sizes its machine types in the name, so a typo in + one keeps them — [f65] for [f64], [i33] for [i32] — while [i], [v], [n] + and [x] carry none and are what parameters are actually called. A name + with no digit, one edit from a type that has one, is a parameter; the + suggestion is dropped and the dyn reading stands, which is the reading + the writer meant. *) + let has_digit s = String.exists (fun c -> c >= '0' && c <= '9') s in + let suggestion = + match near_miss env n with + | Some m when has_digit m && not (has_digit n) -> None + | m -> m + in + match suggestion with | Some m -> Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s? A parameter with no type is dyn, so \ @@ -953,7 +1055,33 @@ let defvar_reads_as_type env (t : Ast.texpr) = so a message naming only one of them would send a reader looking for the wrong mistake. Both readings, both spellings, and the near miss over the value names as well as the type names. *) -let defvar_neither env loc gname n ~values = +(* Both readings, and the paragraph that explains them — but only when both + readings really are open. Three things get in ahead of it, because each one + knows which of the two the writer meant and the paragraph would bury that + under a lecture about a fork they are not standing at: + + a case name, which is a third thing entirely and has its own spelling; a + name another language spells for a type this one has under a different + name; and a plain type typo, where a confident one-edit suggestion turns a + one-line answer into four lines of unrelated reading. The paragraph is for + the name that genuinely could have been either and is neither. *) +let defvar_neither env loc gname n ~values ~cases = + (match List.assoc_opt n cases with + | Some dname -> + Loc.failk "check/defvar-case-not-type" loc + "%s is a case of the data type %s, and a case is not a type of its \ + own — the global's type is the data type: (defvar %s %s). Assign the \ + case you want, as (set %s (%s.%s {.field value ...}))" + n dname gname dname gname dname n + | None -> ()); + (match foreign_spelling n with + | Some m -> + Loc.failk "check/unknown-type" loc "unknown type %s — Flan spells it %s" n m + | None -> ()); + (match near_miss env n with + | Some m -> + Loc.failk "check/unknown-type" loc "unknown type %s — did you mean %s?" n m + | None -> ()); let hint = match near_miss env ~also:values n with | Some m -> Printf.sprintf " — did you mean %s?" m @@ -971,6 +1099,21 @@ let defvar_neither env loc gname n ~values = asked "is this name declared at all", so a global that is itself a defvar still undecided belongs on it: what it resolves to is the next pass's question, not this one's. *) +(* Case name -> the data type it belongs to, read off the declarations rather + than out of [env.cases]: this runs inside [collect], which has registered + the data type *names* by here but not resolved their cases, so the table + would be empty. Last writer wins, exactly as [env.cases] does, and for the + same reason — this is only ever asked "what is this a case of", and two + data types may share a case name. *) +let case_owners (decls : Ast.decl list) = + List.concat_map + (fun (d : Ast.decl) -> + match d.Ast.d with + | Ast.Defdata (dn, vs) -> + List.map (fun (v : Ast.variant) -> (v.Ast.vname, dn)) vs + | _ -> []) + decls + let value_names env (decls : Ast.decl list) = let declared = List.filter_map @@ -992,18 +1135,62 @@ let value_names env (decls : Ast.decl list) = dyn reading is rewritten into exactly [(defvar x dyn )], which is the whole of "it lowers to the same thing": the startup lifting, the re-run guard and the collector root are the ones that form already had. *) +(* A bracket form whose element names a value. [(defvar g [a b])] parses as a + type and stays one — type wins wherever there is a type reading, which is + the rule — so the element had to name an element type, and [b] names a + defvar. Left alone this reaches [resolve_name], where a lowercase name that + is no type is a type variable, and the answer is a paragraph about generic + code the writer was not asking for. + + Both readings, and both spellings, at the element that decided it. The dyn + spelling is the one that actually works: [(defvar g dyn [a b])] is a dyn + global holding a vector, which is what the brackets meant to whoever wrote + them. *) +let rec bracket_value_element env values (t : Ast.texpr) = + let elem (e : Ast.texpr) = + match e.Ast.t with + | Ast.Tname n when (not (is_type_name env n)) && List.mem n values -> + Some (n, e.Ast.tloc) + | _ -> bracket_value_element env values e + in + match t.Ast.t with + | Ast.Tslice e -> elem e + | Ast.Tarray (_, e) -> elem e + | _ -> None + let settle_defvars env (decls : Ast.decl list) : Ast.decl list = let values = lazy (value_names env decls) in + let cases = lazy (case_owners decls) in + (* A bracket form never reaches the fork below: [Parse.defvar3] gives it + [Zeroed] outright, because a bracket that parses as a type has no second + reading to carry. So the element check runs on both, and it is the only + thing the [Zeroed] arm does. *) + let brackets gname (t : Ast.texpr) = + match bracket_value_element env (Lazy.force values) t with + | Some (v, vloc) -> + Loc.failk "check/defvar-bracket-element-is-a-value" vloc + "%s names a value, not a type, and the brackets around it were read \ + as a type — a defvar's third element is a type wherever there is a \ + type reading, so %s had to be the element type. Write a type there \ + for a zeroed global, or put dyn in front of the same brackets — \ + (defvar %s dyn ...) — for a dyn global holding the vector you wrote" + v v gname + | None -> () + in List.map (fun (d : Ast.decl) -> match d.Ast.d with + | Ast.Defvar (n, Some t, Ast.Zeroed) -> brackets n t; d | Ast.Defvar (n, Some t, Ast.Ambiguous e) -> - if defvar_reads_as_type env t then + if defvar_reads_as_type env t then begin + brackets n t; { d with Ast.d = Ast.Defvar (n, Some t, Ast.Zeroed) } + end else begin (match t.Ast.t with | Ast.Tname s when not (List.mem s (Lazy.force values)) -> defvar_neither env t.Ast.tloc n s ~values:(Lazy.force values) + ~cases:(Lazy.force cases) | _ -> ()); let dyn = { Ast.t = Ast.Tname "dyn"; tloc = t.Ast.tloc } in { d with Ast.d = Ast.Defvar (n, Some dyn, Ast.Init e) } @@ -1966,8 +2153,12 @@ let expect ctx loc ~want (got : Tast.expr) = in if Types.fits ~expected:w ~actual:got.Tast.ty then got else - fail loc "expected %s, found %s" (Types.to_string w) - (Types.to_string got.Tast.ty) + (* Kinded so that the one caller who knows more — a call argument, which + can name the function and the parameter — can recognise this exact + refusal at this exact span and say the rest. Every other reader of a + diagnostic ignores [kind]. *) + Loc.failk "check/type-mismatch" loc "expected %s, found %s" + (Types.to_string w) (Types.to_string got.Tast.ty) (* Something a [break] may not jump out of, named so the refusal can say which. See [lentry]: it is a barrier and not a blanket refusal, so a loop written @@ -2841,8 +3032,7 @@ and var ctx loc ~want name = and pass that" name; expect ctx loc ~want (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name))) - | None -> captured ctx loc name; - Loc.failk "check/unknown-name" loc "unknown name %s" name) + | None -> captured ctx loc name; unknown_name ctx loc name) (* What remains of spec-memory.md's ownership section after the repeals of 2026-09-18 is the allocator's side alone: the region rule decides where a @@ -3723,7 +3913,46 @@ and check_truthy ctx c = | c0 when c0.Tast.ty = Types.Dyn -> widen loc Types.Bool (rt loc (Types.Int Types.I32) "flan_dyn_truthy" [ c0 ]) | c0 when Types.fits ~expected:Types.Bool ~actual:c0.Tast.ty -> c0 - | _ -> check ctx ~want:Types.Bool c + | c0 -> + (* Re-checked at [bool] first, and the answer is kept only when it is a + message that knows something this one does not: a literal names itself + ("found the integer literal 1"), and [None] names itself, and both of + those point at the mistake better than a type name would. What comes + back as the *generic* mismatch — "expected bool, found i32", which is + true and tells a reader nothing they did not have — is the one replaced + below. + + The rule, rather than the fact. [expected bool, found i32] is true and + says nothing a reader did not already know; what they do not know is + that this language has exactly two things a condition may be, and that + the dyn one is not the typed one. A dyn condition is Clojure's — nil + and false are false and 0 is true — so a message that told somebody to + compare against zero *in general* would be wrong about half the + language. It is said only of the typed side, which is where they are. + + The comparison is spelled with the condition's own name where there is + one, because [(!= x 0)] is a thing to type and [(!= … 0)] is not. + Anything more complicated than a name gets the operator and no + template: a reconstructed expression would be a guess at code the + reader can see for themselves. *) + (match check ctx ~want:Types.Bool c with + | c1 -> c1 + | exception Loc.Error d when not (String.equal d.Loc.kind "check/type-mismatch") -> + raise (Loc.Error d) + | exception Loc.Error _ -> + let how = + let zero = match c0.Tast.ty with Types.Float _ -> "0.0" | _ -> "0" in + let comparable = + match c0.Tast.ty with Types.Int _ | Types.Float _ -> true | _ -> false + in + match c.Ast.e, comparable with + | Ast.Var n, true -> Printf.sprintf " — test it, as (!= %s %s)" n zero + | _, true -> Printf.sprintf " — test it against %s with !=" zero + | _ -> "" + in + Loc.failk "check/condition-not-bool" loc + "a condition is a bool or a dyn, and this is %s%s" + (Types.to_string c0.Tast.ty) how) | exception Loc.Error _ -> check ctx ~want:Types.Bool c and check_if ctx ?(tail = false) ?want loc c t e = @@ -3747,7 +3976,37 @@ and check_if ctx ?(tail = false) ?want loc c t e = | Some _ -> want | None -> if t.Tast.ty = Types.Never then None else Some t.Tast.ty in - let e = branch ctx (fun () -> in_tail (fun () -> check ctx ?want:ewant e)) in + (* [(and a b c)] is [(let [t a] (if t (let [u b] (if u c u)) t))], so the + *last* operand of an [and] is the then arm and the sentinel that carries + the previous operand's location is the else arm. With no expectation + the then arm supplies one, the sentinel is checked against it, and the + mismatch was reported at the sentinel — which is a caret on the operand + before the one that is wrong. FIX.org records three fixes for this that + were rejected and one that was not: prefer the arm that is not a + compiler temp when deciding which to blame. That is this. + + Only [and] needs it. In an [or] the chain sits in the else arm and the + sentinel in the then arm, so every operand is already blamed at its own + location; and with an expectation in hand both arms are checked against + it rather than against each other, so nothing here runs. *) + let and_sentinel (x : Ast.expr) = + match x.Ast.e with + | Ast.Var n -> + String.length n > 4 && String.sub n 0 4 = "and~" + | _ -> false + in + let e = + match branch ctx (fun () -> in_tail (fun () -> check ctx ?want:ewant e)) with + | v -> v + | exception Loc.Error d + when want = None && and_sentinel e + && String.equal d.Loc.kind "check/type-mismatch" -> + Loc.failk "check/shortcircuit-operand" t.Tast.loc + "an and answers false when it stops early and its last operand \ + otherwise, so the two have to be one type — this operand is %s, \ + and false is a bool" + (Types.to_string t.Tast.ty) + in let ty = if t.Tast.ty = Types.Never then e.Tast.ty else if e.Tast.ty = Types.Never then t.Tast.ty @@ -4214,9 +4473,32 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = fail a.Ast.aloc "this match has two %s arms" c; Hashtbl.add seen c ()); branch ctx (fun () -> + (* What each name in this arm is, in words, for the one refusal + that needs it: a case pattern binds fields positionally, so the + i'th name is the i'th field of the case the arm named. Derived + here rather than carried out of [resolve_pat], because the case + and the subject are both still in hand and the alternative was + widening that function's result for one message. *) + let fields = + match subject, ctor with + | `Data u, Some c -> + (match Tast.case_index u c with + | Some (_, v) -> + List.map + (fun (fd : Tast.field) -> + Printf.sprintf "%s.%s's field %s" u.Tast.dname c + fd.Tast.fname) + v.Tast.vfields + | None -> []) + | `Option _, Some "Some" -> [ "the Option's payload" ] + | _ -> [] + in let binds = - List.map - (fun (n, ty) -> bind ctx n ty ~assignable:false) binds + List.mapi + (fun i (n, ty) -> + let what = List.nth_opt fields i in + bind ctx ?what n ty ~assignable:false) + binds in (* Every arm is the tail, exactly as an [if]'s two arms are. Restored here because checking the scrutinee withdrew it. *) @@ -4264,6 +4546,131 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = question for the layout and not for this — so [.x] is one path and not two, and a union member is read with the accessor everything else is read with. That is the whole of what makes punning ordinary code. *) +(* Every name a value could be standing under here: what is in scope, the + globals, the functions — generic ones included, since a call to one is + written exactly like a call to any other. No type names: a symbol written + where a value goes was not a mistyped struct, and offering one would send + the reader to the wrong file. *) +and value_candidates ctx = + List.map fst ctx.scope + @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.globals [] + @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.fns [] + @ Hashtbl.fold (fun k _ acc -> k :: acc) ctx.env.gsigs [] + +(* The name nothing answers to, refused with whatever this position can still + tell the reader. + + Two readings get in ahead of the bare refusal. The first is the dot: [p.x] + is how C, Go and Odin spell field access and it is the habit everyone + arrives with, so a symbol with a dot in it and a lowercase head is almost + never a name — it is an accessor written the way the last language wrote + it. The head is looked up, so the sentence can say what [p] actually is + rather than guess, and the struct's declaration comes along as a note when + there is one. Capitalised heads are left alone: [Shape.Circle] is a real + spelling in this language and a typo in one is a mistyped case, not a + dot-infix habit. + + The second is the near miss, over values only — see [value_candidates]. *) +and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = + fun ?(setting = false) ctx loc name -> + let dot = String.index_opt name '.' in + let head, field = + match dot with + | Some i when i > 0 && i + 1 < String.length name -> + String.sub name 0 i, String.sub name (i + 1) (String.length name - i - 1) + | _ -> "", "" + in + let lower = head <> "" && head.[0] = Char.lowercase_ascii head.[0] + && head.[0] <> Char.uppercase_ascii head.[0] in + if lower then begin + let ty = + match lookup ctx head with + | Some b -> Some b.bty + | None -> Option.map fst (Hashtbl.find_opt ctx.env.globals head) + in + let sname = + match ty with + | Some (Types.Named n) when fields_named ctx.env n <> None -> Some n + | Some (Types.Ptr (Types.Named n)) when fields_named ctx.env n <> None -> Some n + | _ -> None + in + match sname, ty with + | Some sn, _ -> + let s = Option.get (fields_named ctx.env sn) in + let notes = declared_note ctx.env sn in + (* In a [set] the accessor is the *place*, so the spelling to give is + [(set (.x p) 1)] and not [(.x p)] on its own. Saying "read" at an + assignment would be a sentence that does not apply to the form it is + printed under. *) + let how = + if setting then Printf.sprintf "a field is assigned through an \ + accessor, so write (set (.%s %s) ...)" + field head + else Printf.sprintf "a field is read with an accessor, so write (.%s %s)" + field head + in + if Tast.field_index s field <> None then + Loc.failk "check/dot-access" loc ~notes "unknown name %s — %s" name how + else + Loc.failk "check/dot-access" loc ~notes + "unknown name %s — %s, and %s has no field %s" name how sn field + | None, Some t -> + Loc.failk "check/dot-access" loc + "unknown name %s — a dot is part of the name here, not field access. \ + A field is reached through an accessor, (.%s %s), and %s is %s, \ + which has no fields" + name field head head (Types.to_string t) + | None, None -> + Loc.failk "check/unknown-name" loc + "unknown name %s — nothing named %s is in scope either. A field is \ + reached through an accessor, (.%s %s), not with a dot" + name head field head + end + else + match nearest (value_candidates ctx) name with + | Some m -> + Loc.failk "check/unknown-name" loc "unknown name %s — did you mean %s?" name m + | None -> Loc.failk "check/unknown-name" loc "unknown name %s" name + +(* 1st, 2nd, 3rd, and every other one. *) +and ordinal n = + let suffix = + if n mod 100 >= 11 && n mod 100 <= 13 then "th" + else match n mod 10 with 1 -> "st" | 2 -> "nd" | 3 -> "rd" | _ -> "th" + in + string_of_int n ^ suffix + +(* Check one argument of a call to [name], and if the refusal is the plain + type mismatch raised against *this* argument's own span, say the two things + the caret cannot: which argument of which function this is, and where the + parameter that wanted the other type is declared. + + The span test is what keeps the claim true. A mismatch deeper inside the + argument — an element of a vec literal, an argument of a nested call — is + raised against its own location and is re-raised untouched, because calling + that "the 2nd argument of add" would be a sentence that reads well and + points at the wrong form. The rekind is what stops a nested call from being + named twice: once enriched, it is no longer the kind this looks for. *) +and check_arg ctx name i (want : Types.t) (a : Ast.expr) = + match check ctx ~want a with + | e -> e + | exception Loc.Error d + when String.equal d.Loc.kind "check/type-mismatch" + && d.Loc.dloc == a.Ast.loc -> + let which = ordinal (i + 1) in + let notes = + match Hashtbl.find_opt ctx.env.fparams name with + | Some ps when List.length ps > i -> + let p = List.nth ps i in + [ Loc.note p.Ast.floc + (Printf.sprintf "%s's %s parameter %s is declared %s" + name which p.Ast.fname (Types.to_string want)) ] + | _ -> [] + in + Loc.raise_diag + (Loc.diag ~kind:"check/argument-type" ~notes a.Ast.loc + (Printf.sprintf "%s — this is the %s argument of %s" d.Loc.dmsg which name)) + and fields_named env n : Tast.structure option = match Hashtbl.find_opt env.structs n with | Some s -> Some s @@ -4291,6 +4698,20 @@ and struct_target ctx (target : Ast.expr) : Tast.expr * string = whose arms bind the fields of the case they matched" n | other -> + (* The pattern bound this, and it looks like a destructuring that did not + take: [(match s (Circle c) (.r c))] over a one-field case binds [c] to + the payload itself. "f64 is not a struct" is true and is a type fact + where the reader needs to be told the value is already in hand. *) + (match target.Ast.e with + | Ast.Var n -> + (match lookup ctx n with + | Some { bwhat = Some w; _ } -> + fail target.Ast.loc + "%s is %s — the pattern bound it to %s, so the value is already \ + in hand and there is no field left to read" + n (Types.to_string other) w + | _ -> ()) + | _ -> ()); fail target.Ast.loc "%s is not a struct, so it has no fields" (Types.to_string other) @@ -4301,15 +4722,28 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = | Some b -> if not b.assignable then fail loc - "%s is a parameter, and parameters are not assignable places \ - (spec-memory.md) — bind a local with let" name; + "%s is a parameter, and a parameter is not a place you can assign \ + to — bind a local with let" name; Tast.Plocal b.slot, b.bty | None -> match Hashtbl.find_opt ctx.env.globals name with - | Some (_, true) -> fail loc "%s is a constant" name + | Some (_, true) -> + (* Four words, before: the name and the fact, and nothing about what + to do or where the decision was made. [no_container_defconst] is + the house's own shape for this and the note is [declared_note]'s. + A defconst is what the linker writes into the image, so there is + no assignment to allow — the fix is the other declaration. *) + let notes = + match Hashtbl.find_opt ctx.env.global_locs name with + | Some at -> [ Loc.note at (name ^ " is declared a constant here") ] + | None -> [] + in + Loc.failk "check/set-constant" loc ~notes + "%s is a constant, and a constant is not assignable — it is written \ + into the image and there is nothing to assign to. Declare it with \ + defvar if it has to change" name | Some (ty, false) -> Tast.Pglobal name, ty - | None -> captured ctx loc name; - Loc.failk "check/unknown-name" loc "unknown name %s" name) + | None -> captured ctx loc name; unknown_name ~setting:true ctx loc name) | Ast.Pfield (target, name) -> let target, sname = struct_target ctx target in let s = Option.get (fields_named ctx.env sname) in @@ -4430,10 +4864,35 @@ and call_value ctx ~want loc (callee : Tast.expr) args = fail loc "this is a %s and not a function, so it cannot be called" (Types.to_string other) -and arity loc name n args = - if List.length args <> n then - fail loc "%s takes %d argument%s, given %d" name n - (if n = 1 then "" else "s") (List.length args) +(* A builtin's arity, and the one thing the caret cannot show: whether the + count being measured against is the builtin's or a defn of the same name. + A defn does not shadow a builtin — the dispatch above reaches every builtin + arm before it ever looks in [fns] — so a user function called [get] is + silently unreachable, and the refusal that followed measured the call + against the builtin while pointing at a call the reader had written for + their own. Said outright, with the definition alongside. *) +and arity ctx loc name n args = + if List.length args <> n then begin + let notes = + if Hashtbl.mem ctx.env.fns name then + match Hashtbl.find_opt ctx.env.fn_locs name with + | Some at -> + [ Loc.note at + (name ^ " is also defined here, and this call is not reaching \ + it — rename it to call it") ] + | None -> [] + else [] + in + let shadowed = notes <> [] in + if shadowed then + Loc.failk "check/builtin-arity" loc ~notes + "%s takes %d argument%s, given %d — this is the builtin %s, which a \ + defn of the same name does not replace" + name n (if n = 1 then "" else "s") (List.length args) name + else + fail loc "%s takes %d argument%s, given %d" name n + (if n = 1 then "" else "s") (List.length args) + end (* The operators that fold: [+ - * /], [min]/[max] and the three bitwise combining operators all take two operands or more, and mean the same thing @@ -4466,6 +4925,32 @@ and fold_arity loc name args = (* The first two operands decide the type — [binary] picks which of them is allowed to, and that decision is not re-made per pair — and every operand after them is checked against it. *) +(* The operand, not the form. "[+] takes numbers, found string" with the caret + over the whole [(+ "a" "b")] is the exact "whole form vs operand" shape the + [check_truthy] work already fixed once: the reader has to find which of the + operands is the one being talked about, and the compiler knew. + + And a text operand gets the extra clause, because [+] on two strings is a + reach for concatenation and the answer is a function rather than an + operator here. Named without a call shape on purpose: [concat] and [join] + take a slice of byte slices and the spelling that builds one from string + literals is not a clause in a sentence. *) +and not_numeric name what (a : Tast.expr) = + let text = + match a.Tast.ty with + | Types.String -> true + | Types.Slice (Types.Int Types.U8) -> true + | _ -> false + in + let where = a.Tast.loc in + if text then + fail where + "%s takes %s, and this is %s — there is no %s on text. The prelude \ + concatenates with concat and join" + name what (Types.to_string a.Tast.ty) name + else + fail where "%s takes %s, found %s" name what (Types.to_string a.Tast.ty) + and fold_left_prim ctx ~want loc name p ok what args = let x, y, rest = match args with x :: y :: rest -> x, y, rest | _ -> assert false @@ -4481,8 +4966,7 @@ and fold_left_prim ctx ~want loc name p ok what args = (* Past [unconstrained] a variable here is one the [where] clause admitted, so the concrete predicate below has nothing to say about it — it is answered again, per copy, at the instantiation. *) - if not (ok a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty); + if not (ok a.Tast.ty || generic_ty a.Tast.ty) then not_numeric name what a; let ty = a.Tast.ty in let acc = List.fold_left @@ -4512,7 +4996,11 @@ and dyn_fold ctx ~want loc name first rest = no_dyn_yet loc ~into:false Types.Dyn (Printf.sprintf " — %s has no dyn form" name) in - let apply acc b = rt loc Types.Dyn sym [ acc; box loc b ] in + (* The site travels with the operands. A dyn arithmetic trap is this + language's type error, and until now it printed with no file, no line and + no column — [here loc] is the same string literal [cast_dyn] hands the + runtime, and the runtime prints it as a GNU prefix. *) + let apply acc b = rt loc Types.Dyn sym [ acc; box loc b; here loc ] in let acc = match first with | [ a; b ] -> apply (box loc a) b @@ -4805,14 +5293,14 @@ and named_call ctx ~want loc name args = (* Remainder stays at two: (% a b c) is (% (% a b) c), which is a thing nobody writes on purpose. *) | "%" -> - arity loc name 2 args; + arity ctx loc name 2 args; let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) args in if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then dyn_fold ctx ~want loc name [ a; b ] [] else begin unconstrained ctx.env loc name ~needs:"numeric?" a.Tast.ty; if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); + not_numeric name "numbers" a; prim Tast.Rem a.Tast.ty [ a; b ] end | "=" | "!=" | "<" | "<=" | ">" | ">=" -> @@ -4820,7 +5308,7 @@ and named_call ctx ~want loc name args = | "=" -> Tast.Eq | "!=" -> Tast.Ne | "<" -> Tast.Lt | "<=" -> Tast.Le | ">" -> Tast.Gt | _ -> Tast.Ge in - arity loc name 2 args; + arity ctx loc name 2 args; let a, b = binary ctx ~dyn_ok:true name loc ~want:None args in (* A comparison with a dyn operand answers a *bool*, not a dyn, even though the runtime's own entry point answers a dyn holding one. The reason is @@ -4842,7 +5330,13 @@ and named_call ctx ~want loc name args = | "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le" | ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge" in - let cmp = unbox loc Types.Bool (rt loc Types.Dyn sym [ box loc a; box loc b ]) in + (* [eq] never traps and takes no site; the four orderings do, and get + one, for the reason [dyn_fold] gives. *) + let site = if String.equal sym "flan_dyn_eq" then [] else [ here loc ] in + let cmp = + unbox loc Types.Bool + (rt loc Types.Dyn sym ([ box loc a; box loc b ] @ site)) + in (* [!=] has no entry point of its own: there is one structural equality and the negation is an [i1] flip the backend folds away. *) let r = @@ -4873,16 +5367,16 @@ and named_call ctx ~want loc name args = (match name with | "=" | "!=" -> fail loc - "%s compares machine numbers, enums and strings; %s has no \ - built-in equality (plan.org, Types)" name (Types.to_string a.Tast.ty) + "%s compares machine numbers, enums and strings, and %s is none of \ + those" name (Types.to_string a.Tast.ty) | _ -> fail loc - "%s orders machine numbers and enums; %s has no built-in ordering \ - (plan.org, Types)" name (Types.to_string a.Tast.ty)); + "%s orders machine numbers and enums, and %s is neither" name + (Types.to_string a.Tast.ty)); prim p Types.Bool [ a; b ] end | "not" -> - arity loc name 1 args; + arity ctx loc name 1 args; (* Same truthiness as [if]: a dyn argument is negated on nil/false vs. everything else, not narrowed to a strict bool first. *) prim Tast.Not Types.Bool [ check_truthy ctx (List.hd args) ] @@ -4901,7 +5395,7 @@ and named_call ctx ~want loc name args = would pass two legal shifts and still shift the value away entirely. *) | "<<" | ">>" -> let p = if String.equal name "<<" then Tast.Shl else Tast.Shr in - arity loc name 2 args; + arity ctx loc name 2 args; let a, b = binary ctx name loc ~want:(numeric_want want) args in (match a.Tast.ty with | Types.Int _ -> () @@ -4940,7 +5434,7 @@ and named_call ctx ~want loc name args = not [numeric?]. A generic that declares [ordered?] gets both. *) unconstrained ctx.env loc name ~needs:"ordered?" a.Tast.ty; if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then - fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty); + not_numeric name "numbers" a; let ty = a.Tast.ty in let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in let pick a b = @@ -4956,7 +5450,7 @@ and named_call ctx ~want loc name args = (* (zeroed) is the all-bytes-zero value of whatever it is being stored into, so it only means anything where a type is expected of it. *) | "zeroed" -> - arity loc name 0 args; + arity ctx loc name 0 args; (match want with | Some ty when ty <> Types.Never -> no_zeroed_fn loc "this" ty; @@ -5044,7 +5538,7 @@ and named_call ctx ~want loc name args = (arena-new ...) with a backing buffer, which is the parameterised \ allocator that does exist" | "heap-allocator" -> - arity loc name 0 args; + arity ctx loc name 0 args; expect ctx loc ~want (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_heap_allocator", []))) (* The capacity is explicit and there is no growing backing store: an arena @@ -5052,14 +5546,14 @@ and named_call ctx ~want loc name args = and it is the only shape under which "exhausted" is a state a test can reach on purpose. *) | "arena-new" -> - arity loc name 1 args; + arity ctx loc name 1 args; let cap = check ctx ~want:(Types.Int Types.I64) (List.hd args) in expect ctx loc ~want (mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_arena_new", [ cap ]))) (* Hands the pages back, which [free-all] deliberately does not — see docs/BUILT.md, "free-all is retain-capacity". *) | "arena-destroy" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_arena_destroy", [ a ]))) @@ -5067,7 +5561,7 @@ and named_call ctx ~want loc name args = as a string so that an allocator with no region to release names the site rather than the runtime. *) | "free-all" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc Types.Unit @@ -5076,7 +5570,7 @@ and named_call ctx ~want loc name args = (Query_Features returning an Allocator_Mode_Set); a field is the same answer without the round trip, which is NEXT.md's call. *) | "can-free?" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc Types.Bool @@ -5085,7 +5579,7 @@ and named_call ctx ~want loc name args = (Tast.Prim (Tast.Rt "flan_alloc_can_free", [ a ])); mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))) | "can-free-all?" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc Types.Bool @@ -5097,7 +5591,7 @@ and named_call ctx ~want loc name args = moved; this is the same number, readable, so a program can say what it saw. *) | "alloc-epoch" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc (Types.Int Types.I64) @@ -5106,7 +5600,7 @@ and named_call ctx ~want loc name args = :allocator field carries, so a handler holding several regions can tell which one ran out. *) | "alloc-id" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Rt "flan_alloc_id", [ a ]))) @@ -5118,13 +5612,13 @@ and named_call ctx ~want loc name args = invokes retry" needs a ceiling to raise, and this is it. It is also how a program exhausts an allocator on purpose. *) | "alloc-budget" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Rt "flan_alloc_budget", [ a ]))) | "set-alloc-budget" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ a; n ] -> let a = check ctx ~want:Types.Alloc a in @@ -5135,7 +5629,7 @@ and named_call ctx ~want loc name args = (* "Did you forget to free" is an allocator-tier question and this is the tier answering it — spec-memory.md, "Leaking is defined behaviour". *) | "alloc-live-blocks" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx ~want:Types.Alloc (List.hd args) in expect ctx loc ~want (mk loc (Types.Int Types.I64) @@ -5220,7 +5714,7 @@ and named_call ctx ~want loc name args = end (* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *) | "push" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; x ] -> let target = check ctx target in @@ -5259,7 +5753,7 @@ and named_call ctx ~want loc name args = end | _ -> assert false) | "reserve" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; n ] -> let target = check ctx target in @@ -5335,7 +5829,7 @@ and named_call ctx ~want loc name args = traps a read through a released region. That is the Odin contract: free is a thing you write, and writing it twice is yours to not do. *) | "free" -> - arity loc name 1 args; + arity ctx loc name 1 args; let target = check ctx (List.hd args) in (* A container of owning elements is refused here, and a reader will assume the opposite — that [free] recurses — so this says why it does @@ -5510,7 +6004,7 @@ and named_call ctx ~want loc name args = code: see [alloc_guard]. spec-memory.md is explicit that it either inserts or replaces, and that (set (get m k) v) is not map syntax. *) | "put" -> - arity loc name 3 args; + arity ctx loc name 3 args; (match args with | [ target; k; v ] -> let target = check ctx target in @@ -5560,7 +6054,7 @@ and named_call ctx ~want loc name args = There is no allocation here and therefore no guard: a lookup that finds nothing is an answer, not a failure. *) | "get" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; k ] -> let target = check ctx target in @@ -5590,7 +6084,7 @@ and named_call ctx ~want loc name args = that only exists at run time — a reader building :texture-path out of a token's text. A literal :foo never comes through here. *) | "keyword" -> - arity loc name 1 args; + arity ctx loc name 1 args; (match args with | [ s ] -> let s = check ctx s in @@ -5614,7 +6108,7 @@ and named_call ctx ~want loc name args = question is askable of every value — the same line [get] takes about an absent key. *) | "class-of" -> - arity loc name 1 args; + arity ctx loc name 1 args; (match args with | [ v ] -> expect ctx loc ~want @@ -5635,7 +6129,7 @@ and named_call ctx ~want loc name args = arena — or by any allocator that refuses can-free — as on a heap-backed one. Nothing is freed per entry because nothing was allocated per entry. *) | "map-remove" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; k ] -> let target = check ctx target in @@ -5672,7 +6166,7 @@ and named_call ctx ~want loc name args = key — so this is the one map entry point whose signature carries neither, and the sizes are still needed because the runtime is type-erased. *) | "map-next" -> - arity loc name 4 args; + arity ctx loc name 4 args; (match args with | [ target; cur; k; v ] -> let target = check ctx target in @@ -5696,7 +6190,7 @@ and named_call ctx ~want loc name args = Option the caller then has to match; this is the form a condition wants, and it copies no value. *) | "has-key?" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; k ] -> let target = check ctx target in @@ -5829,7 +6323,7 @@ and named_call ctx ~want loc name args = literal for the same reason [embed]'s path is one — there is nothing at this point in a compile to compute a string from. *) | "compile-error" -> - arity loc name 1 args; + arity ctx loc name 1 args; (match (List.hd args).Ast.e with | Ast.Str s -> fail loc "%s" s | _ -> @@ -5839,7 +6333,7 @@ and named_call ctx ~want loc name args = from. A macro that has to refuse builds the sentence as it expands \ and puts it in the form") | "embed-dir" -> - arity loc name 1 args; + arity ctx loc name 1 args; let arg = List.hd args in let entries = read_embed_dir (embed_path loc arg) arg.Ast.loc in if not (Hashtbl.mem ctx.env.structs "EmbedFile") then @@ -5928,7 +6422,7 @@ and named_call ctx ~want loc name args = #ifdef in the host layer, which is exactly where the two targets are already implemented twice. *) | "barf" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ path; data ] -> let path = check ctx ~want:Types.String path in @@ -5969,7 +6463,7 @@ and named_call ctx ~want loc name args = and 2, 3, 4 here. A handler matching on it is matching on the prelude's [file-op-delete] and friends, not on a literal. *) | "delete-file" | "make-directory" -> - arity loc name 1 args; + arity ctx loc name 1 args; let sym, op = if String.equal name "delete-file" then "flan_file_delete", 2 else "flan_file_mkdir", 4 @@ -5995,7 +6489,7 @@ and named_call ctx ~want loc name args = data, so a retry re-attempts the rename and not the expression that computed where to. *) | "rename-file" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ from_; to_ ] -> let from_ = check ctx ~want:Types.String from_ in @@ -6020,7 +6514,7 @@ and named_call ctx ~want loc name args = length here (index_ty): widening indices is one change across all of them and not a Vec question. *) | "len" -> - arity loc name 1 args; + arity ctx loc name 1 args; let target = List.hd args in let a = check ctx target in (match a.Tast.ty with @@ -6072,7 +6566,7 @@ and named_call ctx ~want loc name args = prim Tast.At ty (target :: idx)) | _ -> fail loc "%s is (%s collection index ...)" name name) | "slice" -> - arity loc name 3 args; + arity ctx loc name 3 args; (match args with | [ target; lo; hi ] -> let target = check ctx target in @@ -6129,7 +6623,7 @@ and named_call ctx ~want loc name args = [free] refuses it by the rule it already had ("free takes an owning container"). *) | "slice-from-ptr" -> - arity loc name 2 args; + arity ctx loc name 2 args; (match args with | [ target; n ] -> let target = check ctx target in @@ -6159,7 +6653,7 @@ and named_call ctx ~want loc name args = (* ── pointers ──────────────────────────────────────────────────── *) | "addr" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = List.hd args in (match place_of_expr a with | None -> @@ -6170,7 +6664,7 @@ and named_call ctx ~want loc name args = let p, ty = check_place ctx a.Ast.loc p in expect ctx loc ~want (mk loc (Types.Ptr ty) (Tast.Addr p))) | "deref" -> - arity loc name 1 args; + arity ctx loc name 1 args; let a = check ctx (List.hd args) in (match a.Tast.ty with | Types.Ptr t -> expect ctx loc ~want (mk loc t (Tast.Deref a)) @@ -6187,7 +6681,7 @@ and named_call ctx ~want loc name args = the value instead, named for what it refuses rather than just that it does. *) | "Some" -> - arity loc name 1 args; + arity ctx loc name 1 args; let arg = List.hd args in let inner = match want with Some (Types.Option t) -> Some t | _ -> None in (* A literal [nil] is refused by this form's own message below, not by @@ -6212,7 +6706,7 @@ and named_call ctx ~want loc name args = (* ── the milestone-2 host primitives (plan.org) ────────────────── *) | "bytes" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.Bytes (Types.Slice (Types.Int Types.U8)) [ check ctx ~want:Types.String (List.hd args) ] @@ -6257,26 +6751,26 @@ and named_call ctx ~want loc name args = copy it, so storing one in a container or returning it hands back a view of storage that has been reused. Copy the bytes for that. *) | "string" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.StrOfBytes Types.String [ byte_slice ctx (List.hd args) ] | "bytes->f64" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.BytesToF64 (Types.Float Types.F64) [ byte_slice ctx (List.hd args) ] | "bytes->i64" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.BytesToI64 (Types.Int Types.I64) [ byte_slice ctx (List.hd args) ] | "f64->bytes" -> - arity loc name 1 args; + arity ctx loc name 1 args; expect ctx loc ~want (to_bytes ctx loc Tast.F64ToBytes (check ctx ~want:(Types.Float Types.F64) (List.hd args))) | "i64->bytes" -> - arity loc name 1 args; + arity ctx loc name 1 args; expect ctx loc ~want (to_bytes ctx loc Tast.I64ToBytes (check ctx ~want:(Types.Int Types.I64) (List.hd args))) | "write-stdout" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ] (* (println x) and (print x): the structural printer, selected on the type @@ -6297,7 +6791,7 @@ and named_call ctx ~want loc name args = cannot be told from the punctuation. The split is exactly top level vs nested, which is why it lives here and not in the walk. *) | "print" | "println" -> - arity loc name 1 args; + arity ctx loc name 1 args; (* Printing is a read, not a move: the walk goes over the value and keeps nothing. Without this, (println v) would consume a Vec and every printing of one would be its last. *) @@ -6402,10 +6896,10 @@ and named_call ctx ~want loc name args = in expect ctx loc ~want (mk loc Types.Unit (Tast.Do (parts @ nl))) | "exit" -> - arity loc name 1 args; + arity ctx loc name 1 args; prim Tast.Exit Types.Never [ check ctx ~want:index_ty (List.hd args) ] | "argv" -> - arity loc name 0 args; + arity ctx loc name 0 args; prim Tast.Argv (Types.Slice Types.String) [] (* ── casts: (i32 x), (f64 x), and an enum both ways ──────────────── @@ -6445,7 +6939,7 @@ and named_call ctx ~want loc name args = meaning here, and not another enum: an enum-to-enum hop goes through (i32 x) so that both ends are written down. *) | _ when Hashtbl.mem ctx.env.enums name -> - arity loc name 1 args; + arity ctx loc name 1 args; let target = resolve_name ctx.env ~seen:[] loc name in let a = check ctx (List.hd args) in (match a.Tast.ty with @@ -6519,12 +7013,16 @@ and named_call ctx ~want loc name args = (List.length params) (if List.length params = 1 then "" else "s") (List.length args); - let args = map2_lr (fun p a -> check ctx ~want:p a) params args in + let i = ref (-1) in + let args = + map2_lr (fun p a -> incr i; check_arg ctx name !i p a) params args + in expect ctx loc ~want (mk loc ret (Tast.Call (name, args))) | None -> if Hashtbl.mem ctx.env.datas name then fail loc - "%s is a data type — a data type value names the case too, as (%s.%s {.field value ...})" + "%s is a data type — a data type value names the case too, as \ + (%s.%s {.field value ...})" name name (first_case_name ctx.env name) else if Hashtbl.mem ctx.env.cases name then (* [(U.C)] and [(C)]: a case written as a call. Both are how someone @@ -6539,7 +7037,42 @@ 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 Loc.failk "check/unknown-function" loc "unknown function %s" name + else + (* The did-you-mean comes first, and for a capitalised head it is asked + of the *type* tables as well: [(Piont 1 2)] with [Point] declared is + a typo, and the generics sentence below would be a confident answer + about a feature nobody was reaching for. Only a capitalised head + consults the types — a lowercase name written where a value goes + was not a mistyped struct, which is [value_candidates]' whole + point. *) + let capitalised = + name <> "" && name.[0] = Char.uppercase_ascii name.[0] + && name.[0] <> Char.lowercase_ascii name.[0] + in + let guess = + match nearest (!builtin_names @ value_candidates ctx) name with + | Some _ as m -> m + | None -> if capitalised then near_miss ctx.env name else None + in + match guess with + | Some m -> + Loc.failk "check/unknown-function" loc + "unknown function %s — did you mean %s?" name m + | None -> + if args <> [] && capitalised then + (* [(defvar p (Pair i32))]. A capitalised head with arguments and + no near miss anywhere is somebody reaching for a parameterised + type, which is what the type resolver says about [(Pair i32)] + when the same text lands in a type position. Before defvar took + either reading, that is the message this text got; it says the + same thing here so the answer does not depend on which side of + the fork the form fell down. *) + Loc.failk "check/unknown-function" loc + "unknown function %s. A capitalised name is a type, and a type \ + given type arguments — (%s ...) — is generic code, which is \ + milestone 5" + name name + else Loc.failk "check/unknown-function" loc "unknown function %s" name (* ── A call to a generic function ─────────────────────────────────────── The whole of instantiation, and it is at the call site because the call @@ -7085,6 +7618,11 @@ let builtins : (string * string * string) list = context/allocator.") ] +(* The forward reference declared beside [nearest], filled the moment the table + it names exists. Nothing reads it before a call is checked, and no call is + checked before this module is loaded. *) +let () = builtin_names := List.map (fun (n, _, _) -> n) builtins + (* ── Declarations: pass 1, collect ─────────────────────────────────── *) (* Constant folding, only over integers and only for defconst — enough for an @@ -7116,6 +7654,33 @@ let rec const_int env (e : Ast.expr) : int64 option = (const_int env x) (y :: rest) | _ -> None +(* [(defconst grid [rows [cols u8]])]. A two-element defconst has no type slot + — the second form is always a value — so the brackets were read as an array + *literal* and [u8] as a name in it, and the refusal that came out was + "unknown name u8", which sends the reader to look for a missing definition + of something the language has had all along. + + A type name inside an array literal is unambiguous evidence, because a type + and a value cannot share a name: [collect]'s claimed table is over every + declaration kind there is. So finding one means the whole form was meant as + a type, and the form that takes one is [defvar]. *) +let rec defconst_type_shaped env gname (v : Ast.expr) = + match v.Ast.e with + | Ast.Arr items -> + List.iter + (fun (i : Ast.expr) -> + match i.Ast.e with + | Ast.Var n when is_type_name env n -> + Loc.failk "check/defconst-is-a-type" i.Ast.loc + "%s is a type, and this is a value: a two-element defconst has no \ + type slot, so the brackets around it were read as an array \ + literal and %s as a name in it. A global declared by its type is \ + a defvar — write (defvar %s ...) with the same brackets" + n n gname + | _ -> defconst_type_shaped env gname i) + items + | _ -> () + let collect env (decls : Ast.decl list) = (* One pass over every declaration kind before any of the others, because the tables below are per-kind — structs, data types, aliases, enums, functions @@ -7402,7 +7967,11 @@ let collect env (decls : Ast.decl list) = in env.tyvars <- []; env.tvpreds <- []; - if vars = [] then Hashtbl.replace env.fns fn.Ast.name (params, ret) + if vars = [] then begin + Hashtbl.replace env.fns fn.Ast.name (params, ret); + Hashtbl.replace env.fparams fn.Ast.name fn.Ast.params; + Hashtbl.replace env.fn_locs fn.Ast.name fn.Ast.nloc + end else begin Hashtbl.replace env.generics fn.Ast.name fn; Hashtbl.replace env.gsigs fn.Ast.name (vars, params, ret) @@ -7412,10 +7981,15 @@ let collect env (decls : Ast.decl list) = | Some t -> resolve env t | None -> fail loc "defvar %s needs a type" n in - Hashtbl.replace env.globals n (ty, false) + Hashtbl.replace env.globals n (ty, false); + Hashtbl.replace env.global_locs n loc | Ast.Defconst (n, Some t, _) -> - Hashtbl.replace env.globals n (resolve env t, true) - | Ast.Defconst (n, None, v) -> untyped := (n, v) :: !untyped + Hashtbl.replace env.globals n (resolve env t, true); + Hashtbl.replace env.global_locs n loc + | Ast.Defconst (n, None, v) -> + defconst_type_shaped env n v; + Hashtbl.replace env.global_locs n loc; + untyped := (n, v) :: !untyped (* [Classes.expand] ran at the top of [build_program] and left none of these behind, the way [Shim.expand] leaves no [declare-c] behind. A driver that assembled a declaration list and skipped that pass would diff --git a/lib/emit.ml b/lib/emit.ml index ca4d8a5..4cdc1fd 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3625,15 +3625,19 @@ declare i64 @flan_dyn_kw(ptr, i64) declare i64 @flan_dyn_map_get(i64, i64) declare void @flan_dyn_map_set(i64, i64, i64) declare i64 @flan_dyn_map_contains(i64, i64) -declare i64 @flan_dyn_add(i64, i64) -declare i64 @flan_dyn_sub(i64, i64) -declare i64 @flan_dyn_mul(i64, i64) -declare i64 @flan_dyn_div(i64, i64) -declare i64 @flan_dyn_rem(i64, i64) -declare i64 @flan_dyn_lt(i64, i64) -declare i64 @flan_dyn_le(i64, i64) -declare i64 @flan_dyn_gt(i64, i64) -declare i64 @flan_dyn_ge(i64, i64) +; The nine that trap carry the site as ptr+len, the way the bounds and +; arithmetic traps in flan_rt.c do: a dyn type error IS the type error in a +; dynamic program, and it used to print with no file and no line. [eq] never +; traps, so it has nowhere to put one. +declare i64 @flan_dyn_add(i64, i64, ptr, i64) +declare i64 @flan_dyn_sub(i64, i64, ptr, i64) +declare i64 @flan_dyn_mul(i64, i64, ptr, i64) +declare i64 @flan_dyn_div(i64, i64, ptr, i64) +declare i64 @flan_dyn_rem(i64, i64, ptr, i64) +declare i64 @flan_dyn_lt(i64, i64, ptr, i64) +declare i64 @flan_dyn_le(i64, i64, ptr, i64) +declare i64 @flan_dyn_gt(i64, i64, ptr, i64) +declare i64 @flan_dyn_ge(i64, i64, ptr, i64) declare i64 @flan_dyn_eq(i64, i64) declare i64 @flan_dyn_len(i64) declare i64 @flan_dyn_at(i64, i64) diff --git a/lib/load.ml b/lib/load.ml index 1d495ec..e56cbf8 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -103,11 +103,15 @@ let is_package_file path = Filename.check_suffix path ".flan" && Sys.file_exists path && not (Sys.is_directory path) +(* [Filename.concat] of a directory and "." leaves the dot on the end, and the + dot was being printed at the reader in the one message that shows this + path. Nothing else depends on the spelling, so it is cleaned here. *) +let absolute d = + let d = if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d in + if Filename.basename d = Filename.current_dir_name then Filename.dirname d else d + let resolve_dir ~file loc path = - let here = - let d = Filename.dirname file in - if Filename.is_relative d then Filename.concat (Sys.getcwd ()) d else d - in + let here = absolute (Filename.dirname file) in let ok d = (Sys.file_exists d && Sys.is_directory d) || is_package_file d in match split_path path with | None, rel -> @@ -117,9 +121,14 @@ let resolve_dir ~file loc path = | Some collection, rel -> (match find_collection here collection with | None -> + (* Stated, rather than asserted and then contradicted in the same + sentence. What the reader needs is the rule — where a collection is + looked for — and the two ends of the search that was run. *) fail loc - "the collection %s: is a directory named %s somewhere above %s, and \ - there is none" collection collection here + "no collection named %s. A collection is a directory of that name in \ + the importing file's own directory or in one above it, and there is \ + none between %s and the root" + collection here | Some root -> let d = Filename.concat root rel in if ok d then d else fail loc "the package %s is not at %s" path d) diff --git a/lib/parse.ml b/lib/parse.ml index e4f450a..0b6b2fd 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -736,7 +736,46 @@ and bindings f (items : Form.t list) : Ast.binding list = Loc.fail odd.loc "binding %s has no value — let takes name/value pairs" (Form.to_string odd) in - if items = [] then Loc.fail f.loc "let needs at least one binding" else go items + (* [(let [x i32 5] ...)] is the first thing anyone arriving from a typed + language writes, and [let] has no annotation slot: the [i32] is read as + [x]'s value and the [5] is left with no name, so the refusal was "binding + 5 has no value", which reads as if the writer had miscounted. + + Only checked when the count is odd — that is, only on the path that was + about to refuse anyway — so a binding vector that parses is never + examined for this. The test for "this names a type" is syntactic, because + nothing is resolved at parse time: a primitive's name, or a capitalised + one, which is the convention the whole corpus keeps and the only two + spellings somebody writes an annotation with. *) + let annotation () = + let type_shaped (x : Form.t) = + match x.Form.v with + | Form.Sym n -> + List.mem n Types.primitive_names + || (n <> "" && n.[0] = Char.uppercase_ascii n.[0] + && n.[0] <> Char.lowercase_ascii n.[0]) + | _ -> false + in + let rec scan i = function + | a :: b :: rest -> + if i mod 2 = 1 && type_shaped a then Some (a, b) else scan (i + 1) (b :: rest) + | _ -> None + in + scan 0 items + in + if items = [] then Loc.fail f.loc "let needs at least one binding" + else begin + if List.length items mod 2 = 1 then + (match annotation () with + | Some (t, v) -> + Loc.failk "parse/let-type-annotation" t.Form.loc + "a let binding takes no type annotation, so %s here is read as the \ + value and %s is left with no name. Write the pair alone — the \ + type is inferred from the value" + (Form.to_string t) (Form.to_string v) + | None -> ()); + go items + end (* ── Destructuring ─────────────────────────────────────────────────── *) @@ -1291,10 +1330,27 @@ let rec decl (f : Form.t) : Ast.decl = would be true and unhelpful. *) let rty = try texpr ret with - | 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 + | Loc.Error { Loc.dloc = inner; dmsg = msg; _ } -> + (* The slot, not whatever inside it [texpr] happened to give up on: + for [(defn f [x i32] (+ x 1))] that was the [1], three forms + deep, where the mistake is that the whole form is in the return + slot. What [texpr] said keeps its own span as a note, because it + is still the reason. *) + if inner.Loc.line = ret.Form.loc.Loc.line + && inner.Loc.col = ret.Form.loc.Loc.col + then + (* [texpr] gave up on the slot form itself, so what it said is + already about the right thing — [unit is written (), not Unit] + leads, and the slot's own clause follows it. *) + Loc.failk "parse/return-type-expected" inner + "%s — this is the return type, which every defn states, and a \ + function that returns nothing writes ()" msg + else + Loc.failk "parse/return-type-expected" ret.Form.loc + ~notes:[ Loc.note inner msg ] + "the return type goes here, and this is %s — every defn states \ + one, and a function that returns nothing writes ()" + (Form.to_string ret) in let fwhere, body = constraints body in mk (Ast.Defn { Ast.name = sym n; params = []; praw = Some (pitems ps); @@ -1744,6 +1800,14 @@ let program (forms : Form.t list) : Ast.decl list = let program_all (forms : Form.t list) : Ast.decl list = parse_forms ~keep_going:true forms +(* The head of the form that was expanded, which is the macro's name wherever + there was a macro. "%d of them" had no antecedent once the message was read + cold; this says what expanded. *) +let expanded_head (f : Form.t) = + match f.Form.v with + | Form.List ({ v = Form.Sym h; _ } :: _) -> h + | _ -> Form.to_string f + (* Single-declaration entry point, for tests and the REPL. *) let decl (f : Form.t) : Ast.decl = temps := 0; @@ -1753,8 +1817,10 @@ let decl (f : Form.t) : Ast.decl = (* One declaration in, one out. A macro at the top level would break that, and there is no top-level macro call: [decl] dispatches on the head and a macro name is not one of the heads it knows. *) - Loc.fail f.loc "expanding this declaration produced %d of them" - (List.length fs) + Loc.failk "parse/expansion-arity" f.loc + "expanding %s produced %d declarations, and one was expected here — a \ + top-level form is one declaration. Nothing joins several into one" + (expanded_head f) (List.length fs) (* Single-expression entry point: C-x C-e, and the tests that parse one expression. It expands, which [Parse.expr] above does not and never did — @@ -1781,5 +1847,7 @@ let expr (f : Form.t) : Ast.expr = (* One expression in, one out. [Macro.program] is a [List.map], so it cannot answer with anything else — this is here because the invariant is worth stating where it is relied on, not because it has been seen. *) - Loc.fail f.loc "expanding this expression produced %d forms, and an \ - expression is one" (List.length fs) + Loc.failk "parse/expansion-arity" f.loc + "expanding %s produced %d forms, and an expression is one — wrap them \ + in (do ...) if they are meant to run in order" + (expanded_head f) (List.length fs) diff --git a/lib/reader.ml b/lib/reader.ml index 66b2ff0..0e098a7 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -89,7 +89,13 @@ let read_string st = advance st; (* opening quote *) let buf = Buffer.create 16 in let rec go () = - if at_end st then Loc.failk "reader/unterminated-string" loc "unterminated string" + if at_end st then + (* The same two places [reader/unclosed] reports, for the same reason: + the fix goes at the quote that is still open, and how far the reader + got before running out is the half a single caret cannot show. *) + Loc.failk "reader/unterminated-string" loc + ~notes:[ Loc.note (here st) "the input ends here, still inside it" ] + "unterminated string — no closing quote" else match peek st with | '"' -> advance st | '\\' -> diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 8169146..062a821 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -759,22 +759,42 @@ static void say(char *buf, int64_t cap, flan_dyn v) { * which without reading the sentence twice — and because the break loop lists * them by name. */ -static _Noreturn void trap2(const char *name, int64_t namelen, const char *op, +/* Where the operation was written, printed as flan_rt.c's traps print it: the + * GNU "file:line:col: " prefix, so `next-error` walks to the dyn failure the + * same way it walks to a bounds failure. The pair is what an emitted string + * literal already is — a pointer and a length, not a C string — and the + * emitter hands it over exactly as [flan_dyn_cast_kind]'s site does. + * + * A NULL [loc] prints nothing at all and the sentence after it is byte for + * byte the one this file printed before: the entry points that have not been + * given a site yet (every one but the five arithmetic and four ordering ones) + * pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and + * has no source position to offer. */ +static void trap_where(const uint8_t *loc, int64_t loclen) { + if (loc != NULL && loclen > 0) + fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc); +} + +static _Noreturn void trap2(const uint8_t *loc, int64_t loclen, + const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a, flan_dyn b) { char sa[SAY_MAX], sb[SAY_MAX]; say(sa, SAY_MAX, a); say(sb, SAY_MAX, b); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s and %s, and %s — (%s %s %s)\n", op, tag_of(a), tag_of(b), why, op, sa, sb); flan_trap((const uint8_t *)name, namelen); } -static _Noreturn void trap1(const char *name, int64_t namelen, const char *op, +static _Noreturn void trap1(const uint8_t *loc, int64_t loclen, + const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a) { char sa[SAY_MAX]; say(sa, SAY_MAX, a); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s, and %s — (%s %s)\n", op, tag_of(a), why, op, sa); flan_trap((const uint8_t *)name, namelen); } @@ -782,11 +802,17 @@ static _Noreturn void trap1(const char *name, int64_t namelen, const char *op, #define TYPE_TRAP "DynType", 7 #define ARITH_TRAP "DynArith", 8 -static _Noreturn void trap_range(const char *op, flan_dyn v, int64_t i, +/* No site reaches these two yet: [at], [set-at], [push] and the allocator + * paths are not among the nine entry points this pass gave a location to. The + * parameter is here so that giving them one later is a call-site change and + * not another round of signature churn. */ +static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen, + const char *op, flan_dyn v, int64_t i, int64_t len) { char sv[SAY_MAX]; say(sv, SAY_MAX, v); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: index %lld is out of bounds for %s of length %lld — %s\n", op, (long long)i, tag_of(v), (long long)len, sv); @@ -1080,7 +1106,7 @@ flan_dyn flan_dyn_map_new(void) { flan_dyn flan_dyn_map_new_class(flan_dyn k) { flan_obj *o; if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) - trap1(TYPE_TRAP, "class instance", "a class tag is a keyword", k); + trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k); o = gc_alloc(OBJ_MAP, 0); o->len = 0; o->u.v.items = NULL; @@ -1177,7 +1203,7 @@ static inline int is_vec(flan_dyn v) { int64_t flan_dyn_need_i64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_INT) - trap1(TYPE_TRAP, "i64", "an int was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "i64", "an int was wanted", v); return dyn_int_value(v); } @@ -1204,13 +1230,13 @@ int64_t flan_dyn_need_i64(flan_dyn v) { * not tell (g 1) from (g (len xs)). */ double flan_dyn_need_f64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) - trap1(TYPE_TRAP, "f64", "a float was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); return dyn_num_value(v); } uint8_t flan_dyn_need_bool(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) - trap1(TYPE_TRAP, "bool", "a bool was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); return (uint8_t)(dyn_payload(v) ? 1 : 0); } @@ -1304,7 +1330,10 @@ int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len, : sizeof name - 1; memcpy(name, target, n); name[n] = '\0'; - trap1(TYPE_TRAP, name, "a number was wanted", v); + /* This one has a site: the cast's own, which the emitter already hands + * over for the cross-kind warning below. It was the first entry point on + * this side to take a location and it was not passing it on. */ + trap1(loc, loc_len, TYPE_TRAP, name, "a number was wanted", v); } int32_t is_float = tag == FLAN_DYN_TAG_FLOAT ? 1 : 0; if (is_float != (want_float ? 1 : 0) && site_first_time(loc, loc_len)) { @@ -1331,7 +1360,7 @@ int32_t flan_dyn_is_nil(flan_dyn v) { * operation that refused. */ flan_dyn flan_dyn_need_not_nil(flan_dyn v) { if (flan_dyn_tag(v) == FLAN_DYN_TAG_NIL) - trap1(TYPE_TRAP, "some", + trap1(NULL, 0, TYPE_TRAP, "some", "Some cannot hold nil -- nil and None would become the same case " "of an (Option dyn)", v); return v; @@ -1367,15 +1396,17 @@ uint8_t flan_dyn_truthy(flan_dyn v) { * its own sentence for the reason flan_rt.c's gives it one: somebody meeting * it has probably never had to think about it. */ -static void want_nums(const char *op, const char *why, flan_dyn a, flan_dyn b) { - if (!is_num(a) || !is_num(b)) trap2(TYPE_TRAP, op, why, a, b); +static void want_nums(const uint8_t *loc, int64_t loclen, const char *op, + const char *why, flan_dyn a, flan_dyn b) { + if (!is_num(a) || !is_num(b)) trap2(loc, loclen, TYPE_TRAP, op, why, a, b); } #define ARITH_NUM "it takes two numbers" -static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { +static flan_dyn arith(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn a, flan_dyn b) { int64_t x, y; - want_nums(op, ARITH_NUM, a, b); + want_nums(loc, loclen, op, ARITH_NUM, a, b); if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { x = dyn_int_value(a); @@ -1385,14 +1416,14 @@ static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { case '-': return flan_dyn_from_i64((int64_t)((uint64_t)x - (uint64_t)y)); case '*': return flan_dyn_from_i64((int64_t)((uint64_t)x * (uint64_t)y)); case '/': - if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) - trap2(ARITH_TRAP, op, + trap2(loc, loclen, ARITH_TRAP, op, "the quotient is one past the largest i64, which is true of " "this pair of operands and no other", a, b); return flan_dyn_from_i64(x / y); default: - if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) return flan_dyn_from_i64(0); return flan_dyn_from_i64(x % y); } @@ -1425,11 +1456,26 @@ static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { } } -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith("+", a, b); } -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith("-", a, b); } -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith("*", a, b); } -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith("/", a, b); } -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); } +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "+", a, b); +} +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "-", a, b); +} +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "*", a, b); +} +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "/", a, b); +} +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "%", a, b); +} /* ── Ordering ────────────────────────────────────────────────────────── * @@ -1444,7 +1490,8 @@ flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); } * numbering, and a program that sorted a mixed vec would get a stable answer * that means nothing. */ -static int order(const char *op, flan_dyn a, flan_dyn b) { +static int order(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn a, flan_dyn b) { if (is_num(a) && is_num(b)) { if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { @@ -1468,22 +1515,26 @@ static int order(const char *op, flan_dyn a, flan_dyn b) { if (c != 0) return c < 0 ? -1 : 1; return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0); } - trap2(TYPE_TRAP, op, + trap2(loc, loclen, TYPE_TRAP, op, "it compares two numbers or two texts, and these are neither", a, b); } -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { - return flan_dyn_from_bool(order("<", a, b) == -1); +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return flan_dyn_from_bool(order(loc, loclen, "<", a, b) == -1); } -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { - int c = order("<=", a, b); +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + int c = order(loc, loclen, "<=", a, b); return flan_dyn_from_bool(c == -1 || c == 0); } -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { - return flan_dyn_from_bool(order(">", a, b) == 1); +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return flan_dyn_from_bool(order(loc, loclen, ">", a, b) == 1); } -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { - int c = order(">=", a, b); +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + int c = order(loc, loclen, ">=", a, b); return flan_dyn_from_bool(c == 1 || c == 0); } @@ -1699,7 +1750,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, case FLAN_VIEW_I64: { int64_t n; if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) - trap2(TYPE_TRAP, op, "this view's elements are int", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are int", v, x); n = dyn_int_value(x); memcpy(p, &n, 8); return; @@ -1707,7 +1758,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, case FLAN_VIEW_F64: { double d; if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) - trap2(TYPE_TRAP, op, "this view's elements are float", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are float", v, x); d = dyn_num_value(x); memcpy(p, &d, 8); return; @@ -1715,7 +1766,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, default: { uint8_t b; if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) - trap2(TYPE_TRAP, op, "this view's elements are bool", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are bool", v, x); b = dyn_payload(x) ? 1 : 0; *p = b; return; @@ -1748,7 +1799,7 @@ flan_dyn flan_dyn_len(flan_dyn v) { if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("len", o)); return flan_dyn_from_i64(o->len); } - trap1(TYPE_TRAP, "len", "only a text, a vec or a map has one", v); + trap1(NULL, 0, TYPE_TRAP, "len", "only a text, a vec or a map has one", v); } /* The index has to be an int, and that is a separate sentence from the @@ -1756,7 +1807,7 @@ flan_dyn flan_dyn_len(flan_dyn v) { * and telling somebody "these are the wrong types" names neither. */ static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) { if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT) - trap2(TYPE_TRAP, op, "an index must be an int", v, i); + trap2(NULL, 0, TYPE_TRAP, op, "an index must be an int", v, i); return dyn_int_value(i); } @@ -1767,16 +1818,16 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) { int64_t k; flan_obj *o; if (!is_text(v) && !is_vec(v)) - trap2(TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); + trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); k = need_index("at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("at", o); - if (k < 0 || k >= len) trap_range("at", v, k, len); + if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len); return view_box(o->u.view.elem, (const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem)); } - if (k < 0 || k >= o->len) trap_range("at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(NULL, 0, "at", v, k, o->len); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); return o->u.v.items[k]; } @@ -1785,20 +1836,20 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) { int64_t k; flan_obj *o; if (is_text(v)) - trap2(TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); + trap2(NULL, 0, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); if (!is_vec(v)) - trap2(TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); + trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); k = need_index("set-at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("set-at", o); uint8_t *p; - if (k < 0 || k >= len) trap_range("set-at", v, k, len); + if (k < 0 || k >= len) trap_range(NULL, 0, "set-at", v, k, len); p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem); view_unbox("set-at", v, o->u.view.elem, x, p); return; } - if (k < 0 || k >= o->len) trap_range("set-at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(NULL, 0, "set-at", v, k, o->len); o->u.v.items[k] = x; } @@ -1807,7 +1858,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x) { if (!is_vec(v)) { /* The value is in the sentence rather than the vec, because the vec is the * thing that is wrong and the value is what says which push it was. */ - trap2(TYPE_TRAP, "push", "only a vec is pushed to", v, x); + trap2(NULL, 0, TYPE_TRAP, "push", "only a vec is pushed to", v, x); } o = dyn_obj(v); if (o->kind == OBJ_VIEW) { @@ -1815,7 +1866,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x) { static const uint8_t push_loc[] = "(dyn push)"; int64_t size; if (!o->u.view.is_vec) - trap2(TYPE_TRAP, "push", + trap2(NULL, 0, TYPE_TRAP, "push", "this view is a slice or an array and cannot grow", v, x); size = view_elem_size(o->u.view.elem); view_unbox("push", v, o->u.view.elem, x, buf); @@ -1869,7 +1920,7 @@ static int64_t map_find(flan_obj *o, flan_dyn k) { } static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) { - if (!is_map(m)) trap2(TYPE_TRAP, op, "only a map answers it", m, k); + if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, op, "only a map answers it", m, k); return dyn_obj(m); } diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 928e1e9..49643de 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -108,20 +108,28 @@ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n); * sentence naming the operation, the tags it was given and the values, and * then takes flan_rt.c's [flan_trap] — which parks the program for inspection * in a dev session and ends it in a standalone build. The three that cannot - * trap say so on their own line. */ + * trap say so on their own line. + * + * The nine below take the site as well: [loc]/[loclen] are the bytes of a + * "file:line:col" string the emitter already has, and the trap prints them as + * a GNU prefix so the failure is somewhere rather than nowhere. It is the same + * pair flan_rt.c's bounds and arithmetic traps take, and the same pair + * [flan_dyn_cast_kind] takes below. A caller with no site — the C tests, and + * anything outside a compiled Flan program — passes (NULL, 0) and gets the + * sentence with no prefix. */ -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); /* Answer a bool dyn. Numbers compare as numbers and text compares bytewise; * a mixture of the two, or anything else, traps. */ -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); /* Structural, and the one operation in this file that never traps: two values * of unrelated tags are not an error, they are unequal. */ diff --git a/runtime/flan_dyn_stub.c b/runtime/flan_dyn_stub.c index ce64ee7..617c601 100644 --- a/runtime/flan_dyn_stub.c +++ b/runtime/flan_dyn_stub.c @@ -148,11 +148,31 @@ static flan_dyn arith(flan_dyn a, flan_dyn b, char op) { } } -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith(a, b, '+'); } -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith(a, b, '-'); } -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith(a, b, '*'); } -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith(a, b, '/'); } -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith(a, b, '%'); } +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '+'); +} +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '-'); +} +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '*'); +} +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '/'); +} +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '%'); +} /* ── Ordering and equality ─────────────────────────────────────────── */ @@ -173,10 +193,26 @@ static int cmp(flan_dyn a, flan_dyn b) { } } -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) < 0); } -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) <= 0); } -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) > 0); } -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) >= 0); } +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) < 0); +} +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) <= 0); +} +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) > 0); +} +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) >= 0); +} /* Structural, and never traps — the header's one exception. */ static int eq(cell *x, cell *y) { diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 09e715d..50ac322 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -40,6 +40,20 @@ * rather than a hand-copied list. */ #include "flan_dyn.h" +/* The nine trapping operators took a site — (loc, len) — when flan_dyn.c's + * traps learned to print a file and a line. This file calls the runtime + * directly and has no source position to offer, so it passes (NULL, 0), which + * prints the sentence exactly as it printed before. */ +#define FDYN_add(a, b) flan_dyn_add((a), (b), NULL, 0) +#define FDYN_sub(a, b) flan_dyn_sub((a), (b), NULL, 0) +#define FDYN_mul(a, b) flan_dyn_mul((a), (b), NULL, 0) +#define FDYN_div(a, b) flan_dyn_div((a), (b), NULL, 0) +#define FDYN_rem(a, b) flan_dyn_rem((a), (b), NULL, 0) +#define FDYN_lt(a, b) flan_dyn_lt((a), (b), NULL, 0) +#define FDYN_le(a, b) flan_dyn_le((a), (b), NULL, 0) +#define FDYN_gt(a, b) flan_dyn_gt((a), (b), NULL, 0) +#define FDYN_ge(a, b) flan_dyn_ge((a), (b), NULL, 0) + void flan_rt_init(int32_t argc, char **argv); void flan_vec_free(void *v, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen); @@ -161,41 +175,41 @@ static void ops(void) { "a boxed int is still an int"); /* Arithmetic. Two ints answer an int; a float anywhere answers a float. */ - check(num(flan_dyn_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); - check(num(flan_dyn_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); - check(num(flan_dyn_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); - check(num(flan_dyn_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); - check(num(flan_dyn_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); - check(num(flan_dyn_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, + check(num(FDYN_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); + check(num(FDYN_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); + check(num(FDYN_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); + check(num(FDYN_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); + check(num(FDYN_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); + check(num(FDYN_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, "% keeps the sign of the dividend"); check(flan_dyn_need_f64( - flan_dyn_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, + FDYN_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, "int and float promote"); check(flan_dyn_need_f64( - flan_dyn_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, + FDYN_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, "float /"); check(flan_dyn_need_f64( - flan_dyn_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, + FDYN_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, "float %"); /* The boxed end of the range arithmetically, not only as a round trip. */ - check(num(flan_dyn_add(flan_dyn_from_i64(140737488355327LL), + check(num(FDYN_add(flan_dyn_from_i64(140737488355327LL), flan_dyn_from_i64(1))) == 140737488355328LL, "+ crosses into the box"); /* Ordering. Numbers against numbers across the two tags, text bytewise, and a NaN that is none of less, equal or greater. */ - check(truth(flan_dyn_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); - check(!truth(flan_dyn_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); - check(truth(flan_dyn_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); - check(truth(flan_dyn_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); - check(truth(flan_dyn_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); - check(truth(flan_dyn_lt(text("abc"), text("abd"))), "< text"); - check(truth(flan_dyn_lt(text("ab"), text("abc"))), "< text prefix"); - check(!truth(flan_dyn_lt(text("abc"), text("abc"))), "< text equal"); + check(truth(FDYN_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); + check(!truth(FDYN_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); + check(truth(FDYN_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); + check(truth(FDYN_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); + check(truth(FDYN_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); + check(truth(FDYN_lt(text("abc"), text("abd"))), "< text"); + check(truth(FDYN_lt(text("ab"), text("abc"))), "< text prefix"); + check(!truth(FDYN_lt(text("abc"), text("abc"))), "< text equal"); { flan_dyn n = flan_dyn_from_f64(0.0 / 0.0), one = flan_dyn_from_i64(1); - check(!truth(flan_dyn_lt(n, one)) && !truth(flan_dyn_gt(n, one)) - && !truth(flan_dyn_le(n, one)) && !truth(flan_dyn_ge(n, one)), + check(!truth(FDYN_lt(n, one)) && !truth(FDYN_gt(n, one)) + && !truth(FDYN_le(n, one)) && !truth(FDYN_ge(n, one)), "nan is unordered in all four directions"); } @@ -952,27 +966,27 @@ static void desc(void) { static void refuse(const char *what) { flan_dyn v = flan_dyn_vec_new(); flan_dyn t = text("hi"); - if (strcmp(what, "add") == 0) (void)flan_dyn_add(flan_dyn_from_i64(3), t); + if (strcmp(what, "add") == 0) (void)FDYN_add(flan_dyn_from_i64(3), t); else if (strcmp(what, "sub") == 0) - (void)flan_dyn_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); + (void)FDYN_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); else if (strcmp(what, "mul") == 0) - (void)flan_dyn_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); + (void)FDYN_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); else if (strcmp(what, "div") == 0) - (void)flan_dyn_div(v, flan_dyn_from_i64(2)); + (void)FDYN_div(v, flan_dyn_from_i64(2)); else if (strcmp(what, "rem") == 0) - (void)flan_dyn_rem(flan_dyn_from_i64(2), flan_dyn_nil()); + (void)FDYN_rem(flan_dyn_from_i64(2), flan_dyn_nil()); else if (strcmp(what, "divzero") == 0) - (void)flan_dyn_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + (void)FDYN_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "remzero") == 0) - (void)flan_dyn_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + (void)FDYN_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "divover") == 0) - (void)flan_dyn_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); + (void)FDYN_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); else if (strcmp(what, "lt") == 0) - (void)flan_dyn_lt(flan_dyn_from_i64(1), t); - else if (strcmp(what, "le") == 0) (void)flan_dyn_le(t, flan_dyn_nil()); - else if (strcmp(what, "gt") == 0) (void)flan_dyn_gt(v, v); + (void)FDYN_lt(flan_dyn_from_i64(1), t); + else if (strcmp(what, "le") == 0) (void)FDYN_le(t, flan_dyn_nil()); + else if (strcmp(what, "gt") == 0) (void)FDYN_gt(v, v); else if (strcmp(what, "ge") == 0) - (void)flan_dyn_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); + (void)FDYN_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); else if (strcmp(what, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1)); else if (strcmp(what, "at") == 0) (void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); diff --git a/test/programs/dyn-trap-site.flan b/test/programs/dyn-trap-site.flan new file mode 100644 index 0000000..726b0ae --- /dev/null +++ b/test/programs/dyn-trap-site.flan @@ -0,0 +1,28 @@ +;;;; A dyn arithmetic trap says where it happened. +;;;; +;;;; In a dynamic-first language the dyn traps ARE the type errors, and until +;;;; the diagnostics pass they printed with no file, no line and no column: +;;;; +;;;; dyn +: int and text, and it takes two numbers — (+ 3 "hi") +;;;; +;;;; flan_rt.c's bounds and arithmetic traps have taken an emitter-threaded +;;;; (loc, loclen) pair since they were written, so the ABI precedent was +;;;; already there; the five arithmetic and four ordering entry points in +;;;; flan_dyn.c simply were never given one. They take it now, and the trap +;;;; prints it as the GNU "file:line:col: " prefix, which is what makes +;;;; next-error walk to a dyn failure the way it walks to a bounds failure. +;;;; +;;;; This program exists for the prefix and for nothing else. The line prints +;;;; first so that the test can tell "the program ran and then trapped" from +;;;; "the program did not start", and the operation is inside a defn so that +;;;; the site reported is the operator's own and not the call's — which is the +;;;; distinction that matters: the + is what failed, and the + is what the +;;;; caret should be under. + +(defn add [x y] dyn + (+ x y)) + +(defn main [] () + (print "before\n") + (print (add 3 "hi")) + (print "unreachable\n")) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index f882fa7..40293cc 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3879,6 +3879,45 @@ level "1" some_nil ~opt:"-O0" (); some_nil ~x86:true (); + (* The dyn trap's own location, end to end: compiled, run, and read off + stderr. In a dynamic-first language these traps are the type errors, + and they printed with no file and no line at all. The site is a string + literal the emitter hands over exactly as it hands [flan_dyn_cast_kind] + its own, so this is asserted on both backends and at -O0: the argument + is an ordinary one and neither backend treats it specially, which is + the claim being pinned. + + 23:3 is the (+ x y) inside [add], not the (add 3 "hi") that called it, + and that is the point of the site being the operator's: the + is what + failed. If the file is edited above line 23 this number moves. *) + let trap_site_out = "before\n" in + let trap_site ?opt ?x86 () = + let exe = compile ?opt ?x86 "programs/dyn-trap-site.flan" in + let code, text = run exe None in + let name = + "dyn: an arithmetic trap says where" + ^ (match opt with Some o -> ", " ^ o | None -> "") + ^ (match x86 with Some true -> ", --x86" | _ -> "") + in + if code <> 134 + || not (contains text trap_site_out) + || not (contains text + "dyn-trap-site.flan:23:3: dyn +: int and text, and it \ + takes two numbers — (+ 3 \"hi\")") + || contains text "unreachable" + then begin + incr failures; + Printf.printf + "FAIL %s\n got: %S (exit %d)\n wanted: %S then the trap \ + with its site (exit 134)\n" + name text code trap_site_out + end; + (try Sys.remove exe with Sys_error _ -> ()) + in + trap_site (); + trap_site ~opt:"-O0" (); + trap_site ~x86:true (); + (* A numeric cast opening a dyn box — FIX.org 2026-09-20. programs/dyn-cast.flan is one program because the three behaviours are one story told in order: the same-kind casts print, the cross-kind ones @@ -3936,8 +3975,14 @@ level "1" || not (contains text "found a dyn holding an int, and converted it to f64") || not (contains text "found a dyn holding a float, and converted it to i64") || not (contains text "found a dyn holding an int, and converted it to f32") - (* The non-numeric box, in the runtime's own words. *) - || not (contains text "bool, and a number was wanted") + (* The non-numeric box, in the runtime's own words — and with the + site in front of them. [flan_dyn_cast_kind] has taken the cast's + location since the warning below needed one, and was the one entry + point on the dyn side that had a location and threw it away on the + trapping path. 71:10 is the (i64 (as-dyn true)) at the end of + the program; if that file is edited above it, this number moves. *) + || not (contains text "dyn-cast.flan:71:10: dyn i64: bool, and a \ + number was wanted") then begin incr failures; Printf.printf diff --git a/test/test_flan.ml b/test/test_flan.ml index f946955..b773aeb 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1587,6 +1587,14 @@ let () = check "the x86 backend roots its dyn values" (contains dyn_asm "flan_dyn_root_push" && contains dyn_asm "flan_dyn_root_pop"); + (* The site travels with the operands, on this backend as on the other: a + dyn arithmetic trap is the type error of a dynamic program, and it used + to print with no file and no line. This backend writes a string constant + as [.byte] hex rather than as text, so the needle is the encoding of the + ":1:21" that ends the site of the [(+ x y)] above — the path in front of + it is the test runner's temporary directory and is not pinnable. *) + check "the x86 backend hands the dyn operators their site" + (contains dyn_asm "0x3a,0x31,0x3a,0x32,0x31"); (* And a program with no dyn in it emits not one byte of any of it, which is what lets the sweep's other MATCHes stand as a regression check on this lane rather than being re-measured by it. *) @@ -1787,9 +1795,12 @@ let () = accepts "a local is assignable" "(defn f [] i32 (let [x 1] (set x 2) x))"; rejects_check "a parameter is not assignable" - "(defn f [x i32] () (set x 2))" ~needle:"parameters are not assignable"; + "(defn f [x i32] () (set x 2))" ~needle:"a parameter is not a place you can assign to"; rejects_check "a constant is not assignable" - "(defconst k 1) (defn f [] () (set k 2))" ~needle:"is a constant"; + "(defconst k 1) (defn f [] () (set k 2))" + ~needle:"k is a constant, and a constant is not assignable — it is \ + written into the image and there is nothing to assign to. \ + Declare it with defvar if it has to change"; accepts "addr of a local gives a pointer" (cursor ^ "(defn g [c (Ptr Cursor)] i32 (.pos c)) \ (defn f [s [u8]] i32 (let [c (Cursor {.src s})] (g (addr c))))"); @@ -1836,6 +1847,78 @@ let () = rejects_check "unknown name" "(defn f [] i32 nope)" ~needle:"unknown name"; rejects_check "unknown function" "(defn f [] i32 (nope 1))" ~needle:"unknown function"; + + (* ── Did-you-mean, and the dot habit ─────────────────────────────── + [near_miss] was written, tested and wired to the type tables alone, so a + mistyped *value* got the bare refusal. The candidate list at a value + position is the scope, the globals and the functions — and, at a call, + the builtin names, which live in no table the checker keeps. No type + names on either list: a symbol written where a value goes was not a + mistyped struct. *) + rejects_check "a mistyped local is a near miss" + "(defn f [] i32 (let [total 1] totl))" ~needle:"did you mean total?"; + rejects_check "a mistyped defn is a near miss" + "(defn helper [x i32] i32 x) (defn f [] i32 (helpr 1))" + ~needle:"unknown function helpr — did you mean helper?"; + rejects_check "a mistyped builtin is a near miss" + "(defn f [] () (prinltn \"hi\"))" + ~needle:"unknown function prinltn — did you mean println?"; + (* [p.x] is the habit from C, Go and Odin, and the checker can see exactly + what the head is, so the refusal names the accessor rather than reporting + a name nobody wrote. The declaration comes along as a note, which is + [declared_note]'s shape. *) + rejects_check "dot-infix field access names the accessor" + "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] p.x))" + ~needle:"a field is read with an accessor, so write (.x p)"; + rejects_check "and says so when the field is not there either" + "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] p.z))" + ~needle:"(.z p), and P has no field z"; + rejects_check "and in a set it is the place that is spelled" + "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set p.x 2) 0))" + ~needle:"a field is assigned through an accessor, so write (set (.x p) ...)"; + accepts "which is a real form" + "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set (.x p) 2) (.x p)))"; + rejects_check "a dotted head that is not a struct says what it is" + "(defn f [] i32 (let [n 1] n.x))" ~needle:"n is i32, which has no fields"; + (* The fourth shape: nothing is bound under the head either, so the message + claims nothing about what q is — only that the dot is not the operator + the writer took it for. *) + rejects_check "and an unbound head claims nothing about it" + "(defn f [] i32 q.x)" + ~needle:"unknown name q.x — nothing named q is in scope either. A field \ + is reached through an accessor, (.x q), not with a dot"; + (* A capitalised head keeps the case spelling it always had: [Shape.Circle] + is real here, so a typo in one is not the dot habit. *) + (* Both sides of the rule, because only the pair says what it is. A + capitalised head is a real spelling here — Shape.Circle — so a typo in + one is a mistyped case and gets none of the accessor advice; the same + text with a lowercase head does. The earlier spelling of this row used + (data ...), which is not a top-level form at all, so it refused as an + unknown top-level form and the needle "unknown" matched that instead of + anything this rule does. *) + (match (try ignore (checked "(defdata Shape [(Circle [r f64])]) \ + (defn f [] Shape Shape.Crcle)"); None + with Loc.Error d -> Some d) with + | Some d -> + check "a capitalised dotted name gets no accessor advice" + (contains d.Loc.dmsg "unknown name Shape.Crcle" + && not (contains d.Loc.dmsg "accessor")) + | None -> check "a mistyped case is refused" false); + (match (try ignore (checked "(defdata Shape [(Circle [r f64])]) \ + (defn f [] Shape shape.Crcle)"); None + with Loc.Error d -> Some d) with + | Some d -> + check "and a lowercase one does" + (contains d.Loc.dmsg + "nothing named shape is in scope either. A field is reached through \ + an accessor, (.Crcle shape), not with a dot") + | None -> check "a lowercase dotted name is refused" false); + (* [(Pair i32)] in a defvar falls down the value fork now that the third + element takes either reading, and the generics answer the type fork gave + it has to be reachable from here too. *) + rejects_check "a capitalised call with arguments is generics" + "(defvar x (Pair i32)) (defn f [] i32 0)" + ~needle:"is generic code, which is milestone 5"; rejects_check "defined twice" "(defn f [] ()) (defn f [] ())" ~needle:"defined twice"; accepts "main with no parameters and no return" "(defn main [] ())"; @@ -2011,13 +2094,13 @@ let () = accepts "typed = on strings" "(defn f [] bool (= \"a\" \"b\"))"; accepts "typed != on strings" "(defn f [] bool (!= \"a\" \"b\"))"; rejects_check "no built-in < on strings" - "(defn f [] bool (< \"a\" \"b\"))" ~needle:"no built-in ordering"; + "(defn f [] bool (< \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; rejects_check "no built-in <= on strings" - "(defn f [] bool (<= \"a\" \"b\"))" ~needle:"no built-in ordering"; + "(defn f [] bool (<= \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; rejects_check "no built-in > on strings" - "(defn f [] bool (> \"a\" \"b\"))" ~needle:"no built-in ordering"; + "(defn f [] bool (> \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; rejects_check "no built-in >= on strings" - "(defn f [] bool (>= \"a\" \"b\"))" ~needle:"no built-in ordering"; + "(defn f [] bool (>= \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; (* (Vec T) is built. What is still refused is the arity: one element type, and a near-miss there would otherwise resolve to a type variable and come back as generics. *) @@ -2156,6 +2239,57 @@ let () = rejects_check "the near miss is over the value names as well as the types" "(defvar score i64 1) (defvar total scor) (defn f [] ())" ~needle:"Nothing named scor is declared as either — did you mean score?"; + (* Three things that know which of the two readings was meant, and get in + ahead of the paragraph rather than being buried under it. A paragraph + about a fork the reader is not standing at is worse than a line. *) + rejects_check "a plain type typo keeps the short answer" + "(defvar total i33) (defn f [] ())" + ~needle:"unknown type i33 — did you mean i32?"; + rejects_check "and another language's spelling is answered by name" + "(defvar total int) (defn f [] ())" + ~needle:"unknown type int — Flan spells it i32"; + rejects_check "a data case is not a type, and says what is" + "(defdata Shape [(Circle [r f64])]) (defvar g Circle) (defn f [] ())" + ~needle:"Circle is a case of the data type Shape, and a case is not a \ + type of its own — the global's type is the data type: (defvar g \ + Shape). Assign the case you want, as (set g (Shape.Circle \ + {.field value ...}))"; + (* A bracket form never reaches that fork — the parser gives it the type + reading outright — so a value name inside one used to land in + [resolve_name] and come back as a lecture about generic code. Both + readings at the element that decided it, and the dyn spelling is the one + that works. *) + rejects_check "a bracket type whose element names a value says both readings" + "(defvar a i64 1) (defvar b i64 2) (defvar g [a b]) (defn f [] ())" + ~needle:"b names a value, not a type, and the brackets around it were \ + read as a type"; + rejects_check "and names the dyn spelling that does work" + "(defvar a i64 1) (defvar b i64 2) (defvar g [a b]) (defn f [] ())" + ~needle:"put dyn in front of the same brackets — (defvar g dyn ...)"; + accepts "which is a real form" + "(defvar a i64 1) (defvar b i64 2) (defvar g dyn [a b]) (defn f [] ())"; + + (* defconst's two-element form has no type slot, so a type written in one + was read as a name in an array literal and reported as unknown. It is + unambiguous evidence: a type and a value cannot share a name here. *) + rejects_check "a type in a two-element defconst names defvar" + "(defconst rows 4) (defconst cols 4) (defconst grid [rows [cols u8]]) \ + (defn f [] ())" + ~needle:"u8 is a type, and this is a value: a two-element defconst has no \ + type slot"; + accepts "and the defvar it names is the form that works" + "(defconst rows 4) (defconst cols 4) (defvar grid [rows [cols u8]]) \ + (defn f [] ())"; + accepts "an ordinary array constant is untouched" "(defconst xs [1 2 3])"; + + (* A parameter name is not a mistyped type. This language sizes its machine + types in the name, so a typo in one keeps the digits and a parameter + called [i] or [n] has none — which is the whole of the rule that stopped + [(defn idx [v i] dyn ...)] being refused. *) + accepts "a short parameter name is not a mistyped type" + "(defn idx [v i] dyn v)"; + rejects_check "but a mistyped machine type still is" + "(defn g [x f65] f64 x)" ~needle:"unknown type f65 — did you mean f64?"; (* ── Computed global initialisers ────────────────────────────────── The order they run in is the compiler's to choose, so a global written @@ -3837,6 +3971,173 @@ let () = | _ -> check "an unknown field has one note" false) | None -> check "an unknown field is refused" false); + (* The call argument, which is the most-hit refusal in the compiler and was + the one that said least: the caret was right and the sentence never named + which argument of which function, nor pointed at the parameter that + wanted the other type. Both halves are asserted here, plus the rule that + keeps the claim honest — a mismatch *inside* an argument is not this + argument's, and is left as it was. *) + (match diag_of "(defn add [a i32 b i32] i32 (+ a b))\n (defn f [] i32 (add 1 \"two\"))" with + | Some d -> + check "a bad call argument has a kind" (d.Loc.kind = "check/argument-type"); + check "and says which argument of which function" + (contains d.Loc.dmsg "this is the 2nd argument of add"); + (match d.Loc.notes with + | [ n ] -> + check "and notes the parameter's declaration" (n.Loc.nloc.Loc.line = 1); + check "and names the parameter" + (contains n.Loc.nmsg "add's 2nd parameter b is declared i32") + | _ -> check "a bad call argument has one note" false) + | None -> check "a bad call argument is refused" false); + (match diag_of "(defn add [a i32 b i32] i32 (+ a b))\n (defn f [] i32 (add 1 (add 2 \"x\")))" with + | Some d -> + let times needle hay = + let n = String.length needle in + List.length + (List.filter + (fun i -> String.length hay - i >= n && String.sub hay i n = needle) + (List.init (max 1 (String.length hay)) Fun.id)) + in + (* Named once, by the call that owns it. The outer call sees a refusal + raised against a span that is not its argument's and passes it on + untouched, which is what stops "the 2nd argument of add" being said + twice about two different forms. *) + check "the inner call owns its own argument, and says so once" + (times "argument of add" d.Loc.dmsg = 1) + | None -> check "a nested bad argument is refused" false); + + (* The condition, which used to state a type fact and stop. The rule has two + halves and the dyn half is not the typed half — a dyn condition is + Clojure's, where 0 is true — so the comparison is offered only where it + is right, and with the condition's own name where it has one. *) + rejects_check "a non-bool condition states the rule" + "(defn f [] i32 (let [x 1] (if x 1 0)))" + ~needle:"a condition is a bool or a dyn, and this is i32 — test it, as (!= x 0)"; + rejects_check "and offers no template for a form it cannot name" + "(defn f [] i32 (if (+ 1 2) 1 0))" + ~needle:"this is i32 — test it against 0 with !="; + rejects_check "and offers no comparison at all for a type that has none" + "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (if p 1 0)))" + ~needle:"a condition is a bool or a dyn, and this is P"; + (* A literal still names itself: that message knows something the rule does + not, so the re-check's answer is kept wherever it is more specific. *) + rejects_check "a literal condition keeps its own message" + "(defn f [] i32 (if 1 1 2))" + ~needle:"expected bool, found the integer literal 1"; + + (* Four words before this: the name and the fact. The declaration is where + the reader's next move is, so it comes along. *) + (match diag_of "(defconst k 1)\n(defn f [] () (set k 2))" with + | Some d -> + check "assigning a constant has a kind" (d.Loc.kind = "check/set-constant"); + (match d.Loc.notes with + | [ n ] -> + check "and notes the defconst" (n.Loc.nloc.Loc.line = 1); + check "and says what it is" + (contains n.Loc.nmsg "k is declared a constant here") + | _ -> check "assigning a constant has one note" false) + | None -> check "assigning a constant is refused" false); + + (* A type annotation in a let is the first thing anyone arriving from a + typed language writes, and let has no slot for one. The old refusal + landed on the form left over — "binding 5 has no value" — which reads as + if they had miscounted. Only checked on the path that was refusing + anyway, so a binding vector that parses is never examined for it. *) + (match (try ignore (program "(defn f [] i32 (let [x i32 5] x))"); None + with Loc.Error d -> Some d) with + | Some d -> + check "a let annotation has a kind" (d.Loc.kind = "parse/let-type-annotation"); + check "and blames the annotation, not the leftover" + (contains d.Loc.dmsg "a let binding takes no type annotation, so i32 \ + here is read as the value and 5 is left with no \ + name") + | None -> check "a let annotation is refused" false); + (match (try ignore (program "(defn f [] i32 (let [x 1 y] x))"); None + with Loc.Error d -> Some d) with + | Some d -> + check "and an ordinary odd binding vector is unchanged" + (contains d.Loc.dmsg "binding y has no value") + | None -> check "an odd binding vector is refused" false); + + (* The operand, not the whole form — the same "whole form vs operand" the + condition work already fixed once. Text gets the extra clause, because + (+ "a" "b") is a reach for concatenation. *) + (match diag_of "(defn f [] () (println (+ \"a\" \"b\")))" with + | Some d -> + check "a non-numeric operand is blamed at the operand" + (d.Loc.dloc.Loc.col = 27); + check "and text is told where concatenation lives" + (contains d.Loc.dmsg + "+ takes numbers, and this is string — there is no + on text. The \ + prelude concatenates with concat and join") + | None -> check "a non-numeric operand is refused" false); + + (* The return slot, not whatever inside it the type parser gave up on. For + (defn f [x i32] (+ x 1)) that was the 1, three forms deep, where the + mistake is that the whole form is in the slot. What the type parser said + keeps its own span as a note. *) + (match (try ignore (program "(defn f [x i32] (+ x 1))"); None + with Loc.Error d -> Some d) with + | Some d -> + check "a body in the return slot blames the slot" (d.Loc.dloc.Loc.col = 17); + check "and says what is there" + (contains d.Loc.dmsg + "the return type goes here, and this is (+ x 1) — every defn states \ + one, and a function that returns nothing writes ()"); + check "and keeps the type parser's reason as a note" + (match d.Loc.notes with + | [ n ] -> contains n.Loc.nmsg "expected a type, found 1" + | _ -> false) + | None -> check "a body in the return slot is refused" false); + + (* A one-field case binds the payload itself, so the destructuring reach + that follows gets a type fact where it needs to be told the value is + already in hand. Only where the pattern is what bound it: an ordinary + local keeps the sentence it had. *) + rejects_check "a case payload says the field is already in hand" + "(defdata Shape [(Circle [r f64]) (Square [s f64])]) \ + (defn f [s Shape] f64 (match s (Circle c) (.r c) (Square q) 0.0))" + ~needle:"c is f64 — the pattern bound it to Shape.Circle's field r, so \ + the value is already in hand and there is no field left to read"; + rejects_check "and an ordinary local keeps the type fact" + "(defn f [] i32 (let [x 1] (.r x)))" + ~needle:"i32 is not a struct, so it has no fields"; + + (* A defn whose name is a builtin's is silently unreachable — the dispatch + reaches every builtin arm before it looks in the function table — and the + arity refusal was measured against the builtin while pointing at a call + the reader had written for their own. *) + (match diag_of "(defstruct P [x i32])\n(defn get [p P] i32 (.x p))\n (defn f [] i32 (let [p (P {.x 1})] (get p)))" with + | Some d -> + check "a shadowed builtin's arity has a kind" + (d.Loc.kind = "check/builtin-arity"); + check "and says whose count it is" + (contains d.Loc.dmsg + "this is the builtin get, which a defn of the same name does not \ + replace"); + (match d.Loc.notes with + | [ n ] -> + check "and notes the definition that is not being reached" + (n.Loc.nloc.Loc.line = 2 + && contains n.Loc.nmsg "this call is not reaching it") + | _ -> check "a shadowed builtin has one note" false) + | None -> check "a shadowed builtin's call is refused" false); + + (* and's last operand is the then arm and the sentinel carrying the previous + operand's location is the else arm, so with no expectation in hand the + mismatch was reported one operand early. FIX.org's accepted fix: blame + the arm that is not a compiler temp. *) + (match diag_of "(defn f [] () (println (and true true (vec-new i32))))" with + | Some d -> + check "and blames its last operand, not the one before it" + (d.Loc.kind = "check/shortcircuit-operand" && d.Loc.dloc.Loc.col = 39); + check "and states what the two answers are" + (contains d.Loc.dmsg + "an and answers false when it stops early and its last operand \ + otherwise, so the two have to be one type — this operand is (Vec \ + i32), and false is a bool") + | None -> check "a mistyped and operand 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. *) @@ -3855,6 +4156,21 @@ let () = check "and notes the opener" (match d.Loc.notes with [ n ] -> n.Loc.nloc.Loc.col = 1 | _ -> false)); + (* The unterminated string had neither half of that shape: one column on the + opening quote and no note at all, where its two neighbours in this file + both have one. *) + (match read "(println \"oops\n" with + | _ -> check "an unterminated string is refused" false + | exception Loc.Error d -> + check "unterminated string has a kind" + (d.Loc.kind = "reader/unterminated-string"); + check "and says what is missing" + (contains d.Loc.dmsg "unterminated string — no closing quote"); + check "and notes where the input ran out" + (match d.Loc.notes with + | [ n ] -> contains n.Loc.nmsg "the input ends here, still inside it" + | _ -> 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