Merge branch 'dev-loop' into worktree-agent-adf9086e00872ff67

This commit is contained in:
Joseph Ferano 2026-09-13 17:24:36 +07:00
commit 1657b87e3d
24 changed files with 2390 additions and 164 deletions

112
BUILT.md
View File

@ -4802,9 +4802,78 @@ the heap tier, the arena tier and the pool tier; a release build answers 0 to ev
the two expectations *is* the assertion, and writing it as one program means nobody can change what a dev build does
without the release row noticing.
The inspector's pointer arm is **not** covered. `test/programs/dev-ptr.flan` is the program, its header carries the
two lines above, and they were read off a running session by hand — the `test_dev.ml` case that would drive it belongs
to another lane's file. `NEXT.md` says so rather than letting the verification read as automated.
`test/programs/dev-ptr.flan` covers the inspector's pointer arm, and it is driven now rather than read by hand. Its
header still carries the two lines a session answers with; `test_dev.ml`'s *"a pointer the registry knows about"* case
asserts the live one whole and the dead one **around** its step number, which is the registry's event counter and
moves if anything allocates ahead of that program. It also asserts that no address appears in the epitaph — an
assertion that would otherwise depend on where the heap landed, which is the point of leaving one out.
## An address you have in your hand
The table above is the *recording* side. This is what reads it, and it is three things that turned out to be one
thing: pointing at a bare address, a breakdown by type, and what is still held.
### The recorded name, back to a type
The table records a **string**, and it has to. The note is built in `check.ml` at the allocation site, where the
concrete element type exists, and what crosses into the runtime is bytes — an ABI carrying a type would be an ABI that
had to agree with the checker's representation of one, which is the coupling the whole no-header-no-tag-word design
refuses.
What closes it is that the string is not a *description*. It is `Types.to_string` of the type, which is the **source
spelling** — `check.ml`'s `reg_note` says so, as the reason the name is worth printing at all — so the round trip is
the language's own reader, its own `Parse.texpr`, and the session's own `Check.resolve`. `Enemy` resolves against the
structs this session holds; `(Vec i32)` rebuilds through `Tapp`; `[3 i32]` through `Tarray`. **No table of spellings
is written down anywhere**, so nothing can fall behind `Types.to_string`.
And it is allowed to **fail**, which matters more than it looks. Not every recorded name is a type: `flan_rt.c` notes
a pool's slot headers as `"pool slots"`, because after a `free-all` an address landing in them must not come back as
an element. That string is not Flan source and must not become one, so a name that does not resolve is refused with
the name quoted and never defaulted to bytes.
### The address root renders a pointer, not a pointee
`(:op "at" :addr N)``M-x flan-inspect-address` — builds a `(Ptr T)` at the address and renders **that**. Rendering
the `T` directly would read the storage whatever the registry said, which is the hex dump this project is trying not
to be. Rendering the pointer puts the walk through `render.ml`'s pointer arm, which is the arm that asks first, so an
address root and a slot root reach the same two answers by the same code and permission is asked in exactly one place
in the compiler.
The one piece the thunk cannot do for itself is the address: **Flan has no integer-to-pointer cast**, deliberately, so
`flan_dev_reg_addr` is an extern beside `flan_agent_frame_slot` and for the same reason — the compiler knows the type
and something outside the language supplies the address. `flan_dev_reg_number` is the other direction, for a *program*
that has to say an address out loud; the language still has no operator for either.
Three refusals, each by name: an address the registry never saw **with no `:type` given** (a stack local, a global, a
pointer from C — the first two are answered by name already); an address the block's element size does not divide,
because rendering the element type there shows one element's tail as another's head, which is a plausible-looking
answer and therefore the worst kind; and a running program, because live-or-dead is exactly what a running program is
changing. A named `:type` overrides all of the first two — overriding is the point of being able to say it — and the
reply carries `:recorded` whenever the table had a name, so the disagreement is never silent.
**No `:path`.** A path steps from the pointee, and the pointee is what the registry has only just been asked to bless.
The whole answer here is the branch.
### One walk, two questions, and what "at exit" means
`flan_dev_reg_by_type` is the group-by, and there is one of it: a leak report **is** a breakdown with the dead left
out, and two walks would drift. Formatting is in the agent and ordering is in the daemon — biggest first, by bytes,
because a breakdown in table order is a list of everything and answers nothing.
**"At exit" is not a hook, and the honest reason is that a game is killed.** A program stopped by a signal runs no
`atexit` handler, no destructor, nothing — so no code written inside the program could report anything about the run
that matters most. The authoritative reader is therefore `(:op "leaks")`, which reads the same table over the agent
socket and can be asked at any moment, including the one before the kill. `flan-dev.el` does not ask on teardown
either: that would put a request on a path that runs every time the editor closes, for an answer nobody asked for.
The hook exists for the other program — the one that returns from `main` — and it is two decisions:
- **Registered by `atexit` from inside `flan_dev_reg_enable`**, not a file-scope `__attribute__((destructor))`. This
file is compiled into *every* build, so a destructor would run in a release build too, and that is exactly the third
place a release build is not free. Registered where it is, a release binary still carries a null pointer, a zero
flag and the declarations.
- **Off unless `FLAN_DEV_LEAKS` is set.** The acceptance table reads `programs/registry.flan`'s output with stderr
folded in, so a report nobody asked for is a report that changes what a dev build prints.
## A restart is not a transaction
Written down in three places rather than fixed, because it is a property and not a defect. If a frame mutates a global
@ -5067,3 +5136,40 @@ nothing: the frame that resumed is still inside the old marked body, past the `(
as running whether or not the mark was cleared. Half a second is about a hundred calls through the body just
installed. `test/programs/dev-pause.flan` exists because `dev-loop.flan` calls `step` four times, which is too tight
for that, and because a program that stops on its own — `dev-break.flan` — would prove nothing about what stopped it.
## A generic may key a map, and the predicate is what pays for it
The map operations are the second entry on the one list `check.ml` keeps of forms the abstract pass does **not**
answer where they are written. `print` and `println` were the first, and for an afternoon they were the only ones:
`hashable?` gated the *type* and not the operations, so a generic could take and return a `(Map $t V)` and could not
`get` or `put` into one.
**The reason was implementation, not design.** A map carries a hash and an equality, and `key_pair` emits them as
*concrete symbols* chosen from the key type — `flan_hash_str` for a string, `flan_hash_flat` for anything compared
bytewise, a generated `map/hash/Point` walking a struct's fields. While `$t` is still a variable there is no symbol
to name and nothing to choose between, so the abstract pass could not build the node. Falling through to the flat
pair would have been worse than refusing: it would hash a string's pointer and a struct's padding.
**What closes it is deferral, and what makes deferral safe is the `where` clause.** `put`, `get`, `has-key?`,
`reserve` and `clone` — the five arms that reach `key_fns` — now check their arguments and then, when the key is a
type variable, return a placeholder of the operation's own type: `Unit` for `put` and `reserve`, `None` for `get`
so the `(Option V)` around it still checks, `false` for `has-key?`, a zeroed map for `clone`. The whole node is
thrown away with the rest of the abstract pass, exactly as `println`'s is, and the real one is built when the copy
is checked with `$t` concrete.
Every member of that list moves a refusal from the definition to a call site, which is the thing the abstract pass
exists to prevent, so **the membership rule matters more than the membership**. `print` and `println` pay nothing:
every type prints, there is no printability predicate because one would always hold, and the deferred check always
succeeds. The map operations *can* fail at a concrete type — a float key has no equality a map can use — and they
are on the list anyway because `{:where (hashable? $t)}` is in the signature. The refusal then has something to
point at: it lands at the call that asked for the type, naming the type, the predicate and the clause, and the
author of the generic wrote that requirement down. That is categorically different from an unconstrained
`(+ a b)` failing deep in a body with no signature to blame, which stays refused at its definition.
**So a generic that does not declare the predicate gets no deferral.** `deferred_key` checks `declares` before it
answers yes, and in practice `map_type` has already refused the signature where the type was written — `(Map $t
i32)` under `{:where (copyable? $t)}` is not a type. `key_pair`'s `Types.Var` arm survives as a backstop for a
route neither covers, and says so rather than claiming to be a design.
`test/programs/generics.flan` runs one written body at two key types; `test/programs/generic-map-reject.flan` is
the other half, a call site at `f64` refused against the clause.

288
NEXT.md
View File

@ -1,3 +1,136 @@
# Decided by the author, end of 2026-09-13: the backend, then a feature freeze
**Priority is finishing the x86 backend and tightening the dev workflow.** After the backend is done,
**feature freeze for the rest of the day.** Work in flight may finish; nothing new starts.
**Stashed, explicitly not wanted now:** `any` and `drop`. Both are designed, neither has a customer,
and the author's words are that they feel like extra language features. `any` is plan.org's opt-in
tagged union (two words, a pointer and a typeid, no GC). `drop` is `spec-memory.md`'s hook for owning
something that is not memory. Their old entries stand; do not schedule either.
## The backend, in the order that finishes it
`DISCUSS.md` item 16 is the report and its verdict is the sequencing: *"the wiring is done and it was
the easy half. What is left is conditions, and the measurement moved them from 'first obstacle' to
'the only obstacle'."* 40 of 111 programs lower today; the other 40 are refused by name.
1. **Conditions, entire.** The transfer-channel guard after every call, the landing pad, the transfer
exit, `fdefers` on it, `emit_restart_case` and `emit_with_alloc`. Several hundred lines of
`emit.ml` **reimplemented from `spec-conditions.md` rather than ported**, because `emit.ml` writes
LLVM control flow and this writes bytes. The semantics are settled and the LLVM path is the oracle:
compare program output, never disassembly.
The mechanism is three pieces. The transfer channel is a pointer passed as the last argument; after
every call, check whether it is set; a set channel jumps to a per-function landing pad that runs
the defers and either handles or re-propagates.
`check_no_transfer` is what makes today's omission sound rather than hopeful — it walks the linked
program and refuses by name. It is also the measure of progress: the 40 refusals are 27
`restart-case`, 7 `signal`, 4 `handler-bind`, 1 `with-allocator`, 1 `fdefers`.
2. **Bounds checks**, which are the same work — `check_at` and `check_slice` cannot exist without the
guard. **Until they do, `--x86` is silently a `--no-bounds-checks` build**, and `bounds.flan` is
the one program that DIFFERs (exit 139 against LLVM's 134). Item 16 says this out loud and calls
deciding what a bounds violation means in a build with no handler one of two cheap things worth
doing first. Do that before item 1, not after.
3. **`Rt` with an aggregate return**, and with it most of the container runtime. `Vec`, `Map` and
`Pool` have not been exercised through this backend at all.
4. **`Fnval`'s indirection cell.** `FnAddr (Fnval n)` emits the symbol, which is right for a
whole-program build and wrong the instant anything is redefined into it. There are no cells and no
`--dev` here, deliberately — **but this is the one that decides whether the backend ever serves the
dev loop**, which is the reason it exists. Item 15's question 5, still waiting.
5. **Size and speed, measured.** Nothing has a number on it. Every value is in memory, every
intermediate is a frame temporary, and a block copy is `rep movsb`. That is the trade the brief
asked for and nobody has checked what it cost.
6. **Debug information.** None; `--x86` and `--debug` are refused together.
Two known divergences that are deliberate and should stay written down: `(uninit)` is stable garbage
rather than `poison`, and `unreachable` is `ud2` rather than UB. Item 16 says to take item 15's
question 4 seriously now that there are two backends that can disagree.
## Tightening the dev workflow — what is already known to want doing
- **Finish the macro branch** (`worktree-agent-a859480edc827ab73`): `dune test` never ran on it.
`HANDOFF-macros.md` on that branch has six items. Its customer is `with-drawing`/`with-mode-2d`,
which removes a class of unbalanced-pair bug from every raylib program.
- **`slice-from-ptr`** — queued below. Blocks three raylib examples and leaves the hand-written `Font`
surface with no example caller.
- **`merged_serve`'s 10s warning path** (`lib/dev.ml:2322-2326`), the last item in `HANDOFF-f1.md`.
- **The memcheck half of the registry**`VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`. The
registry answer and the memcheck answer are different tools and must not be blurred.
## Not in the freeze, because it is already decided and unblocked
**Generic structs and `$n` array lengths** — queued below with the Odin citations. It is a language
feature and the freeze says do not start it. Left here so it is not lost, not so it is picked up.
# Where this is — end of 2026-09-13
**Branch `dev-loop` at `861f591`, working tree clean, `dune test` green.** Read this section first;
everything below it is the standing queue and the decision record.
## Landed today, merged
- **Generics.** Monomorphisation, checked abstractly, `$t` at the binding site and bare `t` at a use.
`{:where (ordered? $t)}` as a Clojure-style map at the head of a body — five predicates: `ordered?`,
`equal?`, `hashable?`, `numeric?`, `copyable?`. **A type variable is move-only by default**; `copyable?`
is the opt-out. Prelude went 80 → 69 defns. A generic may also key a map now, which was a hole closed
the same day. `Tast` and every backend are untouched — instantiation lives entirely in `check.ml`.
- **The x86 backend runs.** `flan build --x86` writes `.s` and hands it to the same clang. **40 of 111
test programs build through it and print exactly what the LLVM build prints.** Off by default.
- **`pause` marking, both halves.** `C-u` before an eval marks the innermost form, `C-u C-u` the
top-level one.
- **`spy-num`.** A watch slot keeps count, min, max, last, mean, windowed to the editor's last tick.
- **Frame rollback**, `PORTING.md` Tier 1 item 6. `restore` goes in the `continue` clause, not a defer.
- **The dev allocation registry is finished.** `M-x flan-inspect-address`, `M-x flan-allocations`,
`M-x flan-leaks`.
- **15 raylib examples**, an idiomatic layer over the bindings, and `vendor/raylib/vector.flan`.
- **The raylib header is tracked** at `vendor/raylib/raylib-5.5.h`. `FLAN_RAYLIB_H` is gone and the
check runs on every build.
- **`{K V}` is dropped.** `(Map K V)` is the only map type spelling.
- **Two test-infrastructure fixes worth not re-deriving:** the socket flake was an ordering bug, not a
race (the test checked for a socket before completing any round-trip); and `the daemon never
listened` was never a race either — it was an llc-and-link taking 6.6s against a 5s await, because
`Build.cachedir` sat under dune's per-run `TMPDIR` and every build was cold. Both fixed.
## Unmerged, and deliberately so
**`worktree-agent-a859480edc827ab73` — macros importable from a package.** Builds clean,
`test/programs/pkg-macro.flan` runs and prints the right answers, **but `dune test` was never run** and
the acceptance wiring is unfinished. `HANDOFF-macros.md` on that branch has the six remaining items.
The finding in it is worth keeping whatever happens to the code: the old refusal claimed collecting a
package's macros needed a second import resolver at the Form level. It did not. The file being compiled
is parsed before `Load` runs too, so no shape of the feature could have left import resolution where it
was — `Load.program` takes forms now and uses the one resolver that always existed.
Its customer is `with-drawing`/`with-mode-2d` over raylib's begin/end pairs, which a lane tried to add
and could not.
**`worktree-agent-a4dca263c97eb0b66`** is an older WIP, "the inspector's address root, half wired on
the Emacs side". **Superseded** — the registry lane built that properly. Delete it.
## What I would do next
1. **Finish the macro branch.** Run `dune test`, fix the mechanical breakage from `Load.program`'s
changed signature, then the five other items in its handoff.
2. **The pointer-length question** — its own queued section below. It blocks three raylib examples and
leaves the hand-written `Font` surface with no example caller.
3. **Generic structs and `$n` array lengths** — queued below, decided, and now unblocked since the
generics lane has merged.
4. `HANDOFF-f1.md` has one item left: whether `merged_serve`'s 10s warning path
(`lib/dev.ml:2322-2326`) deserves a test.
## For siam-farmer
`PORTING.md`'s verdict is unconditional now: the game's state is **fixed arrays with counts**, so it
fits in `defvar` globals, nothing is move-only, and generics is off its critical path. Tier 0 and Tier 1
items 4, 5 and 6 are all done. Nothing blocks writing it.
## Queued: a pointer from C needs a length before it can be indexed
**Sequenced after the generics lane**, which holds `lib/check.ml`.
@ -201,6 +334,24 @@ The prelude keeps a per-type layer for the numeric ones. That is the honest numb
5. **Generics across a real compilation-unit boundary.** `Load` flattens imports before checking so it works
today, but a package boundary that ever becomes a real unit boundary needs the generic's *body* to cross it —
which separate compilation cannot do, and is why C++ puts templates in headers.
6. ~~**`hashable?` gates the type and not the operations.**~~ **Closed the same day it landed.** It was real for
an afternoon: a generic could take and return a `(Map $t V)` and could not `get` or `put` into one, because the
hash and the equality pair are emitted as concrete symbols chosen from the key type and there is no symbol to
name while `$t` is a variable. The fix is that the five map operations that reach the pair — `put`, `get`,
`has-key?`, `reserve`, `clone` — are now **deferred to the instantiation**, joining `print` and `println` on
the one list of forms the abstract pass does not answer where they are written.
**What made that acceptable is the clause, and it is worth stating as a rule rather than as a special case.**
Every member of that list moves a refusal from the definition to a call site, which is the thing the abstract
pass exists to prevent. `print` and `println` pay nothing for it — every type prints, so the deferred check
always succeeds. The map operations *can* fail, and the reason they are still allowed on is that
`{:where (hashable? $t)}` is in the signature: an instantiation at a type with no usable equality is refused
against a requirement the author wrote down, naming the call site, the type it asked for and the predicate it
failed. That is categorically different from an unconstrained `(+ a b)` failing deep in a body with nothing to
blame. **A generic that does not declare the predicate gets no deferral**`deferred_key` checks first, and
`map_type` has usually refused the signature before that. The membership rule for the list is therefore not a
headcount: either the operation cannot fail after substituting, or a declared predicate gives its failure
somewhere to land.
## Decided by the author, 2026-09-13: a type variable takes a `$` sigil
@ -238,16 +389,54 @@ would cost.
## ~~To discuss: five gaps the raylib examples hit and could not close~~ — **three closed, two live elsewhere**
- **Closed:** an enum-typed `defstruct` field is no longer refused by the layout check (an enum *is* an `i32`, and
the predicate is symmetric now, so the enum may be on either side); the header check reaches `defconst` and
`defenum` through name-mapping directives in `vendor/raylib/bindings`, so a wrong flag bit is no longer silent;
and the `Ptr`-indexing gap has its own queue entry at the top of this file, because it now blocks three
examples rather than being a note.
- **Still open, and both are here rather than in a queue entry because neither has a customer pressing:**
**raymath is `static inline`**, so `Clamp`, `Vector2Add` and `Remap` have no symbol to `declare-c` at all — a lane
measured the alternative and found writing the arithmetic in Flan cost nothing, which is what makes this a
non-problem rather than a gap; and **function-pointer parameters** are refused (`SetTraceLogCallback`, the audio
stream processors), which is the callback direction of the FFI and nothing has needed it yet.
Found by the lane that ported `core-2d-camera`, `core-scissor-test`, `core-window-flags`,
`core-world-screen` and `core-window-should-close`. None blocked those five. All five blocked
something else, and each is a language or checker question rather than a missing binding, which is
why they are here and not in a binding list.
1. **A `(Ptr T)` returned from C cannot be indexed.** `indexed` in `lib/check.ml` accepts `Array`
and `Slice` only, so a C function answering `int*` is readable at element 0 through `deref` and
nowhere else. `LoadRandomSequence` is the case that hit it and `core_random_sequence` is
unportable until it moves. The question is what the answer should be: a length has to come from
somewhere before a pointer can become a slice, and C does not supply one. Possibly a
`(slice-from-ptr p n)` where the caller states the length and owns being right about it.
**This has its own queue entry at the top of this file now** — it blocks three more examples than this
section knew about, and both candidate shapes are written out there.
2. ~~**An enum-typed `defstruct` field is refused by the layout check.**~~ **Closed.** The layout
check now accepts an enum where the header says `int`, symmetrically, and still refuses
anything that is not four bytes. `Camera3D.projection` is a `CameraProjection` again and the
`rl/camera-projection` helper is gone; `.projection :perspective` resolves at the construction
site, so the keyword half of the problem went away with it. See BUILT.md.
3. ~~**The header check does not reach `defconst` or `defenum`.**~~ **Closed.** It reaches both.
`bindings` gained `enum`, `const` and `constant` lines that say what a Flan constant is called in
C; every mapped name is compared by value, and a name the mapping cannot find, a rule that
reaches nothing, and a `defenum` with no line at all are each reported rather than skipped. All
eight raylib enums and all 16 `ConfigFlags` bits check out against 5.5. See BUILT.md.
4. ~~**raymath is `static inline`, so there is no symbol to bind.**~~ **Closed for the vector half.**
`Clamp`, `Vector2Add`, `Remap` and the rest exist only in the header and `declare-c` has nothing
to name, so the arithmetic is written in Flan: `vendor/raylib/vector.flan`, a package file with
no `declare-c` in it at all — which is why it is a file of its own rather than more of
`raylib.flan`, the file the header check reads hand-written signatures out of. Vector2 and
Vector3 add/sub/mul/scale/negate/dot/length/distance/normalize/lerp, `v2-angle`, `v2-rotate`,
`v3-cross`, and `remap`, `inverse-lerp`, `wrap-f32` on scalars. raymath's semantics exactly,
including the zero-length guard in `normalize`. **`clamp` and `lerp` are deliberately absent**:
both are already in the prelude, and a second `lerp` would not even be the same function —
the prelude writes `(1-t)a + tb`, raymath writes `a + t*(b - a)`, and shipping both under names
one letter apart is a footgun. The C-shim alternative was rejected on the measurement
`examples/shapes-following-eyes.flan` already took: it would buy identical arithmetic for a
compilation unit in the build and a second place raylib's semantics are written down. rlgl's
matrix stack is still unbound for a different reason, so `core_2d_camera_mouse_zoom` is still
skipped.
5. **Four families are still refused by the importer for want of a `defstruct`.** `FilePathList`
(a `char**`, blocks `core_drop_files`), `Model`/`Mesh`/`Ray`/`BoundingBox` (the model and
3D-collision families), and **function-pointer parameters** (`SetTraceLogCallback`, which blocks
`core_custom_logging`, and the audio stream processors). The first three are ordinary widening —
write the `defstruct` and they import. The function-pointer one is not, and is the interesting
one: it is the callback direction of the FFI, which nothing has needed yet.
## Queued, 2026-09-13 (second session) — everything four lanes left behind
@ -382,12 +571,34 @@ Interactively the controls are now `r` and left-mouse only. `test_web.ml`'s asse
the wasm module went with the embed: `web-files.flan` is web-built and *run* under node and asserts the embedded
bytes print, which is the same property checked harder.
## Queued: an idiomatic layer over the generated bindings
## ~~Queued: an idiomatic layer over the generated bindings~~ — **landed**
Thin Flan-shaped wrappers **over** the generated bindings, not instead of them. The generated set stays honest to C —
that is what makes it checkable against the header — and the layer is where a Flan-shaped API lives. Two of these
already exist by hand in `vendor/raylib/raylib.flan` and are the shape to copy: `collision-point-poly?` takes a slice
and `collision-lines` answers with an `Option`, each wrapping a `-raw` binding of the same name.
Thin Flan-shaped wrappers **over** the generated bindings, not instead of them. Built as three kinds, listed in the
header of `vendor/raylib/raylib.flan`:
- **A slice where C takes a pointer and a count.** The eleven vector-array drawing calls — `draw-line-strip`, the two
triangle batches, the five splines, the two `image-draw-triangle-*`, `draw-triangle-strip-3d` — under one section.
All eleven and not the three anybody calls: a subset puts the hole where the next caller looks. Each also guards the
empty slice, which is the part a hand-written call site gets wrong rather than merely writes out — raylib takes a
count of 0 happily, but `(addr (at pts 0))` is out of bounds before raylib is reached.
- **An `Option` where C signals with a sentinel.** `get-key-pressed` and `get-char-pressed`, raylib's two input
queues, both of which say "empty" with 0. What it buys is in `examples/text-input-box.flan`: the C shape reads the
queue in two places, once to prime the loop and once at the bottom of the body, and the Option shape reads it in
one.
- **An enum where the header says `int`.** `key-up?`, `key-pressed-repeat?`, `mouse-button-up?` — holes in families
whose other halves already took a `Key` or a `MouseButton`, so `(rl/key-down? :space)` compiled and
`(rl/key-up? :space)` did not. **These are not wrappers.** A C enum parameter has an int's ABI, so the hand-written
`declare-c` with the Flan type on it is the whole fix and a `defn` around it would be a rename.
The mechanism for the first two is the `name` directive in `vendor/raylib/bindings`: the generated declaration keeps
the symbol and gives up the name, so nothing about the C signature is hand-written and the generated half keeps its
agreement-by-construction with the header. The third is an `exclude` plus a hand-written line, exactly as `SetExitKey`
and `SetMouseCursor` already were.
**Not built: `with-drawing` and `with-mode-2d`.** An unbalanced begin/end is a real bug and a macro removes it, but a
macro cannot live in a package — the expander collects `defmacro`s from the prelude and from the file being compiled,
and one in an imported package is refused by name. `test/programs/pkg-macro.flan` is that refusal and its whole content
is the case. They have to be written in the program that uses them, or wait for macros to be importable.
## ~~Queued: a restart is not a transaction, and the docs must say so~~ — **landed**
@ -410,46 +621,31 @@ re-applied.
This matters more here than in most Lisps because the intended use is a **game loop**, where the author's plan is to
skip a frame and carry on rather than die — exactly the case where a non-idempotent mutation bites.
## ~~Queued: a dev-build allocation registry~~ — **landed, in part; three of the six remain**
## Queued: a dev-build allocation registry — address to type
## ~~Queued: a dev-build allocation registry~~ — **landed; one item left, and it is not a registry item**
Built. The table is in `runtime/flan_dev.c`, the note is emitted by `check.ml` and dropped by `emit.ml` in a release
build, and the inspector reads it. `BUILT.md`'s *"An address answers with a type"* is the account of it; what follows
is only what is **not** there, so that the gap is a queue entry rather than a discovery.
Items 1 to 5 are built and the test is written. `BUILT.md`'s *"An address answers with a type"* is the account of the
table, the note and the inspector's pointer arm; *"An address you have in your hand"* is the account of the reader —
the address root, the breakdown, the leak report, and what "at exit" turned out to mean.
**Landed:** items 1 and 2 — the inspector follows a live `(Ptr T)` and renders the pointee, and names what died at a
dead one (`<ptr dead: was Enemy, freed at step 15>`). The dead-marking covers the heap `free`, a heap resize's old
block, an arena `free-all` and `arena-destroy`.
**Left, and in this order:**
- **Item 3, point at any heap address.** The lookup is there and answers for any address; nothing exposes it as an
editor op. It wants a verb beside `inspect` that takes an address and a type rather than a frame and a slot, and the
registry's own answer for the type when none is given — which needs the recorded name resolved back to a
`Types.t`, and the table records a string.
- **Item 4, a breakdown by type**, and **item 5, leak attribution at exit.** Both are a walk over the table and a
group-by; `flan_dev_reg_count` is the whole of what exists. Neither is hard and neither has a reader yet, which is
why they were left rather than half-built.
- **The memcheck half of item 6.** The registry now knows an arena's `free-all` killed everything in the region, so a
later read through a pointer into it is *answerable*. Memcheck still says nothing, because nothing told it: the
pages stay mapped and `free-all` is an integer going to zero inside one allocation. Closing that is
`VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`, which `test/test_valgrind.ml` already names. **The two must not
be blurred** — the registry answer and the memcheck answer are different tools reaching different people.
- **A test that drives the inspector's pointer arm.** `test/programs/dev-ptr.flan` is the program and its header has
the two lines a session answers with; they were read off a running session **by hand**. The case belongs beside the
other `locals`/`inspect` cases in `test_dev.ml`, which was another lane's file. `programs/registry.flan` covers the
table itself from the acceptance table, in a dev build and a release one.
**Left:** **the memcheck half of item 6, and nothing else.** The registry knows an arena's `free-all` killed
everything in the region, so a later read through a pointer into it is *answerable*. Memcheck still says nothing,
because nothing told it: the pages stay mapped and `free-all` is an integer going to zero inside one allocation.
Closing that is `VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`, which `test/test_valgrind.ml` already names.
**The two must not be blurred** — the registry answer and the memcheck answer are different tools reaching different
people, and building one is not progress on the other.
**What it does not cover, and does not need to:** stack locals and globals, which the shadow stack and the static type
table already answer by name. A stack address is deliberately not in the table, and a pointer to one still renders
`<ptr>`.
`<ptr>` — the address root refuses such an address by name rather than rendering bytes at it.
**Note on classes:** `defclass` instances will carry shape metadata by design, so they get identification for free and
do not need the registry. This is for plain structs, `Vec`, `Map` and pool storage.
**On cost, as built.** One insert per allocation, always on in a dev build, no opt-out — the author's instruction,
followed literally. Nothing was built per-region, no range recording, no per-allocator opt-out. Revisit only if a real
program shows a problem, and `BUILT.md` names the two places a release build is not quite free.
program shows a problem, and `BUILT.md` still names **two** places a release build is not quite free: the readers
added since are functions nothing in a release build calls, and the exit report is registered by `atexit` from inside
`flan_dev_reg_enable` rather than by a file-scope destructor, precisely so that it is not a third.
## Picked up first, 2026-09-13
@ -661,7 +857,9 @@ second.
One smaller thing found and worth not re-deriving: an enum parameter imports as `i32`, because the header says
`KeyboardKey` and nothing tells the importer the package calls that `Key`. The ABI is identical, the face is worse,
and it is why `(rl/key-down? :space)` keeps its hand-written line.
and it is why `(rl/key-down? :space)` keeps its hand-written line. The idiomatic-layer lane closed the three holes
this left — `key-up?`, `key-pressed-repeat?` and `mouse-button-up?` were generated and therefore took an `i32`, so the
sibling of a call that worked did not — by excluding them and hand-writing the enum type, which is all it takes.
### Landed 2026-09-12 — six tracks, one session

View File

@ -230,9 +230,9 @@ is harmless, but the expression itself need not be: if you inspect
`(spawn-enemy)`, you spawn one per keystroke. That is why there is no
auto-refresh and why `g` is a key you press rather than a timer.
### Two ways to root a walk
### Three ways to root a walk
There are two, they are not equally capable, and the top line of the buffer
There are three, they are not equally capable, and the top line of the buffer
says which one you are on.
**An expression** — `C-c C-i`, and `i` on a global line in the break buffer.
@ -250,8 +250,33 @@ program, and it is refused — by name, with the reason — once the program
resumes or if the frame's body was redefined since the frame was entered. It
cannot start from an expression at all.
Neither subsumes the other, which is why both are here. The one you get is
chosen for you by the line you press `i` on.
**An address** — `M-x flan-inspect-address`. A number, `#x7f…` or decimal, of
the kind a debugger, a valgrind report or a C shim's `printf` hands you. There
is no frame in it and no expression: what it shows is the `(Ptr T)` at that
address, followed if the storage is still live and an epitaph naming what died
there if it is not.
**The type is optional, and leaving it out is the point.** A dev build records
the type at every allocation — the allocator's caller knew it, and a Flan value
carries no header, so that is the only moment anything could — and this command
is the one place that recorded name is read back and turned into a type again.
Naming a type overrides it, for reading half a struct or an element the table
recorded under a container's name; the reply still carries what the allocator
wrote down, so you are never shown one type while the program believes another.
It needs a **stopped** program, for a reason of its own: whether an address is
still live is exactly what a running program is changing. And it takes **no
path** — `RET` does not go into it — because the whole answer is the pointer
arm's branch, and stepping in would step from the pointee, which is the deref
the registry has only just been asked to bless.
An address the registry has never seen is refused by name rather than
rendered. That is a stack local, a global, or a pointer from C; the first two
are answered by name in the stack and globals sections already.
None of the three subsumes the others, which is why all three are here. The
one you get is chosen for you by the line you press `i` on, or by starting an
address root by hand.
**`l` never crosses between them**, and that is structural rather than a rule
someone has to remember. Every entry on the buffer's stack carries its own
@ -259,6 +284,28 @@ root; `RET` only ever lengthens the path under the root already in hand; and
starting a new root starts an empty stack. So a stack with both kinds in it
cannot be built, and `l` has nothing to cross into.
### Where the memory went — `M-x flan-allocations` and `M-x flan-leaks`
The same registry, read as a table rather than at one address. **`M-x
flan-allocations`** is every block it recorded, live and dead both, grouped by
the type the allocator's caller named and ordered biggest first by bytes. The
dead are in it on purpose: in a long-running program they are the bulk of it,
and they are what says where the allocation *went* rather than only where it
stayed.
**`M-x flan-leaks`** is the same walk with the dead left out — what the program
is still holding.
**"Still holding" means at the moment you ask, and there is no exit report to
wait for.** A program killed by a signal, which is how a program under this
editor usually ends, runs no exit handler at all, so nothing written inside it
could report anything. Asking is the answer, and you can ask at any time
including just before you quit. A program that returns from `main` on its own
can print the same breakdown to stderr by being run with `FLAN_DEV_LEAKS` set
— off by default, because a dev build's output belongs to the program.
Both are dev-build only. A release build records nothing and says so.
### The watch buffer — values while the program runs
Everything above is for a program you have stopped, or one you interrupt with a
@ -535,8 +582,10 @@ Use `C-c C-g` if you need frames.
| `M-.` / `M-,` | where a name is written / back |
Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit`
(stop it), `M-x flan-watch` (the watch buffer), `M-x flan-watch-stop`, and
`M-x flan-watch-ghost-mode` (the same values inline).
(stop it), `M-x flan-watch` (the watch buffer), `M-x flan-watch-stop`,
`M-x flan-watch-ghost-mode` (the same values inline),
`M-x flan-inspect-address` (what is at an address), and `M-x flan-allocations`
/ `M-x flan-leaks` (where the memory went, and what is still held).
---

View File

@ -1657,5 +1657,80 @@ that the IR half is findable by name rather than only by a modifier."
nil t))))
(flan-disassemble name t))
;;; What the program is made of, and what it is still holding
;; Two readings of one table. A dev build records the type at every
;; allocation — the allocator's caller knew it, and a Flan value carries no
;; header, so that is the only moment anything could — and this is that table
;; grouped by the name it wrote down.
;;
;; Biggest first, by bytes. Read in table order it is a list of everything
;; and answers nothing; read biggest-first it answers "where did the memory
;; go", which is the only reason either command exists.
(defcustom flan-allocations-buffer "*flan-allocations*"
"Where the allocation breakdown and the leak report are shown."
:type 'string)
(defun flan-allocations--show (op title)
"Ask the daemon for OP and show its rows under TITLE."
(let ((r (flan-dev--request (list :op op))))
(unless (equal (plist-get r :status) "ok")
(user-error "flan: %s" (or (plist-get r :message) "refused")))
(let ((rows (plist-get r :types))
(blocks (plist-get r :blocks))
(bytes (plist-get r :bytes)))
(with-current-buffer (get-buffer-create flan-allocations-buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(special-mode)
(insert (propertize (format "%s\n" title) 'face 'bold))
(insert (propertize (format "%s\n\n" (or (plist-get r :note) ""))
'face 'font-lock-comment-face))
;; An overflowed table has blocks in the program that are in
;; nobody's row, so every number below it is a floor. Said before
;; the numbers, not after them, because a reader who missed it would
;; quote them as counts.
(when (plist-get r :overflow)
(insert (propertize
"the registry overflowed: these are floors, not counts\n\n"
'face 'warning)))
(if (null rows)
(insert "nothing recorded\n")
(insert (propertize (format "%8s %12s %s\n" "blocks" "bytes" "type")
'face 'shadow))
(dolist (row rows)
(insert (format "%8d %12d %s\n" (nth 1 row) (nth 2 row)
(nth 0 row))))
(insert (propertize
(format "\n%8s %12s in %d type%s\n" (or blocks 0)
(or bytes 0) (length rows)
(if (= (length rows) 1) "" "s"))
'face 'shadow))))
(goto-char (point-min)))
(display-buffer flan-allocations-buffer))))
;;;###autoload
(defun flan-allocations ()
"Every block the allocation registry recorded, grouped by type.
Live and dead both: in a long-running program the dead are the bulk of it, and
they are what says where the allocation went rather than only where it
stayed. A dev build only a release build records nothing, and says so."
(interactive)
(flan-allocations--show "allocations" "Allocations, by type"))
;;;###autoload
(defun flan-leaks ()
"What the allocation registry is still holding live, grouped by type.
The same walk with the dead left out, and \"still holding\" means at the moment
you ask. There is no exit report to wait for: a program killed by a signal
which is how a program under this editor usually ends runs no handler at
all, so this command, asked whenever you like and including just before you
quit, is what answers for one. A program that returns from main on its own
can print the same breakdown to stderr under FLAN_DEV_LEAKS."
(interactive)
(flan-allocations--show "leaks" "Still held, by type"))
(provide 'flan-dev)
;;; flan-dev.el ends here

View File

@ -297,10 +297,19 @@ whatever the value came from."
;;; A root, and the path walked from it
;; A root is `(:expr EXPR)' or `(:slot FRAME SLOT NAME)'. The path is a list
;; of steps applied to it in order, and the pair is the whole of this buffer's
;; position — which is why a stack entry carries both and `l' cannot cross
;; between two kinds of root by accident.
;; A root is `(:expr EXPR)', `(:slot FRAME SLOT NAME)' or `(:addr N TYPE)'.
;; The path is a list of steps applied to it in order, and the pair is the
;; whole of this buffer's position — which is why a stack entry carries both
;; and `l' cannot cross between two kinds of root by accident.
;;
;; The third one has no frame in it. An expression root is evaluated wherever
;; the evaluator stands and a slot root is a frame and an index; an address
;; root is a number somebody has in their hand, out of a debugger or a
;; valgrind report, and the daemon asks the allocation registry what is there.
;; It takes no path: what it renders is a `(Ptr T)', so the whole answer is
;; the pointer arm's branch — followed if the storage is live, an epitaph if
;; it is not — and stepping in would be stepping from the pointee, which is
;; the deref the registry has only just been asked to bless.
(defun flan-inspect--root-label (root path)
"How ROOT walked by PATH is named at the top of the buffer and in the trail."
@ -316,6 +325,11 @@ whatever the value came from."
(`(:some) ".some")
(_ "")))
path "")))
;; The address in hex, because that is the spelling every tool that hands
;; one out uses, and the type only when it was *named*: an unnamed one is
;; the registry's own answer and the reply's own `:type' line says it.
(`(:addr ,addr ,ty)
(if ty (format "#x%x as %s" addr ty) (format "#x%x" addr)))
(_ "?")))
;;; Why a thing cannot be entered
@ -353,8 +367,16 @@ root, which is the older and the more limited of the two."
('trunc
"truncated: the walk stopped at its depth bound of 4. Inspect the field that holds it, which re-roots the walk")
('opaque
(format "%s: the walk had no structure for this type, so there are no fields to show"
(plist-get node :text)))
;; A *followed* pointer lands here rather than on the `ptr' arm above,
;; because that arm matches the bare word. Saying "no structure for this
;; type" of it would be false and unhelpful at once: it has structure, it
;; is right there, and the reason you cannot step in is that the step
;; would start from the pointee — the deref the registry blessed once and
;; is not being asked about again.
(if (string-prefix-p "<ptr " (or (plist-get node :text) ""))
"a pointer the registry let the renderer follow: the pointee is already drawn, one level deeper. Stepping in would step from it, which is a second deref nobody has asked about — root at it with `M-x flan-inspect-address' instead"
(format "%s: the walk had no structure for this type, so there are no fields to show"
(plist-get node :text))))
('atom (format "%s is an atom; it has no fields" (plist-get node :text)))
(_ "not something this inspector knows how to enter")))
@ -362,7 +384,7 @@ root, which is the older and the more limited of the two."
(defvar-local flan-inspect--root nil
"What this buffer's walk starts from.
Either `(:expr EXPR)\=' or `(:slot FRAME SLOT NAME)\='.")
One of `(:expr EXPR)\=', `(:slot FRAME SLOT NAME)\=' or `(:addr N TYPE)\='.")
(defvar-local flan-inspect--path nil
"The steps walked from `flan-inspect--root\=', outermost first.
Together with the root this is the whole of where the buffer is. It is a
@ -561,6 +583,17 @@ root exists to fix."
(when path
(list :path
(mapcar #'flan-inspect-wire-step path))))))
(`(:addr ,addr ,ty)
(when path
;; Refused rather than dropped. A path with a step silently
;; gone would render a *different* value and say nothing,
;; which is the failure this whole buffer is built to avoid.
(user-error
"flan: an address root has no path; it renders the pointer, \
and whether that may be followed is the answer"))
(funcall flan-inspect-request-function
(append (list :op "at" :addr addr)
(when ty (list :type ty)))))
(_ (user-error "flan: %S is not a root this inspector knows" root)))))
(unless (equal (plist-get r :status) "ok")
(user-error "flan: %s" (or (plist-get r :message) "refused")))
@ -613,6 +646,36 @@ the listing picks one out. The index is what `locals\=' puts on every line for
this."
(flan-inspect--show (list :slot frame slot name) nil nil))
(defvar flan-inspect-address-history nil
"Addresses `flan-inspect-address\=' has been given, most recent first.")
;;;###autoload
(defun flan-inspect-address (addr &optional type)
"Show what is at ADDR in the stopped program, as TYPE.
The address root. ADDR is a number `#x7f\=', or decimal of the kind a
debugger, a valgrind report or a C shim\='s printf hands you, and which nothing
inside Flan will make for you: there is no integer-to-pointer cast in the
language, deliberately.
TYPE is optional, and leaving it out is the interesting half. A dev build
records the type at every allocation, so the registry already knows what was
put there and the daemon resolves that recorded name back to a type. Naming
one instead overrides it for reading half a struct, or an element the table
recorded under a container\='s name and the reply still carries what the
allocator wrote down, so the disagreement is never silent.
Refused while the program is running: whether an address is still live is
exactly what a running program is changing."
(interactive
(list (read-number "Address: "
(car (mapcar #'string-to-number
flan-inspect-address-history)))
(let ((s (read-string "As type (empty for what was recorded): ")))
(and (not (string-empty-p s)) s))))
(add-to-history 'flan-inspect-address-history (number-to-string addr))
(flan-inspect--show (list :addr addr type) nil nil))
(defun flan-inspect-into ()
"Go into the field or element at point.
Extends the path under the root this buffer already has; it never replaces the

View File

@ -208,6 +208,122 @@
(string-match-p "\\.name +\"all\"\n" text))))
;;; The address root, and the registry listings
(message "\nthe address root")
;; The rooting mode with no frame in it. What is asserted here is the *wire*:
;; the buffer sends `at' with the address, sends `:type' only when one was
;; named, and refuses a path rather than dropping it. What the daemon does
;; with that is test_dev.ml's business, over a real program.
(let* ((sent nil)
(flan-inspect-request-function
(lambda (form) (setq sent form) '(:status "ok" :value "<ptr (Enemy {.hp 41 .x 2})>"
:type "(Ptr Enemy)" :live t :recorded "Enemy")))
(flan-inspect-buffer " *test-inspect*"))
(when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
(let ((text (with-current-buffer
(save-window-excursion
(flan-inspect--show (list :addr 4096 nil) nil))
(buffer-string))))
(test-flan--check "an address root asks the daemon for `at'"
(equal (plist-get sent :op) "at"))
(test-flan--check "with the address"
(equal (plist-get sent :addr) 4096))
;; Absent and not empty: leaving it out is what makes the registry answer
;; for the type, which is the whole of what the address root buys.
(test-flan--check "and no :type when none was named"
(null (plist-get sent :type)))
(test-flan--check "the address is named in hex at the top"
(string-match-p "#x1000" text))))
(let* ((sent nil)
(flan-inspect-request-function
(lambda (form) (setq sent form) '(:status "ok" :value "<ptr 41>" :type "(Ptr i32)")))
(flan-inspect-buffer " *test-inspect*"))
(when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
(let ((text (with-current-buffer
(save-window-excursion
(flan-inspect--show (list :addr 4096 "i32") nil))
(buffer-string))))
(test-flan--check "a named type is sent as :type"
(equal (plist-get sent :type) "i32"))
(test-flan--check "and shown beside the address"
(string-match-p "#x1000 as i32" text))))
;; A path is refused rather than dropped. A path with a step silently gone
;; would render a different value and say nothing, which is the failure the
;; whole buffer is built to avoid.
(let ((flan-inspect-request-function
(lambda (_) '(:status "ok" :value "<ptr 41>"))))
(test-flan--check "an address root refuses a path"
(eq 'caught
(condition-case nil
(flan-inspect--value (list :addr 4096 nil) '((:field "x")))
(user-error 'caught)))))
;; And a followed pointer is refused for the true reason rather than for "no
;; structure": it has structure, it is drawn, and the step would be a second
;; deref nobody asked about.
(test-flan--check "a followed pointer says why it cannot be entered"
(string-match-p
"second deref"
(flan-inspect-refusal
(flan-inspect-parse "<ptr (Enemy {.hp 41 .x 2})>"))))
(message "\nthe registry listings")
(let* ((sent nil)
(flan-dev--request-stub
(lambda (form)
(setq sent form)
'(:status "ok"
:types (("Enemy" 2 64) ("i32" 1 16))
:blocks 3 :bytes 80 :overflow nil
:note "every block the registry recorded"))))
(cl-letf (((symbol-function 'flan-dev--request) flan-dev--request-stub)
((symbol-function 'display-buffer) #'ignore))
(let ((flan-allocations-buffer " *test-allocations*"))
(flan-allocations)
(test-flan--check "the breakdown asks for `allocations'"
(equal (plist-get sent :op) "allocations"))
(let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
(test-flan--check "and lists each type with its blocks and bytes"
(string-match-p "2 +64 +Enemy" text))
(test-flan--check "with a total under it"
(string-match-p "3 +80 +in 2 types" text)))
(flan-leaks)
(test-flan--check "the leak report asks for `leaks'"
(equal (plist-get sent :op) "leaks"))
(kill-buffer " *test-allocations*"))))
;; An overflowed table has blocks in the program that are in nobody's row, so
;; every number under it is a floor. Said before the numbers, because a reader
;; who missed it would quote them as counts.
(cl-letf (((symbol-function 'flan-dev--request)
(lambda (_) '(:status "ok" :types (("Enemy" 1 32)) :blocks 1 :bytes 32
:overflow t)))
((symbol-function 'display-buffer) #'ignore))
(let ((flan-allocations-buffer " *test-allocations*"))
(flan-allocations)
(let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
(test-flan--check "an overflowed table is said to be a floor"
(string-match-p "floors, not counts" text)))
(kill-buffer " *test-allocations*")))
;; And a release build, which records nothing and says so. The refusal comes
;; back as an ordinary error status and reaches the person, rather than an
;; empty listing that reads like a program holding nothing.
(cl-letf (((symbol-function 'flan-dev--request)
(lambda (_) '(:status "error"
:message "the allocation registry is off; this is not a dev build")))
((symbol-function 'display-buffer) #'ignore))
(test-flan--check "a build with no registry refuses rather than showing nothing"
(eq 'caught
(condition-case nil (flan-leaks) (user-error 'caught)))))
;;; The inspector buffer
(message "\nthe inspector buffer")

View File

@ -54,16 +54,17 @@
;; The same centre/size to min/max conversion as in
;; examples/models-box-collisions.flan. Written out here rather than shared
;; because an example is a single file the reader can follow end to end, and
;; a two-file port for eight expressions would cost more than it saves.
;; because an example is a single file the reader can follow end to end.
;;
;; It used to be eight expressions of field arithmetic; it is the half-extent
;; subtracted and added, which is what the C means, now that the package
;; carries vector arithmetic — see vendor/raylib/vector.flan. That file
;; exists because raymath is `static inline` and has no symbol to bind, so
;; v3-sub and v3-add are Flan and not C.
(defn box-around [centre rl/Vector3 size rl/Vector3] rl/BoundingBox
(rl/BoundingBox
{.min (rl/Vector3 {.x (- (.x centre) (/ (.x size) 2.0))
.y (- (.y centre) (/ (.y size) 2.0))
.z (- (.z centre) (/ (.z size) 2.0))})
.max (rl/Vector3 {.x (+ (.x centre) (/ (.x size) 2.0))
.y (+ (.y centre) (/ (.y size) 2.0))
.z (+ (.z centre) (/ (.z size) 2.0))})}))
(let [half (rl/v3-scale size 0.5)]
(rl/BoundingBox {.min (rl/v3-sub centre half)
.max (rl/v3-add centre half)})))
(defn main [] ()
(rl/init-window screen-width screen-height

View File

@ -54,14 +54,15 @@
;; min-corner/max-corner, not centre/size, and every collision call in the
;; family takes the corner form — so this is the conversion the C writes out
;; longhand at each of its two call sites.
;;
;; It used to be eight expressions of field arithmetic here too; it is the
;; half-extent subtracted and added now that the package carries vector
;; arithmetic — see vendor/raylib/vector.flan, which is Flan and not C
;; because raymath is `static inline` and has no symbol to bind.
(defn box-around [centre rl/Vector3 size rl/Vector3] rl/BoundingBox
(rl/BoundingBox
{.min (rl/Vector3 {.x (- (.x centre) (/ (.x size) 2.0))
.y (- (.y centre) (/ (.y size) 2.0))
.z (- (.z centre) (/ (.z size) 2.0))})
.max (rl/Vector3 {.x (+ (.x centre) (/ (.x size) 2.0))
.y (+ (.y centre) (/ (.y size) 2.0))
.z (+ (.z centre) (/ (.z size) 2.0))})}))
(let [half (rl/v3-scale size 0.5)]
(rl/BoundingBox {.min (rl/v3-sub centre half)
.max (rl/v3-add centre half)})))
(defn main [] ()
(rl/init-window screen-width screen-height

View File

@ -17,6 +17,16 @@
;;;; has. It reads fine. A Vector2Add would have saved two lines in the whole
;;;; file.
;;;;
;;;; That measurement is what decided the answer, and the answer landed:
;;;; vendor/raylib/vector.flan is raymath written in Flan, since a C shim
;;;; re-exporting the inlines would have bought identical arithmetic at the
;;;; price of a compilation unit and a second place raylib's semantics live.
;;;; The measurement is left standing rather than rewritten away — one
;;;; subtraction below is `rl/v2-sub` and the rest of the file is unchanged,
;;;; including the atan2/cos/sin path, which is deliberate: it needs no guard
;;;; for a zero-length vector where a normalise would. One line saved, in a
;;;; file that is nothing but vector maths, is the honest size of the gap.
;;;;
;;;; The raylib call it does exercise is collision-point-circle?, which no
;;;; ported example had called, on a frame path, with the point coming
;;;; straight out of get-mouse-position — one struct out of raylib and back
@ -56,9 +66,8 @@
;; because that is what the C does and because it needs no guard for a
;; zero-length vector — atan2(0,0) is 0 and the pupil sits at the right
;; of the eye, which is unreachable anyway since (0,0) is inside.
(let [dx (- (.x mouse) (.x centre))
dy (- (.y mouse) (.y centre))
angle (atan2-f32 dy dx)]
(let [d (rl/v2-sub mouse centre)
angle (atan2-f32 (.y d) (.x d))]
(rl/Vector2 {.x (+ (.x centre) (* limit (cos-f32 angle)))
.y (+ (.y centre) (* limit (sin-f32 angle)))})))))

View File

@ -7,11 +7,19 @@
;;;; state — key-down?, key-pressed?, the mouse position — and this is the
;;;; only example that drains a *queue*: raylib buffers the characters the
;;;; platform produced since the last frame, already through the keyboard
;;;; layout and the dead keys, and hands them back one at a time until it
;;;; answers 0. The loop that empties it is the point of the example, and a
;;;; layout and the dead keys, and hands them back one at a time until it is
;;;; empty. The loop that empties it is the point of the example, and a
;;;; program that read the queue once per frame instead would silently drop
;;;; the second character of a fast pair. It is a plain i32 out of the
;;;; generated bindings; nothing needed adding for it.
;;;; the second character of a fast pair.
;;;;
;;;; raylib says "empty" by answering 0, and rl/get-char-pressed is now a
;;;; Flan wrapper that says it with None instead — see raylib.flan, "Draining
;;;; raylib's two input queues". What that buys is visible below: the C
;;;; shape, which this file had, reads the queue in *two* places, once to
;;;; prime the loop and once at the bottom of the body, and a `> 0` in
;;;; between that a reader has to know raylib's convention to trust. The
;;;; Option shape reads it in one place, and the case where there is no
;;;; character is a branch the checker knows about rather than a comparison.
;;;;
;;;; The second is set-mouse-cursor, which needed a new defenum. raylib's
;;;; header says `int cursor` and means one of eleven MOUSE_CURSOR_ values, so
@ -75,19 +83,22 @@
(do
(rl/set-mouse-cursor :ibeam)
;; Drain the character queue. raylib answers 0 when it is empty, and
;; more than one character can arrive in a single frame — holding a
;; key with the platform's repeat on is the ordinary way that happens.
(let [key (rl/get-char-pressed)]
(while (> key 0)
;; 32..125 is the printable ASCII range the C accepts. Anything
;; outside it — an accented letter, a control character — is
;; dropped rather than stored, because the buffer is bytes and a
;; codepoint above 127 would need more than one of them.
(when (and (>= key 32) (<= key 125) (< letter-count max-input-chars))
(set (at name letter-count) (u8 key))
(set letter-count (+ letter-count 1)))
(set key (rl/get-char-pressed))))
;; Drain the character queue: more than one character can arrive in
;; a single frame — holding a key with the platform's repeat on is
;; the ordinary way that happens — and None is the end of it.
(let [draining true]
(while draining
(match (rl/get-char-pressed)
None (set draining false)
;; 32..125 is the printable ASCII range the C accepts. Anything
;; outside it — an accented letter, a control character — is
;; dropped rather than stored, because the buffer is bytes and a
;; codepoint above 127 would need more than one of them.
(Some key)
(when (and (>= key 32) (<= key 125)
(< letter-count max-input-chars))
(set (at name letter-count) (u8 key))
(set letter-count (+ letter-count 1))))))
(when (rl/key-pressed? :backspace)
(set letter-count (- letter-count 1))

View File

@ -1226,28 +1226,26 @@ let rec key_pair env loc (k : Types.t) : Tast.fnref * Tast.fnref =
the concrete type does not exist until the instantiation. Refused rather
than assumed falling through to [bytewise_key] would hash whatever
bytes the variable turned out to have, which is the wrong answer for a
[string] and for any struct with padding. Inside an instantiation this
arm is unreachable: [env.subst] has already made [k] concrete.
[string] and for any struct with padding.
**This is a known hole and it is deliberate.** It means [hashable?] gates
the *type* and not the operations: a generic may take or return a
[(Map $t V)] under it, and may not [put], [get] or [has?] into one. The
alternative is to add the map operations to the list of forms the
abstract pass defers to instantiation the list [print] and [println]
are the only members of and every member of that list is a place where
a refusal moves from the definition to a call site, which is the thing
the abstract pass exists to prevent. Two members is a short list worth
keeping short; six is a rule nobody can hold in their head. If a generic
over maps is ever wanted, this is the decision to revisit, and it is one
line here plus one in [key_fns]. *)
**This arm is a backstop and nothing normal reaches it.** Two things get
there first. Inside an instantiation [env.subst] has already made [k]
concrete, so there is no variable left. Outside one in the abstract
pass over a generic body the map operations are *deferred*
([deferred_key] below): a key that is a variable declared [hashable?]
never asks for a pair here, and a variable that is not declared it never
gets as far as a [(Map $t V)] to operate on, because [map_type] refuses
the type where it is written. What is left for this arm is a key that is
a variable by some route neither of those covers, and the honest answer
to that is still a refusal rather than a guessed pair. *)
| Types.Var v ->
Loc.failk "check/generic-map-key" loc
"a map keyed by the type variable %s cannot be operated on here: the \
hash and the equality are emitted as concrete symbols chosen from the \
concrete key type, and there is no concrete key type until this \
generic is instantiated. {:where (hashable? $%s)} says the map may be \
taken and returned, not that its keys can be hashed here write the \
operation in a function over the concrete key type and call that" v v
"a map keyed by the type variable %s has no hash and no equality here: \
both are emitted as concrete symbols chosen from the concrete key \
type, and there is none until this generic is instantiated. The map \
operations are deferred to the instantiation when {:where (hashable? \
$%s)} is declared declare it, or write the operation in a function \
over the concrete key type and call that" v v
| Types.String -> Tast.Rtfn "flan_hash_str", Tast.Rtfn "flan_eq_str"
| t when bytewise_key t ->
Tast.Rtfn "flan_hash_flat", Tast.Rtfn "flan_eq_flat"
@ -1417,6 +1415,38 @@ let key_fns env loc k =
let h, e = key_pair env loc k in
mk loc Types.Alloc (Tast.FnAddr h), mk loc Types.Alloc (Tast.FnAddr e)
(* ── The map operations, deferred to the instantiation ─────────────────
True when the key is a type variable, which means the operation cannot be
built here and must be answered by the copy: [key_fns] emits concrete
symbols and there is no concrete key type yet. The caller checks its
arguments first and then returns a placeholder of the operation's own type,
exactly as [print] does see the allow-list comment at the [print] arm for
what being on that list costs and why these are on it.
The predicate is *required* before deferring, and that is the whole safety
argument: with {:where (hashable? $t)} in the signature, the instantiation
refuses at the call site against a requirement the author wrote down. A
variable with no such clause is refused here and now, at the definition,
which is where the abstract pass wants every refusal that has nothing to
point at. In practice [map_type] has already refused such a signature where
the type was written; this repeats it rather than relying on that, the same
way [key_pair] repeats [map_type]'s key check. *)
let deferred_key env loc what (k : Types.t) =
match k with
| Types.Var v ->
if not (declares env.tvpreds v "hashable?") then
Loc.failk "check/generic-map-key" loc
"%s over a map keyed by the type variable %s is refused: the hash and \
the equality are emitted as concrete symbols chosen from the \
concrete key type, and nothing here declares %s hashable. Write \
{:where (hashable? $%s)} at the head of the body then the \
operation is deferred to each instantiation, and a call site that \
asks for a key type that cannot be hashed is refused there, against \
the clause"
what (Types.to_string k) (Types.to_string k) v;
true
| _ -> false
let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let loc = e.Ast.loc in
(* Read the permission this form was given and withdraw it in the same
@ -3639,6 +3669,13 @@ and named_call ctx ~want loc name args =
let n64 =
mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ]))
in
(* Deferred: the sizes are known abstractly but the hash is not, so
the node is a unit no-op and the copy builds the real one. *)
if (match target.Tast.ty with
| Types.Map (k, _) -> deferred_key ctx.env loc "reserve" k
| _ -> false) then
expect loc ~want (mk loc Types.Unit Tast.Unit)
else
let attempt, note =
match target.Tast.ty with
(* For a map the number is entries, not slots: the runtime sizes the
@ -3744,6 +3781,12 @@ and named_call ctx ~want loc name args =
seed is derived from the block's address see flan_rt.c. That is
the runtime's business; from here it is one more allocating call
under the same guard. *)
| Types.Map (k, v) when deferred_key ctx.env loc "clone" k ->
(* Deferred, and the placeholder is a zeroed map of the same type —
the value a (map-new) starts from, so everything written around
the clone still checks against the type it will have. *)
let mty = Types.Map (k, v) in
expect loc ~want (mk loc mty (Tast.Zero mty))
| Types.Map (k, v) ->
let mty = Types.Map (k, v) in
let hash, _ = key_fns ctx.env loc k in
@ -4045,6 +4088,12 @@ and named_call ctx ~want loc name args =
let kt, vt = map_kv loc "put" target.Tast.ty in
let k = check ctx ~want:kt k in
let v = check ctx ~want:vt v in
(* Deferred: the arguments are checked — so a move here is still a move
and a borrow still a borrow and the node itself is a unit no-op,
thrown away with the rest of the abstract pass. *)
if deferred_key ctx.env loc "put" kt then
expect loc ~want (mk loc Types.Unit Tast.Unit)
else
(* Both are bound before the loop, so that a [retry] re-attempts the
allocation and not the expressions that produced the key and the
value. The same rule [push] follows for its element. *)
@ -4076,6 +4125,12 @@ and named_call ctx ~want loc name args =
let target = borrowed ctx target (fun () -> check ctx target) in
let kt, vt = map_kv loc "get" target.Tast.ty in
let k = check ctx ~want:kt k in
(* Deferred, and the placeholder is [None] rather than [Unit]: this
form answers an (Option V), and the abstract pass still has to
type-check whatever the body does with the answer. *)
if deferred_key ctx.env loc "get" kt then
expect loc ~want (mk loc (Types.Option vt) Tast.None_)
else
let hash, eq = key_fns ctx.env loc kt in
let ks = fresh_slot ctx kt in
let out = fresh_slot ctx vt in
@ -4157,6 +4212,11 @@ and named_call ctx ~want loc name args =
let target = borrowed ctx target (fun () -> check ctx target) in
let kt, vt = map_kv loc "has-key?" target.Tast.ty in
let k = check ctx ~want:kt k in
(* Deferred, and the placeholder is a [bool] — the form a condition
wants, so the condition around it still has to check. *)
if deferred_key ctx.env loc "has-key?" kt then
expect loc ~want (mk loc Types.Bool (Tast.Bool false))
else
let hash, eq = key_fns ctx.env loc kt in
let ks = fresh_slot ctx kt in
let found =
@ -4540,8 +4600,7 @@ and named_call ctx ~want loc name args =
printing of one would be its last. *)
let target = List.hd args in
let a = borrowed ctx target (fun () -> check ctx target) in
(* ── The allow-list, and it has exactly two members: [print] and
[println].
(* ── The allow-list, and what it takes to get on it ───────────────
plan.org names [println] as the one compiler-provided exception it
"selects a structural printer at each concrete instantiation" and
that cannot be reconciled with an abstract pass as written: a pass that
@ -4553,10 +4612,33 @@ and named_call ctx ~want loc name args =
Every member of this list is a place where a refusal moves from the
definition to a call site, which is the thing the abstract pass exists
to prevent. That is the whole cost of the exception and the reason the
list stays two long and is written down here. There is no [where]
predicate for printability on purpose: every type prints, so the
predicate would always hold and would only be noise on a signature.
to prevent. **That cost is not the same for every member, and the list
is not closed.** What makes it bearable is whether the call site has a
*stated requirement* to be refused against.
[print] and [println] have none and need none: every type prints, so
there is no [where] predicate for printability one would always hold
and would be noise on a signature and there is correspondingly no
call site these can be refused at. They are deferred and then always
succeed. That is the cheapest possible membership.
The map operations [put], [get], [has-key?], [reserve], [clone],
through [deferred_key] beside [key_fns] are the other kind, and they
are here on a different argument. They *can* fail at a concrete type,
so deferring them does move a refusal. But [{:where (hashable? $t)}] is
in the signature, and it is the author's own written requirement: an
instantiation at a non-hashable type is refused against that clause, by
name, at the call that asked for the type. That is a refusal the caller
can act on and one the generic's author chose to be responsible for
categorically different from an unconstrained [(+ a b)] failing deep in
a body with no signature to blame, which is the case the abstract pass
exists to prevent and which stays refused at the definition. A generic
that does *not* declare the predicate gets no deferral: [deferred_key]
checks first, and [map_type] has usually refused the signature already.
So the rule for adding to this list is not a headcount. It is: either
the operation cannot fail after substituting, or a declared predicate
gives its failure a place to land. Anything else is answered here.
The node produced here is a unit no-op, thrown away with the rest of
the abstract pass. The real printer is selected when the copy is
@ -4871,9 +4953,12 @@ and instantiate env loc gname vars subst cparams cret =
| Some t ->
if not (pred_holds p.Ast.pname t) then
Loc.failk "check/predicate-unsatisfied" loc
"%s here would instantiate %s at $%s = %s, and %s is not %s — \
the body of %s is written against {:where (%s $%s)}"
gname gname p.Ast.pvar (Types.to_string t) (Types.to_string t)
"this call instantiates %s at $%s = %s, and %s does not \
answer %s which %s requires, being written {:where (%s \
$%s)}. The requirement is the signature's, so the refusal is \
here, at the call that asked for the type: pass one the \
predicate admits"
gname p.Ast.pvar (Types.to_string t) (Types.to_string t)
p.Ast.pname gname p.Ast.pname p.Ast.pvar)
fn.Ast.fwhere;
(* The entry goes in *before* the body is checked, which is what makes a

View File

@ -1032,6 +1032,372 @@ let inspect t ~frame ~slot ~path =
":type " ^ Wire.quote ty; ":value " ^ Wire.quote v ]))
(* ── The allocation registry, read from this end ───────────────────── *)
(* [BUILT.md]'s "An address answers with a type" is what the table is and why.
What follows is the reader: three verbs that ask the agent for what is
recorded, and one of them turns a recorded *name* back into a type.
Nothing here is emitted and nothing here is in a release build. A release
binary's table is a null pointer, so every one of these comes back with the
agent saying the registry is off which is an answer, and is the same
answer [programs/registry.flan]'s release row asserts. *)
type reg_entry =
{ rlive : bool;
roff : int; (* how far into the block the address lands *)
rbytes : int; (* the block's extent *)
relem : int; (* one element, or 0 where the block is not an array *)
rseq : int; (* when it was recorded *)
rdied : int; (* when it was released, or 0 while it is live *)
rtype : string } (* the Flan spelling the compiler wrote beside the call *)
(* [reg at ADDR] answers one of three things and they are three different
facts: a row, "never heard of it", or "there is no table". Kept apart here
rather than collapsed into an option, because an address the registry never
saw is a stack local or a pointer from C a perfectly good address with no
entry and a release build is a build that records nothing about any
address at all. A caller that could not tell them apart would report the
second as the first. *)
let reg_at t ~addr : (reg_entry option, string) result =
match request t (Printf.sprintf "reg at %d" addr) with
| exception Unix.Unix_error (e, _, _) ->
Error ("cannot reach the program: " ^ Unix.error_message e)
| text ->
let line = String.trim (List.hd (String.split_on_char '\n' text)) in
if line = "none" then Ok None
else if String.length line > 4 && String.sub line 0 4 = "err " then
Error (String.sub line 4 (String.length line - 4))
else
(* "ok LIVE OFF BYTES ELEM SEQ DIED\tTYPE". The type is last and behind
a tab because a spelling holds spaces "(Vec i32)" and nothing
else on the line does. *)
(match String.index_opt line '\t' with
| None -> Error ("the program answered " ^ line)
| Some tab ->
let head = String.sub line 0 tab
and ty = String.sub line (tab + 1) (String.length line - tab - 1) in
(match String.split_on_char ' ' head with
| [ "ok"; live; off; bytes; elem; seq; died ] ->
(match List.map int_of_string_opt [ live; off; bytes; elem; seq; died ] with
| [ Some live; Some off; Some bytes; Some elem; Some seq; Some died ] ->
Ok (Some { rlive = live <> 0; roff = off; rbytes = bytes;
relem = elem; rseq = seq; rdied = died; rtype = ty })
| _ -> Error ("the program answered " ^ line))
| _ -> Error ("the program answered " ^ line)))
(* The recorded name, back to a [Types.t].
This is the one thing item 3 needed that nothing else in the registry did,
and the whole of the difficulty is that **the table records a string**. It
has to: the note is built in [check.ml] at the allocation site, where the
concrete type exists, and what crosses into the runtime is bytes an
[ABI] that carried a type would be an ABI that had to agree with the
checker's representation of one, which is the coupling the whole
no-header-no-tag-word design refuses.
What closes it is that the string is not a description. It is
[Types.to_string] of the type, which is the *source spelling* that is
said in [check.ml]'s [reg_note] as the reason the name is worth printing at
all so the round trip is the language's own reader, the language's own
type-expression parser, and the session's own resolver. `Enemy' resolves
against the structs this session holds, `(Vec i32)' rebuilds through
[Tapp], `[3 i32]' through [Tarray]. No table of spellings is written down
anywhere, so nothing can fall behind [Types.to_string].
And it is allowed to fail, which matters more than it looks. Not every
recorded name is a type: [flan_rt.c] notes a pool's slot headers as
"pool slots", because after a free-all an address landing in them must not
come back as an element. That string is not Flan source and must not
become one so a name that does not resolve is refused with the name
quoted, and never defaulted to bytes. *)
let type_of_spelling t spelling : (Types.t, string) result =
let refuse why =
Error
(Printf.sprintf "%s is not a type this session can resolve: %s"
(Wire.quote spelling) why)
in
match Reader.read_all ~file:"<registry>" spelling with
| exception Loc.Error { Loc.dmsg = why; _ } -> refuse why
| [] -> refuse "there is nothing in it"
| _ :: _ :: _ -> refuse "it is more than one form"
| [ f ] ->
(match Check.resolve t.session.Session.env (Parse.texpr f) with
| ty -> Ok ty
| exception Loc.Error { Loc.dmsg = why; _ } -> refuse why)
(* The extern that hands a number back as a pointer.
The one piece an address-rooted thunk cannot work out for itself, and it is
the same arrangement [flan/dev-slot] has for a frame's slot: Flan has no
integer-to-pointer cast, deliberately, and the inspector is not a Flan
program. Everything after this is ordinary a pointer-to-pointer cast and
a render, which is what [Session.render_slot] already does at a slot's
address. *)
let addr_extern : Tast.extern =
{ Tast.ename = "flan/dev-addr"; esym = "flan_dev_reg_addr";
eparams = [ Types.Int Types.I64 ];
eret = Types.Ptr (Types.Int Types.U8) }
(* Renders the value [(Ptr ty)] holding [addr], in the program.
**A pointer and not the pointee, and that is the design.** Rendering the
[ty] at that address directly would read the storage whatever the registry
said, which is the hex dump this project does not want to be. Rendering a
[(Ptr ty)] puts the walk through [render.ml]'s pointer arm, which is the
arm that asks first: live, and the pointee is rendered one level deeper;
dead, and the epitaph says what died there instead. So an address root and
a slot root reach the same two answers by the same path, and the permission
question is asked in exactly one place in the compiler.
Built here rather than in [session.ml] because it is the inspector's
rooting mode and not the session's: a session renders what a *program*
holds a frame's slot, a global and an address handed in from outside is
neither of those. *)
let render_addr (s : Session.t) ~addr ~(ty : Types.t)
: (Session.change, string) result =
let loc = Loc.unknown in
let extra = ref [] and nslots = ref 0 in
let c =
{ Render.structs = s.Session.program.Tast.structs;
unions = s.Session.program.Tast.unions;
enums =
Hashtbl.fold (fun k v acc -> (k, v) :: acc) s.Session.env.Check.enums [];
emit = Session.dev_emitter;
ptrs = Some Session.dev_pointers;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
extra := ty :: !extra;
i) }
in
let pty = Types.Ptr ty in
let root =
{ Tast.e =
Tast.Prim
(Tast.Cast pty,
[ { Tast.e =
Tast.Call
("flan/dev-addr",
[ { Tast.e = Tast.Int (Int64.of_int addr, Types.I64);
ty = Types.Int Types.I64; loc } ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ]);
ty = pty; loc }
in
match Render.render c 0 root with
| exception Loc.Error { Loc.dmsg = why; _ } -> Error why
| parts ->
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
s.Session.thunks <- s.Session.thunks + 1;
let name = Printf.sprintf "at/%d" s.Session.thunks in
let thunk : Tast.fn =
{ Tast.name; params = []; ret = Types.Unit;
body = (nullary "flan/dev-begin" :: parts) @ [ nullary "flan/dev-end" ];
fdefers = []; fparent = None; floc = loc;
slots = Array.of_list (List.rev !extra);
(* Every slot in here is the walk's own scratch: what is being shown
is storage this thunk reaches by address. *)
snames = Array.make (List.length !extra) None }
in
let program =
{ s.Session.program with
Tast.fns = s.Session.program.Tast.fns @ [ thunk ];
externs = s.Session.program.Tast.externs @ Session.externs @ [ addr_extern ] }
in
let ir =
Emit.redefinition ~dev:true ~debug:s.Session.debug ~known:(Session.known s)
~call:name program ~fns:[ name ]
in
Ok { Session.ir; names = []; fns = []; installs = true }
(* [(:op "at" :addr N :type "Enemy")] — point at any heap address.
The inspector's third rooting mode, and the one that needs no frame.
[locals] and [inspect] root at a frame and a slot, which is the address the
shadow stack knows and the type [Tast.fn.slots] knows. This roots at an
address somebody has in their hand out of a C debugger, out of a printed
[Ptr], out of a leak report and there is no frame to read a type off.
**So the type comes from the registry when it is not given**, which is what
the table was carrying a string for all along and what nothing had yet
read. See [type_of_spelling] for how the string becomes a [Types.t] and why
it is allowed to refuse.
**A given [:type] wins over the recorded one**, and is not checked against
it. Overriding is the point of being able to say it: a pointer into the
middle of a block, a struct the registry recorded under a container's
spelling, a reinterpretation someone is doing on purpose. What is *not*
silent is the disagreement the reply carries [:recorded] whenever the
table had a name, so a client showing one type while the allocator wrote
down another can say so.
**Refused while running**, the same as [inspect] and for a related reason
rather than the same one: there is no frame here to be redefined under us,
but there is a table, and live-or-dead is exactly the thing a running
program is changing. An answer read off a program mid-frame is an answer
about a moment that has already gone.
**Refused at an address the block does not divide.** When the entry records
an element size and the offset is not a multiple of it, the address is
inside an element rather than at one, and rendering the element type there
would read one element's tail as another's head a plausible-looking
answer, which is the worst kind. Said with the offset, so the reader can
see how far off it is, and overridable by naming a [:type] the way any
other reinterpretation is.
**No [:path].** A path steps from the pointee, and the pointee is what the
registry has only just been asked to bless: the whole answer here is the
pointer arm's branch. Somebody who wants to walk from what they found
reaches it the way the break buffer already does the value is rendered,
and stepping into it is a different root. *)
let inspect_addr t ~addr ~want_type =
if addr <= 0 then error "an address is a positive number"
else if not (alive t) then error "the program exited; restart flan dev"
else
match state t with
| Running ->
error
"the program is running; whether an address is still live is exactly \
what a running program is changing, so it is read from a stopped one"
| Unreachable m -> error ("cannot ask the program about that address: " ^ m)
| Stopped _ ->
(match reg_at t ~addr with
| Error m -> error m
| Ok entry ->
let recorded = Option.map (fun e -> e.rtype) entry in
let chosen =
match want_type with
| Some spelling -> type_of_spelling t spelling
| None ->
(match entry with
| Some e -> type_of_spelling t e.rtype
| None ->
Error
"the registry has never seen that address and no :type was \
given, so there is nothing to say what is there a stack \
local, a global or a pointer from C is deliberately not in \
the table, and the shadow stack answers for the first two \
by name")
in
(match chosen with
| Error m -> error m
| Ok ty ->
let misaligned =
match (want_type, entry) with
| None, Some e when e.relem > 0 && e.roff mod e.relem <> 0 ->
Some e
| _ -> None
in
(match misaligned with
| Some e ->
error
(Printf.sprintf
"that address is %d bytes into a block of %s, whose \
elements are %d bytes: it is inside an element rather \
than at one, and reading %s there would show one \
element's tail as another's head. Name a :type to read \
it anyway."
e.roff e.rtype e.relem e.rtype)
| None ->
let told =
match recorded with
| None -> [ ":recorded nil" ]
| Some r -> [ ":recorded " ^ Wire.quote r ]
in
let where =
match entry with
| None -> []
| Some e ->
[ Printf.sprintf ":offset %d" e.roff;
Printf.sprintf ":bytes %d" e.rbytes;
Printf.sprintf ":elem %d" e.relem;
Printf.sprintf ":step %d" e.rseq;
Printf.sprintf ":freed %d" e.rdied ]
in
let live =
match entry with Some e when e.rlive -> "t" | _ -> "nil"
in
(match render_addr t.session ~addr ~ty with
| Error m -> error m
| exception Failure m -> error m
| Ok c ->
(match run_render_thunk t ~tag:"a" ~c with
| Error m -> error m
| Ok v ->
ok
([ Printf.sprintf ":addr %d" addr;
":type " ^ Wire.quote (Types.to_string (Types.Ptr ty));
":value " ^ Wire.quote v; ":live " ^ live ]
@ told @ where))))))
(* [reg types] and [reg leaks] — the table grouped by type spelling.
The walk and the group-by are one function in [flan_dev.c], because a leak
report is a breakdown with the dead left out and two walks would drift.
What this end adds is the order: biggest first, by bytes. A breakdown read
in table order is a list of everything and tells you nothing; a breakdown
read biggest-first is the answer to "where did the memory go", which is the
only reason either verb exists.
[:overflow] is carried rather than swallowed. A table that filled has
blocks in the program that are in nobody's row, so every number below it is
a floor and not a count, and a reader that could not tell would quote them
as counts. *)
let reg_rows t ~verb =
match request t verb with
| exception Unix.Unix_error (e, _, _) ->
Error ("cannot reach the program: " ^ Unix.error_message e)
| text ->
(match String.split_on_char '\n' text with
| [] -> Error "the program answered nothing"
| hdr :: rest ->
let hdr = String.trim hdr in
if String.length hdr > 4 && String.sub hdr 0 4 = "err " then
Error (String.sub hdr 4 (String.length hdr - 4))
else
(match String.split_on_char ' ' hdr with
| [ n; over ] when int_of_string_opt n <> None ->
let rows =
List.filter_map
(fun line ->
match String.index_opt line '\t' with
| None -> None
| Some tab ->
let ty =
String.sub line (tab + 1) (String.length line - tab - 1)
in
(match
List.map int_of_string_opt
(String.split_on_char ' ' (String.sub line 0 tab))
with
| [ Some count; Some bytes ] -> Some (ty, count, bytes)
| _ -> None))
rest
in
let rows =
List.stable_sort (fun (_, _, a) (_, _, b) -> compare b a) rows
in
Ok (rows, over <> "0")
| _ -> Error ("the program answered " ^ hdr)))
let reg_listing t ~verb ~note =
match reg_rows t ~verb with
| Error m -> error m
| Ok (rows, overflow) ->
let blocks = List.fold_left (fun a (_, c, _) -> a + c) 0 rows
and bytes = List.fold_left (fun a (_, _, b) -> a + b) 0 rows in
ok
[ ":types "
^ Wire.list
(List.map
(fun (ty, c, b) ->
Wire.list [ Wire.quote ty; string_of_int c; string_of_int b ])
rows);
Printf.sprintf ":blocks %d" blocks;
Printf.sprintf ":bytes %d" bytes;
(if overflow then ":overflow t" else ":overflow nil");
":note " ^ Wire.quote note ]
(* [(:op "globals")] — the globals the stopped stack reaches, in one section.
Locals were the half the shadow stack was built for; these are arguably the
@ -1786,6 +2152,42 @@ let handle t req =
(* No :frame, and that is the point: the section is the stack's, not a
frame's. See [globals_op]. *)
| Some "globals" -> globals_op t
(* [(:op "at" :addr N)] and an optional [:type]. The rooting mode with no
frame in it: an address somebody has in their hand, and the registry's
own answer for what is there when none is named. See [inspect_addr]. *)
| Some "at" ->
(match Wire.int_field req "addr" with
| None ->
error
"at needs :addr, the address to point at; it is the one thing this \
verb cannot work out for itself"
| Some addr -> inspect_addr t ~addr ~want_type:(Wire.string_field req "type"))
(* What this program is made of, by type. Everything the table holds, live
and dead both the dead are the bulk of it in a long-running program and
they are what says where the allocation went, not only where it stayed. *)
| Some "allocations" ->
reg_listing t ~verb:"reg types"
~note:
"every block the registry recorded, live and dead, grouped by the \
type the allocator's caller named"
(* And what is still held.
"At exit" is the question this answers and it needs saying plainly,
because the obvious reading does not survive contact with a game. A
program killed by a signal which is how a program under this editor
usually ends runs no handler at all, so nothing written inside it could
report anything. There are therefore two readers and they are not
alternatives: this verb, which reads the same table over the agent socket
and can be asked at any moment, including the last one before the kill;
and an atexit hook in [flan_dev.c] for the program that returns from main
on its own, which is off unless FLAN_DEV_LEAKS is set, because a dev
build's output is read by the acceptance table. *)
| Some "leaks" ->
reg_listing t ~verb:"reg leaks"
~note:
"what the registry still holds live at the moment it was asked; a \
program that is killed runs no exit handler, so this verb and not a \
hook is what answers for one"
| Some "layout" ->
(match Wire.string_field req "type" with
| Some ty -> layout t ~ty

View File

@ -1055,6 +1055,8 @@ static int flan_reg_full; /* something found no slot */
* second version of the allocator gated on a build flag is worse than a
* branch. That is a real cost and not zero; BUILT.md says so rather than
* repeating the claim that a release build carries nothing. */
static void flan_reg_report(void); /* the exit report, at the bottom */
void flan_dev_reg_enable(void) {
if (flan_reg_on) return;
flan_reg = (flan_reg_entry *)calloc(FLAN_REG_CAP, sizeof *flan_reg);
@ -1063,6 +1065,12 @@ void flan_dev_reg_enable(void) {
which is what a release build answers too. */
if (flan_reg == NULL) return;
flan_reg_on = 1;
/* Here and not at file scope: a destructor attribute would run in every
build, since this file is linked into every build, and that would be a
third place a release build is not free. Registered from inside the one
function only a dev build's constructor calls, a release binary still
carries a null pointer, a zero flag and the declarations. */
if (getenv("FLAN_DEV_LEAKS") != NULL) atexit(flan_reg_report);
}
int flan_dev_reg_enabled(void) { return flan_reg_on; }
@ -1259,3 +1267,148 @@ int64_t flan_dev_reg_count(int32_t live_only) {
return n;
}
/* ── Reading the table back ───────────────────────────────────────────
*
* Three accessors and no formatter. Everything above this point is on the
* writer's side a game loop and everything below is read by a person
* pressing a key, so the shape that matters here is "hand back what is
* recorded" rather than "hand back a sentence". The agent turns these into
* protocol lines and the daemon turns those into an editor reply; the one
* piece of text this file still writes is the exit report at the bottom,
* which has nowhere else to go.
*/
/* What the table records for the address [p], live or dead. The containment
* lookup, exposed: [flan_dev_reg_live] answers the renderer's yes/no and
* [flan_dev_reg_emit] writes the epitaph, and neither hands back the *name*,
* which is what a reader that wants to point at a bare address needs it has
* no (Ptr T) to read the type off, so the table's own answer is the only
* answer there is.
*
* [off] is how far into the block [p] lands, and it is not decoration: with
* [elem] it is what says whether the address is an element boundary or the
* middle of one. A caller that renders a T at an offset that is not a
* multiple of [elem] would be reading one element's tail as another's head,
* so it is given the two numbers rather than a flag it cannot check. */
int32_t flan_dev_reg_at(const void *p, const char **type, int64_t *typelen,
int64_t *off, int64_t *bytes, int64_t *elem,
int64_t *seq, int64_t *died) {
flan_reg_entry *e = flan_reg_on ? flan_reg_find((uintptr_t)p) : NULL;
if (e == NULL) return 0;
if (type) *type = e->type;
if (typelen) *typelen = e->typelen;
if (off) *off = (int64_t)((uintptr_t)p - e->base);
if (bytes) *bytes = e->bytes;
if (elem) *elem = e->elem;
if (seq) *seq = e->seq;
if (died) *died = e->died;
return 1;
}
/* An address, as a number, handed back as a pointer. The one thing an
* address-rooted render thunk cannot do for itself: Flan has no integer-to-
* pointer cast, deliberately a program that could make a pointer out of
* arithmetic is a program the type system stops describing and the
* inspector is not a program. It is the same arrangement [flan_agent_frame_
* slot] already has for a frame's slot, and for the same reason: the compiler
* knows the type, and something outside the language supplies the address. */
void *flan_dev_reg_addr(int64_t a) { return (void *)(uintptr_t)a; }
/* And back the other way, which is the half a *program* needs rather than the
* inspector. The address root above takes a number, and the things that hand
* out addresses as numbers all live outside the language gdb, valgrind, a C
* library's callback, a printf("%p") in somebody's shim. A Flan program that
* wants to say one out loud has no cast for it, deliberately: pointer
* arithmetic out of an integer is the thing the type system stops describing.
* So the conversion is a C function, named and visible, and the language
* still has no operator for it. */
int64_t flan_dev_reg_number(const void *p) { return (int64_t)(uintptr_t)p; }
/* The table, by type spelling: one row per distinct name, with how many
* blocks carry it and how many bytes they hold. [live_only] is the whole
* difference between "what is this program made of" and "what is still held",
* which is why there is one walk here and not two a leak report is a
* breakdown with the dead left out, and writing it twice would let the two
* drift.
*
* Caller-owned buffers, and the return is how many distinct types there were
* rather than how many were written: a caller whose buffers were too small is
* told so by the number coming back larger than [cap], which is the same
* contract the watch table's count has.
*
* The grouping is O(rows x types) on string compare. The table is 4096 slots
* and the reader is a person, so this is the side the cost belongs on the
* same judgement [flan_reg_find] is written down for. Compared by *content*
* and not by pointer: the name is a literal the compiler emitted beside a
* call site, and two modules that both allocate an Enemy emit two of them. */
int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts,
int64_t *bytes, const char **types,
int64_t *typelens, int64_t cap) {
int64_t i, n = 0;
if (!flan_reg_on) return 0;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
int64_t j;
int found = 0;
if (e->base == 0) continue;
if (live_only && e->died != 0) continue;
for (j = 0; j < n && j < cap; j++) {
if (typelens[j] != e->typelen) continue;
if (memcmp(types[j], e->type, (size_t)e->typelen) != 0) continue;
counts[j]++;
bytes[j] += e->bytes;
found = 1;
break;
}
if (found) continue;
if (n < cap) {
types[n] = e->type;
typelens[n] = e->typelen;
counts[n] = 1;
bytes[n] = e->bytes;
}
n++;
}
return n;
}
/* ── What is still held when the program returns ──────────────────────
*
* Registered by [flan_dev_reg_enable] and therefore only in a dev build,
* which is the point: a file-scope destructor would run in *every* build,
* because this file is compiled into every build, and that would be a third
* place a release build is not free. BUILT.md names two and only two.
*
* Off unless FLAN_DEV_LEAKS is set, and that is not timidity. The acceptance
* table reads programs/registry.flan's output with stderr folded in, so a
* report nobody asked for is a report that changes what a dev build prints.
*
* And it says "at exit" honestly. This runs when main returns or something
* calls exit(). A program killed with a signal which is how a game under
* the editor usually ends runs no handler at all, and no hook written here
* could change that. The answer for that program is the daemon's own verb,
* which reads the same table over the agent socket and can be asked at any
* moment, including the one before the kill. This hook is for the program
* that finishes on its own. */
static void flan_reg_report(void) {
enum { ROWS = 128 };
int64_t counts[ROWS], bytes[ROWS], typelens[ROWS];
const char *types[ROWS];
int64_t n, i, blocks = 0, held = 0;
n = flan_dev_reg_by_type(1, counts, bytes, types, typelens, ROWS);
if (n == 0) return;
for (i = 0; i < n && i < ROWS; i++) { blocks += counts[i]; held += bytes[i]; }
fprintf(stderr, "flan: %lld block%s still held at exit, %lld bytes\n",
(long long)blocks, blocks == 1 ? "" : "s", (long long)held);
for (i = 0; i < n && i < ROWS; i++)
fprintf(stderr, "flan: %6lld %10lld %.*s\n", (long long)counts[i],
(long long)bytes[i], (int)typelens[i], types[i]);
if (n > ROWS)
fprintf(stderr, "flan: and %lld more type%s than this report holds\n",
(long long)(n - ROWS), n - ROWS == 1 ? "" : "s");
if (flan_reg_full)
fprintf(stderr,
"flan: the table overflowed, so this is a floor and not a "
"count\n");
}

View File

@ -7,13 +7,12 @@
;;;;
;;;; N is the registry's own event counter and is no part of the claim: it
;;;; moves if anything allocates or frees ahead of this program's two Vecs.
;;;; A test that asserts these lines should match around it, not on it.
;;;; `test_dev.ml' matches around it and never on it.
;;;;
;;;; Both lines are what `(:op "locals" :frame 1)` answers with today, and
;;;; both were read off a running session by hand. **No test drives this
;;;; program yet**: the case belongs beside the other `locals` and `inspect`
;;;; cases in test_dev.ml, which is another lane's file. NEXT.md says so
;;;; rather than letting the verification read as automated.
;;;; Both lines are what `(:op "locals" :frame 1)` answers with, and the
;;;; `a pointer the registry knows about' case in test_dev.ml is what drives
;;;; them. They were read off a running session by hand once; they are not
;;;; read by hand any more.
;;;;
;;;; Why a Vec rather than a struct on the stack: a stack address is not in
;;;; the registry by design — the shadow stack already answers for a local by
@ -24,6 +23,20 @@
(defstruct Boom [why i32])
(defstruct Enemy [hp i32 x i32])
;;; The address root — `(:op "at" :addr N)' — takes a number, and the things
;;; that hand out addresses as numbers all live outside the language: a
;;; debugger, valgrind, a C shim's printf. A Flan program has no cast for it
;;; on purpose — pointer arithmetic out of an integer is what the type system
;;; stops describing — so saying one out loud is a declare-c.
(declare-c ptr-num [p (Ptr Enemy)] i64 "flan_dev_reg_number")
;;; Where the two addresses are left for a reader to find. Globals rather than
;;; a printed line because a global is reachable by name from `C-x C-e' while
;;; the program is stopped, and a local is not: the test asks the session for
;;; them the way a person at the break loop would.
(defvar live-addr i64)
(defvar dead-addr i64)
(defn deeper [] i64
(restart-case
(do (error (Boom {.why 7})) 1)
@ -37,6 +50,8 @@
(let [live (addr (at v 0))
dead (addr (at w 0))]
(free w)
(set live-addr (ptr-num live))
(set dead-addr (ptr-num dead))
(deeper))))
(defvar ticks i64)

View File

@ -0,0 +1,26 @@
;;;; The map operations over a type-variable key, refused at the call site.
;;;;
;;;; A generic body is checked once with its type variables abstract, and the
;;;; map operations are one of the few forms that cannot be answered there:
;;;; the hash and the equality are emitted as concrete symbols chosen from the
;;;; concrete key type, and there is none until a copy exists. So they are
;;;; deferred to the instantiation, the way print and println are.
;;;;
;;;; What makes deferring them safe — and different from an unconstrained
;;;; (+ a b), which stays refused at the definition — is the clause. The
;;;; signature says {:where (hashable? $t)}, so a call site that asks for a
;;;; key type with no usable equality is refused against a requirement the
;;;; author wrote down, at the call that asked for it. A float is that type:
;;;; NaN is not equal to itself, and 0.0 and -0.0 are equal while differing
;;;; bytewise.
(defn seen? [k $t] bool
{:where (hashable? $t)}
(let [m (map-new t i32)]
(put m k 1)
(let [answer (has-key? m k)]
(free m)
answer)))
(defn main [] ()
(println (seen? 3))
(println (seen? 1.5)))

View File

@ -86,6 +86,27 @@
{:where (copyable? $t)}
(do x (zeroed)))
;; The map operations over a key that is a type variable. The hash and the
;; equality are concrete symbols chosen from the concrete key type, so there
;; is nothing to emit here — these are deferred to the instantiation, the way
;; println is, and {:where (hashable? $t)} is what allows it: the refusal for
;; a key type that cannot be hashed lands at the call site, against a
;; requirement written down in this signature. Without the clause the type
;; (Map $t i32) is refused where it is written; see generic-map-reject.flan
;; for the call-site half.
(defn bump [k $t n i32] i32
{:where (hashable? $t)}
(let [m (map-new t i32)]
(reserve m 8)
(put m k n)
(put m k (+ n (match (get m k) (Some v) v _ 0)))
(let [c (clone m)
answer (+ (match (get c k) (Some v) v _ -1)
(if (has-key? c k) 1 0))]
(free c)
(free m)
answer)))
(defn main [] ()
(println (ident 3))
(println (ident 4.5))
@ -126,6 +147,10 @@
(println (widen 3 (i64 0)))
(println (zero-of 9))
;; One written body, two key types, two emitted copies.
(println (bump 7 10))
(println (bump "key" 3))
(let [a (arena-new 4096)
keep (filter (slice ns 0 4) (fn [x] (> x 5)))
one (one-of 4.5)]

View File

@ -1325,7 +1325,7 @@ let () =
output is an answer a per-type copy used to give. *)
let generics_out =
"3\n4.5\ntrue\n7\n5\n-1\n5\n42\n3\n1\n10\n1\n8\n\
3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\n3\n3\n0\n3\n4.5\n"
3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\n3\n3\n0\n21\n7\n3\n4.5\n"
in
outputs "generics" "programs/generics.flan" generics_out;
outputs ~opt:"-O0" "generics, -O0" "programs/generics.flan" generics_out;
@ -1396,6 +1396,18 @@ let () =
refuses "a runaway instantiation names the chain"
"programs/generic-runaway.flan" "grow at ([2 i32])";
(* The other half of the map deferral. The operations over a key that is a
type variable are deferred to the instantiation there is no hash and
no equality to emit until the key type is concrete and what makes
that safe is that {:where (hashable? $t)} is in the signature, so the
refusal lands at the call that asked for the type, against a
requirement the author wrote down. What is asserted is that it names
the type passed and the predicate it failed, and not the body. *)
refuses "a generic over maps, instantiated at a key that cannot be hashed"
"programs/generic-map-reject.flan" "does not answer hashable?";
refuses "and it names the type the call site asked for"
"programs/generic-map-reject.flan" "at $t = f64";
refuses "a package's main is not visible" "programs/pkg-hidden-main.flan"
"sand/main is not a name";
refuses "one directory under two aliases" "programs/pkg-two-aliases.flan"

View File

@ -1348,6 +1348,315 @@ let () =
end
end;
(* ── A pointer the registry knows about ───────────────────────── *)
(* The inspector's pointer arm, and the address root beside it.
[programs/dev-ptr.flan] carried the two lines a session answers with in
its own header and said, in the header, that they had been read off a
running session **by hand**. This is the case that makes that stop
being true. Nothing else drives it: [programs/registry.flan] asserts
the *table* from the acceptance side live or not, in a dev build and
a release one and says nothing about what an inspector renders.
The claim has two halves and they are what the registry bought. A
pointer into live Vec storage is *followed*, one level deeper, and its
pointee rendered by the same walk as anything else. A pointer into
storage that has been freed is not followed, and names what died there
instead. Both pointers have the same static type, so nothing but the
table can tell them apart which is the whole argument of "permission,
not identification". *)
let psock = tmp "ptr.sock" and pout = tmp "ptr.out" in
(try Sys.remove psock with Sys_error _ -> ());
let pfd = Unix.openfile pout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let ppid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-ptr.flan"; "-s"; psock |]
Unix.stdin pfd Unix.stderr
in
Unix.close pfd;
if not (listening ~pid:ppid psock) then begin
fail "the pointer daemon %s" !listen_why;
(try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect psock in
let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let value r = Option.value ~default:"" (Wire.string_field r "value") in
let message r =
Option.value ~default:(status r) (Wire.string_field r "message")
in
let flag r key =
match Wire.field r key with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let starts s pre =
String.length s >= String.length pre
&& String.equal (String.sub s 0 (String.length pre)) pre
in
let contains hay needle =
let n = String.length needle in
let rec go i =
i + n <= String.length hay
&& (String.equal (String.sub hay i n) needle || go (i + 1))
in
go 0
in
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the pointer program never stopped"
else begin
let entries r =
match Wire.field r "locals" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List
[ { Form.v = Form.Str n; _ }; { Form.v = Form.Str ty; _ };
{ Form.v = Form.Str v; _ }; _ ] -> Some (n, ty, v)
| _ -> None)
l
| _ -> []
in
let listing = ask "(:op \"locals\" :frame 1)" in
if status listing <> "ok" then
fail "locals of the frame holding the two pointers: %s"
(message listing)
else begin
let got = entries listing in
let find n = List.find_opt (fun (m, _, _) -> String.equal m n) got in
(* The live half, asserted whole. A pointer with nobody to ask
renders [<ptr>]; this is what having somebody to ask buys. *)
(match find "live" with
| Some ("live", "(Ptr Enemy)", "<ptr (Enemy {.hp 41 .x 2})>") -> ()
| Some (_, ty, v) ->
fail "a live pointer into Vec storage rendered %s : %s" v ty
| None ->
fail "the frame holding the two pointers listed no `live': %s"
(String.concat ", " (List.map (fun (n, _, _) -> n) got)));
(* And the dead half, asserted *around* the step number and never on
it. The step is the registry's own event counter: it moves if
anything allocates or frees ahead of this program's two Vecs, and
the program's header says so. What is being claimed is that the
pointer was not followed and that what died is named. *)
(match find "dead" with
| None -> fail "the frame holding the two pointers listed no `dead'"
| Some (_, ty, v) ->
if ty <> "(Ptr Enemy)" then
fail "the dead pointer's type is %s, not (Ptr Enemy)" ty;
let pre = "<ptr dead: was Enemy, freed at step " in
if not (starts v pre && String.length v > String.length pre
&& v.[String.length v - 1] = '>')
then fail "a pointer into freed Vec storage rendered %s" v
else
let n =
String.sub v (String.length pre)
(String.length v - String.length pre - 1)
in
if int_of_string_opt n = None then
fail "the epitaph's step is %S, which is not a number" n;
(* No address in it, and that is deliberate rather than an
omission: an address is not stable across two runs, so
printing one would make this very assertion depend on where
the heap landed. *)
if contains v "0x" then
fail "the epitaph carried an address: %s" v)
end;
(* ── The address root ─────────────────────────────────────── *)
(* [(:op "at" :addr N)] is the rooting mode with no frame in it. The
two addresses are left in globals by the program, which is how a
person at a break loop reaches them too a global is evaluable by
name while stopped and a local is not. *)
let addr name =
let r =
ask (Printf.sprintf "(:op \"eval-expr\" :code %S :file \"<t>\")" name)
in
if status r <> "ok" then None else int_of_string_opt (value r)
in
(match (addr "live-addr", addr "dead-addr") with
| Some live, Some dead when live > 0 && dead > 0 ->
(* The type is not given, so the answer for it is the registry's
own the recorded *string*, resolved back to a type by the
session. That resolution is the whole of what item 3 needed and
it is what this line is really asserting: nothing but the table
said `Enemy' here. *)
let r = ask (Printf.sprintf "(:op \"at\" :addr %d)" live) in
if status r <> "ok" then fail "pointing at a live address: %s" (message r)
else begin
if value r <> "<ptr (Enemy {.hp 41 .x 2})>" then
fail "the address root rendered %s at a live address" (value r);
if Option.value ~default:"" (Wire.string_field r "type")
<> "(Ptr Enemy)"
then
fail "the address root resolved the recorded name to %s"
(Option.value ~default:"" (Wire.string_field r "type"));
if not (flag r "live") then
fail "a live address came back not live";
if Option.value ~default:"" (Wire.string_field r "recorded")
<> "Enemy"
then fail "the reply did not carry what the table recorded"
end;
(* And the dead one, by the same route and with the same type,
which is the point: the static type cannot tell these apart. *)
let r = ask (Printf.sprintf "(:op \"at\" :addr %d)" dead) in
if status r <> "ok" then fail "pointing at a dead address: %s" (message r)
else begin
if not (starts (value r) "<ptr dead: was Enemy, freed at step ")
then fail "the address root rendered %s at a dead address" (value r);
if flag r "live" then fail "a freed address came back live"
end;
(* A named :type wins over the recorded one and is not checked
against it overriding is the point of being able to say it
but the disagreement is never silent: [:recorded] is carried
whenever the table had a name. *)
let r =
ask (Printf.sprintf "(:op \"at\" :addr %d :type \"i32\")" live)
in
if status r <> "ok" then
fail "reading a live address as a named type: %s" (message r)
else begin
if value r <> "<ptr 41>" then
fail "a named :type did not win over the recorded one: %s"
(value r);
if Option.value ~default:"" (Wire.string_field r "recorded")
<> "Enemy"
then fail "an overridden read did not say what was recorded"
end;
(* An address inside an element rather than at one. Rendering the
element type there would show one element's tail as another's
head a plausible-looking answer, which is the worst kind so
it is refused with the offset, and a named :type reads it
anyway. *)
let r = ask (Printf.sprintf "(:op \"at\" :addr %d)" (live + 1)) in
if status r <> "error" then
fail "an address inside an element answered anyway: %s" (value r)
else if not (contains (message r) "inside an element") then
fail "a misaligned address was refused without saying why: %s"
(message r);
let r =
ask (Printf.sprintf "(:op \"at\" :addr %d :type \"i32\")" (live + 4))
in
if status r <> "ok" then
fail "a named :type did not reach the second half of an element: %s"
(message r)
else if value r <> "<ptr 2>" then
fail "reading the second i32 of an Enemy gave %s" (value r)
| _ ->
fail "the program did not leave its two addresses in globals");
(* An address the registry has never seen is a fact and not a failure
a stack local, a global, or a pointer from C and with no
[:type] there is nothing to say what is there. Refused by name,
rather than answered with bytes. *)
let r = ask "(:op \"at\" :addr 12345)" in
if status r <> "error" then
fail "an address the registry never saw was rendered anyway: %s"
(value r)
else if not (contains (message r) "never seen") then
fail "an unknown address was refused without saying why: %s" (message r);
(* ── The breakdown, and what is still held ─────────────────── *)
(* Both are one walk over the table in [flan_dev.c] with the dead
left out of the second, and the difference between the two answers
is the assertion: this program freed one of its two Enemy blocks,
so the breakdown has both and the leak report has one. Counting
only the rows would pass with the walk stubbed out; counting the
difference cannot. *)
let enemy r =
match Wire.field r "types" with
| Some { Form.v = Form.List l; _ } ->
List.fold_left
(fun acc (e : Form.t) ->
match e.Form.v with
| Form.List
[ { Form.v = Form.Str "Enemy"; _ };
{ Form.v = Form.Int n; _ }; { Form.v = Form.Int b; _ } ] ->
Some (Int64.to_int n, Int64.to_int b)
| _ -> acc)
None l
| _ -> None
in
let all = ask "(:op \"allocations\")" in
let live = ask "(:op \"leaks\")" in
if status all <> "ok" then fail "the breakdown by type: %s" (message all)
else if status live <> "ok" then fail "the leak report: %s" (message live)
else begin
(match (enemy all, enemy live) with
| Some (2, _), Some (1, _) -> ()
| got, held ->
let say = function
| None -> "no row"
| Some (n, b) -> Printf.sprintf "%d blocks, %d bytes" n b
in
fail
"the table should hold two Enemy blocks with one of them freed; \
the breakdown says %s and the leak report says %s" (say got)
(say held));
(* Ordered biggest first, by bytes. A breakdown read in table order
is a list of everything and answers nothing; biggest-first is the
answer to "where did the memory go", which is the only reason
either verb exists. *)
let bytes r =
match Wire.field r "types" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List [ _; _; { Form.v = Form.Int b; _ } ] ->
Some (Int64.to_int b)
| _ -> None)
l
| _ -> []
in
let rec descending = function
| a :: (b :: _ as rest) -> a >= b && descending rest
| _ -> true
in
if not (descending (bytes all)) then
fail "the breakdown is not ordered biggest first";
(* And a leak report is a subset of the breakdown, always: nothing
can be live that was never recorded. *)
let sum r = List.fold_left ( + ) 0 (bytes r) in
if sum live > sum all then
fail "the leak report holds more bytes than the whole table does"
end
end;
(* And a running program is refused. There is no frame here to be
redefined under us the registry is a table and not a stack but
live-or-dead is exactly what a running program is changing, so an
answer read mid-frame is an answer about a moment that has gone. *)
let r = ask "(:op \"restart\" :name \"carry-on\")" in
if status r <> "ok" then
fail "resuming the pointer program: %s" (message r);
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "the pointer program never resumed"
else begin
let r = ask "(:op \"at\" :addr 4096)" in
if status r <> "error" then
fail "a running program answered the address root"
end;
ignore (ask "(:op \"close\")");
Unix.close c;
if not
(await ~ms:5000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] ppid with
| 0, _ -> false
| _ -> true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] ppid) with Unix.Unix_error _ -> ())
end
end;
(* ── The globals a stopped stack reaches ───────────────────────── *)
(* The other half of what a break loop can show. Locals are one frame's;

View File

@ -2194,20 +2194,30 @@ let () =
"(defn outer [s [$t]] () {:where (ordered? $t)} (sort! s))";
(* A map key that is a type variable has no hash and no equality to emit:
they are chosen from the concrete type, which does not exist yet. So
hashable? gates the *type* and not the operations a generic may take
and return a (Map $t V) and may not put into one. Pinned because it is a
deliberate hole and not an oversight: closing it means adding the map
operations to the list of forms the abstract pass defers to
instantiation, which is print and println and should stay that short. *)
they are chosen from the concrete type, which does not exist yet. So the
map operations join print and println on the list of forms the abstract
pass defers to the instantiation but only under the predicate, which is
what gives the deferred refusal somewhere to land. Without one the type
itself is refused where it is written, at the definition. *)
rejects_check "a map keyed by a type variable that is not hashable?"
~needle:"is not a map key"
"(defn f [m (Map $t i32)] i32 {:where (copyable? $t)} (len m))";
accepts "and hashable? is what says it is"
"(defn f [m (Map $t i32)] i32 {:where (hashable? $t)} (len m))";
rejects_check "but hashable? does not make the key hashable here"
~needle:"not that its keys can be hashed here"
accepts "and under it the operations are deferred, not refused"
"(defn f [m (Map $t i32) k $t] () {:where (hashable? $t)} (put m k 1))";
accepts "get over a type-variable key answers an (Option V)"
"(defn f [m (Map $t i32) k $t] i32 {:where (hashable? $t)} \
(match (get m k) (Some v) v _ 0))";
accepts "and so do has-key?, reserve and clone"
"(defn f [m (Map $t i32) k $t] bool {:where (hashable? $t)} \
(do (reserve m 8) (let [c (clone m)] (free c) (has-key? m k))))";
(* The definition is still where a generic with no clause to point at is
refused: nothing has been written down for an instantiation to be judged
against, so the refusal has nowhere to move to. *)
rejects_check "a map built inside a generic that declares nothing"
~needle:"is not a map key"
"(defn f [k $t] () (let [m (map-new t i32)] (put m k 1) (free m)))";
(* ── The acceptance program checks end to end ──────────────────── *)
accepts "calc-me.flan type checks"

View File

@ -93,6 +93,25 @@ int flan_dev_watch_read(uint32_t i, char *nd, uint64_t ncap,
uint64_t flan_dev_watch_name_cap(void);
uint64_t flan_dev_watch_val_cap(void);
/* The allocation registry, read the same way and on the same thread. The
* renderer's two questions is this address live, and what died here are
* asked from inside a compiled thunk and never come through this file; these
* three are the *reader's* side, which has no (Ptr T) to read a type off and
* so has to ask the table what it recorded.
*
* Formatting lives here rather than in flan_dev.c for the reason [watch] and
* [result] already have: this runs on the listener thread, where allocating
* and snprintf are legal, and what the game thread writes stays a fixed
* table nobody has to format to fill. */
int32_t flan_dev_reg_at(const void *p, const char **type, int64_t *typelen,
int64_t *off, int64_t *bytes, int64_t *elem,
int64_t *seq, int64_t *died);
int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts,
int64_t *bytes, const char **types,
int64_t *typelens, int64_t cap);
int flan_dev_reg_enabled(void);
int flan_dev_reg_overflowed(void);
/* A ring the listener writes and the game thread reads. One producer, one
* consumer, so two atomics and no lock the game thread must never block on
* the loader.
@ -975,6 +994,121 @@ static void handle_line(char *line, sink *o) {
free(v);
return;
}
/* "reg at ADDR" — what the allocation registry records for one address.
*
* The reader's side of the table, and the one question the renderer's own
* two cannot answer. Inside a thunk the type at the far end of a pointer is
* already static (Ptr Enemy) says Enemy so [reg-live] and [reg-emit]
* only ever needed permission. Somebody pointing at a bare address has no
* (Ptr T) to read a type off, and the recorded name is the whole of what
* there is to go on.
*
* Answered while the program is running as well as while it is stopped:
* this reads a table, not a stack, and nothing here walks a chain another
* thread is pushing. Whether the *answer* holds still long enough to be
* worth acting on is the caller's judgement, and the daemon makes it.
*
* ADDR is read with base 0, so both 0x-hex and decimal arrive; an editor
* that has an address as text has it in one of those two spellings. */
if (strncmp(line, "reg at ", 7) == 0) {
const char *type = NULL;
int64_t typelen = 0, off = 0, bytes = 0, elem = 0, seq = 0, died = 0;
char *end = NULL;
unsigned long long a;
if (!flan_dev_reg_enabled()) {
reply(o, "err the allocation registry is off; this is not a dev build\n");
return;
}
a = strtoull(line + 7, &end, 0);
if (end == line + 7 || a == 0) {
reply(o, "err reg at wants an address\n");
return;
}
if (!flan_dev_reg_at((const void *)(uintptr_t)a, &type, &typelen, &off,
&bytes, &elem, &seq, &died)) {
/* Never heard of it, which is a fact and not a failure: a stack local,
* a global, or a pointer from C. The daemon says which of those it
* might be; this says only that the table has nothing. */
reply(o, "none\n");
return;
}
{
char hdr[128];
int k = snprintf(hdr, sizeof hdr, "ok %d %lld %lld %lld %lld %lld\t",
died == 0 ? 1 : 0, (long long)off, (long long)bytes,
(long long)elem, (long long)seq, (long long)died);
if (k > 0) emit(o, hdr, (size_t)k);
/* Last, and after a tab, because a type spelling holds spaces —
* "(Vec i32)" and nothing else on the line does. It cannot hold a tab
* or a newline: it is Types.to_string of a type the programmer wrote. */
if (typelen > 0) emit(o, type, (size_t)typelen);
reply(o, "\n");
}
return;
}
/* "reg types" — the whole table grouped by type spelling; "reg leaks" — the
* same walk with the dead left out.
*
* One verb would have done with a flag, and two exist because the two
* questions are asked at different moments and read differently: a
* breakdown is "what is this program made of", a leak report is "what is
* still held". The *walk* is one function in flan_dev.c for exactly that
* reason two of them would drift.
*
* A header first, like [watch]: how many rows follow, and whether the table
* ever overflowed. The second is not decoration an overflowed table has
* blocks in the program that are in nobody's row, so every number below is
* a floor, and a reader that could not tell would quote them as counts. */
if (strcmp(line, "reg types") == 0 || strcmp(line, "reg leaks") == 0) {
enum { REG_ROWS = 256 };
/* Allocated here and freed before the reply is finished, not declared as
* static arrays. 256 rows of four words is 8KB, and static would put that
* 8KB in the BSS of every build this package is linked into including a
* release build of a game that imports the agent, which never writes a
* row. That is flan_dev.c's own argument against a fixed table, at a
* thirty-second of the size, and it is the same rule: a release build
* carries a null pointer and the declarations.
*
* Allocating is legal here for [watch]'s reason and no other: this runs
* on the listener thread, or on the compiler thread in a merged build.
* The table the game thread writes is a fixed static in flan_dev.c
* precisely so that *it* allocates nothing. */
int64_t *counts = malloc(REG_ROWS * sizeof *counts);
int64_t *bytes = malloc(REG_ROWS * sizeof *bytes);
int64_t *typelens = malloc(REG_ROWS * sizeof *typelens);
const char **types = malloc(REG_ROWS * sizeof *types);
int64_t n, i;
int live_only = line[4] == 'l';
if (counts == NULL || bytes == NULL || typelens == NULL || types == NULL) {
free(counts); free(bytes); free(typelens); free(types);
reply(o, "err out of memory reading the allocation registry\n");
return;
}
if (!flan_dev_reg_enabled()) {
free(counts); free(bytes); free(typelens); free(types);
reply(o, "err the allocation registry is off; this is not a dev build\n");
return;
}
n = flan_dev_reg_by_type(live_only ? 1 : 0, counts, bytes, types, typelens,
REG_ROWS);
{
char hdr[64];
int k = snprintf(hdr, sizeof hdr, "%lld %d\n",
(long long)(n < REG_ROWS ? n : REG_ROWS),
flan_dev_reg_overflowed());
if (k > 0) emit(o, hdr, (size_t)k);
}
for (i = 0; i < n && i < REG_ROWS; i++) {
char row[64];
int k = snprintf(row, sizeof row, "%lld %lld\t", (long long)counts[i],
(long long)bytes[i]);
if (k > 0) emit(o, row, (size_t)k);
if (typelens[i] > 0) emit(o, types[i], (size_t)typelens[i]);
reply(o, "\n");
}
free(counts); free(bytes); free(typelens); free(types);
return;
}
/* Before the dlopen, not after it: a module there is no room to queue is
* one there is no point relocating, and refusing here means no handle is
* taken for it at all. Only one producer runs at a time, so room seen now is

View File

@ -57,9 +57,6 @@ name IsWindowFocused window-focused?
name IsWindowResized window-resized?
name IsWindowState window-state?
name IsCursorOnScreen cursor-on-screen?
name IsKeyUp key-up?
name IsKeyPressedRepeat key-pressed-repeat?
name IsMouseButtonUp mouse-button-up?
name IsFileDropped file-dropped?
name IsFileExtension file-extension?
name IsFileNameValid file-name-valid?
@ -139,6 +136,53 @@ exclude DrawSphereWires
exclude DrawRay
exclude GetScreenToWorldRay
# ── The idiomatic layer, which is what these last two blocks are for ──
#
# Three kinds of C signature get a Flan face in raylib.flan rather than the
# generated one, and each kind is a directive here so that the generated file
# does not also define the name. See the "An idiomatic layer" section of
# raylib.flan for what each wrapper buys at the call site.
#
# 1. An `int` parameter the package already has a defenum for. These are
# excluded and hand-written with the enum type, exactly as SetExitKey and
# SetMouseCursor already are, and for the same reason: a keyword resolves
# against the members at compile time and a typo is an error there. What
# makes these three different from those is that they are *holes in a
# family that already exists* — key-down? takes a Key and key-up? took an
# i32, so `(rl/key-up? :space)` did not compile while `(rl/key-down?
# :space)` did. A wrapper would be a pure rename; the fix is the
# declaration.
exclude IsKeyUp
exclude IsKeyPressedRepeat
exclude IsMouseButtonUp
# 2. A sentinel return, wrapped by a Flan defn that answers an Option. The
# generated declaration is still what calls C and is still checked against
# the header — only its *name* moves aside, which is what `name` is for.
# Nothing about the signature is wrong, so there is no reason to hand-write
# it and lose the generated half's by-construction agreement.
name GetCharPressed get-char-pressed-raw
name GetKeyPressed get-key-pressed-raw
# 3. A pointer-and-count pair where Flan has a slice. Same treatment and the
# same reason: the C signature is right, the Flan face is a slice, so the
# generated line keeps the symbol and the wrapper takes the name. This is
# every raylib entry point that takes an array of vectors as pointer plus
# count, and it is the whole family on purpose — a subset would put the
# hole exactly where the next caller looks, which is the argument
# raylib.flan makes about ConfigFlags.
name DrawLineStrip draw-line-strip-raw
name DrawTriangleFan draw-triangle-fan-raw
name DrawTriangleStrip draw-triangle-strip-raw
name DrawTriangleStrip3D draw-triangle-strip-3d-raw
name DrawSplineLinear draw-spline-linear-raw
name DrawSplineBasis draw-spline-basis-raw
name DrawSplineCatmullRom draw-spline-catmull-rom-raw
name DrawSplineBezierQuadratic draw-spline-bezier-quadratic-raw
name DrawSplineBezierCubic draw-spline-bezier-cubic-raw
name ImageDrawTriangleFan image-draw-triangle-fan-raw
name ImageDrawTriangleStrip image-draw-triangle-strip-raw
# ── What the package's constants are called in C ────────────────────
#
# enum <FlanEnum> <C_PREFIX> every member of that defenum

View File

@ -1,4 +1,4 @@
;;;; Generated from raylib.h by `flan generate-c`. Do not edit this file.
;;;; Generated from raylib-5.5.h by `flan generate-c`. Do not edit this file.
;;;;
;;;; Every line here was read out of the C header named by `headers`, and
;;;; the next regeneration overwrites the file — so a correction made here
@ -10,7 +10,7 @@
;;;;
;;;; Regenerating compares the package against the header first and
;;;; refuses to write when they disagree, so this file and the
;;;; hand-written declarations beside it agreed with raylib.h when it was made.
;;;; hand-written declarations beside it agreed with raylib-5.5.h when it was made.
(declare-c window-fullscreen? [] bool "IsWindowFullscreen")
(declare-c window-hidden? [] bool "IsWindowHidden")
@ -93,13 +93,10 @@
(declare-c set-automation-event-base-frame [frame i32] "SetAutomationEventBaseFrame")
(declare-c start-automation-event-recording [] "StartAutomationEventRecording")
(declare-c stop-automation-event-recording [] "StopAutomationEventRecording")
(declare-c key-pressed-repeat? [key i32] bool "IsKeyPressedRepeat")
(declare-c key-up? [key i32] bool "IsKeyUp")
(declare-c get-key-pressed [] i32 "GetKeyPressed")
(declare-c get-char-pressed [] i32 "GetCharPressed")
(declare-c get-key-pressed-raw [] i32 "GetKeyPressed")
(declare-c get-char-pressed-raw [] i32 "GetCharPressed")
(declare-c set-gamepad-mappings [mappings string] i32 "SetGamepadMappings")
(declare-c set-gamepad-vibration [gamepad i32 left-motor f32 right-motor f32 duration f32] "SetGamepadVibration")
(declare-c mouse-button-up? [button i32] bool "IsMouseButtonUp")
(declare-c get-mouse-x [] i32 "GetMouseX")
(declare-c get-mouse-y [] i32 "GetMouseY")
(declare-c get-mouse-delta [] Vector2 "GetMouseDelta")
@ -108,7 +105,7 @@
(declare-c set-mouse-scale [scale-x f32 scale-y f32] "SetMouseScale")
(declare-c get-mouse-wheel-move-v [] Vector2 "GetMouseWheelMoveV")
(declare-c update-camera-pro [camera (Ptr Camera3D) movement Vector3 rotation Vector3 zoom f32] "UpdateCameraPro")
(declare-c draw-line-strip [points (Ptr Vector2) point-count i32 color Color] "DrawLineStrip")
(declare-c draw-line-strip-raw [points (Ptr Vector2) point-count i32 color Color] "DrawLineStrip")
(declare-c draw-line-bezier [start-pos Vector2 end-pos Vector2 thick f32 color Color] "DrawLineBezier")
(declare-c draw-circle-sector [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSector")
(declare-c draw-circle-sector-lines [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSectorLines")
@ -117,16 +114,16 @@
(declare-c draw-rectangle-gradient-v [pos-x i32 pos-y i32 width i32 height i32 top Color bottom Color] "DrawRectangleGradientV")
(declare-c draw-rectangle-gradient-h [pos-x i32 pos-y i32 width i32 height i32 left Color right Color] "DrawRectangleGradientH")
(declare-c draw-rectangle-gradient-ex [rec Rectangle top-left Color bottom-left Color top-right Color bottom-right Color] "DrawRectangleGradientEx")
(declare-c draw-triangle-fan [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleFan")
(declare-c draw-triangle-strip [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleStrip")
(declare-c draw-triangle-fan-raw [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleFan")
(declare-c draw-triangle-strip-raw [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleStrip")
(declare-c draw-poly [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPoly")
(declare-c draw-poly-lines [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPolyLines")
(declare-c draw-poly-lines-ex [center Vector2 sides i32 radius f32 rotation f32 line-thick f32 color Color] "DrawPolyLinesEx")
(declare-c draw-spline-linear [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineLinear")
(declare-c draw-spline-basis [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBasis")
(declare-c draw-spline-catmull-rom [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineCatmullRom")
(declare-c draw-spline-bezier-quadratic [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierQuadratic")
(declare-c draw-spline-bezier-cubic [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierCubic")
(declare-c draw-spline-linear-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineLinear")
(declare-c draw-spline-basis-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBasis")
(declare-c draw-spline-catmull-rom-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineCatmullRom")
(declare-c draw-spline-bezier-quadratic-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierQuadratic")
(declare-c draw-spline-bezier-cubic-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierCubic")
(declare-c draw-spline-segment-linear [p-1 Vector2 p-2 Vector2 thick f32 color Color] "DrawSplineSegmentLinear")
(declare-c draw-spline-segment-basis [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentBasis")
(declare-c draw-spline-segment-catmull-rom [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentCatmullRom")
@ -197,8 +194,8 @@
(declare-c image-draw-triangle [dst (Ptr Image) v-1 Vector2 v-2 Vector2 v-3 Vector2 color Color] "ImageDrawTriangle")
(declare-c image-draw-triangle-ex [dst (Ptr Image) v-1 Vector2 v-2 Vector2 v-3 Vector2 c-1 Color c-2 Color c-3 Color] "ImageDrawTriangleEx")
(declare-c image-draw-triangle-lines [dst (Ptr Image) v-1 Vector2 v-2 Vector2 v-3 Vector2 color Color] "ImageDrawTriangleLines")
(declare-c image-draw-triangle-fan [dst (Ptr Image) points (Ptr Vector2) point-count i32 color Color] "ImageDrawTriangleFan")
(declare-c image-draw-triangle-strip [dst (Ptr Image) points (Ptr Vector2) point-count i32 color Color] "ImageDrawTriangleStrip")
(declare-c image-draw-triangle-fan-raw [dst (Ptr Image) points (Ptr Vector2) point-count i32 color Color] "ImageDrawTriangleFan")
(declare-c image-draw-triangle-strip-raw [dst (Ptr Image) points (Ptr Vector2) point-count i32 color Color] "ImageDrawTriangleStrip")
(declare-c image-draw [dst (Ptr Image) src Image src-rec Rectangle dst-rec Rectangle tint Color] "ImageDraw")
(declare-c image-draw-text [dst (Ptr Image) text string pos-x i32 pos-y i32 font-size i32 color Color] "ImageDrawText")
(declare-c image-draw-text-ex [dst (Ptr Image) font Font text string position Vector2 font-size f32 spacing f32 tint Color] "ImageDrawTextEx")
@ -245,7 +242,7 @@
(declare-c draw-point-3d [position Vector3 color Color] "DrawPoint3D")
(declare-c draw-circle-3d [center Vector3 radius f32 rotation-axis Vector3 rotation-angle f32 color Color] "DrawCircle3D")
(declare-c draw-triangle-3d [v-1 Vector3 v-2 Vector3 v-3 Vector3 color Color] "DrawTriangle3D")
(declare-c draw-triangle-strip-3d [points (Ptr Vector3) point-count i32 color Color] "DrawTriangleStrip3D")
(declare-c draw-triangle-strip-3d-raw [points (Ptr Vector3) point-count i32 color Color] "DrawTriangleStrip3D")
(declare-c draw-cube-wires-v [position Vector3 size Vector3 color Color] "DrawCubeWiresV")
(declare-c draw-sphere-ex [center-pos Vector3 radius f32 rings i32 slices i32 color Color] "DrawSphereEx")
(declare-c draw-cylinder [position Vector3 radius-top f32 radius-bottom f32 height f32 slices i32 color Color] "DrawCylinder")

View File

@ -27,9 +27,29 @@
;;;; f64 where raylib says float now emits `double` in the generated
;;;; prototype, and raylib reads garbage.
;;;;
;;;; Two bindings keep a hand-written Flan wrapper, both because their Flan
;;;; face is deliberately not raylib's: collision-point-poly? takes a slice,
;;;; and collision-lines answers with an Option. Both wrappers are Flan.
;;;; Some bindings keep a hand-written Flan wrapper, because their Flan face
;;;; is deliberately not raylib's. Three shapes of that, and every wrapper in
;;;; this file is one of them:
;;;;
;;;; - a slice where C takes a pointer and a count — collision-point-poly?,
;;;; load-image-from-memory, load-font-ex, and the eleven vector-array
;;;; drawing calls under "A slice where raylib wants a pointer and a
;;;; count";
;;;; - an Option where C signals failure by a bool out-parameter or a
;;;; sentinel — collision-lines, get-key-pressed, get-char-pressed;
;;;; - an enum where the header says `int`. These are NOT wrappers: a C
;;;; enum parameter has an int's ABI, so the hand-written declare-c with
;;;; the Flan type on it is the whole fix, and set-exit-key,
;;;; set-mouse-cursor, key-up? and mouse-button-up? are all that.
;;;;
;;;; What is NOT here, and was asked for: with-drawing and with-mode-2d over
;;;; raylib's begin/end pairs. An unbalanced pair is a real bug and a macro
;;;; removes it, but a macro cannot live in a package — the expander collects
;;;; defmacros from the prelude and from the file being compiled, and a
;;;; defmacro in an imported package is refused by name
;;;; (test/programs/pkg-macro.flan, an acceptance case whose whole content is
;;;; the refusal). So these have to be written in the program that uses them,
;;;; or wait for macros to be importable, and neither is this file's to do.
;; Layouts are C's — no object headers anywhere — so these are exactly
;; raylib's structs and nothing marshals.
@ -133,6 +153,18 @@
(declare-c key-down? [key Key] bool "IsKeyDown")
(declare-c key-released? [key Key] bool "IsKeyReleased")
;; The other two halves of that family, hand-written for exactly the reason
;; above and added late: they were generated, so they took an i32, so
;; `(rl/key-up? :space)` did not compile while `(rl/key-down? :space)` did.
;; That is a hole in a family rather than a missing convenience — a caller
;; who has used key-down? has no reason to expect the sibling to be spelled
;; differently, and what they get instead of a keyword is a number nobody
;; checks. Nothing wraps these: the ABI of a C enum parameter is the ABI of
;; an int, so the declaration IS the fix and a defn around it would only be
;; a rename.
(declare-c key-up? [key Key] bool "IsKeyUp")
(declare-c key-pressed-repeat? [key Key] bool "IsKeyPressedRepeat")
(declare-c mouse-button-pressed?
[button MouseButton] bool
"IsMouseButtonPressed")
@ -140,6 +172,37 @@
(declare-c mouse-button-released?
[button MouseButton] bool
"IsMouseButtonReleased")
(declare-c mouse-button-up? [button MouseButton] bool "IsMouseButtonUp")
;; ── Draining raylib's two input queues ──────────────────────────────
;;
;; Both of these answer "nothing left" with 0, and 0 is also a value the
;; caller could otherwise have to think about — KEY_NULL for one, the NUL
;; byte for the other. An Option says which of the two it is in the type, so
;; the loop that drains the queue cannot read the sentinel as a key or as a
;; character: `while (> key 0)` is a comparison a reader has to know the
;; convention to trust, and `(while-some ...)` — or the `if-let` shape the
;; examples use — is one a reader can check.
;;
;; The generated declarations are still what call C; only their names moved
;; aside, to -raw, via the `name` lines in `bindings`. Nothing about the C
;; signature was wrong, so hand-writing it would have taken the generated
;; half's agreement-by-construction with the header and given nothing back.
;;
;; get-key-pressed answers an i32 and not a Key. A Key is a *closed* set the
;; package names a subset of, and this queue reports every key on the
;; keyboard including the ones no member covers, so the enum would be a
;; promise the value does not keep. Comparing the answer against `:space`
;; would be the reason to want it, and that is what key-pressed? is for.
(defn get-key-pressed [] (Option i32)
(let [k (get-key-pressed-raw)]
(if (= k 0) None (Some k))))
;; Unicode codepoint, not a byte: raylib decodes the platform's input, so a
;; value above 127 is a real codepoint and not the first byte of one.
(defn get-char-pressed [] (Option i32)
(let [c (get-char-pressed-raw)]
(if (= c 0) None (Some c))))
(declare-c get-mouse-position [] Vector2 "GetMousePosition")
@ -793,6 +856,95 @@
(declare-c draw-rectangle-rounded-lines-ex [rec Rectangle roundness f32
segments i32 thick f32 color Color] "DrawRectangleRoundedLinesEx")
;; ── A slice where raylib wants a pointer and a count ─────────────────
;;
;; Eleven entry points take an array of vectors as a pointer plus an `int`
;; count. A Flan slice already carries both, so every call site that does not
;; go through a wrapper has to take the slice apart itself — `(addr (at pts
;; 0))` and `(len pts)`, twice, in the right order — and the compiler cannot
;; check that the two halves came from the same slice. The wrapper is where
;; that idiom lives, which is the rule collision-point-poly? set.
;;
;; It also guards the empty case, which is the part a hand-written call site
;; gets wrong rather than merely writes out. raylib takes a count of 0 and
;; draws nothing, but `(at pts 0)` on an empty slice is out of bounds before
;; raylib is ever reached: the safe call is "do not call at all", and it is
;; written once here instead of at every use.
;;
;; All eleven and not the three anybody has called. A subset would have its
;; hole exactly where the next caller looks, which is the argument this file
;; already makes about ConfigFlags, and the eleven are one family — there is
;; no line to draw between DrawSplineLinear and DrawSplineBasis that a reader
;; would predict.
;;
;; `bindings` makes the opposite argument a few lines above its own list —
;; that hand-writing the variants of a family "would widen the half that has
;; to be maintained by hand for nothing the examples ask for" — and it is
;; right there and does not reach here. That paragraph is about hand-written
;; `declare-c` lines, which are exactly the half a header change can falsify.
;; None of these eleven is one: each is a `name` directive, so the generated
;; declaration keeps the C symbol and its checked signature and gives up only
;; its Flan name. The hand-maintained half does not widen at all — what is
;; written below is Flan calling Flan, and it cannot disagree with raylib. They sit together here rather than each in its own section
;; for the same reason: the justification above is one argument about a shape
;; that cuts across Shapes, Images and 3D, and splitting the family would
;; mean writing it three times or leaving two thirds of it unexplained.
;;
;; Each -raw below is a generated declaration whose name moved aside; see the
;; `name` lines at the foot of `bindings`.
(defn draw-line-strip [points [Vector2] color Color] ()
(when (> (len points) 0)
(draw-line-strip-raw (addr (at points 0)) (len points) color)))
(defn draw-triangle-fan [points [Vector2] color Color] ()
(when (> (len points) 0)
(draw-triangle-fan-raw (addr (at points 0)) (len points) color)))
(defn draw-triangle-strip [points [Vector2] color Color] ()
(when (> (len points) 0)
(draw-triangle-strip-raw (addr (at points 0)) (len points) color)))
(defn draw-triangle-strip-3d [points [Vector3] color Color] ()
(when (> (len points) 0)
(draw-triangle-strip-3d-raw (addr (at points 0)) (len points) color)))
;; The five spline drawers. raylib reads the same point array five different
;; ways; the only difference between these wrappers is which one it calls.
(defn draw-spline-linear [points [Vector2] thick f32 color Color] ()
(when (> (len points) 0)
(draw-spline-linear-raw (addr (at points 0)) (len points) thick color)))
(defn draw-spline-basis [points [Vector2] thick f32 color Color] ()
(when (> (len points) 0)
(draw-spline-basis-raw (addr (at points 0)) (len points) thick color)))
(defn draw-spline-catmull-rom [points [Vector2] thick f32 color Color] ()
(when (> (len points) 0)
(draw-spline-catmull-rom-raw (addr (at points 0)) (len points) thick color)))
(defn draw-spline-bezier-quadratic [points [Vector2] thick f32 color Color] ()
(when (> (len points) 0)
(draw-spline-bezier-quadratic-raw
(addr (at points 0)) (len points) thick color)))
(defn draw-spline-bezier-cubic [points [Vector2] thick f32 color Color] ()
(when (> (len points) 0)
(draw-spline-bezier-cubic-raw
(addr (at points 0)) (len points) thick color)))
;; The same two into an Image rather than the frame. `dst` stays a pointer:
;; it is the thing being written, not an array, and raylib's convention for
;; an in-place Image is the whole Image* family in this file.
(defn image-draw-triangle-fan [dst (Ptr Image) points [Vector2] color Color] ()
(when (> (len points) 0)
(image-draw-triangle-fan-raw dst (addr (at points 0)) (len points) color)))
(defn image-draw-triangle-strip
[dst (Ptr Image) points [Vector2] color Color] ()
(when (> (len points) 0)
(image-draw-triangle-strip-raw dst (addr (at points 0)) (len points) color)))
;; ── Text ────────────────────────────────────────────────────────────
;;
;; Both of these use raylib's built-in font, and both therefore need

233
vendor/raylib/vector.flan vendored Normal file
View File

@ -0,0 +1,233 @@
;;;; Vector arithmetic over raylib's Vector2 and Vector3, in Flan.
;;;;
;;;; This is raymath, and raymath is the one part of raylib that cannot be
;;;; bound at all. raymath.h defines every one of its functions `static
;;;; inline` (RMAPI expands to it), so Vector2Add and Clamp and Remap have no
;;;; symbol in libraylib for `declare-c` to name — not a signature the
;;;; importer gets wrong, not a struct the package has not described, but
;;;; nothing to link against. NEXT.md item 4 records it and names the two
;;;; ways out: write the arithmetic in Flan, or compile a small C file that
;;;; re-exports the inlines as real symbols.
;;;;
;;;; It is written in Flan, and the measurement that decided it was already
;;;; taken: examples/shapes-following-eyes.flan is an example whose every
;;;; line is vector maths, ported without a vector library, and its own
;;;; header reports that this cost nothing — the C does not use raymath there
;;;; either. A C shim would buy identical arithmetic at the price of a
;;;; compilation unit in the build, a second place raylib's semantics are
;;;; written down, and a third target's worth of it for the web build.
;;;;
;;;; Every function here is raymath's, semantics included, and the ones where
;;;; that is not obvious say so. The one worth knowing without reading: at
;;;; zero length, v2-normalize and v3-normalize answer the zero vector rather
;;;; than dividing and producing NaNs. raymath makes that choice and a caller
;;;; who has raymath in mind would be surprised by the other one.
;;;;
;;;; ── Why this is a file of its own ───────────────────────────────────
;;;;
;;;; The split is on `declare-c`, not on "idiomatic". raylib.flan is the
;;;; package's statement about C: every line in it is a declaration or a thin
;;;; wrapper over one, it is the file the header check reads hand-written
;;;; signatures out of, and a wrong line in it stops the build. There is not
;;;; one `declare-c` below and there never will be, because there is nothing
;;;; to declare — so nothing here can be checked against a header, and
;;;; nothing here can be made wrong by raylib changing. A reader who wants to
;;;; know what the package claims about C should not have to walk past four
;;;; hundred lines of float arithmetic to find out, and 1300 lines of
;;;; raylib.flan is already the argument against adding to it.
;;;;
;;;; A package is a directory, so this is simply another .flan beside the
;;;; others and is qualified `rl/` like the rest of it.
;;;;
;;;; ── Names ───────────────────────────────────────────────────────────
;;;;
;;;; `v2-` and `v3-`, not `vector2-`. These appear nested inside each other —
;;;; `(rl/v2-add p (rl/v2-scale d t))` is the ordinary shape — and the longer
;;;; spelling puts more characters between the reader and the arithmetic than
;;;; it puts meaning. The prefix still says the type, which is the part a
;;;; language without generics needs it to say.
;;;;
;;;; ── What is NOT here, on purpose ────────────────────────────────────
;;;;
;;;; `clamp` and `lerp`. Both are already in the prelude — clamp as a macro
;;;; (prelude.ml, "clamp is a macro and not a function"), lerp as a function
;;;; — and both are unqualified names every program already has;
;;;; examples/textures-fog-of-war.flan calls the prelude's clamp today. A
;;;; second `rl/lerp` would not even be the same function: the prelude writes
;;;; the weighted sum `(1-t)a + tb`, which returns b exactly at t = 1.0,
;;;; where raymath writes `a + t*(b - a)`, which does not once rounding is
;;;; involved. Shipping both under names one letter apart is a bug waiting
;;;; for whoever picks the wrong one. So: use the prelude's, and what is
;;;; added below is the neighbours the prelude does not have.
;; ── f32, the scalars raymath has and the prelude does not ───────────
;; Where `value` falls between `start` and `end`, as 0.0 at start and 1.0 at
;; end. raymath spells this `Normalize`, which collides with the vector
;; normalize two sections down and means something unrelated to it; it is the
;; inverse of lerp and is named for that. start = end is a division by zero,
;; as it is in raymath: an empty range has no answer and inventing one would
;; hide the caller's bug.
(defn inverse-lerp [value f32 start f32 end f32] f32
(/ (- value start) (- end start)))
;; raymath's Remap, to the character: inverse-lerp on the input range, then
;; lerp on the output range, and NOT clamped to either. A value outside the
;; input range maps outside the output range, which is what makes it usable
;; for extrapolation — a caller who wants it bounded writes the prelude's
;; clamp around it and can see that they did.
;;
;; Written as one expression rather than as (lerp out-start out-end
;; (inverse-lerp ...)) because the prelude's lerp is the weighted-sum form
;; and raymath's Remap is the a + t*(b - a) form; composing them would be a
;; different function in the last bit.
(defn remap [value f32 in-start f32 in-end f32
out-start f32 out-end f32] f32
(+ (* (/ (- value in-start) (- in-end in-start))
(- out-end out-start))
out-start))
;; raymath's Wrap. Brings a value into [min, max) by subtracting whole spans
;; of it — an angle past 2π, a scrolling offset past the tile width. floor
;; and not truncation, so a value below min wraps up instead of sticking.
(defn wrap-f32 [value f32 lo f32 hi f32] f32
(- value (* (- hi lo) (floor-f32 (/ (- value lo) (- hi lo))))))
;; ── Vector2 ─────────────────────────────────────────────────────────
(defn v2-add [a Vector2 b Vector2] Vector2
(Vector2 {.x (+ (.x a) (.x b)) .y (+ (.y a) (.y b))}))
(defn v2-sub [a Vector2 b Vector2] Vector2
(Vector2 {.x (- (.x a) (.x b)) .y (- (.y a) (.y b))}))
;; Componentwise, which is raymath's Vector2Multiply and is not a dot product
;; or anything else that deserves the word "multiply" unqualified. It is what
;; a non-uniform scale is written as.
(defn v2-mul [a Vector2 b Vector2] Vector2
(Vector2 {.x (* (.x a) (.x b)) .y (* (.y a) (.y b))}))
(defn v2-scale [v Vector2 k f32] Vector2
(Vector2 {.x (* (.x v) k) .y (* (.y v) k)}))
(defn v2-negate [v Vector2] Vector2
(Vector2 {.x (- 0.0 (.x v)) .y (- 0.0 (.y v))}))
(defn v2-dot [a Vector2 b Vector2] f32
(+ (* (.x a) (.x b)) (* (.y a) (.y b))))
;; The squared forms are not micro-optimisation dressed up: comparing two
;; distances, or a distance against a radius, is the common case and neither
;; needs the square root. raymath has both for the same reason.
(defn v2-length-sqr [v Vector2] f32
(+ (* (.x v) (.x v)) (* (.y v) (.y v))))
(defn v2-length [v Vector2] f32
(sqrt-f32 (+ (* (.x v) (.x v)) (* (.y v) (.y v)))))
(defn v2-distance-sqr [a Vector2 b Vector2] f32
(let [dx (- (.x a) (.x b))
dy (- (.y a) (.y b))]
(+ (* dx dx) (* dy dy))))
(defn v2-distance [a Vector2 b Vector2] f32
(let [dx (- (.x a) (.x b))
dy (- (.y a) (.y b))]
(sqrt-f32 (+ (* dx dx) (* dy dy)))))
;; Zero in, zero out — raymath's Vector2Normalize guards on `length > 0` and
;; returns {0, 0}, and this does the same. The alternative is dividing by
;; zero and answering a vector of NaNs, which then propagates through every
;; subsequent frame's arithmetic and reports itself somewhere else entirely.
;; The guard is the whole reason this is a function and not two divisions
;; written at the call site.
(defn v2-normalize [v Vector2] Vector2
(let [length (sqrt-f32 (+ (* (.x v) (.x v)) (* (.y v) (.y v))))]
(if (> length 0.0)
(let [inv (/ 1.0 length)]
(Vector2 {.x (* (.x v) inv) .y (* (.y v) inv)}))
(Vector2 {.x 0.0 .y 0.0}))))
;; The signed angle from a to b, in radians, via atan2 of the 2D cross
;; product over the dot. Signed and not absolute, so it says which way to
;; turn; raymath's Vector2Angle is this and not the acos form.
(defn v2-angle [a Vector2 b Vector2] f32
(atan2-f32 (- (* (.x a) (.y b)) (* (.y a) (.x b)))
(+ (* (.x a) (.x b)) (* (.y a) (.y b)))))
;; a + t*(b - a) componentwise, which is raymath's Vector2Lerp exactly. The
;; note in the file header applies: the prelude's scalar lerp is the
;; weighted-sum form and this is not, so the two do not agree in the last bit
;; at t = 1.0. raymath's is kept here because a vector path that disagrees
;; with raylib's own would be the surprise.
(defn v2-lerp [a Vector2 b Vector2 t f32] Vector2
(Vector2 {.x (+ (.x a) (* t (- (.x b) (.x a))))
.y (+ (.y a) (* t (- (.y b) (.y a))))}))
;; Counter-clockwise by `angle` radians in raylib's screen space, which has y
;; growing downward — so on screen it turns the other way from the way the
;; maths reads. raymath's Vector2Rotate, unchanged.
(defn v2-rotate [v Vector2 angle f32] Vector2
(let [c (cos-f32 angle)
s (sin-f32 angle)]
(Vector2 {.x (- (* (.x v) c) (* (.y v) s))
.y (+ (* (.x v) s) (* (.y v) c))})))
;; ── Vector3 ─────────────────────────────────────────────────────────
(defn v3-add [a Vector3 b Vector3] Vector3
(Vector3 {.x (+ (.x a) (.x b)) .y (+ (.y a) (.y b)) .z (+ (.z a) (.z b))}))
(defn v3-sub [a Vector3 b Vector3] Vector3
(Vector3 {.x (- (.x a) (.x b)) .y (- (.y a) (.y b)) .z (- (.z a) (.z b))}))
(defn v3-mul [a Vector3 b Vector3] Vector3
(Vector3 {.x (* (.x a) (.x b)) .y (* (.y a) (.y b)) .z (* (.z a) (.z b))}))
(defn v3-scale [v Vector3 k f32] Vector3
(Vector3 {.x (* (.x v) k) .y (* (.y v) k) .z (* (.z v) k)}))
(defn v3-negate [v Vector3] Vector3
(Vector3 {.x (- 0.0 (.x v)) .y (- 0.0 (.y v)) .z (- 0.0 (.z v))}))
(defn v3-dot [a Vector3 b Vector3] f32
(+ (+ (* (.x a) (.x b)) (* (.y a) (.y b))) (* (.z a) (.z b))))
;; Right-handed, which is the convention raylib's camera uses: the cross of
;; the x axis with the y axis is the z axis.
(defn v3-cross [a Vector3 b Vector3] Vector3
(Vector3 {.x (- (* (.y a) (.z b)) (* (.z a) (.y b)))
.y (- (* (.z a) (.x b)) (* (.x a) (.z b)))
.z (- (* (.x a) (.y b)) (* (.y a) (.x b)))}))
(defn v3-length-sqr [v Vector3] f32
(+ (+ (* (.x v) (.x v)) (* (.y v) (.y v))) (* (.z v) (.z v))))
(defn v3-length [v Vector3] f32
(sqrt-f32 (+ (+ (* (.x v) (.x v)) (* (.y v) (.y v))) (* (.z v) (.z v)))))
(defn v3-distance-sqr [a Vector3 b Vector3] f32
(let [dx (- (.x a) (.x b))
dy (- (.y a) (.y b))
dz (- (.z a) (.z b))]
(+ (+ (* dx dx) (* dy dy)) (* dz dz))))
(defn v3-distance [a Vector3 b Vector3] f32
(let [dx (- (.x a) (.x b))
dy (- (.y a) (.y b))
dz (- (.z a) (.z b))]
(sqrt-f32 (+ (+ (* dx dx) (* dy dy)) (* dz dz)))))
;; Zero in, zero out, exactly as v2-normalize and for the same reason.
(defn v3-normalize [v Vector3] Vector3
(let [length (sqrt-f32 (+ (+ (* (.x v) (.x v)) (* (.y v) (.y v)))
(* (.z v) (.z v))))]
(if (> length 0.0)
(let [inv (/ 1.0 length)]
(Vector3 {.x (* (.x v) inv) .y (* (.y v) inv) .z (* (.z v) inv)}))
(Vector3 {.x 0.0 .y 0.0 .z 0.0}))))
(defn v3-lerp [a Vector3 b Vector3 t f32] Vector3
(Vector3 {.x (+ (.x a) (* t (- (.x b) (.x a))))
.y (+ (.y a) (* t (- (.y b) (.y a))))
.z (+ (.z a) (* t (- (.z b) (.z a))))}))