Ask which lines allocate, and believe the runtime over the enumeration
[Check.memory_sites] is the pass [Check.no_gc]'s shape: it runs over the finished program, answers a diagnostic list, and tells nothing downstream that it ran. Two classes on the diagnostic's kind — the collector's heap and an allocator the program named — so the CLI, the daemon and the editor dispatch on one field and none of them reads a message to find the class. [--warn-memory] on check and build prints them where errors go, in the shape flycheck parses, without moving the exit status. [(:op "memory")] answers the same list over a session's last checked program, needing no program on the far end. [M-x flan-check-memory] paints it two faces fainter than an error's, cleared by an edit or by asking again. Two of the spec's own examples turned out not to allocate, and the precision rule outranks the enumeration: (vec-new T) passes a capacity of literal zero to flan_vec_init, which returns before the grow, and flan_map_init takes no block at all and says so in its own comment. The block arrives at the first push, which is the line that is marked. The classifier reads the capacity argument rather than the symbol, which is what lets slurp be marked through the same entry point vec-new is silent through. FIX.org has the rest of the evidence.
This commit is contained in:
Joseph Ferano
parent
7db5ec1885
commit
5b0062219e
88
FIX.org
88
FIX.org
@ -806,3 +806,91 @@ script already has SURVEY_FLAGS, which hands the same extra flags to both
|
|||||||
sides, and both sides do accept -O0 — and something that walks the two prim
|
sides, and both sides do accept -O0 — and something that walks the two prim
|
||||||
match arms mechanically rather than relying on somebody reading them side by
|
match arms mechanically rather than relying on somebody reading them side by
|
||||||
side, which is how this gap survived. Neither is queued.
|
side, which is how this gap survived. Neither is 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.
|
||||||
|
|||||||
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. *)
|
the flag, and that is the property the flag is worth having for. *)
|
||||||
let no_gc_flag = "--no-gc"
|
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 =
|
let flags =
|
||||||
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
|
[ 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
|
(* 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
|
have taken. One function because there is one rule, and the only thing that
|
||||||
@ -299,11 +325,19 @@ let () =
|
|||||||
|> Flan.Parse.program_all
|
|> Flan.Parse.program_all
|
||||||
|> List.iter (fun d -> print_endline (summarise d))))
|
|> List.iter (fun d -> print_endline (summarise d))))
|
||||||
files
|
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
|
List.iter
|
||||||
(fun path ->
|
(fun path ->
|
||||||
with_errors path (fun () ->
|
with_errors path (fun () ->
|
||||||
let p = checked path in
|
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
|
List.iter
|
||||||
(fun (g : Flan.Tast.global) ->
|
(fun (g : Flan.Tast.global) ->
|
||||||
Printf.printf "%s %s %s\n"
|
Printf.printf "%s %s %s\n"
|
||||||
@ -666,7 +700,8 @@ let () =
|
|||||||
prerr_endline
|
prerr_endline
|
||||||
"usage: flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
|
"usage: flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
|
||||||
[--no-bounds-checks] \
|
[--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
|
exit 2
|
||||||
in
|
in
|
||||||
with_errors path (fun () ->
|
with_errors path (fun () ->
|
||||||
@ -677,6 +712,9 @@ let () =
|
|||||||
what [main] happened to reach would come and go as the program was
|
what [main] happened to reach would come and go as the program was
|
||||||
edited elsewhere. *)
|
edited elsewhere. *)
|
||||||
if List.mem no_gc_flag rest then Flan.Check.no_gc p;
|
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
|
(* The link follows the program, not the import list: a package nothing
|
||||||
reachable calls into contributes no C and no linker argument, and its
|
reachable calls into contributes no C and no linker argument, and its
|
||||||
functions are not emitted either. That is what lets one file import
|
functions are not emitted either. That is what lets one file import
|
||||||
@ -877,12 +915,12 @@ let () =
|
|||||||
exit code)
|
exit code)
|
||||||
| _ ->
|
| _ ->
|
||||||
prerr_endline
|
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 import-c <header.h> [package.flan...] [clang flags...]\n\
|
||||||
\ flan generate-c <package-dir>\n\
|
\ flan generate-c <package-dir>\n\
|
||||||
\ flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
|
\ flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
|
||||||
[--no-bounds-checks] [--dev] \
|
[--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 run <file.flan> [build flags...] [--] [program args...]\n\
|
||||||
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
|
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
|
||||||
\ flan dev <program.flan> [-s socket] [--x86]";
|
\ flan dev <program.flan> [-s socket] [--x86]";
|
||||||
|
|||||||
@ -546,6 +546,60 @@ 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.
|
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. Both are fainter than an error — a dotted or
|
||||||
|
dimmed underline, no message drawn beside the line — because the code is not
|
||||||
|
wrong. 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
|
### The watch buffer — values while the program runs
|
||||||
|
|
||||||
Everything above is for a program you have stopped, or one you interrupt with a
|
Everything above is for a program you have stopped, or one you interrupt with a
|
||||||
@ -935,8 +989,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`,
|
(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-watch-ghost-mode` (the same values inline),
|
||||||
`M-x flan-inspect-address` (what is at an address), `M-x flan-macroexpand-all`
|
`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` /
|
(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).
|
`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).
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
|
|||||||
135
emacs/flan.el
135
emacs/flan.el
@ -2712,5 +2712,140 @@ can print the same breakdown to stderr under FLAN_DEV_LEAKS."
|
|||||||
(interactive)
|
(interactive)
|
||||||
(flan-allocations--show "leaks" "Still held, by type"))
|
(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: a dotted underline rather than an error's wave, a dimmed
|
||||||
|
;; colour, and no per-site `after-string' — the message goes in `help-echo' and
|
||||||
|
;; the count in the echo area. 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 font-lock-warning-face :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--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--memory-overlays)
|
||||||
|
(progn (flan-clear-memory) (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))
|
||||||
|
(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)
|
(provide 'flan)
|
||||||
;;; flan.el ends here
|
;;; flan.el ends here
|
||||||
|
|||||||
171
lib/check.ml
171
lib/check.ml
@ -8437,3 +8437,174 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
|
|||||||
|
|
||||||
let no_gc (p : Tast.program) =
|
let no_gc (p : Tast.program) =
|
||||||
match dyn_sites p with [] -> () | ds -> raise (Loc.Errors ds)
|
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
@ -2994,6 +2994,45 @@ let watch_read t ~reset =
|
|||||||
| exception Unix.Unix_error (e, _, _) ->
|
| exception Unix.Unix_error (e, _, _) ->
|
||||||
error ("cannot reach the program: " ^ Unix.error_message 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 =
|
let handle t req =
|
||||||
match Wire.string_field req "op" with
|
match Wire.string_field req "op" with
|
||||||
| Some "eval" ->
|
| Some "eval" ->
|
||||||
@ -3179,6 +3218,7 @@ let handle t req =
|
|||||||
"what the registry still holds live at the moment it was asked; a \
|
"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 \
|
program that is killed runs no exit handler, so this verb and not a \
|
||||||
hook is what answers for one"
|
hook is what answers for one"
|
||||||
|
| Some "memory" -> memory_op t ~file:(Wire.string_field req "file")
|
||||||
| Some "layout" ->
|
| Some "layout" ->
|
||||||
(match Wire.string_field req "type" with
|
(match Wire.string_field req "type" with
|
||||||
| Some ty -> layout t ~ty
|
| Some ty -> layout t ~ty
|
||||||
|
|||||||
@ -4690,6 +4690,64 @@ let () =
|
|||||||
else begin
|
else begin
|
||||||
let c = connect dsock in
|
let c = connect dsock in
|
||||||
let said r = Option.value ~default:(status r) (Wire.string_field r "message") 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 () =
|
let parked () =
|
||||||
match Wire.field (request c "(:op \"describe\")") "parked" with
|
match Wire.field (request c "(:op \"describe\")") "parked" with
|
||||||
| Some { Form.v = Form.Sym "t"; _ } -> true
|
| Some { Form.v = Form.Sym "t"; _ } -> true
|
||||||
|
|||||||
@ -3575,6 +3575,120 @@ let () =
|
|||||||
end)
|
end)
|
||||||
Check.builtins;
|
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 ──────────────────── *)
|
(* ── The acceptance program checks end to end ──────────────────── *)
|
||||||
accepts "calc-me.flan type checks"
|
accepts "calc-me.flan type checks"
|
||||||
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
|
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user