From 042ddd73d98bcfcf057b0ed974621738a2b97151 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Mon, 14 Sep 2026 11:25:05 +0700 Subject: [PATCH] One buffer for four lowerings, and it remembers which one you were reading --- docs/handoffs/HANDOFF-lowering-buffer.md | 201 +++++++- emacs/MANUAL.md | 80 +++ emacs/flan-lower.el | 610 +++++++++++++++++++++++ emacs/flan-mode.el | 10 + emacs/test-flan-dev.el | 179 +++++++ 5 files changed, 1068 insertions(+), 12 deletions(-) create mode 100644 emacs/flan-lower.el diff --git a/docs/handoffs/HANDOFF-lowering-buffer.md b/docs/handoffs/HANDOFF-lowering-buffer.md index d633f6f..bf3b910 100644 --- a/docs/handoffs/HANDOFF-lowering-buffer.md +++ b/docs/handoffs/HANDOFF-lowering-buffer.md @@ -41,11 +41,14 @@ heading, `outline-hide-body` and `outline-show-all` collapse and expand everythi `outline-next-visible-heading` / `outline-previous-visible-heading` are `n` and `p`. Hand-rolling it would be a hundred lines re-implementing that badly. -Headings are found by `outline-search-function` keyed to a text property this file puts on the four heading -lines, **not** by a regexp over the text. That is not fussiness: LLVM IR has `;` comments, assembler output -has `#` and `;` comments and lines that start with `.`, and `objdump` prints `:` label lines. Any -regexp loose enough to match four section headers matches inside three of the four bodies, and folding then -fragments in the middle of a listing. +`outline-regexp` is `"[▸▾] "` — the fold arrow that starts each heading, and nothing else. That is not +decoration standing in for structure, it is the one anchor available: LLVM IR has `;` comments, assembler +output has `#` and `;` comments and lines that start with `.`, and `objdump` prints `:` label +lines, so a regexp loose enough to match four section headers written in ordinary characters also matches +inside three of the four bodies, and folding then fragments in the middle of a listing. Neither arrow can +begin a line of any of the three. `outline-search-function` would have done the same job keyed to a text +property, at the cost of a four-argument protocol to get exactly right; the arrow is simpler and it is also +the affordance, so it earns its place twice. ### 3. The open/closed state is a global alist keyed by section, and nothing else @@ -63,11 +66,185 @@ applies it to the newly drawn buffer. Visibility is never read back out — that outline folds with overlays or with text properties, which is a thing that has changed between Emacs versions and is none of this file's business. -## Status +## What was built -- [x] Handoff stub, decisions fixed -- [ ] `emacs/flan-lower.el` -- [ ] Key in `flan-mode`, autoloads -- [ ] Tests in `emacs/test-flan-dev.el` -- [ ] `emacs/MANUAL.md` -- [ ] `dune test`, `@page`, `@cells` +| file | what | +|---|---| +| `emacs/flan-lower.el` | the whole feature: the four fetches, the narrowing, the renderer, the folding and the memory of it | +| `emacs/flan-mode.el` | `C-c C-l` and the autoload | +| `emacs/test-flan-dev.el` | 26 checks, after the disassembly section | +| `emacs/MANUAL.md` | its own section, plus rows in both key tables, the settings table and the file table | + +## The keymap + +| Key | Command | Does | +|---|---|---| +| `TAB`, `RET`, `mouse-1` | `flan-lower-toggle` | open or close the section point is in | +| `S-TAB` | `flan-lower-cycle-all` | close everything, or open everything if it is all shut | +| `c` | `flan-lower-collapse-all` | close every section | +| `e` | `flan-lower-expand-all` | open every section | +| `n` / `p` | `outline-next-visible-heading` / `outline-previous-visible-heading` | between headings | +| `g` | `flan-lower-refresh` | compile again, redraw all four | +| `r` | `flan-lower-refresh-section` | compile and redraw only this one | +| `q` | `quit-window` | | + +`n` and `p` are outline's own commands bound straight into the map, which is +the same thing they mean in `flan-inspect-mode` and `flan-cnr-mode`: move +between the buffer's own units. `special-mode` binds the digits and `-` to +`digit-argument` and `negative-argument`, so the collapse and expand keys are +letters rather than the `+`/`-` pair they would otherwise have been. + +`r` exists because the four are not the same price. The IR is the frontend +alone; `llc -O2` over a whole program's worth of it is the one that is felt. +The intermediates live in a scratch directory per buffer, so refreshing one +section reuses the IR the other three were made from. Refreshing the IR drops +every intermediate, because everything is downstream of it and the next `r` on +another section must not answer out of a file the old IR produced. The +directory goes with the buffer, on `kill-buffer-hook`, and there is a check +for that -- four intermediates per invocation left in `/tmp` would add up. + +## Two things worth knowing + +**The narrowing is `dump.sh`'s awk, ported.** The IR runs from `define +...@"flan.NAME"(` to `}`; the two assembler sections from the `flan.NAME:` +label to the `.size` that ends it; the disassembly from `:` to the +blank line after it. All four keep their last line, which is what makes a +closing brace part of the listing rather than the start of the next one. The +name is the Flan one -- `step`, not `flan.step` -- and a packaged function is +written the way the program names it, `sim/settle`, which is why every pattern +allows for LLVM's quoting. + +**A section's failure is that section's text, not the buffer's.** `llc` can be +missing while the IR is perfectly readable, and a buffer that refused +altogether would be the wrong answer to that. Each fetch is wrapped, and the +error message -- which is the tool's own stderr -- becomes the body. + +## Testing + +26 checks in `emacs/test-flan-dev.el`, immediately after the disassembly +section and needing no daemon, which is itself the distinction between the two +commands. + +Twenty-one of them drive the renderer with `flan-lower-fetch-function` rebound +to canned text. That is deliberate: folding, and the memory of what was +folded, are renderer properties, and putting four compilers and an `llc -O2` +behind every redraw would have cost seconds per redraw and proved nothing +about folding. The real fetch is exercised once at the end, guarded on `llc`, +`as` and `objdump`, and that one costs about 2.2s. + +`buffer-string` is useless for any of it, because it returns hidden text too: +"all four are still named when everything is shut" would pass without anything +being shut. Every visibility check is `invisible-p`, which means what it says +whether outline folded with an overlay or with a text property. + +- `dune test --root .` exit 0, every suite green, `emacs: all tests passed`. +- `dune build --root . @page` and `@cells` both exit 0. + +## Transcript + +`emacs -Q --batch -L emacs -l try.el -- _build/default/bin/main.exe +test/programs/dev-repl.flan`, printing the buffer *as displayed* — invisible +characters dropped, so a folded section really is absent rather than merely +unprinted. + +Opened on `step`, with the remembered default (the IR open): + +``` +== M-x flan-lowering step == +; every lowering of step +; file ~/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/test/programs/dev-repl.flan +; compiler /home/joe/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/_build/default/bin/main.exe +; flags none +; showing what this file compiles to, not what a running program is +; calling for this name -- for that, C-c C-a + +▾ LLVM IR 8 lines +define i64 @"flan.step"(ptr %xfer) { +entry: + %t1 = load i64, ptr @"flan.ticks" + %t2 = add i64 %t1, 1 + store i64 %t2, ptr @"flan.ticks" + %t3 = load i64, ptr @"flan.ticks" + ret i64 %t3 +} + +▸ LLVM -O0 13 lines +▸ LLVM -O2 10 lines +▸ x86 backend 18 lines +``` + +`TAB` on the x86 heading, then `TAB` on the IR heading — the state the author +described, his own backend open and the other three shut: + +``` +== TAB on the x86 heading, TAB on the IR heading == +; every lowering of step +; file ~/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/test/programs/dev-repl.flan +; compiler /home/joe/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/_build/default/bin/main.exe +; flags none +; showing what this file compiles to, not what a running program is +; calling for this name -- for that, C-c C-a + +▸ LLVM IR 8 lines +▸ LLVM -O0 13 lines +▸ LLVM -O2 10 lines +▾ x86 backend 18 lines +0000000000012d94 : + 12d94: push %rbp + 12d95: mov %rsp,%rbp + ... +``` + +The command run again on a *different* function. The preference is the +section's, so the backend is still the open one: + +``` +== M-x flan-lowering main -- a different function, same preference == +; every lowering of main +; file ~/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/test/programs/dev-repl.flan +; compiler /home/joe/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/_build/default/bin/main.exe +; flags none +; showing what this file compiles to, not what a running program is +; calling for this name -- for that, C-c C-a + +▸ LLVM IR 48 lines +▸ LLVM -O0 63 lines +▸ LLVM -O2 58 lines +▾ x86 backend 69 lines +0000000000012df4 : + 12df4: push %rbp +``` + +`c`, then `e`, then `n`/`p`. Collapsed, all four are still named with their +line counts, which is the buffer as a summary: + +``` +== c, collapse all == +; every lowering of main +; file ~/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/test/programs/dev-repl.flan +; compiler /home/joe/Development/flan/.claude/worktrees/agent-a9d4028fa5752ba39/_build/default/bin/main.exe +; flags none +; showing what this file compiles to, not what a running program is +; calling for this name -- for that, C-c C-a + +▸ LLVM IR 48 lines +▸ LLVM -O0 63 lines +▸ LLVM -O2 58 lines +▸ x86 backend 69 lines +== e, expand all, then n/p between headings == +== e, expand all, then n/p between headings == +n -> ▾ LLVM IR 48 lines +n n -> ▾ LLVM -O2 58 lines +p -> ▾ LLVM -O0 63 lines + +``` + +## What is not here + +- `C-c C-l` is not in `web/index.html`, so `web/examples/quotes.sh` does not + quote it. Its list of bindings is fixed and the page is a separate artefact; + adding a row there is a page change, not this one. +- A `desktop` or `savehist` story for the fold state, deliberately: it lives + for the Emacs session and no longer. +- The batch run leaves its scratch directory behind, because `emacs -batch` + exiting runs no `kill-buffer-hook`. Interactively the hook fires. diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 3a43981..a33c335 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -589,6 +589,7 @@ mode's, so they work in a file you have only opened. | `C-c C-d` | what the running program currently defines | | `C-c C-v` | help on the name at point | | `C-c C-a` | disassemble a function; `C-u` first for its LLVM IR | +| `C-c C-l` | every lowering of a function: IR, `-O0`, `-O2`, x86 backend | | `C-c C-m` | what the macro call at point expands to; `C-u` for all the way | Completion, eldoc and `M-.` all read one cached answer rather than asking the @@ -597,6 +598,79 @@ changed: when you connect, and after an evaluation the daemon accepted. --- +## Every lowering of one function — `C-c C-l` + +`C-c C-l` on a name opens `*flan-lowering*`: the LLVM IR the frontend emits for +that function, what `llc` makes of it at `-O0` and at `-O2`, and what the +hand-written x86 backend emits, all narrowed to the one function. It is +`spike/x86/dump.sh` with a buffer around it. Reading one against another is the +only way to check a lowering by eye, and the reason the second backend is +trustworthy is that the two agree. + +The four are folding sections, so the buffer is a four-line summary when +everything is shut: + +``` +; every lowering of step +; file ~/src/game.flan +; compiler /home/joe/src/flan/_build/default/bin/main.exe +; flags none +; showing what this file compiles to, not what a running program is +; calling for this name -- for that, C-c C-a + +▸ LLVM IR 8 lines +▸ LLVM -O0 13 lines +▸ LLVM -O2 10 lines +▾ x86 backend 19 lines +0000000000012d94 : + 12d94: push %rbp + ... +``` + +Which sections are open is remembered for the rest of the Emacs session, and it +is remembered **by section, not by function**: if you are working on the backend +this week, `C-c C-l` on a different name leaves the backend open and the other +three shut. It is not written to disk — four booleans are not worth a +preference file. + +| Key | Does | +|---|---| +| `TAB` | open or close the section point is in | +| `S-TAB` | close everything, or open everything if it is all shut | +| `c` | close every section | +| `e` | open every section | +| `n` / `p` | to the next or previous section heading | +| `g` | compile the file again and redraw all four | +| `r` | compile and redraw only the section point is in | +| `q` | bury the buffer | + +`r` is worth the separate key because the four are not the same price: the IR +is the frontend alone, and `llc -O2` over a whole program's worth of it is the +one that is felt. Refreshing one section reuses the IR the other three were +made from. Refreshing the IR drops everything, since everything is downstream +of it. + +This is **not** `C-c C-a`, and no prefix argument turns one into the other. +`C-c C-a` asks the *running program* what the body it is calling for a name +actually came out as; only the daemon can answer that, because the daemon +compiled that module and still has both its `.ll` and its `.so`. `C-c C-l` asks +what the *file on disk* compiles to, by compiling it, and needs no program +running at all. The two cannot be merged: neither `llc -O2` nor the x86 backend +has ever been run over an installed body, so there is no four-way answer in the +daemon to give. The `showing` line in each buffer's header says which of the two +you are reading. + +`C-u C-c C-l` asks for the file as well as the name, for the case where the +function you want to read is not in the buffer you are in. + +The four outputs need `llc`, `as` and `objdump` on `PATH` — the backend writes +machine code rather than mnemonics, so its section is assembled and +disassembled to be readable, which is also a check that the bytes are well +formed. A section whose tool is missing says so in place of its listing; the +other three are unaffected. + +--- + ## When something is wrong **An error draws an overlay** where it happened, with the message. It clears the @@ -638,6 +712,7 @@ Use `C-c C-g` if you need frames. | `C-c C-m` | what the macro call at point expands to | | `C-u C-c C-m` | ...all the way, rather than one step | | `C-c C-a` | disassemble; `C-u` first for LLVM IR | +| `C-c C-l` | every lowering of a function, in folding sections | | `C-c C-g` | debug under lldb, through dape | | `C-c C-d` | what the running program defines | | `C-c C-v` | help on the name at point | @@ -665,6 +740,10 @@ Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit` | `flan-dev-poll-interval` | `1.0` | seconds between checks for whether it stopped | | `flan-dev-daemon-buffer` | `"*flan-dev*"` | the daemon's own log | | `flan-dev-start-timeout` | `60` | seconds to wait for a program to come up | +| `flan-lower-buffer` | `"*flan-lowering*"` | where `C-c C-l` writes | +| `flan-lower-program` | `"flan"` | the compiler `C-c C-l` shells out to | +| `flan-lower-flags` | `nil` | flags for `flan emit` — `("--dev")` for the dev lowerings | +| `flan-lower-llc` | `"llc"` | what the `-O0` and `-O2` sections are made with | | `flan-watch-buffer` | `"*flan-watch*"` | where watched values are painted | | `flan-watch-interval` | `0.2` | seconds between repaints — not the watch rate | | `flan-watch-ghost-call-regexp` | `"watch\(?:-[[:alnum:]]+\)?"` | the head of a call ghost text anchors on | @@ -681,6 +760,7 @@ Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit` | `flan-watch.el` | watched values: the program pushes, this paints them in a buffer and inline | | `flan-cnr.el` | the conditions-and-restarts buffer | | `flan-inspect.el` | the value inspector | +| `flan-lower.el` | the lowering buffer: four outputs, folding, and which was open | | `flan-dape.el` | lldb through dape; optional | There is no Flan parser in any of them. The client sends text and the compiler diff --git a/emacs/flan-lower.el b/emacs/flan-lower.el new file mode 100644 index 0000000..38bcbde --- /dev/null +++ b/emacs/flan-lower.el @@ -0,0 +1,610 @@ +;;; flan-lower.el --- Every lowering of one function, in one buffer -*- lexical-binding: t; -*- + +;; `spike/x86/dump.sh' prints four lowerings of one function side by side -- +;; the LLVM IR the frontend emits, what `llc' makes of it at -O0 and at -O2, +;; and what the hand-written x86 backend emits. Reading one against another is +;; the only way to check a lowering by eye, and the whole reason the second +;; backend is trustworthy is that the two agree. This is that script with a +;; buffer around it. +;; +;; A scrollback is the wrong shape for it. Three of the four are noise on any +;; given day and the fourth is the one being worked on, so the four are +;; sections that fold, and which of them is open is remembered -- keyed to the +;; section and not to the function, because "I am on the backend this week" is +;; a fact about the backend and holds across every function looked at while it +;; is true. +;; +;; This is *not* `flan-disassemble', and the two cannot be merged. `C-c C-a' +;; asks the running program what the body it is calling for a name actually +;; came out as; only the daemon can answer that, because the daemon compiled +;; the module and still has both the .ll and the .so. Neither `llc -O2' nor +;; the hand-written backend has ever been run over that body, so there is no +;; four-way answer in the daemon to give. This command asks the other +;; question -- what does the source on disk compile to -- by compiling it, and +;; its header says so in as many words so that a listing never implies the +;; stronger claim. +;; +;; The folding is `outline-minor-mode', which is Emacs' own and has been since +;; long before Magit: `outline-flag-region' hides a subtree and +;; `outline-next-visible-heading' walks between them. Nothing under emacs/ +;; requires a package that is not in Emacs and this does not start. +;; +;; Headings are found by the arrow that starts them, `▸' or `▾' at column +;; zero. That is not decoration standing in for structure: a regexp loose +;; enough to match four section headers written in ordinary characters also +;; matches inside three of the four bodies -- LLVM IR has `;' comments, +;; assembler output has `#' and `;' comments and lines beginning `.', and +;; objdump prints `:' label lines -- and folding then fragments in +;; the middle of a listing. Neither arrow can begin a line of any of the +;; three, so the arrow is both the affordance and the anchor. + +;;; Code: + +(require 'subr-x) +(require 'seq) +(require 'outline) +(require 'flan-dev) + +(defgroup flan-lower nil + "Every lowering of one Flan function, side by side." + :group 'flan + :prefix "flan-lower-") + +(defcustom flan-lower-buffer "*flan-lowering*" + "Buffer `flan-lowering' writes into." + :type 'string) + +(defcustom flan-lower-program "flan" + "The Flan compiler this shells out to. +A buffer under this editor is usually being worked on beside the compiler +that built it, so the useful value is often an absolute path into a build +directory rather than whatever is first on PATH." + :type 'string) + +(defcustom flan-lower-flags nil + "Flags passed to `flan emit', and so to both the IR and the x86 section. +`(\"--dev\")' compares the four dev lowerings rather than the four release +ones. Only `flan emit' understands them: `llc' is handed the IR that came +out, so the two LLVM sections follow whatever this chose without being told." + :type '(repeat string)) + +(defcustom flan-lower-llc "llc" + "The LLVM static compiler the -O0 and -O2 sections are made with." + :type 'string) + +;; The four, in the order they lower: what the frontend wrote, what LLVM makes +;; of it twice, and what this project's own backend makes of it. The symbols +;; are what the remembered state is keyed by, so they are the one part of this +;; list that is not free to change. +(defconst flan-lower--sections + '((ir . "LLVM IR") + (O0 . "LLVM -O0") + (O2 . "LLVM -O2") + (x86 . "x86 backend")) + "Section ids and the names they are shown under, in order.") + +(defconst flan-lower--heading-re "^[▸▾] " + "What a section heading looks like from the start of a line.") + +;; Session state and nothing more. Four booleans do not want a preference +;; file: it would be a thing to migrate the first time a section is renamed, +;; and nobody has ever wanted yesterday's fold state back. The IR is open to +;; begin with because a buffer that opens with everything shut reads as though +;; the command failed. +(defvar flan-lower--state + '((ir . t) (O0 . nil) (O2 . nil) (x86 . nil)) + "Which sections are open, for this Emacs session. +Keyed by section and not by function on purpose -- see the header. This is +the single source of truth: a toggle changes this and then applies it to the +buffer, and a redraw applies it to the buffer it has just drawn. Visibility +is never read back out, which would tie this to whether outline folds with +overlays or with text properties.") + +(defvar flan-lower-fetch-function #'flan-lower--fetch + "How one section's text is obtained. +Called with (SECTION FILE NAME FLAGS) and answers a string, or signals an +error whose message becomes the section's body. A variable rather than a +call so that the renderer can be driven from a test without four subprocesses +and an `llc -O2' per redraw.") + +(defvar-local flan-lower--file nil "Source file the sections were made from.") +(defvar-local flan-lower--name nil "Flan name the sections were narrowed to.") +(defvar-local flan-lower--flags nil "Flags `flan emit' was given.") +(defvar-local flan-lower--texts nil "Alist of section id to its text.") +(defvar-local flan-lower--dir nil "Scratch directory the intermediates live in.") + +;;; Faces + +(defface flan-lower-heading '((t :inherit bold)) + "Face for a section heading.") + +(defface flan-lower-count '((t :inherit shadow)) + "Face for the line count beside a section heading.") + +;;; Getting the four + +(defun flan-lower--scratch () + "The scratch directory for this buffer, made on first use. +The intermediates are kept rather than piped so that refreshing one section +does not recompile the file: `llc -O2' is the slow one and the IR it reads +has not changed." + (unless (and flan-lower--dir (file-directory-p flan-lower--dir)) + (setq flan-lower--dir (make-temp-file "flan-lower-" t))) + flan-lower--dir) + +(defun flan-lower--clean () + "Remove this buffer's scratch directory." + (when (and flan-lower--dir (file-directory-p flan-lower--dir)) + (delete-directory flan-lower--dir t)) + (setq flan-lower--dir nil)) + +(defun flan-lower--run (out program &rest args) + "Run PROGRAM with ARGS, stdout to OUT, and answer OUT. +A failure is signalled with the program's own stderr, because every one of +these is a compiler and the compiler's complaint is the whole of what a +reader needs." + (let ((err (expand-file-name "stderr" (flan-lower--scratch)))) + (unless (executable-find program) + (error "no %s on PATH" program)) + (let ((code (apply #'call-process program nil (list (list :file out) err) + nil args))) + (unless (eq code 0) + (error "%s exited %s: %s" program code + (string-trim + (with-temp-buffer (insert-file-contents err) (buffer-string))))) + out))) + +(defun flan-lower--slurp (file) + "The contents of FILE as a string." + (with-temp-buffer (insert-file-contents file) (buffer-string))) + +(defun flan-lower--ll (file flags) + "The IR for FILE under FLAGS, made once and kept. +Every section is downstream of this one: `llc' reads it twice and the x86 +section is the same frontend asked for a different back half." + (let ((ll (expand-file-name "out.ll" (flan-lower--scratch)))) + (unless (file-exists-p ll) + (apply #'flan-lower--run ll flan-lower-program "emit" file flags)) + ll)) + +(defun flan-lower--fetch (section file name flags) + "The text of SECTION for NAME in FILE, compiled with FLAGS. +Narrowed to the one function, which is almost always what is wanted: the +prelude is emitted too, so a two-line program is ten thousand lines of IR." + (let ((sym (concat "flan\\." (regexp-quote name)))) + (pcase section + ('ir + ;; LLVM spells the name `@"flan.step"' when it needs quoting and + ;; `@flan.step' when it does not, and a packaged name always needs it. + (flan-lower--narrow (flan-lower--slurp (flan-lower--ll file flags)) + (concat "^define .*@\"?" sym "\"?(") "^}")) + ((or 'O0 'O2) + (let ((s (expand-file-name (format "out.%s.s" section) (flan-lower--scratch)))) + (unless (file-exists-p s) + (flan-lower--run s flan-lower-llc + (if (eq section 'O0) "-O0" "-O2") + (flan-lower--ll file flags) "-o" s)) + ;; `.size' ends the function in GAS output, and it is the last line + ;; of it rather than the first line of the next. + (flan-lower--narrow (flan-lower--slurp s) + (concat "^\"?" sym "\"?:") "\\.size"))) + ('x86 + (let ((dis (expand-file-name "out.x86.dis" (flan-lower--scratch)))) + (unless (file-exists-p dis) + (let ((s (expand-file-name "out.x86.s" (flan-lower--scratch))) + (o (expand-file-name "out.x86.o" (flan-lower--scratch)))) + ;; The IR is asked for first even though this path does not read + ;; it, so that a frontend error is reported once, in whichever + ;; section is fetched first, rather than twice in two dialects. + (flan-lower--ll file flags) + (apply #'flan-lower--run s flan-lower-program + "emit" "--x86" file flags) + ;; The backend writes machine code, not mnemonics, so its .s is + ;; `.byte' blobs. Assembling and disassembling is what makes it + ;; readable -- and it is also a check that the bytes are well + ;; formed, which reading them never would be. + (flan-lower--run o "as" "--64" "-o" o s) + (flan-lower--run dis "objdump" "-d" "--no-show-raw-insn" o))) + (flan-lower--narrow (flan-lower--slurp dis) + (concat "<" sym ">:") "^$"))) + (_ (error "no such section: %s" section))))) + +(defun flan-lower--narrow (text start end) + "The run of TEXT from the line matching START to the line matching END. +Both lines are kept, which is what makes a function's closing brace and its +`.size' part of the listing rather than the start of the next one. Answers +nil when START never matches, which is what a name the file does not define +looks like." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (when (re-search-forward start nil t) + (let ((beg (line-beginning-position))) + (forward-line 1) + (if (re-search-forward end nil t) + (buffer-substring-no-properties beg (line-beginning-position 2)) + (buffer-substring-no-properties beg (point-max))))))) + +(defun flan-lower--gather (sections) + "Fetch each of SECTIONS into `flan-lower--texts', replacing what was there. +One section's failure is that section's text and not the buffer's: `llc' can +be missing while the IR is perfectly readable, and a buffer that refuses +altogether would be the wrong answer to that." + (dolist (s sections) + (let ((text (condition-case err + (or (funcall flan-lower-fetch-function + s flan-lower--file flan-lower--name + flan-lower--flags) + (format "nothing for `%s' here\n" flan-lower--name)) + (error (concat (error-message-string err) "\n"))))) + (setf (alist-get s flan-lower--texts) text)))) + +;;; Drawing it + +(defun flan-lower--header (label text) + "Insert a header line naming LABEL with TEXT, wrapped under the label. +Wrapped by hand rather than with `fill-region', which is what the sibling +buffer uses: filling canonicalises runs of spaces, and every value here is a +path or a flag list whose columns are the point of it." + (let* ((start (point)) + (indent "; ") + (lead (format "; %-11s " label)) + (col (length lead)) + (fresh t)) + (insert lead) + (dolist (word (split-string (or text "") "[ \t\n]+" t)) + (cond + (fresh (setq fresh nil)) + ((> (+ col 1 (length word)) 78) + (insert "\n" indent) + (setq col (length indent))) + (t (insert " ") (setq col (1+ col)))) + (insert word) + (setq col (+ col (length word)))) + (insert "\n") + (put-text-property start (point) 'face 'font-lock-comment-face))) + + +;; Enough highlighting to tell the three languages apart at a glance, and no +;; more. A major mode for each would be three modes to keep, and what is +;; wanted here is only that a register not read like a mnemonic. +(defconst flan-lower--ir-keywords + (regexp-opt '("define" "declare" "ret" "load" "store" "call" "br" "add" + "sub" "mul" "sdiv" "udiv" "srem" "icmp" "fcmp" "alloca" + "getelementptr" "phi" "select" "switch" "bitcast" "zext" + "sext" "trunc" "inttoptr" "ptrtoint" "unreachable" "tail" + "and" "or" "xor" "shl" "lshr" "ashr" "label") + 'symbols)) + +(defconst flan-lower--ir-types + (regexp-opt '("i1" "i8" "i16" "i32" "i64" "ptr" "void" "float" "double") + 'symbols)) + +(defun flan-lower--rules (section) + "Highlighting rules for SECTION, as an alist of regexp to face." + (pcase section + ('ir `((,flan-lower--ir-keywords . font-lock-keyword-face) + (,flan-lower--ir-types . font-lock-type-face) + ("[%@][-A-Za-z0-9_.\"$/]+" . font-lock-variable-name-face) + ("^\\s-*;.*$" . font-lock-comment-face))) + ('x86 `(("^ *[0-9a-f]+:" . shadow) + ("<[^>\n]+>" . font-lock-function-name-face) + ("%[a-z0-9]+" . font-lock-variable-name-face) + ("\\$0x[0-9a-f]+" . font-lock-constant-face) + ("#.*$" . font-lock-comment-face))) + (_ `(("^\\s-*\\.[a-zA-Z_0-9.]+" . font-lock-preprocessor-face) + ("^[^ \t\n#][^ \t\n]*:" . font-lock-function-name-face) + ("%[a-z0-9]+" . font-lock-variable-name-face) + ("\\$-?[0-9]+\\|\\$0x[0-9a-f]+" . font-lock-constant-face) + ("#.*$" . font-lock-comment-face))))) + +(defun flan-lower--fontify (beg end section) + "Highlight BEG..END as SECTION's language. +Earlier rules win, which is why comments come last in every list: a `#' to +the end of the line is a comment whatever it holds, so it is painted over +whatever the rules above it found in there." + (save-excursion + (dolist (rule (flan-lower--rules section)) + (goto-char beg) + (while (re-search-forward (car rule) end t) + (let ((s (match-beginning 0)) (e (match-end 0))) + ;; An anchored rule can match the empty string, and a search that + ;; does not move is a loop that does not end. + (if (= s e) + (unless (eobp) (forward-char 1)) + (unless (get-text-property s 'face) + (put-text-property s e 'face (cdr rule))))))))) + +(defun flan-lower--insert-section (id label) + "Insert the heading and body for section ID under LABEL." + (let* ((raw (or (alist-get id flan-lower--texts) "")) + ;; Trimmed, because the blank line that ends an objdump function is + ;; the narrowing's terminator rather than part of the listing, and a + ;; count that included it would be one instruction out. + (text (if (string-empty-p (string-trim raw)) raw + (concat (string-trim-right raw "\n+") "\n"))) + (lines (if (string-empty-p text) 0 + (1- (length (split-string text "\n"))))) + (open (alist-get id flan-lower--state)) + (hbeg (point))) + (insert (if open "▾ " "▸ ")) + (insert (propertize label 'face 'flan-lower-heading)) + (insert (propertize (format " %d line%s" lines (if (= lines 1) "" "s")) + 'face 'flan-lower-count)) + (insert "\n") + (put-text-property hbeg (point) 'flan-lower-section id) + ;; The blank line after the listing belongs to the body and not to the + ;; gap between sections. That is what makes an open section breathe and a + ;; buffer with everything shut four adjacent lines -- a summary, which is + ;; the shape it is meant to have when it is closed. + (let ((bbeg (point))) + (insert text) + (unless (string-suffix-p "\n" text) (insert "\n")) + (flan-lower--fontify bbeg (point) id) + (insert "\n") + (put-text-property bbeg (point) 'flan-lower-section id)))) + +(defun flan-lower--draw () + "Erase this buffer and write the header and the four sections into it." + (let ((inhibit-read-only t)) + (erase-buffer) + (let ((start (point))) + (insert (format "; every lowering of %s\n" flan-lower--name)) + (put-text-property start (point) 'face 'font-lock-comment-face)) + (flan-lower--header "file" (abbreviate-file-name (or flan-lower--file ""))) + (flan-lower--header "compiler" flan-lower-program) + (flan-lower--header "flags" (if flan-lower--flags + (string-join flan-lower--flags " ") + "none")) + ;; The counterpart of `flan-disassemble's `showing' line, and it has to be + ;; here for the same reason: four listings of a name look exactly like an + ;; answer about the program, and this one is an answer about the file. + (flan-lower--header + "showing" "what this file compiles to, not what a running program is \ +calling for this name -- for that, C-c C-a") + (insert "\n") + (pcase-dolist (`(,id . ,label) flan-lower--sections) + (flan-lower--insert-section id label)) + (flan-lower--apply-state) + (set-buffer-modified-p nil))) + +;;; Folding + +(defun flan-lower--heading-bounds () + "Bounds of the section whose heading point is on, as (HEAD-END . SUB-END)." + (let ((hend (line-end-position)) + (send (save-excursion + (forward-line 1) + (if (re-search-forward flan-lower--heading-re nil t) + (1- (match-beginning 0)) + (point-max))))) + (cons hend (max hend send)))) + +(defun flan-lower--apply-state () + "Fold every section the way `flan-lower--state' says, arrows and all." + (let ((inhibit-read-only t) + (modified (buffer-modified-p))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward flan-lower--heading-re nil t) + (goto-char (match-beginning 0)) + (let* ((id (get-text-property (point) 'flan-lower-section)) + (open (alist-get id flan-lower--state)) + (props (text-properties-at (point)))) + ;; The arrow is rewritten rather than redrawn with the rest, so the + ;; properties that make it a heading have to be put back by hand: + ;; inserted text inherits nothing the caller did not arrange. + (delete-char 1) + (insert (if open "▾" "▸")) + (set-text-properties (1- (point)) (point) props) + (goto-char (match-beginning 0)) + (pcase-let ((`(,hend . ,send) (flan-lower--heading-bounds))) + (outline-flag-region hend send (not open)) + ;; Onwards from the end of this heading, so the next search does + ;; not find the arrow that was just rewritten. + (goto-char hend))))) + (set-buffer-modified-p modified))) + +(defun flan-lower--section-at-point () + "The section point is in, heading or body, or nil above the first one." + (get-text-property (point) 'flan-lower-section)) + +(defun flan-lower--goto-section (id) + "Put point on section ID's heading, if it is here." + (let ((pos (save-excursion + (goto-char (point-min)) + (catch 'found + (while (re-search-forward flan-lower--heading-re nil t) + (when (eq (get-text-property (match-beginning 0) + 'flan-lower-section) + id) + (throw 'found (match-beginning 0)))) + nil)))) + (when pos (goto-char pos)))) + +(defun flan-lower-toggle (&optional event) + "Open or close the section point is in, or the one EVENT was over. +Above the first heading there is nothing to fold, so this moves to the first +section instead of doing nothing -- the same bargain `flan-cnr-tab' makes." + (interactive (list last-nonmenu-event)) + (when (and event (listp event) (mouse-event-p event)) (mouse-set-point event)) + (let ((id (flan-lower--section-at-point))) + (if (null id) + (outline-next-visible-heading 1) + (setf (alist-get id flan-lower--state) (not (alist-get id flan-lower--state))) + ;; Point may be inside a body that is about to be hidden, and a point + ;; in invisible text is a cursor that appears to have vanished. + (flan-lower--goto-section id) + (flan-lower--apply-state)))) + +(defun flan-lower--set-all (open) + "Open every section if OPEN, else close every one." + (pcase-dolist (`(,id . ,_) flan-lower--sections) + (setf (alist-get id flan-lower--state) open)) + (let ((id (flan-lower--section-at-point))) + (when (and id (not open)) (flan-lower--goto-section id))) + (flan-lower--apply-state)) + +(defun flan-lower-collapse-all () + "Close every section, leaving the four names and their line counts." + (interactive) + (flan-lower--set-all nil)) + +(defun flan-lower-expand-all () + "Open every section." + (interactive) + (flan-lower--set-all t)) + +(defun flan-lower-cycle-all () + "Close everything if anything is open, and otherwise open everything." + (interactive) + (flan-lower--set-all + (not (seq-some (lambda (s) (alist-get (car s) flan-lower--state)) + flan-lower--sections)))) + +;;; Refreshing + +(defun flan-lower--position () + "Where point is, as (SECTION . LINE-WITHIN-IT), for putting it back." + (let ((id (flan-lower--section-at-point))) + (when id + (cons id (count-lines + (or (save-excursion (flan-lower--goto-section id) (point)) + (point-min)) + (line-beginning-position)))))) + +(defun flan-lower--restore (pos screen-line) + "Put point back at POS and the window back at SCREEN-LINE." + (when pos + (when (flan-lower--goto-section (car pos)) + (forward-line (cdr pos)))) + ;; Guarded because under `emacs -batch' there is no window at all, and an + ;; unguarded `set-window-start' would be a failure with nothing to do with + ;; what was being refreshed. + (when-let ((win (and screen-line (get-buffer-window (current-buffer))))) + (set-window-start win (save-excursion + (vertical-motion (- screen-line)) + (point))))) + +(defun flan-lower--redraw (sections) + "Re-fetch SECTIONS and draw the buffer again, keeping point where it was." + (let* ((pos (flan-lower--position)) + (win (get-buffer-window (current-buffer))) + ;; How far down the window point is sitting, so that a redraw is a + ;; redraw and not a jump to the top of a listing being read. + (screen-line (and win (count-screen-lines (window-start win) (point))))) + (flan-lower--gather sections) + (flan-lower--draw) + (flan-lower--restore pos screen-line))) + +(defun flan-lower-refresh () + "Compile the file again and redraw all four sections." + (interactive) + (flan-lower--clean) + (setq flan-lower--texts nil) + (flan-lower--redraw (mapcar #'car flan-lower--sections))) + +(defun flan-lower-refresh-section () + "Compile and redraw only the section point is in. +Worth its own key because the four are not the same price: the IR is the +frontend alone, and `llc -O2' over a whole program's worth of it is the one +that is felt." + (interactive) + (let ((id (flan-lower--section-at-point))) + (unless id (user-error "flan: point is not in a section")) + ;; Only this section's intermediate goes; the IR everything is downstream + ;; of stays, which is the whole saving. + ;; The IR is what the other three are made from, so refreshing it drops + ;; their intermediates too -- they are not redrawn here, but the next `r' + ;; on one of them must not answer out of a file the old IR produced. + (dolist (f (pcase id + ('ir '("out.ll" "out.O0.s" "out.O2.s" + "out.x86.s" "out.x86.o" "out.x86.dis")) + ('O0 '("out.O0.s")) + ('O2 '("out.O2.s")) + ('x86 '("out.x86.s" "out.x86.o" "out.x86.dis")))) + (let ((p (expand-file-name f (flan-lower--scratch)))) + (when (file-exists-p p) (delete-file p)))) + (flan-lower--redraw (list id)))) + +;;; The mode + +(defvar flan-lower-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "TAB") #'flan-lower-toggle) + (define-key map (kbd "RET") #'flan-lower-toggle) + (define-key map [mouse-1] #'flan-lower-toggle) + (define-key map [backtab] #'flan-lower-cycle-all) + (define-key map "c" #'flan-lower-collapse-all) + (define-key map "e" #'flan-lower-expand-all) + ;; `n' and `p' move between the buffer's own units, the way they do in + ;; `flan-inspect-mode' and `flan-cnr-mode'. Here the unit is a section. + (define-key map "n" #'outline-next-visible-heading) + (define-key map "p" #'outline-previous-visible-heading) + (define-key map "g" #'flan-lower-refresh) + (define-key map "r" #'flan-lower-refresh-section) + (define-key map "q" #'quit-window) + map) + "Keys in `flan-lower-mode'.") + +(define-derived-mode flan-lower-mode special-mode "flan-lower" + "Every lowering of one Flan function, in foldable sections. + +\\{flan-lower-mode-map}" + (setq buffer-read-only t) + (setq-local truncate-lines t) + ;; Set before the minor mode goes on, because that is when it reads them. + (setq-local outline-regexp "[▸▾] ") + (setq-local outline-level (lambda () 1)) + (outline-minor-mode 1) + (add-hook 'kill-buffer-hook #'flan-lower--clean nil t)) + +;;;###autoload +(defun flan-lowering (name &optional file) + "Show every lowering of NAME in FILE: the IR, -O0, -O2, and the x86 backend. + +FILE defaults to the file the current buffer is visiting. NAME is the Flan +one -- `step', not `flan.step' -- and a packaged function is written the way +the program names it, `sim/settle'. + +What this shows is what FILE compiles to today, which is not the same claim +as `flan-disassemble' (\\[flan-disassemble]): that one asks the running program what the body +it is calling for a name actually came out as, and only the daemon can +answer it. The two cannot be merged, because the daemon has the installed +body's IR and its object and has never run either `llc -O2' or the x86 +backend over it. + +Which sections are open is remembered for the session, by section rather +than by function: asking for a different name leaves whichever of the four +was being read open." + (interactive + (list (or (thing-at-point 'symbol t) + (completing-read + "Lowerings of: " + (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) + flan-dev--defs)) + nil nil nil nil + (and (fboundp 'flan-current-defun-name) + (flan-current-defun-name)))) + (when current-prefix-arg + (read-file-name "Lowerings from file: " nil nil t)))) + (let ((src (or file buffer-file-name))) + (unless src + (user-error "flan: no file to compile; visit one or give it a file")) + (with-current-buffer (get-buffer-create flan-lower-buffer) + (unless (derived-mode-p 'flan-lower-mode) (flan-lower-mode)) + ;; A new name means new intermediates only if the file changed; the + ;; narrowing is done here, so the same file's IR is reused across names. + (unless (equal flan-lower--file (expand-file-name src)) + (flan-lower--clean)) + (setq flan-lower--file (expand-file-name src) + flan-lower--name name + flan-lower--flags flan-lower-flags + flan-lower--texts nil) + (flan-lower--gather (mapcar #'car flan-lower--sections)) + (flan-lower--draw) + (goto-char (point-min))) + (display-buffer flan-lower-buffer))) + +(provide 'flan-lower) +;;; flan-lower.el ends here diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 747aa2a..17a2bb4 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -73,6 +73,10 @@ (autoload 'flan-dev-restart-program "flan-dev" nil t) ;; Bound below, like the rest, and it was the one missing an autoload. (autoload 'flan-disassemble "flan-dev" nil t) +;; The other question about the same function, and the reason it is a second +;; command rather than a fifth argument to the first: `flan-disassemble' asks +;; the running program, and this compiles the file. +(autoload 'flan-lowering "flan-lower" nil t) ;; C-c C-m and the half of it that is findable by name rather than by a ;; modifier. Real autoloads for the reason stated above: a `declare-function' ;; would leave M-x with nothing to load. @@ -195,6 +199,12 @@ line is off screen." ;; IR it was built from. C-u for the IR rather than a second key: it is ;; the same question asked of the same body. (define-key map (kbd "C-c C-a") #'flan-disassemble) + ;; Every lowering of the name at point -- the IR, `llc' at -O0 and at -O2, + ;; and the hand-written x86 backend -- in one buffer of folding sections. + ;; Beside C-c C-a and not under it: that one answers for the program that + ;; is running, this one for the file on disk, and no prefix argument can + ;; make one of those into the other. + (define-key map (kbd "C-c C-l") #'flan-lowering) ;; What the macro call before point expands to. CIDER's key, and `C-u' for ;; the fixpoint rather than a second one — the same question asked of the ;; same form, which is the rule `C-c C-a' above already follows. One step diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index a747b25..ba54d24 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -14,6 +14,7 @@ (require 'flan-dev) (require 'flan-repl) (require 'flan-watch) +(require 'flan-lower) (defvar test-flan--failures 0) @@ -809,6 +810,184 @@ is written instead — the real `message' call the real command makes." (flan-dev-quit) (ignore-errors (delete-file socket3))) + ;; ── Every lowering of one function, in one buffer ───────────────────── + ;; + ;; No daemon: this command compiles the file rather than asking the running + ;; program, which is the whole distinction between it and `C-c C-a' above. + ;; + ;; Most of what is checked here is the renderer -- folding, and the memory + ;; of what was folded -- so the fetch is replaced with canned text. Driving + ;; it through the real one would put four compilers and an `llc -O2' behind + ;; every redraw, and prove nothing about folding that the canned text does + ;; not. The real fetch is exercised once, at the end, where it belongs. + ;; + ;; `buffer-string' is no use for any of it: it returns hidden text too, so + ;; "all four are still named when everything is shut" would pass without + ;; anything being shut at all. `invisible-p' is the predicate that means + ;; what it says, and it means it whether outline folded with an overlay or + ;; with a text property. + (let* ((flan-lower--state (copy-alist flan-lower--state)) + (flan-lower-fetch-function + (lambda (section _file name _flags) + (format "%s-first-line of %s\n%s-second-line\n" + section name section))) + (visible + (lambda () + (let ((out nil) (p (point-min))) + (while (< p (point-max)) + (if (invisible-p p) + (setq p (next-single-char-property-change p 'invisible)) + (push (buffer-substring-no-properties p (1+ p)) out) + (setq p (1+ p)))) + (apply #'concat (nreverse out))))) + ;; Somewhere inside a section's body, which is where invisibility is + ;; the thing to ask about. + (body-of + (lambda (id) + (with-current-buffer flan-lower-buffer + (save-excursion + (goto-char (point-min)) + (search-forward (format "%s-first-line" id)) + (point)))))) + (flan-lowering "step" file) + (with-current-buffer flan-lower-buffer + (test-flan--check "C-c C-l opens a lowering buffer in its own mode" + (derived-mode-p 'flan-lower-mode)) + ;; The claim the header makes, which is the opposite of the one + ;; `flan-disassemble' makes, and the reason both commands exist. + (test-flan--check "whose header says it is the file and not the program" + (string-match-p "what this file compiles to" + (buffer-string))) + (test-flan--check "and names all four lowerings" + (let ((v (funcall visible))) + (and (string-match-p "LLVM IR" v) + (string-match-p "LLVM -O0" v) + (string-match-p "LLVM -O2" v) + (string-match-p "x86 backend" v)))) + (test-flan--check "with a line count beside each, so a shut one still says something" + (= 4 (length (seq-filter + (lambda (l) (string-match-p " 2 lines\\'" l)) + (split-string (funcall visible) "\n"))))) + ;; Out of the box the IR is the open one, so it is the one whose body + ;; can be read and the other three are the ones that cannot. + (test-flan--check "the open section's body is showing" + (not (invisible-p (funcall body-of 'ir)))) + (test-flan--check "and a shut section's body is not" + (and (invisible-p (funcall body-of 'O0)) + (invisible-p (funcall body-of 'O2)) + (invisible-p (funcall body-of 'x86)))) + + ;; TAB, on the heading and from inside the body, which are the two + ;; places a reader's point actually is. + (flan-lower--goto-section 'x86) + (flan-lower-toggle) + (test-flan--check "TAB on a heading opens that section" + (not (invisible-p (funcall body-of 'x86)))) + (test-flan--check "and leaves the others alone" + (and (not (invisible-p (funcall body-of 'ir))) + (invisible-p (funcall body-of 'O0)))) + (goto-char (funcall body-of 'x86)) + (flan-lower-toggle) + (test-flan--check "TAB inside a body shuts the section it is in" + (invisible-p (funcall body-of 'x86))) + (test-flan--check "and puts point back on its heading, not into hidden text" + (eq (flan-lower--section-at-point) 'x86)) + + ;; `c' and `e': the buffer as a summary, and the buffer as everything. + (flan-lower-collapse-all) + (test-flan--check "c shuts every section" + (seq-every-p (lambda (s) + (invisible-p (funcall body-of (car s)))) + flan-lower--sections)) + (test-flan--check "and all four are still named, which is what makes it a summary" + (let ((v (funcall visible))) + (and (string-match-p "LLVM IR" v) + (string-match-p "LLVM -O0" v) + (string-match-p "LLVM -O2" v) + (string-match-p "x86 backend" v) + ;; ...and not one line of any listing. + (not (string-match-p "first-line" v))))) + (flan-lower-expand-all) + (test-flan--check "e opens every section" + (seq-every-p (lambda (s) + (not (invisible-p (funcall body-of (car s))))) + flan-lower--sections)) + + ;; n and p move between headings, the way they do in the inspector. + (goto-char (point-min)) + (outline-next-visible-heading 1) + (test-flan--check "n moves to the first heading" + (eq (flan-lower--section-at-point) 'ir)) + (outline-next-visible-heading 2) + (outline-previous-visible-heading 1) + (test-flan--check "n n p leaves point on the second" + (eq (flan-lower--section-at-point) 'O0))) + + ;; The point of the whole thing: the backend open and nothing else, then + ;; the command run again on a *different* function. Keyed to the section + ;; rather than to the function, so the preference survives the change of + ;; subject -- which is the case that would fail if it were keyed the other + ;; way, and the one the author asked for by name. + (flan-lower-collapse-all) + (with-current-buffer flan-lower-buffer + (flan-lower--goto-section 'x86) + (flan-lower-toggle)) + (flan-lowering "main" file) + (with-current-buffer flan-lower-buffer + (test-flan--check "re-running names the new function" + (string-match-p "; every lowering of main" (buffer-string))) + (test-flan--check "and the section that was open is still the open one" + (not (invisible-p (funcall body-of 'x86)))) + (test-flan--check "and the ones that were shut are still shut" + (and (invisible-p (funcall body-of 'ir)) + (invisible-p (funcall body-of 'O0)) + (invisible-p (funcall body-of 'O2)))) + (test-flan--check "the new function's text is what is in there" + (string-match-p "x86-first-line of main" (buffer-string))) + + ;; A refresh is a redraw of the same thing, and must not throw the + ;; reader back to the top of a listing they were part-way down. + (flan-lower-expand-all) + (goto-char (funcall body-of 'O2)) + (forward-line 1) + (let ((was (flan-lower--position))) + (flan-lower-refresh) + (test-flan--check "g redraws without moving point off the line it was on" + (equal was (flan-lower--position)))))) + + ;; And once for real, against the compiler dune just built: four + ;; subprocesses, four narrowings, and the one thing canned text cannot + ;; check -- that the awk `dump.sh' does by hand finds the same function in + ;; four formats that agree about nothing else. + (if (not (and flan (file-executable-p flan) + (executable-find "llc") (executable-find "as") + (executable-find "objdump"))) + (message " skip lowering: no llc/as/objdump, or no compiler to run") + (let ((flan-lower-program flan) + (flan-lower--state '((ir . t) (O0 . t) (O2 . t) (x86 . t)))) + (flan-lowering "step" program) + (with-current-buffer flan-lower-buffer + (let ((text (buffer-string))) + (test-flan--check "the IR section is the definition and nothing above it" + (string-match-p "^define .*flan\\.step" text)) + (test-flan--check "the -O0 and -O2 sections are that label's own block" + (= 2 (length (seq-filter + (lambda (l) (string-match-p "\\`flan\\.step:" l)) + (split-string text "\n"))))) + (test-flan--check "and -O2 is the shorter of the two, which is the point" + (< (length (alist-get 'O2 flan-lower--texts)) + (length (alist-get 'O0 flan-lower--texts)))) + (test-flan--check "the x86 section is the backend's bytes, disassembled" + (and (string-match-p ":" text) + (string-match-p "push +%rbp" text)))) + ;; The scratch directory is this buffer's and goes with it; /tmp is + ;; not a place to leave four intermediates behind per invocation. + (let ((dir flan-lower--dir)) + (kill-buffer) + (test-flan--check "and the intermediates go when the buffer does" + (not (file-directory-p dir))))))) + + ;; ── Marking a form with (pause) ─────────────────────────────────────── ;; ;; docs/DISCUSS.md §9: `C-u' before an evaluation marks a form so the program