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

Merge branch 'master' into worktree-agent-acca0e216df6ca366

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 10:42:50 +07:00
commit 22401a6521
17 changed files with 482 additions and 457 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
CLAUDE.md
View File

@ -1,125 +1,54 @@
# Working in this repository
For any agent working here, including a lane in its own worktree. These are
standing rules, not preferences. Where a rule has a reason, the reason is given
once — the rules without one are the ones that have already cost something.
Standing rules for any agent here, including a lane in its own worktree.
## Never
- **Never touch anything under `/home/joe/Development/fnm/`.** That is the
author's own working copy of the falling-sand game, open in an editor with a
live session attached. `fnm/flan/sand.flan` is not the same file as this
repository's `sand.flan` and is never to be read-and-written-back, moved or
edited. The copy in this repository is ordinary tracked source and may be
edited like any other file.
- **Never execute `examples/*.flan`, `sand.flan`, or anything that links
raylib.** They open a window on the author's desktop, which strobes it.
Compile them, emit them, diff them — never run them.
- **Never run `dune clean`.** It walks up out of a worktree and deletes the main
checkout's `_build`, which takes the author's `flan` binary with it. This has
happened. Run `dune` with `--root .` from inside your own worktree.
- **Never kill a `flan dev` daemon you did not start.** The author keeps a live
one attached to their editor all day. Orphans from finished lanes are fair
game; anything whose cwd is under `fnm/` is not.
- **Never put a `Co-Authored-By`, a `Claude-Session` trailer, or any other
watermark in a commit message.**
- **Touch anything under `/home/joe/Development/fnm/`.** The author's live
working copy, with an editor session attached. This repository's `sand.flan`
is a different file and may be edited normally.
- **Execute `examples/*.flan`, `sand.flan`, or anything linking raylib.** They
open a window that strobes the author's desktop. Compile, emit, diff — never run.
- **Run `dune clean`.** It escapes a worktree and deletes the main checkout's
`_build`. Run `dune` with `--root .` from inside your own worktree.
- **Kill a `flan dev` daemon you did not start.** The author keeps one attached
to their editor.
- **Put `Co-Authored-By`, a `Claude-Session` trailer or any watermark in a commit.**
## Commits and branches
## Commits
`master` is the trunk and tracks `origin/master`. Lanes work in their own git
worktree off it and do not merge or push — merges are resolved by the session
that dispatched the lane.
A commit message is a single declarative sentence in the repository's voice,
saying what is now true rather than what was done: "A thunk named for the order
it was minted in is a different signature after a reorder", not "fix thunk
naming bug". A body is for the reasoning, when there is any.
`master` is the trunk. Lanes work in their own worktree and never merge or push;
the dispatching session merges. A commit message is one declarative sentence
saying what is now true, not what was done.
## Tests
`dune test --root .` is the suite and takes seconds. Run it constantly; it must
be green before a lane reports.
`dune build @checks` is `@page`, `@x86` and `@cells` — the reference page's
examples still compile and print what the page says, the hand-written x86
backend still agrees with LLVM, and a `--dev` build still calls through its
indirection cells. `@sanitize` and `@valgrind` run the corpus under ASan/UBSan
and memcheck and take tens of minutes.
Those three stay out of a lane's own run. They are swept in a batch after
several lanes have merged, and the fixes are batched with them. Keeping the
default run fast is deliberate: a suite that takes tens of minutes is a suite
nobody runs.
Note that ASan does not see a stack-lifetime bug — uninitialised stack reads
need `@valgrind`.
`dune test --root .` must be green before a lane reports; grep its output for
FAIL, since the exit code alone has lied. `@checks` (`@page`, `@x86`, `@cells`),
`@sanitize` and `@valgrind` are slow and run once between batches of lanes, with
the author's permission, never inside a lane. ASan misses uninitialised stack
reads; `@valgrind` catches them.
## Evidence
Read the source, do not recall it. `docs/REFERENCES.md` lists the reference
clones on this machine — Odin, SBCL, Zig, Carp, clojure-mode, CIDER, raylib and
the rest — and what each one answers. A claim in these notes that came from one
of them was read out of the clone; the ones that were recalled instead have been
wrong before.
Read the source, do not recall it — this repository and the reference clones
listed in `docs/REFERENCES.md`. Verify a brief's facts before building on them.
The same applies to this repository. Cite a file and a line because you opened
it. When a brief hands you a list of facts, verify them before building on them
— a brief written from a stale tree has sent a lane a full day in the wrong
direction.
## Records
## Diagnostics
Keep only what the code cannot say.
Elm's shape: the source line, a caret, what the compiler understood, and the fix
named. Beyond that:
- `TODO.org` — one `**` heading per item under a subsystem: `TODO` a gap, `NEXT`
decided and queued, `WAIT` blocked (say on what), `CANCELLED` rejected with a
one-line reason so it is not re-proposed, `DONE` only when the decision is not
obvious from the code (two lines, what it rules out). On a merge conflict keep
both sides.
- The reason for non-obvious code goes in a comment beside it.
- `docs/BUILT.md` holds only reasoning that spans several files.
- No handoff files.
- A message is written for someone who has never used Flan and does not know its
history. Never "X is now Y", never "X was renamed", never our rationale. If
`defvar` no longer exists, the message says `defvar` does not exist — not that
it became something else.
- The clauses come in one order: what the compiler understood, then what
conflicts with it, then the fix — "expected i32, found string".
- Every suggestion a message prints must compile.
- An assertion about the compiler's own invariants is prefixed `internal:` and
says it is a compiler bug. A user never caused one.
## Reviews
## Writing
User-facing prose — the README, `web/index.html`, the Emacs manual — is plain.
Odin's website is the reference: declarative rather than second-person, the
concept defined before the mechanics, the code example after the prose that
frames it, and rationale given its own subsection rather than mixed in.
No aphorisms, no closing lines built for effect, no rhetorical inversions. If a
sentence's only content is its own style, cut it. This applies to reports and
commit messages as much as to documentation.
## The records
- `TODO.org` — every decision, question and known gap, one `**` heading each
under a subsystem heading, with an org keyword saying where it stands: `TODO`
for a gap, `NEXT` for what is queued, `WAIT` for what is blocked and on what,
`DONE` for what was settled, `CANCELLED` for an idea considered and rejected.
A lane records its decision here, as a few lines saying what was decided and
what it rules out — never the argument and never the measurements. On a merge
conflict in this file, keep both sides: two lanes recording two decisions is
not a conflict.
- `docs/BUILT.md` — why the parts that exist are shaped the way they are. The
largest and most load-bearing document here. Reasoning that will not fit in a
few lines goes here, and `TODO.org` carries one line pointing at it.
- `docs/handoffs/` — one report per finished work session.
- `docs/README.md` indexes all of it.
A `CANCELLED` entry is not housekeeping. An idea rejected without a record is an
idea that gets re-proposed, so the one-line reason is the whole value of it.
## The shape of the work
The author dogfoods the language in a separate project, hits friction, and
reports it. Work is dispatched as parallel lanes in isolated worktrees; every
lane is reviewed by an independent agent before it merges; the dispatching
session resolves the merges.
A review is adversarial. Verify by building and running rather than by reading,
measure both sides of a claimed fix, and say what you actually measured. A lane
that reports a number you did not reproduce is a lane with a number you should
reproduce.
Every lane gets an independent adversarial review before it merges: build and
run rather than read, measure both sides of a claimed fix, and reproduce any
number a lane reports.

91
TODO.org
View File

@ -501,7 +501,8 @@ capturing value. Two things for it to know: a widening thunk's environment holds
code pointer rather than a GC object, and capturing a dyn stays refused until a
synthesised environment has a descriptor.
** TODO CFn and C's calling convention
** WAIT CFn and C's calling convention
Decided 2026-09-25: waits with C callbacks, until a program needs one.
A Flan function's signature ends with the transfer channel and a C caller knows
nothing about one, so a =CFn= is not a C callback today. Under a future
=--no-conditions= flag a =CFn= signature could drop the channel and reach C's
@ -524,7 +525,8 @@ dispatch values. With single dispatch on literal values there is no specificity
question, and inheritance or multiple dispatch would create one. Unknown-slot
checking needs class-typed tracking the dyn side deliberately does not have.
** TODO update-instance-for-redefined-class, the user hook
** NEXT update-instance-for-redefined-class, the user hook
Decided 2026-09-25: build it after typed class slots land, shaped for the REPL — written and installed from a live session as a one-time "here is how to migrate this", without restarting. It receives the instance with the added and discarded slots and their old values, and runs at each instance's lazy migration. A hook that signals parks in the break buffer with a restart that falls back to name-matching migration.
Left out of v1 because name matching is the half that makes redefinition usable
and the hook is what makes it expressive. The obvious spelling is a generic riding
the dispatch that exists, and the migration already computes both the added and
@ -736,10 +738,12 @@ call site that asked for that type. The data is there — =instantiation_origin=
exists and the session already uses it — and wiring it into every failure under an
instantiation is a lane of its own.
** TODO Generics across a real compilation-unit boundary
It works today because =Load= flattens imports before checking. A package boundary
that ever becomes a real unit boundary needs the generic's body to cross it, which
separate compilation cannot do — which is why C++ puts templates in headers.
** DONE A program is one compilation, so a generic's body is always visible
CLOSED: [2026-09-25]
Odin's and Zig's model: packages are never compiled separately. The cost is build
time proportional to the whole program and no binary-only packages. If separate
compilation is ever wanted, Rust's answer is the one to take — a compiled package
carries its generics' checked bodies and the user instantiates them.
** DONE Collapsing the prelude buys 27 to 15, not 27 to 6
CLOSED: [2026-09-13]
@ -824,7 +828,8 @@ the losing side meets the strict =bool= boundary and traps —
=(or false (box "s"))= is the case. Whether a =bool= arm and a =dyn= arm should
join as =dyn= is the author's call and is not settled.
** TODO A truthiness failure re-runs the whole failing subtree
** NEXT A truthiness failure re-runs the whole failing subtree
Decided 2026-09-25: fix it without changing any message — the retry reuses what the first pass settled for each subtree (memoised by node), so nested =not= is linear. Test with a deep nest that must fail fast and with the existing message tests unchanged.
The retry exists to keep a refused literal's message unchanged and re-runs the
subtree rather than the leaf, which is exponential in nested =not= depth on a
program that does not type-check. Moot for anything that compiles; only the
@ -864,7 +869,8 @@ correct code, so any per-push flag is a false positive by the language's own
semantics; the refined version needs liveness across control flow, which is the
flow tracking that was repealed.
** TODO Catching a use-after-release statically
** NEXT Catching a use-after-release statically
Decided 2026-09-25: a study, not a build — how arena memory escapes in real Flan code, and whether a sound lexical check would catch most of it. The result goes in docs/BUILT.md; nothing is built on it without the author.
Open, and for the first time with evidence available: the epoch trap is built, and
there is a =Vec= to write real arena programs with, so whether the escapes that
actually occur are lexical can now be answered. The next thing to look at, not the
@ -1051,7 +1057,8 @@ Every program in the corpus that compiles, has a =main= and terminates agrees wi
the LLVM build down to stderr. =docs/BUILT.md=, "The hand-written x86 backend, and
the four measurements behind it", is the account.
** TODO Nothing pins the LLVM side at -O0 when the two backends are compared
** NEXT Nothing pins the LLVM side at -O0 when the two backends are compared
Decided 2026-09-25: the x86 parity survey compares against LLVM at -O0 only; -O2 is never its target. The acceptance suite's paired -O2/-O0 rows stay, being the check for undefined behaviour in emitted IR, which is a different question.
The survey builds both sides at the default =-O2=, so a construct LLVM folds is
compared as a constant rather than as a lowering. That is how the float =%= gap
survived. Two things would close it: an =-O0= pass of the sweep, and something
@ -1116,7 +1123,8 @@ The module links and runs. What is not proved is a collection running while a li
instance of a dyn-holding struct sits in a frame of a body that module delivered.
For the next sweep rather than for a lane.
** TODO A sliced string loses the trailing NUL
** NEXT A sliced string loses the trailing NUL
Decided 2026-09-25: both backends emit a NUL after every string literal, and a declare-c wrapper passes a literal argument to C without the copy it makes for any other string. A string is still pointer and length; no slice is promised a NUL. Rules out a NUL guarantee on every string.
The x86 backend emits a NUL after every string constant and the LLVM one does not,
so a =declare-c= wrapper leaning on the courtesy is already backend-dependent as
well as slice-dependent. The contract is pointer and length, and nothing promised
@ -1127,7 +1135,8 @@ Decided 2026-09-25: emit the x86 backend's =.cfi= directives in every build. No
They are correct in every build and free at runtime, and a release build is where
a crash would most want them. One =if= in three places.
** TODO A !DILexicalBlock per Let
** WAIT A !DILexicalBlock per Let
Decided 2026-09-25: waits until Flan is debugged in gdb or lldb; the break buffer, which reads the shadow stack, already answers correctly.
Inside nested =let=s that bind the same name, a debugger still answers with the
outer one. The disambiguating suffix makes both visible, which is not the same as
making the answer right. It needs block structure the typed IR does not carry, and
@ -1241,7 +1250,8 @@ build, because a layout that changes with a build flag can disagree silently
across the reload boundary. One addition: a budget, because =retry= needs a
handler that can make the same request succeed.
** TODO The Vec generation word has no reader
** NEXT The Vec generation word has no reader
Decided 2026-09-25: remove the word, and in a dev build fill a Vec's old buffer with the dead-beef pattern when a push moves it, so a stale slice reads visibly wrong values. No slice layout change; a release build is untouched. Rules out a dev-only word on every slice.
It is bumped on reallocation and read by nothing. The stale-slice trap it exists
for needs a slice that can carry the Vec's identity, and a slice is pointer and
length — so either slices grow a word in a dev build or the trap does not exist.
@ -1254,7 +1264,8 @@ live bytes, 0 for none, that a =retry= handler raises. The failure bullet says
"raises the allocator's budget" where it said "grows the arena", since no arena
grows. A growable arena is not ruled out; nothing here asks for one.
** TODO The Vec header is not the size the spec fixes
** NEXT The Vec header is not the size the spec fixes
Decided 2026-09-25: five words in every build, the epoch included, so a release build still traps on a container whose region was released. The spec changes to match the code; nothing else does.
Five words in every build rather than the spec's four, and for a stated reason: a
redefinition module is built separately from its host and nothing makes the two
agree on a struct size. Give the reload path a way to carry the build flags and
@ -1321,7 +1332,8 @@ until something touches it. The registry is advisory: a key the class never
declared is dropped by the next migration, which is data loss with no enforcement
behind it.
** TODO A class registry keeps one slot list per class, not one per layout version
** WAIT A class registry keeps one slot list per class, not one per layout version
Decided 2026-09-25: waits for a case name-matching migration to the current list gets wrong.
"A redefined class's old instances stay resolvable" needs every version's metadata
retained for as long as any instance holds it, the way nothing is ever
=dlclose=d. What exists is one current slot list and one generation per class, and
@ -1399,7 +1411,8 @@ through a pointer into it is answerable; memcheck is told the same fact, so the
same read is reported. The two stay two claims — different tools reaching
different people.
** TODO The leak question across the corpus
** NEXT The leak question across the corpus
Decided 2026-09-25: one pass over the whole corpus with LeakSanitizer and memcheck's leak check on. Memory an allocator holds by design is set aside; memory nothing owns is a leak and is fixed. The sweeps' default stays leak-checking off.
Both sweeps run with leak checking off, because allocate-once-never-free is this
runtime's design and a leak check produces a suppression list. A green sweep
therefore says nothing about who frees the newly allocating =(bytes s)=. Worth
@ -1499,7 +1512,8 @@ A finished program parks instead of dying, and a daemon op wakes it and re-enter
Globals are not reset between runs — the process never died. Rules out a fresh
process per run.
** TODO Re-run does not work under --two-process
** NEXT Re-run does not work under --two-process
Decided 2026-09-25: re-run under =--two-process= starts a fresh child, installed redefinitions included, and says that globals start over because the process is new.
A finished child process is genuinely gone, so there is nothing to wake. Re-run is
merged-build only, and since the default backend runs merged it is no longer the
blocked case.
@ -1539,7 +1553,8 @@ was delivered" is a generation number rather than a name, so evaluating from
inside a break into a thunk that stops on the same condition class is settled by
comparing two integers.
** TODO Whose break it is, which no counter answers
** NEXT Whose break it is, which no counter answers
Decided 2026-09-25: fix it. A stop records whether the thread that stopped was running the evaluation's thunk or the program's own code, so the sentence is decided by the frame and not by the generation counter.
A game loop that signals during the build or the wait bumps the generation exactly
as a thunk would. The machine-readable fields stay right; what is wrong is the
sentence. The per-frame program-or-eval label is computed by the daemon from
@ -1592,7 +1607,8 @@ that polls or waits. Full invisibility — a dev build linking the agent whether
not the source says so — needs the package force-linked and is a decision about
what =--dev= means.
** TODO FLAN_AGENT_SOCKET in a shell's environment steals the socket
** NEXT FLAN_AGENT_SOCKET in a shell's environment steals the socket
Decided 2026-09-25: narrow the gate. The daemon also exports its own pid, and the constructor binds the socket only when that pid is the program's parent (or the program itself, in a merged build).
Binding unlinks the path first, and before the constructor that unlink was reached
only by an explicit call. A sentence about the shape of the gate rather than an
observed problem: only the daemon sets the variable and it never runs release
@ -1656,7 +1672,8 @@ on the frame, the restart listing carrying the signature, and the daemon compili
each argument against the declared type and writing the values into the frame's
buffer before aiming the channel.
** TODO The type identity of a local is not qualified
** NEXT The type identity of a local is not qualified
Decided 2026-09-25: a local's type prints package-qualified in the break buffer and the inspector, as a field's and a condition's already do.
Settled for conditions and for structs, because =Load= qualifies every declaration
at import. Still open for locals, where the debug information gives a bare name and
nothing qualifies it.
@ -1748,7 +1765,8 @@ nothing orders the two. The read raised on a closed socket and the test binary
exited 1 with no failure line, which is the worst shape a failure can have when
a lane is judged on the exit status.
** TODO A program driven by a real flan dev daemon under a sanitizer
** NEXT A program driven by a real flan dev daemon under a sanitizer
Decided 2026-09-25: =flan dev --sanitize= builds the host under ASan/UBSan on the LLVM backend (refused by name with =--x86=), and the @sanitize alias gains a case driving a real session through reloads and a break.
The daemon builds its host through its own path and the CLI has no way to pass a
sanitizer flag to it. Named as the check worth adding next; a day rather than an
hour. The x86 backend is not a gap here — that pair is refused by name, because
@ -1835,10 +1853,15 @@ pass. Deriving from clojure-mode at runtime stays rejected: it would add an
external dependency to a mode that ships in this repository and needs nothing
beyond stock Emacs, and that community is mid-transition to a tree-sitter mode.
** TODO 373 lines in 20 files still reindent differently
Concentrated in four files, untouched by the Emacs pass and untouched before it.
The indenter and the hand-formatting there disagree about shapes nothing has
looked at.
** DONE Every tracked .flan file reindents to itself
CLOSED: [2026-09-25]
clojure-mode decided each shape. The indenter was wrong on one: a =with-= head,
and a qualified =def…= or =with-= head, now indents as a body, and a qualified
name finds its unqualified part's spec. The rest was hand formatting and was
reindented: a =cond= or =match= result on its own line sits under its test, and
an ordinary call's later arguments align under its first. A lone =;= comment
line goes to =comment-column= in every Lisp mode, so continuation comments are
written as =;;= lines above the code instead.
** DONE C-c C-i inspects the expression at point
No prompt, because the expression is already written in the buffer. =C-u= opens
@ -1962,6 +1985,12 @@ motion states in that mode; every other key, including what =special-mode-map=
binds, stays Evil's. The other special-mode buffers (inspect, watch, doc, disassembly,
diagnostics, lower) have the same exposure and are not changed.
** NEXT C-x C-e in a package's file resolves names in that package
Decided 2026-09-25: CIDER's rule — an evaluation sent from a file resolves names
as code written in that file would, so =(integrate 1.0)= in =physics/step.flan=
reaches the package's own functions, =defn-= included. Today it answers
"unknown function", resolving as the program's main file.
** NEXT Evil takes the keys in the other Flan buffers
The inspect, watch, doc, disassembly, diagnostics and lower buffers get the break
buffer's treatment: the keys each binds itself go to Evil's normal and motion
@ -2047,7 +2076,8 @@ host built with no user program, and a load-file op — the reload machinery
already builds a file as a module. Open: what =flan-rerun= does with no =main=,
and a half-loaded file. =C-c C-k= is taken by the inspector.
** TODO The daemon buffer is navigable but not coloured
** NEXT The daemon buffer is navigable but not coloured
Decided 2026-09-25: errors, warnings and notes take compilation-mode's faces, and the program's own output takes a face of its own so it reads apart from the compiler's.
=*flan*= is all plain text. =compilation-minor-mode= is on (=emacs/flan.el:822=)
so =next-error= works, but a minor mode installs no font-lock. Open: whether the
program's output should look different from the compiler's.
@ -2212,7 +2242,8 @@ The five that run — =macros=, =macro-params=, =macro-unless=, =pkg-macro=,
out with the other negative cases. The list stays explicit rather than a glob.
Not yet run under the sweep: that waits for the batched =@sanitize=.
** TODO The mutation pass has not been re-run
** NEXT The mutation pass has not been re-run
Decided 2026-09-25: re-run it once after the second batch of 2026-09-25 merges, with the heavy sweeps, after asking the author.
Sixty mutations, nineteen of which left the whole suite green; all nineteen are
closed, each re-planted and watched fail against the new test. What is open is
that the pass has not been run again, so nineteen is the old number.
@ -2232,10 +2263,10 @@ it kept; without =keep= that file is gone and the second half is =None=. The
two-process daemon moves the host's IR from the path it is given and no longer
recomputes =Build.workdir=.
** TODO The 2MB OFL font is not vendored
One example wants a font that is OFL and redistributable; it says on screen when
it is missing and runs either way. A call about the repository, not about the
port.
** CANCELLED The 2MB OFL font is not vendored
CLOSED: [2026-09-25]
Two megabytes of history for one example that already says on screen when the
font is missing and runs without it.
** DONE old-ocaml/ and the built executables are untracked on purpose
The executables are what a build drops beside their sources. =old-ocaml/= is the

28
emacs/flan-mode.el
View File

@ -581,12 +581,27 @@ For `syntax-propertize-function'."
("declare" . 1)
("declare-c" . 1))
"How each form indents, by name.
Anything not named here that begins with `def' is treated as `:defn' by
`flan-indent-function'; anything else indents as a function call.")
A qualified name falls back to the entry for its unqualified part. Anything
still unnamed that begins with `def' (but not `default') or `with-' indents as
`:defn' in `flan-indent-function'; anything else indents as a function call.")
(defun flan--indent-spec (name)
"The indent spec for the form called NAME, or nil."
(and name (cdr (assoc name flan-indent-specs))))
"The indent spec for the form called NAME, or nil.
A qualified name falls back to its unqualified part, so `rl/when' would find
the entry for `when' — `clojure--get-indent-method' does the same."
(and name
(cdr (or (assoc name flan-indent-specs)
(and (string-match "/\\([^/]+\\)\\'" name)
(assoc (match-string 1 name) flan-indent-specs))))))
(defun flan--definer-p (name)
"Non-nil if NAME indents as a definition or a `with-' form.
Either may be qualified: `rl/with-drawing' is a `with-' form. This is
`clojure-indent-function''s fallback for a head with no spec, regexp and all;
`default…' is excluded there because it is not a definer, and here too."
(and name
(string-match "\\`\\(?:\\S +/\\)?\\(def[a-z]*\\|with-\\)" name)
(not (string-match-p "\\`default" (match-string 1 name)))))
(defconst flan--labelled-forms '("dotimes" "while" "until")
"Loops that may carry a label, which `break' and `continue' name.
@ -755,8 +770,9 @@ decision to `calculate-lisp-indent'."
;; No spec. Anything else spelled `def…' is a definition and indents
;; like one, which covers `defstruct', `defdata', `defunion',
;; `defenum', `defonce', `defconst' and `defalias' without naming
;; them.
((and name (string-match-p "\\`def" name))
;; them. A `with-' form is a body too — `rl/with-drawing',
;; `rl/with-mode-2d camera' — whatever it takes before the body.
((flan--definer-p name)
(+ lisp-body-indent head-column))
;; A clause: `(name [params] body…)'. `handler-bind', `handler-case'
;; and `restart-case' all write their clauses this way, and the head is

48
emacs/test-flan-mode.el
View File

@ -326,6 +326,54 @@
y 2.0]
(print y))")
;; A `with-' form is a body, qualified or not, whatever it takes on the head's
;; line — `clojure-indent-function''s fallback. From `examples/core-2d-camera.flan'.
(test-flan-mode--check
"a qualified with- form indents its body by two past an argument"
"(rl/with-mode-2d camera
(rl/draw-rectangle-rec player rl/red)
(rl/draw-grid 10 1.0))")
(test-flan-mode--check
"a qualified def form indents its body by two"
"(m/defthing name
(body))")
;; A qualified name finds the spec of its unqualified part.
(test-flan-mode--check
"a qualified when keeps when's spec"
"(rl/when (ready?)
(go))")
;; `default…' begins with `def' and is not a definer.
(test-flan-mode--check
"a default-prefixed call aligns its arguments"
"(default-color a
b)")
;; A cond result on its own line sits under its test, not deeper.
(test-flan-mode--check
"a cond result on its own line aligns with its test"
"(cond
(= k 1)
(one)
:else
(other))")
(test-flan-mode--check
"a match result on its own line aligns with its pattern"
"(match v
(Int n) n
(List items)
(length items))")
;; A trailing argument of an ordinary call aligns under the first argument,
;; even when it is long; only a `with-', `def' or specced head gives a body.
(test-flan-mode--check
"an ordinary call's arguments align under the first one"
"(push missing
`(when (ok) (go)))")
;;; Font lock

6
examples/textures-image-generation.flan
View File

@ -65,13 +65,13 @@
;; to corner.
(set (at textures 0)
(upload (rl/gen-image-gradient-linear screen-width screen-height 0
rl/red rl/blue)))
rl/red rl/blue)))
(set (at textures 1)
(upload (rl/gen-image-gradient-linear screen-width screen-height 90
rl/red rl/blue)))
rl/red rl/blue)))
(set (at textures 2)
(upload (rl/gen-image-gradient-linear screen-width screen-height 45
rl/red rl/blue)))
rl/red rl/blue)))
;; density 0 means the falloff reaches the edge of the image.
(set (at textures 3)
(upload (rl/gen-image-gradient-radial screen-width screen-height 0.0

4
syntax-sketch.flan
View File

@ -13,8 +13,8 @@
;; Normative references: spec-memory.md (ownership, containers, places,
;; generics, function values) and spec-conditions.md (restart semantics).
(import rl "vendor:raylib") ; directory = package, declaration optional;
; imports are always qualified rl/foo
;; Imports are always qualified: rl/foo.
(import rl "vendor:raylib") ; directory = package, declaration optional
;; ── Type notation ─────────────────────────────────────────────────────
;; [4 f32] fixed array — a value, copies on assignment

142
test/programs/arena-region.flan
View File

@ -28,82 +28,82 @@
(let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0)]
(cond
(= which 1)
;; The refusal. The context here is the heap, which can free one
;; block, and a (Vec Value) against it is a free that would release
;; the slots and strand every inner Vec — so the construction dies
;; rather than the free three hundred lines later.
(let [bad (vec-new Value)]
(println (length bad)))
;; The refusal. The context here is the heap, which can free one
;; block, and a (Vec Value) against it is a free that would release
;; the slots and strand every inner Vec — so the construction dies
;; rather than the free three hundred lines later.
(let [bad (vec-new Value)]
(println (length bad)))
(= which 2)
;; Use after free-all, which is a different mechanism and worth
;; pinning separately: the allocator's epoch moves on every free-all
;; and every container records the epoch it was made at. The header
;; below was copied *out* of the arena container into a local before
;; the release, which is the case the check has to cover and the
;; reason spec-memory.md makes an Allocator a pointer rather than a
;; copied value — a copied allocator would carry its own epoch and
;; the copy would never notice.
(let [outer (vec-new Value frame)]
(let [inner (vec-new Value frame)]
(push inner (Value.Int {.n (i64 7)}))
(push outer (Value.List {.items inner})))
(match (at outer 0)
(List items)
(do (println (length items))
(free-all frame)
(println (length items)))
_ (println 0)))
;; Use after free-all, which is a different mechanism and worth
;; pinning separately: the allocator's epoch moves on every free-all
;; and every container records the epoch it was made at. The header
;; below was copied *out* of the arena container into a local before
;; the release, which is the case the check has to cover and the
;; reason spec-memory.md makes an Allocator a pointer rather than a
;; copied value — a copied allocator would carry its own epoch and
;; the copy would never notice.
(let [outer (vec-new Value frame)]
(let [inner (vec-new Value frame)]
(push inner (Value.Int {.n (i64 7)}))
(push outer (Value.List {.items inner})))
(match (at outer 0)
(List items)
(do (println (length items))
(free-all frame)
(println (length items)))
_ (println 0)))
(= which 3)
;; ZII, which is the hole a guard only at the construction would have
;; left. The items field is omitted from the literal, so it is a zeroed
;; Vec with no allocator at all — it never went near (vec-new) — and
;; the first push is what adopts the context. So the branch is emitted
;; at every growth too, and there it asks the container, which answers
;; from the allocator it will adopt when it has none of its own.
(let [v (Value.List {})]
(match v
(List items)
(do (push items (Value.Int {.n (i64 1)}))
(println (length items)))
_ (println 0)))
;; ZII, which is the hole a guard only at the construction would have
;; left. The items field is omitted from the literal, so it is a zeroed
;; Vec with no allocator at all — it never went near (vec-new) — and
;; the first push is what adopts the context. So the branch is emitted
;; at every growth too, and there it asks the container, which answers
;; from the allocator it will adopt when it has none of its own.
(let [v (Value.List {})]
(match v
(List items)
(do (push items (Value.Int {.n (i64 1)}))
(println (length items)))
_ (println 0)))
:else
(do
;; The control, and it is the case the frame tier exists for: a
;; (Vec (Vec i32)) owns storage at two levels and is perfectly happy
;; in a region, because free-all releases every block the region
;; handed out and the inner ones are among them. The rule asks about
;; the *allocator*, never "does this element own anything", so this
;; must be built without complaint.
(with-allocator frame
(let [rows (vec-new Row)]
(let [row (vec-new i32)]
(push row 1)
(push row 2)
(push rows row))
(println (length rows))
(println (length (at rows 0)))))
(free-all frame)
;; And the same container against the heap dies — asserted from the
;; other side in run 1 above; here the point is only that the region
;; run above got no complaint.
(with-allocator frame
(let [vs (vec-new Value)]
(push vs (Value.Int {.n (i64 41)}))
(println (length vs))))
(free-all frame)
;; And the zeroed field of run 3, this time in the region: the growth
;; guard has to pass here as surely as it has to fail there, or every
;; ZII container in an arena would be unusable.
(with-allocator frame
(let [v (Value.List {})]
(match v
(List items)
(do (push items (Value.Int {.n (i64 1)}))
(println (length items)))
_ (println 0))))
(free-all frame))))
(do
;; The control, and it is the case the frame tier exists for: a
;; (Vec (Vec i32)) owns storage at two levels and is perfectly happy
;; in a region, because free-all releases every block the region
;; handed out and the inner ones are among them. The rule asks about
;; the *allocator*, never "does this element own anything", so this
;; must be built without complaint.
(with-allocator frame
(let [rows (vec-new Row)]
(let [row (vec-new i32)]
(push row 1)
(push row 2)
(push rows row))
(println (length rows))
(println (length (at rows 0)))))
(free-all frame)
;; And the same container against the heap dies — asserted from the
;; other side in run 1 above; here the point is only that the region
;; run above got no complaint.
(with-allocator frame
(let [vs (vec-new Value)]
(push vs (Value.Int {.n (i64 41)}))
(println (length vs))))
(free-all frame)
;; And the zeroed field of run 3, this time in the region: the growth
;; guard has to pass here as surely as it has to fail there, or every
;; ZII container in an arena would be unusable.
(with-allocator frame
(let [v (Value.List {})]
(match v
(List items)
(do (push items (Value.Int {.n (i64 1)}))
(println (length items)))
_ (println 0))))
(free-all frame))))
(arena-destroy frame)
0)

12
test/programs/arena-value.flan
View File

@ -51,13 +51,13 @@
(match v
(Int n) n
(List items)
(let [t (i64 0)]
(dotimes [i (length items)]
(set t (+ t (total (at items i)))))
t)
(let [t (i64 0)]
(dotimes [i (length items)]
(set t (+ t (total (at items i)))))
t)
(Table entries)
(+ (match (get entries "xs") (Some x) (total x) None (i64 0))
(match (get entries "ys") (Some y) (total y) None (i64 0)))
(+ (match (get entries "xs") (Some x) (total x) None (i64 0))
(match (get entries "ys") (Some y) (total y) None (i64 0)))
_ (i64 0)))
(defn build [] i64

9
test/programs/edn.flan
View File

@ -213,8 +213,9 @@
;; ── The refusals, each asserted on its own reason ─────────────────
(refusal "\"a\\nb\"") ; an escape inside a string
(refusal "\"a\\\"b\"") ; an escaped quote — the case where a wrong
; version returns `a\` and leaves `b"` behind
;; An escaped quote is the case where a wrong version returns `a\` and
;; leaves `b"` behind.
(refusal "\"a\\\"b\"") ; an escaped quote
(refusal "\"unterminated") ; not a refusal, but the other string failure
;; A set is read now, so what is left to refuse about one is its balance. A
;; `#{` that pushed nothing would answer "no error" for both of these.
@ -228,8 +229,8 @@
(refusal "\\a") ; a character literal
(refusal "12x") ; starts like a number, is not one
(refusal "[1 :]") ; a colon with no name
(refusal "@") ; not the start of any value — and the case a
; scan-to-delimiter reads as a one-byte symbol
;; `@` is the case a scan-to-delimiter reads as a one-byte symbol.
(refusal "@") ; not the start of any value
(refusal "`x") ; a Clojure reader macro, not EDN
(refusal "[1 2}") ; the wrong closer
(refusal "]") ; a closer with nothing open

2
test/programs/frame-rollback.flan
View File

@ -154,7 +154,7 @@
(do (update-frame col)
(set frames (+ frames 1)))
(continue [] (restore)
(set skipped (+ skipped 1)))))
(set skipped (+ skipped 1)))))
(defn main [] i32
(set (.brush world) 1)

170
test/programs/json.flan
View File

@ -118,41 +118,41 @@
(defn read-value [c (Ptr json/Cursor) t json/Token] Value
(cond
(= (.kind t) json/tok-bool)
(Value.Bool {.b (match (json/bool-of t) (Some v) v None false)})
(Value.Bool {.b (match (json/bool-of t) (Some v) v None false)})
(= (.kind t) json/tok-int)
(Value.Int {.n (match (json/int-of t) (Some v) v None (i64 0))})
(Value.Int {.n (match (json/int-of t) (Some v) v None (i64 0))})
(= (.kind t) json/tok-float)
(Value.Float {.x (match (json/float-of t) (Some v) v None 0.0)})
(Value.Float {.x (match (json/float-of t) (Some v) v None 0.0)})
(= (.kind t) json/tok-string)
(Value.Text {.s (match (json/string-of t) (Some s) s None "")})
(Value.Text {.s (match (json/string-of t) (Some s) s None "")})
(= (.kind t) json/tok-array-open)
(let [items (vec-new Value)
u (json/next c)
more (and (json/ok? c) (!= (.kind u) json/tok-array-close))]
(while more
(push items (read-value c u))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-array-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
(do (set u (json/next c))
;; A comma and then the closer. Named, because a trailing
;; comma is legal JSON5 and a reader that quietly allowed
;; it would be reading a different format than it claims.
;;
;; The fail is what ends the loop, through the ok? test
;; below it and not on its own — so these two are in this
;; order on purpose, and swapping them spins.
(when (= (.kind u) json/tok-array-close)
(json/fail c json/err-trailing-comma (.pos u)))
(when (not (json/ok? c))
(set more false))))))
(Value.Array {.items items}))
(let [items (vec-new Value)
u (json/next c)
more (and (json/ok? c) (!= (.kind u) json/tok-array-close))]
(while more
(push items (read-value c u))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-array-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
(do (set u (json/next c))
;; A comma and then the closer. Named, because a trailing
;; comma is legal JSON5 and a reader that quietly allowed
;; it would be reading a different format than it claims.
;;
;; The fail is what ends the loop, through the ok? test
;; below it and not on its own — so these two are in this
;; order on purpose, and swapping them spins.
(when (= (.kind u) json/tok-array-close)
(json/fail c json/err-trailing-comma (.pos u)))
(when (not (json/ok? c))
(set more false))))))
(Value.Array {.items items}))
;; An object key is a quoted string and nothing else — an unquoted one was
;; already refused by the tokenizer as a bare word, so what reaches here is
@ -160,41 +160,41 @@
;; same string-of the values use, so the map owns its keys and the source
;; buffer is not in the picture.
(= (.kind t) json/tok-object-open)
(let [entries (map-new string Value)
k (json/next c)
more (and (json/ok? c) (!= (.kind k) json/tok-object-close))]
(while more
(if (!= (.kind k) json/tok-string)
(do (json/fail c json/err-unexpected-token (.pos k))
(set more false))
(let [key (match (json/string-of k) (Some s) s None "")]
(json/expect c json/tok-colon)
(if (not (json/ok? c))
(set more false)
(let [v (json/next c)]
(if (not (json/ok? c))
(set more false)
(do
(put entries key (read-value c v))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-object-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
;; Same two steps, same order, same reason as the
;; array arm: the fail ends the loop through the
;; ok? test under it, and it has to, because the
;; next pass would otherwise ask string-of for the
;; text of a closing brace.
(do (set k (json/next c))
(when (= (.kind k) json/tok-object-close)
(json/fail c json/err-trailing-comma (.pos k)))
(when (not (json/ok? c))
(set more false))))))))))))
(Value.Object {.entries entries}))
(let [entries (map-new string Value)
k (json/next c)
more (and (json/ok? c) (!= (.kind k) json/tok-object-close))]
(while more
(if (!= (.kind k) json/tok-string)
(do (json/fail c json/err-unexpected-token (.pos k))
(set more false))
(let [key (match (json/string-of k) (Some s) s None "")]
(json/expect c json/tok-colon)
(if (not (json/ok? c))
(set more false)
(let [v (json/next c)]
(if (not (json/ok? c))
(set more false)
(do
(put entries key (read-value c v))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-object-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
;; Same two steps, same order, same reason as the
;; array arm: the fail ends the loop through the
;; ok? test under it, and it has to, because the
;; next pass would otherwise ask string-of for the
;; text of a closing brace.
(do (set k (json/next c))
(when (= (.kind k) json/tok-object-close)
(json/fail c json/err-trailing-comma (.pos k)))
(when (not (json/ok? c))
(set more false))))))))))))
(Value.Object {.entries entries}))
:else Value.Null))
@ -204,34 +204,34 @@
(defn count-leaves [v Value] i32
(match v
(Array items)
(let [n 0]
(dotimes [i (length items)]
(set n (+ n (count-leaves (at items i)))))
n)
(let [n 0]
(dotimes [i (length items)]
(set n (+ n (count-leaves (at items i)))))
n)
;; map-next fills an out-parameter with a copy of the value's bytes, which
;; for a Value holding a container is a second header over the same block.
;; In a region that is an alias and not a second owner, so walking a map is
;; the ordinary iteration and needs no accessor of its own.
(Object entries)
(let [n 0
cur (i64 0)
k ""
e Value.Null]
(while (map-next entries (addr cur) (addr k) (addr e))
(set n (+ n (count-leaves e))))
n)
(let [n 0
cur (i64 0)
k ""
e Value.Null]
(while (map-next entries (addr cur) (addr k) (addr e))
(set n (+ n (count-leaves e))))
n)
_ 1))
(defn sum-ints [v Value] i64
(match v
(Int n) n
(Array items)
(let [t (i64 0)]
(dotimes [i (length items)]
(set t (+ t (sum-ints (at items i)))))
t)
(let [t (i64 0)]
(dotimes [i (length items)]
(set t (+ t (sum-ints (at items i)))))
t)
(Object entries)
(match (get entries "xs") (Some x) (sum-ints x) None (i64 0))
(match (get entries "xs") (Some x) (sum-ints x) None (i64 0))
_ (i64 0)))
(defn describe [v Value] string
@ -244,9 +244,9 @@
(defn text-at [v Value key string] string
(match v
(Object entries)
(match (get entries key)
(Some x) (match x (Text s) s _ "<not a string>")
None "<missing>")
(match (get entries key)
(Some x) (match x (Text s) s _ "<not a string>")
None "<missing>")
_ "<not an object>"))
(defn read-doc [src [u8]] Value
@ -413,7 +413,7 @@
(println (sum-ints v)) ; [1 2 3]
(println (describe (match v (Object e) (match (get e "gravity")
(Some g) g None Value.Null)
_ Value.Null)))
_ Value.Null)))
;; The escapes, resolved. The quotes in `name` never existed as bytes
;; in the source; é is two bytes out of six and the emoji is four out
;; of twelve; and the eight one-character escapes are eight bytes.

8
test/programs/pkgs/tree/tree.flan
View File

@ -25,8 +25,8 @@
(match t
(Leaf n) n
(Branch kids)
(let [s (i64 0)]
(dotimes [i (length kids)]
(set s (+ s (total (at kids i)))))
s)
(let [s (i64 0)]
(dotimes [i (length kids)]
(set s (+ s (total (at kids i)))))
s)
Empty (i64 0)))

6
test/programs/utf8.flan
View File

@ -102,9 +102,9 @@
(show-dec (slice lone-cont 0 1)) ; a continuation byte leading
(show-dec (slice overlong2 0 2)) ; overlong "/"
(show-dec (slice overlong3 0 3)) ; overlong "/" again, three bytes
(show-dec (slice overlong4 0 4)) ; and four. Added after a mutation run:
; relaxing 0xf0's floor to 0x80 left the
; whole suite green without this line.
;; Added after a mutation run: relaxing 0xf0's floor to 0x80 left the
;; whole suite green without this line.
(show-dec (slice overlong4 0 4)) ; and four
(show-dec (slice surrogate 0 3)) ; U+D800
(show-dec (slice above-max 0 4)) ; U+110000
(show-dec (slice lead-f5 0 4)) ; 0xf5 leads nothing

112
vendor/edn/provide.flan vendored
View File

@ -216,8 +216,8 @@
(let [t (next c)]
(when (not (ok? c))
(return (derived-bad
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(cond
(= (.kind t) tok-int) (ok-derived `i64 (form-nil) `(need-int c))
(= (.kind t) tok-float) (ok-derived `f64 (form-nil) `(need-float c))
@ -231,12 +231,12 @@
(= (.kind t) tok-nil)
(derived-bad
(joined3 "the nil at " (where src (.pos t))
" has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out"))
" has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out"))
:else
(derived-bad
(joined3 "the value at " (where src (.pos t))
" is not one defedn derives a type from — a map, a vector, a set, an integer, a float, a boolean or a string")))))
" is not one defedn derives a type from — a map, a vector, a set, an integer, a float, a boolean or a string")))))
;; A vector, whose elements must all come to the same type. The first element
;; decides; every one after it is compared against that decision and both
@ -245,8 +245,8 @@
(defn- derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
(when (at-byte? c \])
(return (derived-bad
(joined3 "the empty vector at " (where src at-pos)
" has no element to derive an element type from — defedn reads the shape out of the data, and an empty collection carries none"))))
(joined3 "the empty vector at " (where src at-pos)
" has no element to derive an element type from — defedn reads the shape out of the data, and an empty collection carries none"))))
(let [head (derive c (joined name "-item") src)]
(when (bad? head)
(return head))
@ -266,12 +266,12 @@
cn (Form.Sym {.s (joined name "-new")})]
(ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty
(vec-new a)))
`(let [xs (~cn a)]
(expect c tok-vec-open)
(while (and (ok? c) (not (at-byte? c \])))
(push xs ~read1))
(expect c tok-vec-close)
xs))))))
`(let [xs (~cn a)]
(expect c tok-vec-open)
(while (and (ok? c) (not (at-byte? c \])))
(push xs ~read1))
(expect c tok-vec-close)
xs))))))
;; Why every collection gets a one-line constructor of its own.
;;
@ -294,8 +294,8 @@
(defn- derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
(when (at-byte? c \})
(return (derived-bad
(joined3 "the empty set at " (where src at-pos)
" has no element to derive an element type from"))))
(joined3 "the empty set at " (where src at-pos)
" has no element to derive an element type from"))))
(let [head (derive-key c (joined name "-key") src)]
(when (bad? head)
(return head))
@ -315,12 +315,12 @@
cn (Form.Sym {.s (joined name "-new")})]
(ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty
(map-new a)))
`(let [tbl (~cn a)]
(expect c tok-set-open)
(while (and (ok? c) (not (at-byte? c \})))
(put tbl ~read1 true))
(expect c tok-map-close)
tbl))))))
`(let [tbl (~cn a)]
(expect c tok-set-open)
(while (and (ok? c) (not (at-byte? c \})))
(put tbl ~read1 true))
(expect c tok-map-close)
tbl))))))
;; One element of a set. The scalars that are map keys pass; a vector becomes a
;; fixed array, which is one where a Vec is not; anything else is refused here
@ -334,8 +334,8 @@
(return d))
(when (not (key-type? (.ty d)))
(return (derived-bad
(joined3 "a set of " (render (.ty d))
" is not something this builds: a set becomes a (Map T bool), so its elements are map keys. Integers, booleans, strings and vectors of those are"))))
(joined3 "a set of " (render (.ty d))
" is not something this builds: a set becomes a (Map T bool), so its elements are map keys. Integers, booleans, strings and vectors of those are"))))
d))
;; A vector in key position. Its length is part of its type, so every element
@ -346,8 +346,8 @@
(let [open (next c)]
(when (at-byte? c \])
(return (derived-bad
(joined3 "the empty vector at " (where src (.pos open))
" is inside a set, and an empty fixed array has no element type and no length"))))
(joined3 "the empty vector at " (where src (.pos open))
" is inside a set, and an empty fixed array has no element type and no length"))))
(let [head (derive c (joined name "-item") src)]
(when (bad? head)
(return head))
@ -364,30 +364,30 @@
(expect c tok-vec-close)
(when (not (key-type? (.ty head)))
(return (derived-bad
(joined3 "a set of vectors of " (render (.ty head))
" is not something this builds: the vector becomes a fixed array, which is a map key only when its elements are compared bytewise"))))
(joined3 "a set of vectors of " (render (.ty head))
" is not something this builds: the vector becomes a fixed array, which is a map key only when its elements are compared bytewise"))))
(let [elem (.ty head)
read1 (.reader head)
count (Form.Int {.i n})]
(ok-derived `[~count ~elem] (.decls head)
`(let [arr (array ~count ~elem)
i 0]
(expect c tok-vec-open)
(while (and (ok? c) (not (at-byte? c \])) (< i ~count))
(set (at arr i) ~read1)
(set i (+ i 1)))
(expect c tok-vec-close)
arr)))))))
`(let [arr (array ~count ~elem)
i 0]
(expect c tok-vec-open)
(while (and (ok? c) (not (at-byte? c \])) (< i ~count))
(set (at arr i) ~read1)
(set i (+ i 1)))
(expect c tok-vec-close)
arr)))))))
(defn- disagreement [what string src [u8] at-pos i32 n i64
first Form second Form] string
first Form second Form] string
(joined3 (joined3 "the " what " at ")
(where src at-pos)
(joined3 (joined3 " holds more than one shape: its first element is "
(render first) " and element ")
(i64->string n)
(joined3 " is " (render second)
". Every element has to be the same shape, because the type this becomes has one element type"))))
". Every element has to be the same shape, because the type this becomes has one element type"))))
;; ── A map, which is a struct ────────────────────────────────────────
;;
@ -403,8 +403,8 @@
(defn- derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
(when (at-byte? c \})
(return (derived-bad
(joined3 "the empty map at " (where src at-pos)
" has no keys to derive fields from — a struct with no fields is not a shape anything can be read into"))))
(joined3 "the empty map at " (where src at-pos)
" has no keys to derive fields from — a struct with no fields is not a shape anything can be read into"))))
(let [fields (vec-new Form) ; the defstruct's [name type ...] vector
clauses (vec-new Form) ; the reader's cond: test, body, test, body
missing (vec-new Form) ; one per field, checked when the map closes
@ -414,14 +414,14 @@
(let [k (next c)]
(when (not (ok? c))
(return (derived-bad
(joined3 "the data file could not be read at "
(where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(joined3 "the data file could not be read at "
(where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(when (!= (.kind k) tok-keyword)
(return (derived-bad
(joined3 (joined3 "the map at " (where src at-pos) " has a key at ")
(where src (.pos k))
" that is not a keyword. A struct's fields are named, so every key of a map defedn reads has to be one — :name, not \"name\" and not 1"))))
(joined3 (joined3 "the map at " (where src at-pos) " has a key at ")
(where src (.pos k))
" that is not a keyword. A struct's fields are named, so every key of a map defedn reads has to be one — :name, not \"name\" and not 1"))))
(let [fname (copy-text (.text k))
d (derive c (joined3 name "-" fname) src)]
(when (bad? d)
@ -441,11 +441,11 @@
;; bit is decided here, where the field is, so the two cannot fall
;; out of step the way a parallel list of names would.
(push missing
`(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name})
.extra? false
.pos (.pos k)})))))
`(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name})
.extra? false
.pos (.pos k)})))))
(set idx (+ idx 1)))))
(expect c tok-map-close)
;; An unknown key. The hand-written reader skips one, which is right when a
@ -455,12 +455,12 @@
;; handle the condition still reads the rest.
(push clauses `:else)
(push clauses
`(do (signal (SchemaDrift {.field (copy-text (.text k))
.struct ~(Form.Str {.s name})
.extra? true
.pos (.pos k)}))
(when (not (skip-value c))
(return out))))
`(do (signal (SchemaDrift {.field (copy-text (.text k))
.struct ~(Form.Str {.s name})
.extra? true
.pos (.pos k)}))
(when (not (skip-value c))
(return out))))
(let [sname (Form.Sym {.s name})
rname (Form.Sym {.s (joined "read-" name)})
struct `(defstruct ~sname ~(Form.Vec {.xs (slice fields)}))
@ -539,7 +539,7 @@
(Some src) (provide name path src)
None (refuse
(joined3 "there is no file at " path
", read relative to the file this defedn is written in — the same place (embed \"...\") would look")))
", read relative to the file this defedn is written in — the same place (embed \"...\") would look")))
_ (refuse "defedn's first argument is the name of the struct to declare, written as a name"))
_ (refuse "defedn's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from"))))

52
vendor/edn/read.flan vendored
View File

@ -93,44 +93,44 @@
(= (.kind t) tok-symbol) (keyword (.text t))
(= (.kind t) tok-vec-open)
(let [items (vec-new dyn)
u (next c)]
(while (and (ok? c)
(!= (.kind u) tok-vec-close)
(!= (.kind u) tok-eof))
(push items (read-value c u))
(set u (next c)))
items)
(let [items (vec-new dyn)
u (next c)]
(while (and (ok? c)
(!= (.kind u) tok-vec-close)
(!= (.kind u) tok-eof))
(push items (read-value c u))
(set u (next c)))
items)
;; A set ends on tok-map-close, because `}` is the byte that ends it. The
;; dedup is the map's own: put replaces the value of an equal key, so a
;; set with a duplicate in it never exists and #{[0 0] [0 0]} is one
;; element by structure, not by header identity.
(= (.kind t) tok-set-open)
(let [s {}
u (next c)]
(while (and (ok? c)
(!= (.kind u) tok-map-close)
(!= (.kind u) tok-eof))
(put s (read-value c u) true)
(set u (next c)))
s)
(let [s {}
u (next c)]
(while (and (ok? c)
(!= (.kind u) tok-map-close)
(!= (.kind u) tok-eof))
(put s (read-value c u) true)
(set u (next c)))
s)
;; A map's key is a whole value, read by the same recursion as anything
;; else — :a and "a" are two keys, [0 0] can key a map, and the old
;; (Map string Value) narrowing that collapsed them is gone with the type
;; that forced it.
(= (.kind t) tok-map-open)
(let [m {}
k (next c)]
(while (and (ok? c)
(!= (.kind k) tok-map-close)
(!= (.kind k) tok-eof))
(let [key (read-value c k)
u (next c)]
(put m key (read-value c u)))
(set k (next c)))
m)
(let [m {}
k (next c)]
(while (and (ok? c)
(!= (.kind k) tok-map-close)
(!= (.kind k) tok-eof))
(let [key (read-value c k)
u (next c)]
(put m key (read-value c u)))
(set k (next c)))
m)
:else nil))

82
vendor/json/provide.flan vendored
View File

@ -177,8 +177,8 @@
(let [t (next c)]
(when (not (ok? c))
(return (derived-bad
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(cond
(= (.kind t) tok-int) (ok-derived `i64 (form-nil) `(need-int c))
(= (.kind t) tok-float) (ok-derived `f64 (form-nil) `(need-float c))
@ -191,12 +191,12 @@
(= (.kind t) tok-null)
(derived-bad
(joined3 "the null at " (where src (.pos t))
" has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out"))
" has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out"))
:else
(derived-bad
(joined3 "the value at " (where src (.pos t))
" is not one defjson derives a type from — an object, an array, a number, a boolean or a string")))))
" is not one defjson derives a type from — an object, an array, a number, a boolean or a string")))))
;; An array, whose elements must all come to the same type. The first decides;
;; every one after it is compared against that, and both positions are named
@ -205,8 +205,8 @@
(defn- derive-array [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
(when (at-byte? c \])
(return (derived-bad
(joined3 "the empty array at " (where src at-pos)
" has no element to derive an element type from — defjson reads the shape out of the data, and an empty collection carries none"))))
(joined3 "the empty array at " (where src at-pos)
" has no element to derive an element type from — defjson reads the shape out of the data, and an empty collection carries none"))))
(let [head (derive c (joined name "-item") src)]
(when (bad? head)
(return head))
@ -218,12 +218,12 @@
(return item))
(when (not (same-type? (.ty head) (.ty item)))
(return (derived-bad
(joined3 (joined3 "the array at " (where src at-pos)
" holds more than one shape: element 0 is ")
(render (.ty head))
(joined3 (joined3 " and element " (i64->string n) " is ")
(render (.ty item))
". Every element of an array has to be the same shape, because the (Vec T) it becomes has one element type")))))
(joined3 (joined3 "the array at " (where src at-pos)
" holds more than one shape: element 0 is ")
(render (.ty head))
(joined3 (joined3 " and element " (i64->string n) " is ")
(render (.ty item))
". Every element of an array has to be the same shape, because the (Vec T) it becomes has one element type")))))
(comma c)
(set n (+ n 1))))
(expect c tok-array-close)
@ -238,21 +238,21 @@
;; better for it too.
(ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty
(vec-new a)))
`(let [xs (~cn a)]
(expect c tok-array-open)
(while (and (ok? c) (not (at-byte? c \])))
(push xs ~read1)
(comma c))
(expect c tok-array-close)
xs))))))
`(let [xs (~cn a)]
(expect c tok-array-open)
(while (and (ok? c) (not (at-byte? c \])))
(push xs ~read1)
(comma c))
(expect c tok-array-close)
xs))))))
;; ── An object, which is a struct ────────────────────────────────────
(defn- derive-object [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
(when (at-byte? c \})
(return (derived-bad
(joined3 "the empty object at " (where src at-pos)
" has no members to derive fields from — a struct with no fields is not a shape anything can be read into"))))
(joined3 "the empty object at " (where src at-pos)
" has no members to derive fields from — a struct with no fields is not a shape anything can be read into"))))
(let [fields (vec-new Form) ; the defstruct's [name type ...] vector
clauses (vec-new Form) ; the reader's cond: test, body, test, body
missing (vec-new Form) ; one per field, checked when the object closes
@ -262,12 +262,12 @@
(let [k (next c)]
(when (not (ok? c))
(return (derived-bad
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(joined3 "the data file could not be read at " (where src (error-pos c))
(joined ": " (error-message (.err c)))))))
(when (!= (.kind k) tok-string)
(return (derived-bad
(joined3 "the object at " (joined3 (where src at-pos) " has a member at " (where src (.pos k)))
" whose name is not a string, which JSON requires"))))
(joined3 "the object at " (joined3 (where src at-pos) " has a member at " (where src (.pos k)))
" whose name is not a string, which JSON requires"))))
;; The comparison in the generated reader is against the token's RAW
;; text, which costs no allocation per key. That is only the same
;; question as "is this the field" when the name has no escape in it —
@ -277,12 +277,12 @@
(let [raw (.text k)]
(when (has-escape? raw)
(return (derived-bad
(joined3 "the member name at " (where src (.pos k))
" has an escape in it. A generated reader compares a key against the bytes as written, which costs nothing per key and is only the same question when the name is written plainly — so this one is refused rather than matched wrongly"))))
(joined3 "the member name at " (where src (.pos k))
" has an escape in it. A generated reader compares a key against the bytes as written, which costs nothing per key and is only the same question when the name is written plainly — so this one is refused rather than matched wrongly"))))
(when (not (name-like? raw))
(return (derived-bad
(joined3 "the member name at " (where src (.pos k))
" is not a name a program could write, so there is no field it can become. A struct's fields are named; letters, digits, - and ? are what a name is made of"))))
(joined3 "the member name at " (where src (.pos k))
" is not a name a program could write, so there is no field it can become. A struct's fields are named; letters, digits, - and ? are what a name is made of"))))
(expect c tok-colon)
(let [fname (copy-of raw)
d (derive c (joined3 name "-" fname) src)]
@ -303,11 +303,11 @@
;; beside the field, so the two cannot fall out of step the way a
;; parallel list of names would.
(push missing
`(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name})
.extra? false
.pos (.pos close)})))))
`(when (= (bit-and seen ~bit) 0)
(signal (SchemaDrift {.field ~lit
.struct ~(Form.Str {.s name})
.extra? false
.pos (.pos close)})))))
(comma c)
(set idx (+ idx 1))))))
(expect c tok-object-close)
@ -316,12 +316,12 @@
;; program that declines to handle the condition still reads the rest.
(push clauses `:else)
(push clauses
`(do (signal (SchemaDrift {.field (match (string-of k) (Some s) s None "")
.struct ~(Form.Str {.s name})
.extra? true
.pos (.pos k)}))
(when (not (skip-value c))
(return out))))
`(do (signal (SchemaDrift {.field (match (string-of k) (Some s) s None "")
.struct ~(Form.Str {.s name})
.extra? true
.pos (.pos k)}))
(when (not (skip-value c))
(return out))))
(let [sname (Form.Sym {.s name})
rname (Form.Sym {.s (joined "read-" name)})
struct `(defstruct ~sname ~(Form.Vec {.xs (slice fields)}))
@ -420,7 +420,7 @@
(Some src) (provide name path src)
None (refuse
(joined3 "there is no file at " path
", read relative to the file this defjson is written in — the same place (embed \"...\") would look")))
", read relative to the file this defjson is written in — the same place (embed \"...\") would look")))
_ (refuse "defjson's first argument is the name of the struct to declare, written as a name"))
_ (refuse "defjson's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from"))))

24
vendor/raylib/raylib.flan vendored
View File

@ -551,7 +551,7 @@
"CheckCollisionCircleRec")
(declare-c collision-circle-line? [center Vector2 radius f32
p1 Vector2 p2 Vector2] bool "CheckCollisionCircleLine")
p1 Vector2 p2 Vector2] bool "CheckCollisionCircleLine")
(declare-c collision-point-rec?
[point Vector2 rec Rectangle] bool
@ -562,13 +562,13 @@
"CheckCollisionPointCircle")
(declare-c collision-point-triangle? [point Vector2 a Vector2 b Vector2
c Vector2] bool "CheckCollisionPointTriangle")
c Vector2] bool "CheckCollisionPointTriangle")
;; `threshold` is in pixels, and it is not optional in practice: raylib's test
;; is a distance comparison in floats, so a point exactly on the line fails at
;; a threshold of 0. 1 is the useful smallest value.
(declare-c collision-point-line? [point Vector2 p1 Vector2 p2 Vector2
threshold i32] bool "CheckCollisionPointLine")
threshold i32] bool "CheckCollisionPointLine")
;; The one binding whose Flan face is not raylib's, and one of only two in
;; this file with a hand-written wrapper on top. A Flan slice crosses as
@ -685,12 +685,12 @@
"DrawTextureV")
(declare-c draw-texture-ex [texture Texture2D position Vector2 rotation f32
scale f32 tint Color] "DrawTextureEx")
scale f32 tint Color] "DrawTextureEx")
;; A negative source width or height flips the sprite, which is how a sheet is
;; drawn facing the other way without a second image.
(declare-c draw-texture-rec [texture Texture2D source Rectangle position Vector2
tint Color] "DrawTextureRec")
tint Color] "DrawTextureRec")
;; The two above, in one call, and the only one of the four that both takes a
;; source rectangle and scales: `source` picks a cell out of an atlas, `dest`
@ -933,10 +933,10 @@
;; Angles are degrees, clockwise from the +x axis, and `segments` is how many
;; straight pieces the arc is made of — 0 lets raylib pick from the radius.
(declare-c draw-ring [center Vector2 inner f32 outer f32 start f32 end f32
segments i32 color Color] "DrawRing")
segments i32 color Color] "DrawRing")
(declare-c draw-ring-lines [center Vector2 inner f32 outer f32 start f32 end f32
segments i32 color Color] "DrawRingLines")
segments i32 color Color] "DrawRingLines")
;; Counter-clockwise, and raylib means it: the clockwise winding is culled and
;; draws nothing at all, which looks exactly like a broken binding.
@ -968,15 +968,15 @@
;; `roundness` is 0 to 1 as a fraction of the shorter side, so 0 is a plain
;; rectangle and 1 is a stadium.
(declare-c draw-rectangle-rounded [rec Rectangle roundness f32 segments i32
color Color] "DrawRectangleRounded")
color Color] "DrawRectangleRounded")
;; No thickness here — see the section note. The `-ex` form below is the one
;; that takes it.
(declare-c draw-rectangle-rounded-lines [rec Rectangle roundness f32 segments i32
color Color] "DrawRectangleRoundedLines")
color Color] "DrawRectangleRoundedLines")
(declare-c draw-rectangle-rounded-lines-ex [rec Rectangle roundness f32
segments i32 thick f32 color Color] "DrawRectangleRoundedLinesEx")
segments i32 thick f32 color Color] "DrawRectangleRoundedLinesEx")
;; ── A slice where raylib wants a pointer and a count ─────────────────
;;
@ -1524,7 +1524,7 @@
;; so a one-character string is unaffected by it. raylib's own DrawTextEx adds
;; it the same way measure-text-ex counts it, which is why the two agree.
(declare-c draw-text-ex [font Font text string position Vector2
font-size f32 spacing f32 tint Color] "DrawTextEx")
font-size f32 spacing f32 tint Color] "DrawTextEx")
;; Pure arithmetic over the font — no GL, no window — and therefore the one
;; thing in this section the acceptance table can assert. See the note above:
@ -1568,7 +1568,7 @@
"GetGlyphAtlasRec")
(declare-c draw-text-codepoint [font Font codepoint i32 position Vector2
font-size f32 tint Color] "DrawTextCodepoint")
font-size f32 tint Color] "DrawTextCodepoint")
;; DrawTextCodepoints and LoadFontData are not bound. The first is the slice
;; problem again and adds nothing draw-text-ex does not already do from a