;;; flan-lower.el --- Every lowering of one function, in one buffer  -*- lexical-binding: t; -*-

;; Author: Joseph Ferano <joseph@ferano.io>
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Keywords: languages, lisp, tools

;; The headers above are what make this directory installable.  M-x
;; package-install-file on it reads them, and a file with no Version: is not a
;; package as far as package.el is concerned -- until now the client was
;; reachable only by adding it to load-path by hand, which is a thing to
;; explain to every person who wants to try it.
;;
;; 29.1 is the floor because it is the oldest Emacs any of this has been run
;; against, not because some function here is known to need it.  dape, which
;; flan-dape drives, asks for 29.1 as well and is a soft dependency: it is
;; reached through declare-function, so the rest of the client loads and works
;; without it and it is deliberately not listed above.  The compiler this talks
;; to is not an Emacs package and cannot be listed here either -- emacs/MANUAL.md
;; says what has to be on PATH.

;; `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 `<flan.step>:' 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."
  (if pos
      (when (flan-lower--goto-section (car pos))
        (forward-line (cdr pos)))
    ;; Point was in the header, above every section.  The top is where it was
    ;; and the top is where it goes back to; leaving it wherever the redraw
    ;; finished would put it at the end of the buffer, which is a worse jump
    ;; than the one this whole function exists to avoid.
    (goto-char (point-min)))
  ;; 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)
  ;; Minor-mode bindings take precedence over this mode's map.  Outline owns
  ;; TAB by default, so give this buffer its intended folding keys back
  ;; without changing Outline's bindings anywhere else.
  (let ((map (copy-keymap outline-minor-mode-map)))
    (define-key map (kbd "TAB") #'flan-lower-toggle)
    (define-key map [backtab] #'flan-lower-cycle-all)
    (setq-local minor-mode-overriding-map-alist
                (cons (cons 'outline-minor-mode map)
                      (assq-delete-all 'outline-minor-mode
                                       minor-mode-overriding-map-alist))))
  (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