Merge branch 'dev-loop' into worktree-agent-adf9086e00872ff67
This commit is contained in:
commit
1657b87e3d
112
BUILT.md
112
BUILT.md
@ -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
288
NEXT.md
@ -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
|
||||
|
||||
|
||||
@ -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).
|
||||
|
||||
---
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))})))))
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
141
lib/check.ml
141
lib/check.ml
@ -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
|
||||
|
||||
402
lib/dev.ml
402
lib/dev.ml
@ -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
|
||||
|
||||
@ -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");
|
||||
}
|
||||
|
||||
@ -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)
|
||||
|
||||
26
test/programs/generic-map-reject.flan
Normal file
26
test/programs/generic-map-reject.flan
Normal 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)))
|
||||
@ -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)]
|
||||
|
||||
@ -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"
|
||||
|
||||
309
test/test_dev.ml
309
test/test_dev.ml
@ -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;
|
||||
|
||||
@ -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"
|
||||
|
||||
134
vendor/agent/flan_agent.c
vendored
134
vendor/agent/flan_agent.c
vendored
@ -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
|
||||
|
||||
50
vendor/raylib/bindings
vendored
50
vendor/raylib/bindings
vendored
@ -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
|
||||
|
||||
33
vendor/raylib/generated.flan
vendored
33
vendor/raylib/generated.flan
vendored
@ -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")
|
||||
|
||||
158
vendor/raylib/raylib.flan
vendored
158
vendor/raylib/raylib.flan
vendored
@ -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
233
vendor/raylib/vector.flan
vendored
Normal 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))))}))
|
||||
Loading…
x
Reference in New Issue
Block a user