Memory diagnostics on demand: gc and native allocation sites, faintly
# Conflicts: # FIX.org
This commit is contained in:
commit
f030c5f7f1
88
FIX.org
88
FIX.org
@ -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
75
HANDOFF.md
Normal 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 3–8,
|
||||
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.
|
||||
48
bin/main.ml
48
bin/main.ml
@ -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]";
|
||||
|
||||
@ -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).
|
||||
|
||||
---
|
||||
|
||||
|
||||
151
emacs/flan.el
151
emacs/flan.el
@ -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
|
||||
|
||||
171
lib/check.ml
171
lib/check.ml
@ -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)
|
||||
|
||||
40
lib/dev.ml
40
lib/dev.ml
@ -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
120
sand.flan
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user