Memory diagnostics on demand: gc and native allocation sites, faintly

# Conflicts:
#	FIX.org
This commit is contained in:
Joseph Ferano 2026-09-20 12:57:30 +07:00
commit f030c5f7f1
10 changed files with 821 additions and 106 deletions

88
FIX.org
View File

@ -871,3 +871,91 @@ from bin/, which would be backwards anyway; it means the pipeline moving into
lib/ — Build, or a small front-end module beside it — with the two checkers'
difference made an argument, and bin/ and test_support.ml both calling that.
Not queued.
* Memory diagnostics on demand, decided 2026-09-20
** The author's spec
Clojure's [*warn-on-boxed*] crossed with Rider's heap-allocation squiggles.
Both kinds of allocation: the GC's — boxing a typed value into dyn where it is
not an immediate, map/vec/string construction, the big-int spill — and the
native side's — vec-new, a push that may grow, arena allocation, slurp,
anything routing through an allocator. Two visually distinct classes, rendered
in different colours by the editor and both FAINTER than an error ("they
should somewhat fade"). Off by default, surfaced on demand two ways: an Emacs
command of the "check for warnings" shape that asks for the current buffer's
and overlays the answer, and a compiler flag so the CLI can decide when they
appear. Flycheck integration a nice-to-have. Precision over completeness in
v1: never mark a site that does not allocate — a dyn immediate must not
squiggle — and a site that allocates only sometimes says "may allocate".
** What landed
[Check.memory_sites], a pass over the finished program in the shape
[Check.no_gc] already has: it runs after checking, answers a [Loc.diag list],
and nothing downstream is told it exists. Asking cannot change what compiles.
The class rides on the diagnostic's [kind] — "memory/gc" or "memory/native" —
so the CLI and the daemon dispatch on one field and neither parses a message.
[flan check FILE --warn-memory] and [flan build ... --warn-memory] print them
to stderr in the standard [file:line:col: warning: ] shape with the squiggle,
filtered to the file named on the command line. The exit status does not move.
[(:op "memory")] on the dev daemon answers [(LOC KIND MESSAGE)] rows over
[t.session.program], needing no running program — a parked session answers it.
[M-x flan-check-memory] in flan.el paints them: two faces, both fainter than
[flan-error-face] and with no message drawn beside the line, priority under an
error's so a refusal still wins a shared span. [M-x flan-clear-memory], or an
edit, or asking again, takes them down.
** Where this overrode the spec, and the evidence
*** (vec-new T) and (map-new K V) are not marked.
The spec's enumeration lists vec-new as a native allocation; the runtime says
otherwise and the spec's own precision rule says to believe the runtime. The
["vec-new"] arm in check.ml passes a capacity of literal zero to
[flan_vec_init], and that function's body returns before [flan_vec_grow] when
[cap <= 0]. [flan_map_init] never takes a block at all and carries its own
comment saying so — "No block until something is put in it". The block arrives
at the first push or put, and those are the lines marked. [(vec-new dyn)] and
a dyn map literal are the other answer: those are the dyn runtime's own
objects and [gc_alloc] runs at the call, so they are marked.
The classifier reads [flan_vec_init]'s capacity argument rather than keying on
the symbol, which is what lets [slurp] — the caller that sizes the Vec to the
file — be marked "allocates" through the same entry point that vec-new is
silent through.
*** Dyn arithmetic is not marked.
[flan_dyn_add] and its siblings end in [flan_dyn_from_i64], so a wide enough
result does spill. Nothing static knows the operands, and a squiggle under
every dyn [+] is exactly the false positive the precision rule exists to
prevent. [flan_dyn_from_i64] IS marked at an explicit crossing, and only when
the value can leave the 48-bit payload: a literal inside ±2^47 and a value
widened from a narrower integer type are both provably immediate and silent.
*** Keywords are not marked.
Interned and immortal — flan_dyn.c's intern table holds the only copy of each
name, nothing removes one, and [mark_value] walks BOX_OBJ and nothing else.
There is no GC object to attribute.
*** The overlays outlive the next command.
The spec asked for the paths that clear an error overlay. Those hang off
[pre-command-hook], which takes an overlay down before the next keystroke —
right for feedback about a failed evaluation, and fatal for an annotation:
moving point through a marked line is what you do with these on screen. They
clear on [after-change-functions] instead, plus the explicit command and the
repeat-toggle. Documented in emacs/MANUAL.md.
** Flycheck
flan.el has no flycheck wiring of any kind, so per the spec's own branch no
checker was defined. emacs/MANUAL.md documents the CLI pattern and carries the
[flycheck-define-checker] form for anyone who wants one — the flag is the
command, and the printed shape is the error pattern.
** Pinned
test/test_flan.ml pins three programs by exact location, kind and message: the
collected heap (a dyn vec, a map literal, a string crossing, a wide i64, and
the five immediates plus an i32 widening that must stay silent); the allocator
side (arena-new, slurp's sized vec-init, a typed container's view record, put,
reserve, with a typed vec-new and map-new silent between them); and dyn
arithmetic answering nothing at all. test/test_dev.ml drives [(:op "memory")]
over the socket against programs/dev-dyn-global.flan, whose one line is two
gc crossings at two columns and no native allocation anywhere.

75
HANDOFF.md Normal file
View File

@ -0,0 +1,75 @@
# Handoff — 2026-09-19 (written before a full /clear)
Read this, then delete it. Style: user wants extreme concision, plain language,
no filler, decisions discussed one at a time BEFORE dispatching, agents
dispatched one at a time. No commit watermarks. `dune test` stays fast.
## State of the repo
- Branch `dev-loop`, tip `73ab213` (merge of the x86 dyn + conditions lane).
All green after merge: dune test 287/0, @x86 137 match / 0 differ,
@sanitize clean.
- dyn now works on the default x86 dev daemon. handler-bind is now a value
(body's last form) on both backends.
- `sand.flan` is the author's UNCOMMITTED WIP. Never commit it. Stash around
merges (`git stash push sand.flan -m wip`, pop after). `game-data.edn`
untracked, leave it.
- Known open hole (flagged, not fixed): `dune test` exits 0 even when
test_acceptance prints failures — nothing surfaces them.
## In flight: M2 item 1 — dyn maps + keywords
Agent worktree: `.claude/worktrees/agent-a3009901a950e8daa`
(branch `worktree-agent-a3009901a950e8daa`). NOT committed yet — uncommitted
changes across lib/{ast,check,emit,load,parse,prelude}.ml, runtime/flan_dyn.{h,c},
test/dune; it was writing checker/parse tests in test/test_flan.ml when it hit
the session limit (resets 7:20pm Asia/Bangkok).
To finish: spawn an agent IN THAT WORKTREE (don't reset it) with: "Finish the
in-progress dyn maps + keywords lane. Read the uncommitted diff first to see
what exists. Remaining: tests in test_flan.ml, acceptance rows (LLVM, -O0,
--x86; run programs for real output, never guess wording; no double-quotes in
OCaml comments), then ONCE at the end: dune test --force, dune build @x86
--force, dune build @sanitize --force. Commit in the repo's prose voice."
Then: stash sand.flan, merge, run the three sweeps, pop stash.
## M2 queue (FIX.org "M2 queue" section, line ~408) — dispatch ONE AT A TIME
1. dyn maps + keywords (in flight, above)
2. per-type descriptors — use Opus-class agent (representation change)
3. typed containers into dyn as views (rides on 2)
4. nil↔None at (Option T)
5. typed =/!= grow strings
6. defclass = named dyn map + CLOS/Clojure dispatch (after 1)
7. dyn if truthiness
8. return slot stays mandatory — decision only, no work
Model plan agreed with user: session on Opus, Sonnet agents for items 38,
Opus agents for item 2 and for reviews of merges.
## Not yet recorded in FIX.org (do this early, cheap)
Append a section on the syntax-family discussion (2026-09-19):
- User wants an F#-ish indentation/ML surface syntax, side by side with
s-exprs. Languages that "disappear" for them: Python > Odin > F#.
- Agreed architecture if it happens: one AST (the existing forms), second
reader; macros stay usable from both; Nim-style quote-block could allow
writing macros in ML syntax too.
- Middle options discussed: Parinfer (editor-only), wisp/sweet-exprs
(indentation-implied parens), simplified in-paren syntax. Rhombus = the
maximal reference.
- DECISION: deferred, no spike queued. User's current hypothesis: their
Clojure friction may be immutability/planning-ahead, not parens — they
will write imperative Flan as-is and see if parens still grate. Revisit
with that evidence.
## Environment notes
- /tmp (7.6G tmpfs) was 100% full; freed ~470M of stale dune test dirs, now
~95%. Remaining bulk: 2.6G Refold-Defold Claude scratch + ~850M numeric
JVM/Defold dirs — user hasn't said whether that session is closed; ask
before deleting.
- Verify agents' worktree bases: every past agent arrived stale. Prompt must
demand git log check + reset to dev-loop tip.
- Repeated full sweeps are the main time sink — tell agents to verify
incrementally, full sweeps once at the end.

View File

@ -203,9 +203,35 @@ let no_annotate_flag = "--no-annotate"
the flag, and that is the property the flag is worth having for. *)
let no_gc_flag = "--no-gc"
(* "Which of these lines allocates?", printed and nothing else. The other side
of [--no-gc]: that flag refuses a program for holding a dyn, this one only
says where the memory goes on the collector's heap and on an allocator the
program named, told apart by the diagnostic's kind. Off by default, because
a warning on every push in a program that means them is noise; asked for,
because a frame budget is a question you ask on purpose.
It is a warning and not an error, and it says so in the one way that
matters: the exit status does not move. See [Check.memory_sites], which is
a pass over the checked program and, like [Check.no_gc], tells nothing
downstream that it ran. *)
let warn_memory_flag = "--warn-memory"
let flags =
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
x86_flag; llvm_flag; no_annotate_flag; no_gc_flag ]
x86_flag; llvm_flag; no_annotate_flag; no_gc_flag; warn_memory_flag ]
(* The warnings, where errors go. Printed one to a location in the repo's
standard [file:line:col:] shape, with the squiggle [Loc.entry] draws, so
an editor or a flycheck checker parses them exactly as it parses an error.
Not through [Loc.report_all]: that appends a count of *errors*, and these
are not errors. *)
let print_memory_warnings ~file (p : Flan.Tast.program) =
List.iter
(fun (d : Flan.Loc.diag) ->
prerr_endline
(Flan.Loc.entry ~mark:'~' ~label:"warning: " d.Flan.Loc.dloc
d.Flan.Loc.dmsg))
(Flan.Check.memory_sites ~file p)
(* Which backend a command got, from the two flags and the default it would
have taken. One function because there is one rule, and the only thing that
@ -299,11 +325,19 @@ let () =
|> Flan.Parse.program_all
|> List.iter (fun d -> print_endline (summarise d))))
files
| _ :: "check" :: files when files <> [] ->
| _ :: "check" :: args when List.exists (fun a -> not (is_flag a)) args ->
let warn_memory = List.mem warn_memory_flag args in
let files = List.filter (fun a -> not (is_flag a)) args in
List.iter
(fun path ->
with_errors path (fun () ->
let p = checked path in
(* After the listing is decided and before it is printed is not a
distinction anything can see: the warnings go to stderr and the
listing to stdout. What matters is that they are asked of a
program that checked, which is what leaves the exit status
alone. *)
if warn_memory then print_memory_warnings ~file:path p;
List.iter
(fun (g : Flan.Tast.global) ->
Printf.printf "%s %s %s\n"
@ -666,7 +700,8 @@ let () =
prerr_endline
"usage: flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
[--no-bounds-checks] \
[--dev] [--debug] [--sanitize] [--no-gc] [--target=wasm32-wasi|web|js]";
[--dev] [--debug] [--sanitize] [--no-gc] [--warn-memory] \
[--target=wasm32-wasi|web|js]";
exit 2
in
with_errors path (fun () ->
@ -677,6 +712,9 @@ let () =
what [main] happened to reach would come and go as the program was
edited elsewhere. *)
if List.mem no_gc_flag rest then Flan.Check.no_gc p;
(* Before reachability too, and for the same reason: a push in a function
nothing calls is still a push somebody wrote. *)
if List.mem warn_memory_flag rest then print_memory_warnings ~file:path p;
(* The link follows the program, not the import list: a package nothing
reachable calls into contributes no C and no linker argument, and its
functions are not emitted either. That is what lets one file import
@ -877,12 +915,12 @@ let () =
exit code)
| _ ->
prerr_endline
"usage: flan (read|parse|check|emit|shim) <file.flan>...\n flan emit <file.flan> [--x86] [--dev] [--debug] [--no-bounds-checks]\n\
"usage: flan (read|parse|check|emit|shim) <file.flan>...\n flan check <file.flan>... [--warn-memory]\n flan emit <file.flan> [--x86] [--dev] [--debug] [--no-bounds-checks]\n\
\ flan import-c <header.h> [package.flan...] [clang flags...]\n\
\ flan generate-c <package-dir>\n\
\ flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
[--no-bounds-checks] [--dev] \
[--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web|js]\n\
[--debug] [--sanitize] [--x86] [--warn-memory] [--target=wasm32-wasi|web|js]\n\
\ flan run <file.flan> [build flags...] [--] [program args...]\n\
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
\ flan dev <program.flan> [-s socket] [--x86]";

View File

@ -546,6 +546,62 @@ can print the same breakdown to stderr by being run with `FLAN_DEV_LEAKS` set
Both are dev-build only. A release build records nothing and says so.
### Which lines allocate — `M-x flan-check-memory`
The two commands above ask the running program what it *took*. This one asks the
compiler what the source *says*, and draws the answer under the characters that
say it. Clojure's `*warn-on-boxed*` crossed with Rider's heap-allocation
squiggles.
It needs no running program — a parked session answers it — and it is **off
until you ask**. A program that means its allocations does not want them
underlined while it is being written; you ask when the question is "where is
this frame's memory going".
**Two colours, because there are two heaps.** One face for the dyn runtime's
collected heap: a string, a vec or a map crossing into `dyn`, the view record a
typed container takes when it crosses, an `i64` too wide for a `dyn`'s payload.
Another for an allocator the program named: a push or a `reserve` past capacity,
a `clone`, a `slurp`, a new arena. The two underlines differ in style as well as
in colour, so you can tell the classes apart without relying on colour alone.
Both are fainter than an error: neither inherits the error face, and neither
draws its message into the line the way a rejection does. Hover for the
sentence; the count is in the echo area.
**What is deliberately not marked is the half worth knowing.** A `dyn` immediate
costs nothing, so nothing is drawn: `nil`, a `bool`, an `f64`, a keyword, and any
integer inside ±2^47 live in the word itself. Neither is `(vec-new T)` or
`(map-new K V)` — a typed container takes no block until something is put in it,
and the line that is marked is the first push. A site that allocates only
sometimes says so in its first two words: "may allocate".
They last until you edit the buffer — they are a reading of the source, not
feedback about an evaluation, so moving point through them leaves them alone.
Asking again while they are up takes them down.
#### The same thing from the command line, and flycheck
`flan check FILE --warn-memory` prints the same list in the standard
`file:line:col: warning: ...` shape, on stderr, with the squiggle. `flan build`
takes the flag too. **The exit status does not move** — these are warnings, and
a program that only warns still builds.
There is no flycheck checker in `flan.el` today. If you want one, the flag is
what it should call, and the message shape is what it should parse:
```elisp
(flycheck-define-checker flan-memory
"Flan's allocation diagnostics."
:command ("flan" "check" "--warn-memory" source-original)
:error-patterns
((warning line-start (file-name) ":" line ":" column
": warning: " (message) line-end))
:modes flan-mode)
```
Only the file named on the command line is reported, so the prelude's own pushes
— real, and none of your business — stay out of it.
### The watch buffer — values while the program runs
Everything above is for a program you have stopped, or one you interrupt with a
@ -935,8 +991,10 @@ Commands with no key: `M-x flan` (start a program), `M-x flan-quit`
(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), `M-x flan-macroexpand-all`
(the `C-u` half of `C-c C-m`, by name), and `M-x flan-allocations` /
`M-x flan-leaks` (where the memory went, and what is still held).
(the `C-u` half of `C-c C-m`, by name), `M-x flan-allocations` /
`M-x flan-leaks` (where the memory went, and what is still held), and
`M-x flan-check-memory` / `M-x flan-clear-memory` (which lines allocate, marked
in the buffer).
---

View File

@ -2712,5 +2712,156 @@ can print the same breakdown to stderr under FLAN_DEV_LEAKS."
(interactive)
(flan-allocations--show "leaks" "Still held, by type"))
;;; Which lines allocate
;; The static half of the two commands above, and the distinction is the whole
;; reason it is a separate feature: `flan-allocations' asks the running program
;; what it took, and this asks the compiler what the source says. It needs no
;; program on the far end — a parked session answers it — and it points at
;; characters in the buffer rather than at a table of type names.
;;
;; Clojure's `*warn-on-boxed*' crossed with Rider's heap-allocation squiggles,
;; and off by default for the same reason both of those are: a program that
;; means its allocations does not want them underlined while it is being
;; written. You ask when the question is "where is this frame's memory going".
;;
;; Two classes and two faces, because the two heaps are not the same heap:
;; `memory/gc' is the dyn runtime's collected heap and `memory/native' is an
;; allocator the program named. The daemon decides which; nothing here reads
;; the message to find out.
;;
;; **Fainter than an error, deliberately.** These are annotations on code that
;; is correct. So: no per-site `after-string' — which is the loud half of the
;; error overlay, a message drawn into the line — and neither face inherits
;; `error'. The message goes in `help-echo' and the count in the echo area.
;; The two underlines differ in style as well as in colour, so the classes are
;; told apart without relying on colour alone. An error must still win where
;; the two land on one span, which is what the lower `priority' is for.
;;
;; **And they last, which an error overlay does not.** The error overlay is
;; feedback about the evaluation that just failed, so any command at all takes
;; it down; these are a reading of the source, so they last until the source
;; changes. `after-change-functions', not `pre-command-hook': moving point
;; through a marked line is exactly what you do with them on screen, and an
;; annotation that vanished on the first `C-n' could never be read. Asking a
;; second time with them up takes them down, which is the toggle people expect
;; of a command they turned on.
(defface flan-memory-gc-face
'((t :inherit warning :weight normal
:underline (:style wave)))
"Face for a line that allocates on the dyn runtime's collected heap."
:group 'flan)
(defface flan-memory-native-face
'((t :inherit font-lock-constant-face :weight normal
:underline (:style line)))
"Face for a line that allocates through an allocator the program named."
:group 'flan)
(defun flan--memory-overlays (&optional buffer)
"The Flan memory overlays in BUFFER, or in the current buffer."
(with-current-buffer (or buffer (current-buffer))
(seq-filter (lambda (o) (overlay-get o 'flan-memory))
(overlays-in (point-min) (point-max)))))
(defun flan-clear-memory (&optional buffer)
"Remove the allocation annotations from BUFFER, or from the current buffer."
(interactive)
(with-current-buffer (or buffer (current-buffer))
(remove-overlays (point-min) (point-max) 'flan-memory t)
(remove-hook 'after-change-functions #'flan--clear-memory-on-change t)))
(defun flan--clear-memory-on-change (_beg _end _len)
"Take this buffer's allocation annotations down, as an `after-change-functions'.
They are a reading of the source as it was when you asked, and an edit is
what makes that reading stale nothing smaller does, which is why this is
not the `pre-command-hook' the error overlays use."
(flan-clear-memory))
(defun flan--marked-buffers ()
"Every buffer that currently has allocation annotations in it.
One request paints every buffer visiting a file the answer names, so the
toggle and the refresh are questions about all of them and not about the
one point happens to be in: asking from a third buffer would otherwise
stack a second copy on the two that were already marked."
(seq-filter (lambda (b) (flan--memory-overlays b)) (buffer-list)))
(defun flan--memory-face (kind)
"The face for a diagnostic of KIND, or nil if KIND is not one of ours."
(cond ((equal kind "memory/gc") 'flan-memory-gc-face)
((equal kind "memory/native") 'flan-memory-native-face)))
(defun flan--show-memory (loc kind msg)
"Mark MSG of KIND at LOC, if LOC names a file some buffer is visiting.
Returns the buffer it marked, or nil."
(let ((parts (flan--parse-loc loc))
(face (flan--memory-face kind)))
(when (and parts face)
(let ((buf (flan--buffer-visiting (nth 0 parts))))
(when buf
(with-current-buffer buf
(let* ((beg (flan--position (nth 1 parts) (nth 2 parts)))
(end (save-excursion (goto-char beg) (line-end-position)))
(ov (make-overlay beg end buf t nil)))
(overlay-put ov 'flan-memory t)
(overlay-put ov 'face face)
(overlay-put ov 'help-echo msg)
(overlay-put ov 'evaporate nil)
;; Under an error's 100: a refusal and an annotation can land on
;; one span, and the refusal is the one you have to act on.
(overlay-put ov 'priority 50)
(add-hook 'after-change-functions
#'flan--clear-memory-on-change nil t)
buf)))))))
;;;###autoload
(defun flan-check-memory ()
"Underline every line of this session's program that allocates.
Two colours: one for the dyn runtime's collected heap a string, a vec or a
map crossing into dyn, a typed container's view record, an i64 too wide for a
dyn's payload and one for an allocator the program named: a push or a
reserve past capacity, a clone, a slurp, a new arena. Both fainter than an
error, because the code is not wrong.
What is deliberately *not* marked is the half worth knowing: a dyn immediate.
nil, a bool, an f64, a keyword and an int inside ±2^47 live in the word
itself, so boxing one costs nothing and nothing is drawn. Neither is
`(vec-new T)' or `(map-new K V)' a typed container takes no block until
something is put in it; the block arrives at the first push, which is the
line that is marked.
The annotations last until you edit the buffer. Asking again while they are
up takes them down."
(interactive)
(if (flan--marked-buffers)
(progn (mapc #'flan-clear-memory (flan--marked-buffers))
(message "flan: allocation marks off"))
(let ((r (flan--request (list :op "memory"))))
(unless (equal (plist-get r :status) "ok")
(user-error "flan: %s" (or (plist-get r :message) "refused")))
(let ((here 0) (elsewhere 0))
;; Nothing was marked in *this* buffer or the branch above would have
;; run — but another one may be, and painting over it would stack a
;; second copy with a second `help-echo'.
(mapc #'flan-clear-memory (flan--marked-buffers))
(dolist (row (plist-get r :sites))
(if (flan--show-memory (nth 0 row) (nth 1 row) (nth 2 row))
(setq here (1+ here))
(setq elsewhere (1+ elsewhere))))
(cond
((and (zerop here) (zerop elsewhere))
(message "flan: nothing in this program allocates"))
((zerop here)
(message "flan: %d allocating site%s, none in a buffer you have open"
elsewhere (if (= elsewhere 1) "" "s")))
(t
(message "flan: %d allocating site%s marked%s"
here (if (= here 1) "" "s")
(if (zerop elsewhere) ""
(format ", %d more elsewhere" elsewhere)))))))))
(provide 'flan)
;;; flan.el ends here

View File

@ -8425,3 +8425,174 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
let no_gc (p : Tast.program) =
match dyn_sites p with [] -> () | ds -> raise (Loc.Errors ds)
(* ── Memory diagnostics ─────────────────────────────────────────────────
"Which of these lines allocates?", answered on demand. Clojure's
[*warn-on-boxed*] crossed with Rider's heap-allocation squiggles, and the
same shape [dyn_sites] above has: a pass over the finished program, off
unless somebody asks, and nothing downstream is told it exists. Asking for
it cannot change what compiles.
Two classes, because the two heaps are not the same heap and a reader wants
to know which one a line is spending. [kind] carries it ["memory/gc"] is
the dyn runtime's collected heap, ["memory/native"] is an allocator the
program named so the CLI and the daemon dispatch on one field and neither
has to parse a message.
**Precision over completeness.** A site named here allocates, and a site
that only *might* says so in the first two words. That rule is what decides
the table below, and it decided it against the obvious guesses more than
once every claim here was read out of runtime/flan_rt.c and
runtime/flan_dyn.c rather than assumed:
- [(vec-new T)] does not allocate. The lowering passes a capacity of zero
(see the [flan_vec_init] call in the ["vec-new"] arm) and
[flan_vec_init]'s body returns before [flan_vec_grow] when [cap <= 0].
The block arrives at the first push. [(map-new K V)] is the same: its
[flan_map_init] leaves [data] NULL and says so on its own line.
[(vec-new dyn)] and [(map-new dyn)] are the *other* answer those are
the dyn runtime's own objects and [gc_alloc] runs at the call.
- A dyn immediate does not allocate: nil, a bool, an f64, a keyword, and
an int inside the payload. The payload is 48 bits
([DYN_PAYMASK]/[DYN_INT_MAX] in flan_dyn.c), so only an i64 that can
leave ±2^47 is a "may allocate", and a value widened from a narrower
integer type provably cannot.
- A keyword is interned and immortal [flan_dyn_kw]'s entry is not a GC
object and the collector never traces one so it is not named here.
- Dyn arithmetic is not named. [flan_dyn_add] and its siblings end in
[flan_dyn_from_i64], so a wide enough result spills, but nothing static
knows the operands and a squiggle on every [(+ a b)] over dyn is the
false positive this pass exists not to have. *)
(* The payload's range, restated from [DYN_INT_MAX]/[DYN_INT_MIN] in
runtime/flan_dyn.c: 2^47-1 and its negation less one. Restated rather than
read, the way every other number this compiler shares with the runtime is,
and wrong only in the direction of a missing warning if the runtime ever
widens it. *)
let dyn_payload_max = 140737488355327L
let dyn_payload_min = -140737488355328L
(* An integer type that cannot reach the payload's edge whatever its value. *)
let narrower_than_payload (t : Types.t) =
match t with
| Types.Int (Types.I8 | Types.I16 | Types.I32
| Types.U8 | Types.U16 | Types.U32) -> true
| _ -> false
(* Can this argument to [flan_dyn_from_i64] spill onto the heap?
One level of unwrapping and no more: [box] widens with a single
[Cast i64], and peeling further would walk through a *narrowing* cast the
programmer wrote and report a range the value cannot have. *)
let int_may_spill (e : Tast.expr) =
let e =
match e.Tast.e with
| Tast.Prim (Tast.Cast (Types.Int Types.I64), [ inner ])
when narrower_than_payload inner.Tast.ty -> inner
| _ -> e
in
match e.Tast.e with
| Tast.Int (n, _) -> n > dyn_payload_max || n < dyn_payload_min
| _ -> not (narrower_than_payload e.Tast.ty)
(* A [flan_vec_init] whose capacity is a literal zero takes no block. That is
every [(vec-new T)]; [slurp] passes the file's size and is the caller that
makes this a test rather than a constant. *)
let vec_init_allocates (args : Tast.expr list) =
match args with
| _ :: _ :: cap :: _ ->
(match cap.Tast.e with Tast.Int (n, _) -> n > 0L | _ -> true)
| _ -> true
(* The classifier. [Some (kind, message)] for a site that allocates or may,
[None] for everything else and [None] is the answer for every symbol not
named here, which is what keeps a new runtime entry point silent rather
than guessed at. *)
let memory_class (sym : string) (args : Tast.expr list) =
let gc m = Some ("memory/gc", m) and native m = Some ("memory/native", m) in
match sym with
(* ── The collected heap ── *)
| "flan_dyn_from_bytes" ->
gc "allocates: a string crossing into dyn is copied onto the \
collector's heap"
| "flan_dyn_vec_new" ->
gc "allocates: a dyn vector is an object on the collector's heap"
| "flan_dyn_map_new" ->
gc "allocates: a dyn map is an object on the collector's heap"
| "flan_dyn_view_vec" | "flan_dyn_view_flat" ->
gc "allocates: a typed container crossing into dyn takes a view record \
on the collector's heap the elements are not copied, the record is"
| "flan_dyn_from_i64" when (match args with [ x ] -> int_may_spill x | _ -> true) ->
gc "may allocate: an i64 outside ±2^47 does not fit a dyn's payload and \
spills onto the collector's heap"
(* ── An allocator the program named ── *)
| "flan_arena_new" ->
native "allocates: an arena takes its whole region from the host here"
| "flan_vec_init" when vec_init_allocates args ->
native "allocates: the Vec is sized up front and takes its block from \
its allocator here"
| "flan_vec_push" ->
native "may allocate: a push past the Vec's capacity grows it through \
its allocator"
| "flan_vec_reserve" ->
native "may allocate: a reserve past the Vec's capacity grows it through \
its allocator"
| "flan_map_put" ->
native "may allocate: a put past the map's load factor grows its block \
through its allocator"
| "flan_map_reserve" ->
native "may allocate: a reserve past the map's load factor grows its \
block through its allocator"
| "flan_vec_clone" ->
native "may allocate: cloning a non-empty Vec takes a new block from its \
allocator"
| "flan_map_clone" ->
native "may allocate: cloning a non-empty map takes a new block from its \
allocator"
| _ -> None
(** Every site in the program that allocates, or may. Ordered by source
position, one diagnostic per location and class a lowering emits several
runtime calls at one location and a reader wants the line named once.
[?file] narrows it to one source file, which is what a command that was
handed a path wants: the prelude pushes onto Vecs on a dozen lines and an
import has its own, and neither is a line the person who asked can do
anything about. Left out, everything the program holds is reported which
is what a client that does its own filtering, the editor among them,
should ask for. *)
let memory_sites ?file (p : Tast.program) : Loc.diag list =
let found = ref [] in
let seen = Hashtbl.create 64 in
let look (e : Tast.expr) =
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, args) ->
(match memory_class sym args with
| None -> ()
| Some (kind, msg) ->
let loc = e.Tast.loc in
let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
&& not (Hashtbl.mem seen key) then begin
Hashtbl.replace seen key ();
found := Loc.diag ~kind loc msg :: !found
end)
| _ -> ()
in
(* A global's initialiser runs at startup and allocates there as much as a
body does [(defvar names (vec-new dyn))] is a heap object before main
has a line of its own so the globals are walked and not only the
functions. *)
List.iter (fun (g : Tast.global) -> Tast.walk look g.Tast.ginit) p.Tast.globals;
List.iter
(fun (fn : Tast.fn) -> List.iter (Tast.walk look) fn.Tast.body)
p.Tast.fns;
let placed (d : Loc.diag) = d.Loc.dloc.Loc.line > 0 in
List.stable_sort
(fun a b ->
match (placed a, placed b) with
| true, false -> -1
| false, true -> 1
| _ -> Loc.before a.Loc.dloc b.Loc.dloc)
(List.rev !found)

View File

@ -3003,6 +3003,45 @@ let watch_read t ~reset =
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
(* [(:op "memory")] — which lines of this session's program allocate.
The static counterpart of [allocations] and [leaks] above, and the
distinction is worth stating because the three read as one family and are
not. Those two ask the *running* program what it took and what it still
holds; this one asks the compiler what the source says, needs no program on
the other end of the socket, and works on a session whose process has
parked or died. It is [Check.memory_sites] and nothing else the session
already holds the last program that checked, so there is no re-read of the
file and no second opinion about what the buffer contains.
Everything is returned, the prelude's lines included, and [:file] is
offered rather than applied: the editor knows which buffers it has open and
[flan.el] compares paths with [file-equal-p], which a string match here
could not. A client that wants one file's worth and does not want to filter
can still say so.
Each row is [(LOC KIND MESSAGE)]: the location in the same
[file:line:col] spelling every other reply uses, the diagnostic's kind
["memory/gc"] for the collector's heap, ["memory/native"] for an allocator
the program named and the sentence. The kind is the field a client paints
from; nothing should be reading the message for its class. *)
let memory_op t ~file =
let ds = Check.memory_sites ?file t.session.Session.program in
let row (d : Loc.diag) =
Wire.list
[ Wire.quote (Loc.to_string d.Loc.dloc);
Wire.quote d.Loc.kind;
Wire.quote d.Loc.dmsg ]
in
ok
[ ":sites " ^ Wire.list (List.map row ds);
Printf.sprintf ":count %d" (List.length ds);
":note "
^ Wire.quote
"every site the checker can prove allocates, and every one it can \
prove may; a dyn immediate nil, a bool, an f64, a keyword, an \
int inside the payload is not one and is not listed" ]
let handle t req =
match Wire.string_field req "op" with
| Some "eval" ->
@ -3188,6 +3227,7 @@ let handle t req =
"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 "memory" -> memory_op t ~file:(Wire.string_field req "file")
| Some "layout" ->
(match Wire.string_field req "type" with
| Some ty -> layout t ~ty

120
sand.flan
View File

@ -1,63 +1,29 @@
;;;; Falling sand — Flan port of the Odin/Janet/Lisp/jank versions in ~/Development/fnm.
;;;;
;;;; Kept at parity with lisp/sand.lisp, clojure/src/fnm/sand.clj and
;;;; src/fnm/sand.jank: the same constants, the same eight functions, and
;;;; nothing else. Anything a reference version does not have does not belong
;;;; here — this file is the acceptance program for the language, not a
;;;; showcase for raylib bindings.
;;;;
;;;; It is tested twice: headless (N frames, hash the grid — the version CI runs
;;;; on native and wasm32) and interactive at 120 fps. Both halves are one file
;;;; now. The link follows what the program reaches, so
;;;; test/programs/sand-headless.flan imports *this file* as a package, calls
;;;; the simulation directly, and pulls in neither a window nor libraylib. The
;;;; main below is not exported: an entry point is not something a package
;;;; offers.
;;;;
;;;; Note what it deliberately does not use: no Vec, no Map, no generics, no
;;;; macros of its own, no allocator other than the stack and static storage.
;;;; It does call rl/with-drawing, which is the raylib package's macro over
;;;; the BeginDrawing/EndDrawing pair — the parity rule is what the reference
;;;; versions do, and lisp/sand.lisp writes rl:with-drawing there.
;;;;
;;;; Notation reminders (see plan.org and spec-memory.md):
;;;; [n T] fixed array, length n, element T — a VALUE, copies
;;;; [T] slice, ptr+len, non-owning (Vec T) owning, move-only
;;;; (Ptr T) pointer (Handle T) generational handle
;;;; types are inline name/type pairs, as in `let` and `defstruct`
;;;; a return type of () means the function returns nothing
(import rl "vendor:raylib") ; directory = package; declaration optional
(import agent "vendor:agent") ; the dev agent: redefinitions, installed below
(import rl "vendor:raylib")
(import agent "vendor:agent")
(import edn "vendor:edn")
;;;; ── The simulation ───────────────────────────────────────────
;;;;
;;;; No raylib between here and the next banner, which is what the headless
;;;; driver imports this file for. The hash is over exactly this.
(defconst screen-width 900)
(defconst screen-height 600)
(defconst cell-size 5)
;; f32: velocity is [f32], and there is no implicit widening.
(defconst gravity f32 0.05)
(defconst rows (/ screen-height cell-size))
(defconst cols (/ screen-width cell-size))
(defconst brush-size 10)
;; Packed 0xRRGGBBAA. A cell of 0 means empty, so no Option and no tag word.
(defconst colors [4 u32] [0xFFF00FFF 0x3B6E8CFF 0xA83232FF 0xCC6B1FFF])
(defn dyn->f64 [v f64] f64 v)
(defn dyn->u32 [v i64] u32 (u32 v))
(defvar gravity dyn 0.05)
(defvar colors dyn
(let [v (vec-new dyn)]
(push v 0xFFF00FFF)
(push v 0x3B6E8CFF)
(push v 0xA83232FF)
(push v 0xCC6B1FFF)
v))
;; Flat, unboxed, statically sized. No headers, so these are exactly
;; rows*cols*4 bytes each — the same memory the Odin port has. Fixed arrays are
;; values, so `(set grid (zeroed))` overwrites in place rather than reallocating.
;; No initialiser means all-bytes-zero (plan.org, zero values), so these are
;; BSS and cost nothing to start. `(zeroed)` below is the explicit spelling for
;; re-zeroing later — a memset, not an allocation.
(defvar grid [rows [cols u32]])
(defvar velocity [rows [cols f32]])
;; An index into colors, not a colour.
(defvar current-color i32)
(defvar current-color dyn 0)
(defn clear-grid [] ()
(set grid (zeroed))
@ -66,9 +32,6 @@
(defn next-color [] ()
(set current-color (% (+ current-color 1) (len colors))))
;; Drop a brush-sized cloud of grains centred on [row col]. This is what the
;; mouse drives interactively and what the headless run calls directly — the
;; only difference between the two is where the centre comes from.
(defn paint-at [row i32 col i32] ()
(let [half (/ brush-size 2)]
(dotimes [x brush-size]
@ -79,18 +42,11 @@
(>= c 0) (< c (- cols 1))
(= 0 (at grid r c))
(< (rand-f32) 0.5))
(set (at grid r c) (at colors current-color))
(set (at grid r c) (dyn->u32 (at colors current-color)))
(set (at velocity r c) 1.0)))))))
;; Move the grain at [row col] as far down as it can, sliding to a free
;; diagonal neighbour when the cell below is taken.
;;
;; Imperative `while` with early `return`, not loop/recur — see plan.org
;; "Loop story". The recur version read as a tail call but was a countdown
;; over a mutable scan position, which is what a while loop is.
(defn settle [row i32 col i32] ()
(let [vel (+ gravity (at velocity row col))
(let [vel (+ (f32 (dyn->f64 gravity)) (at velocity row col))
y (min (- rows 1) (+ row (i32 vel)))]
(while (> y row)
(when (= 0 (at grid y col))
@ -112,10 +68,8 @@
(set (at velocity row col) 0.0)
(return))))
(set y (- y 1)))
;; Nowhere to fall: reset the accumulated velocity and stay put.
(set (at velocity row col) 0.0)))
;; One frame of physics. Bottom-up, so a grain settles at most once per frame.
(defn step [] ()
(let [row (- rows 2)]
(while (>= row 0)
@ -124,11 +78,6 @@
(settle row col)))
(set row (- row 1)))))
;; FNV-1a over the grid, so the headless run has one number to compare. It has
;; to be identical on native and wasm32, which is the whole reason rand-f32 is
;; a seeded PRNG written in Flan rather than libc's (plan.org, RNG is ours).
;; Named because a let binding takes no type annotation, and 0xcbf29ce484222325
;; does not fit the i32 an unannotated integer literal would default to.
(defconst fnv-offset u64 0xcbf29ce484222325)
(defconst fnv-prime u64 1099511628211)
@ -142,21 +91,6 @@
(set h (* h fnv-prime))))))
h))
;;;; ── The raylib front-end ──────────────────────────────────
;;;;
;;;; Everything from here on needs a window, and nothing headless reaches any
;;;; of it — which is why importing this file costs a headless build nothing.
;; Every cross-function call in a dev build routes through an indirection cell,
;; so redefining this from the REPL reaches the running loop on the next frame.
;; No `varfn` (Janet), no `let update = ref` (OCaml), no var-routing (jank).
;; Release builds compile the same source to direct calls.
;;
;; A cell holds an (Fn ...) — a plain function pointer, no captured environment;
;; this one is (Fn [] ()), `settle`'s is (Fn [i32 i32] ()). Redefining
;; `settle` while `game-update` is mid-frame is safe because old code is never
;; unloaded; changing its SIGNATURE is not, and the reload rejects it. See
;; plan.org "What redefinition cannot do".
(defn game-update [] ()
(when (rl/key-pressed? :r) (clear-grid))
(when (rl/mouse-button-down? :left)
@ -166,8 +100,6 @@
(when (rl/mouse-button-released? :left) (next-color))
(step))
;; (defconst the-data (Vec u8) (slurp "game-data.edn"))
(defn game-draw [] ()
(rl/clear-background rl/black)
(dotimes [row rows]
@ -180,28 +112,18 @@
(rl/get-color c))))))
(rl/draw-fps 20 20))
(defvar frame Allocator (arena-new 262144))
(defvar game-data dyn
(handler-case (edn/read-file "game-data.edn")
[(FileError [c] nil)]))
(defn main [] ()
(rl/set-trace-log-level :warning)
(rl/init-window screen-width screen-height "SAND")
(defer (rl/close-window))
(rl/set-target-fps 120)
;; The dev agent listens on a socket for redefinitions and hands them over;
;; (agent/poll) below is where they are installed. Building without --dev is
;; fine — nothing has cells to install into, so a module is refused on the
;; listener thread and the loop never notices.
(agent/start "/tmp/flan-sand.sock")
;; Bare (defn main []) — argv and the i32 status are both optional.
;; Nothing in this loop allocates, so context/temp is never even touched.
(until (rl/window-should-close?)
;; The frame boundary, and the only place a redefinition becomes visible.
;; An error while installing/evaluating a dev form, or during the update,
;; leaves one CL-style escape hatch: choose `continue' in the editor to
;; abandon this frame and return to the next one with the game still live.
;; Keep drawing outside it. Skipping between BeginDrawing and EndDrawing
;; would leave raylib's frame unbalanced, and rl/with-drawing does not
;; change that — it guarantees the two calls stay together and stay
;; matched, not that a transfer out of the body reaches the second one.
;; The restart being out here is still what makes `continue' safe.
(restart-case
(do (agent/poll)
(game-update))

View File

@ -4607,6 +4607,64 @@ let () =
else begin
let c = connect dsock in
let said r = Option.value ~default:(status r) (Wire.string_field r "message") in
(* [(:op "memory")] — which lines of the program allocate, asked of
the daemon rather than of the running program. It is
[Check.memory_sites] over the session's last checked program, so
it needs no process on the far end and says the same thing here
as [flan check --warn-memory] says on the command line.
This fixture is the one that earns the check: its [(set config
{:s "kept" :n 1})] is two crossings into the collected heap on
one line the map and the string inside it at columns the
squiggle has to get right, and it has no native allocation
anywhere, which is the half a classifier that answered "gc" for
everything would also pass. Rows from the prelude ride along and
are ignored here; [flan.el] filters by the buffers it has open. *)
let mem_rows () =
let r = request c "(:op \"memory\")" in
if status r <> "ok" then begin
fail "--%s: memory: %s" backend (said r); []
end
else
match Wire.field r "sites" with
| Some { Form.v = Form.List rows; _ } ->
List.filter_map
(fun (row : Form.t) ->
match row.Form.v with
| Form.List
[ { Form.v = Form.Str loc; _ };
{ Form.v = Form.Str kind; _ };
{ Form.v = Form.Str msg; _ } ] ->
Some (loc, kind, msg)
| _ -> None)
rows
| _ -> fail "--%s: memory answered no :sites" backend; []
in
let rows = mem_rows () in
let ours =
List.filter
(fun (loc, _, _) ->
contains_sub loc "programs/dev-dyn-global.flan")
rows
in
let has loc kind needle =
List.exists
(fun (l, k, m) ->
contains_sub l loc && k = kind && contains_sub m needle)
ours
in
if not (has ":23:15" "memory/gc" "a dyn map is an object") then
fail "--%s: memory did not name the map literal at 23:15: %s"
backend
(String.concat "; "
(List.map (fun (l, k, _) -> l ^ " " ^ k) ours));
if not (has ":23:19" "memory/gc" "a string crossing into dyn") then
fail "--%s: memory did not name the string at 23:19" backend;
if List.exists (fun (_, k, _) -> k = "memory/native") ours then
fail
"--%s: memory called a line of dev-dyn-global.flan a native \
allocation, and the file has none"
backend;
let parked () =
match Wire.field (request c "(:op \"describe\")") "parked" with
| Some { Form.v = Form.Sym "t"; _ } -> true

View File

@ -3564,6 +3564,120 @@ let () =
end)
Check.builtins;
(* ── Memory diagnostics, --warn-memory ──────────────────────────
[Check.memory_sites] over a checked program: which lines allocate, on
which heap, and the half that is harder to keep true which lines do
not.
Pinned exactly, location and message both, and the location matters as
much as the wording: the whole feature is a squiggle under a character,
and a pass that found the right number of sites at the wrong columns
would draw them under the wrong forms. The file is fixed to [<test>] so
the prelude's own pushes, which are real and are not the caller's
business, stay out of the comparison. *)
let memory name src want =
let got =
List.map
(fun (d : Loc.diag) ->
(d.Loc.dloc.Loc.line, d.Loc.dloc.Loc.col, d.Loc.kind, d.Loc.dmsg))
(Check.memory_sites ~file:"<test>" (checked src))
in
let show (l, c, k, m) = Printf.sprintf "\n %d:%d %s %S" l c k m in
if got <> want then begin
incr failures;
Printf.printf "FAIL %s\n wanted:%s\n got:%s\n" name
(String.concat "" (List.map show want))
(String.concat "" (List.map show got))
end
in
let gc = "memory/gc" and native = "memory/native" in
(* The collected heap. Every row here is a [gc_alloc] in flan_dyn.c on the
way through, and the negatives between them are the point: a typed
[vec-new] takes no block, and neither does an immediate. *)
memory "the collected heap, and what does not touch it"
"(defvar wide i64 999999999999999)\n\
(defvar small i32 7)\n\
(defn take [x] () (print x))\n\
(defn main [] ()\n\
\ (let [tv (vec-new i32)\n\
\ dv (vec-new dyn)\n\
\ m {:a 1}]\n\
\ (take \"hi\")\n\
\ (take 5)\n\
\ (take true)\n\
\ (take nil)\n\
\ (take :kw)\n\
\ (take 1.5)\n\
\ (take small)\n\
\ (take wide)\n\
\ (push tv 1)\n\
\ (push dv 2)))"
[ (6, 12, gc, "allocates: a dyn vector is an object on the collector's heap");
(7, 11, gc, "allocates: a dyn map is an object on the collector's heap");
(8, 11, gc,
"allocates: a string crossing into dyn is copied onto the collector's \
heap");
(* The only integer here that can leave the 48-bit payload. [small] is an
i32 widened to i64 at the crossing and provably cannot, [5] is a
literal inside the range, and neither is named. *)
(15, 11, gc,
"may allocate: an i64 outside ±2^47 does not fit a dyn's payload and \
spills onto the collector's heap");
(* The typed push, which is the native side; [(push dv 2)] on the line
below it is the dyn runtime's own vector growing itself and is not a
site the program can do anything about. *)
(16, 5, native,
"may allocate: a push past the Vec's capacity grows it through its \
allocator") ];
(* The allocator side, and the two shapes of [flan_vec_init]: [slurp] sizes
the Vec to the file and takes a block here, [(vec-new i32 a)] passes a
capacity of zero and takes none. Same runtime entry point, two answers,
which is why the classifier reads the capacity argument rather than the
symbol alone. *)
memory "an allocator the program named"
"(defvar gv (Vec i64) (vec-new i64))\n\
(defn take [x] () (print x))\n\
(defn arith [a b] () (take (+ a b)))\n\
(defn main [] ()\n\
\ (let [a (arena-new 4096)\n\
\ tm (map-new string i32 a)\n\
\ tv (vec-new i32 a)\n\
\ txt (slurp \"x\" a)]\n\
\ (take gv)\n\
\ (put tm \"k\" 1)\n\
\ (reserve tv 4)\n\
\ (arith 1 2)\n\
\ (print (len txt))))"
[ (5, 11, native,
"allocates: an arena takes its whole region from the host here");
(8, 13, native,
"allocates: the Vec is sized up front and takes its block from its \
allocator here");
(* A (Vec i64) crossing into dyn is a view, and the view record is a
heap object even though not one element is copied. *)
(9, 11, gc,
"allocates: a typed container crossing into dyn takes a view record on \
the collector's heap the elements are not copied, the record is");
(10, 5, native,
"may allocate: a put past the map's load factor grows its block through \
its allocator");
(11, 5, native,
"may allocate: a reserve past the Vec's capacity grows it through its \
allocator") ];
(* Two negatives on their own, because they are the ones a careless
classifier gets wrong and a test that only counted rows would not catch.
[(+ a b)] over two dyns ends in [flan_dyn_from_i64] and can spill but
nothing static knows the operands, and a squiggle under every dyn
addition is the false positive this pass exists not to have. *)
memory "dyn arithmetic stays immediate, and an empty program is silent"
"(defn take [x] () (print x))\n\
(defn add2 [a b] () (take (+ a b)))\n\
(defn main [] () (add2 1 2))"
[];
(* ── The acceptance program checks end to end ──────────────────── *)
accepts "calc-me.flan type checks"
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);