The diagnostics pass: every message shows, explains, and names the fix
# Conflicts: # FIX.org
This commit is contained in:
commit
5ea6884d2c
63
FIX.org
63
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.
|
||||
|
||||
225
docs/DIAGNOSTICS-AUDIT.md
Normal file
225
docs/DIAGNOSTICS-AUDIT.md
Normal file
@ -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`.
|
||||
788
lib/check.ml
788
lib/check.ml
File diff suppressed because it is too large
Load Diff
22
lib/emit.ml
22
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)
|
||||
|
||||
21
lib/load.ml
21
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)
|
||||
|
||||
86
lib/parse.ml
86
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)
|
||||
|
||||
@ -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
|
||||
| '\\' ->
|
||||
|
||||
@ -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);
|
||||
}
|
||||
|
||||
|
||||
@ -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. */
|
||||
|
||||
@ -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) {
|
||||
|
||||
@ -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));
|
||||
|
||||
28
test/programs/dyn-trap-site.flan
Normal file
28
test/programs/dyn-trap-site.flan
Normal file
@ -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"))
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user