flan/emacs/flan-watch.el

;;; flan-watch.el --- A pinned, self-overwriting watch buffer  -*- lexical-binding: t; -*-

;; A HUD for a running Flan program: a buffer that always shows the current
;; frame's values and nothing else.  Ported from the author's Clojure
;; `clj-watch', with one thing kept and one thing inverted.
;;
;; KEPT, and it is the good idea in the original: **the program decides what is
;; shown**.  There is no watch-expression machinery here, no per-variable
;; registration, no UI for building a query.  The program says what it wants
;; seen, from inside its own loop, and this paints it.  Everything a watch list
;; would need — where it lives, whether it survives a restart, whether it gets
;; committed by accident — stops being a question when the list is the code.
;;
;; INVERTED: the original polls.  Emacs calls `(watch/render)' on a timer and
;; paints the string that comes back, which in Clojure costs an eval and an eval
;; is cheap.  Here it is not.  An evaluation *compiles a module and dlopens it*
;; — tens of milliseconds and a new .so each time, in a directory nothing
;; sweeps — so polling at 5Hz would produce hundreds of shared objects a minute
;; to read a number that was already in a register.
;;
;; So the program pushes.  It calls into the runtime's watch table from its own
;; loop; this reads the table, which is memory rather than an evaluation.  Both
;; halves are cheap for opposite reasons, and two things fall out that a poll
;; could not have given:
;;
;;   the values update at *frame rate* rather than at the timer's rate — the
;;   timer only decides how often the picture is repainted, not how fresh it
;;   is;
;;
;;   and the last frame's values are still there while the program is
;;   *stopped*.  A break loop is precisely when no thunk can run at a frame
;;   boundary, because there are no more frames, and precisely when you want to
;;   see what the last one held.
;;
;; Also kept from the original, and for its stated reasons: the request is
;; **async**, because a synchronous call on a timer blocks Emacs's UI every
;; tick; and the paint is `replace-buffer-contents' rather than erase-and-
;; insert, because it diffs, so point and scroll survive a repaint instead of
;; being yanked to the top five times a second.
;;
;; What a program writes today, with no compiler change:
;;
;;     (declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
;;     (declare-c watch-f64 [name string x f64] i32 "flan_dev_watch_f64")
;;
;;     (defn step [] i64
;;       (set ticks (+ ticks 1))
;;       (watch-i64 "ticks" ticks)
;;       ticks)
;;
;; Scalars only, so far.  A struct or a slice needs a compile-time walk over
;; its type — a `(watch "hp" hp)' form in the checker — and that is a file this
;; change does not own.  See BUILT.md.

;;; Code:

(require 'flan-dev)
(require 'subr-x)

(defgroup flan-watch nil
  "A pinned watch buffer for a running Flan program."
  :group 'flan
  :prefix "flan-watch-")

(defcustom flan-watch-buffer "*flan-watch*"
  "Buffer the watch table is painted into."
  :type 'string)

(defcustom flan-watch-interval 0.2
  "Seconds between repaints.

This is the *repaint* rate, not the watch rate.  The program writes its values
every frame whatever this is; all this decides is how often the picture is
refreshed, which is why a slow value here costs freshness and nothing else."
  :type 'number)

(defvar flan-watch--timer nil)
(defvar flan-watch--pending nil
  "Non-nil while a watch request is out and its reply has not been read.")
(defvar flan-watch--rows nil
  "The last table painted, as a list of (NAME . VALUE).")

;;; Painting

(defun flan-watch--format (rows overflow)
  "The buffer's text for ROWS.  OVERFLOW means some name found no slot."
  (if (null rows)
      (concat "nothing is being watched\n\n"
              "The program decides what is shown.  Call into the watch table\n"
              "from your own loop:\n\n"
              "  (declare-c watch-i64 [name string x i64] i32 \"flan_dev_watch_i64\")\n"
              "  ...\n"
              "  (watch-i64 \"ticks\" ticks)\n")
    (let ((w (apply #'max (mapcar (lambda (r) (length (car r))) rows))))
      (concat
       (mapconcat (lambda (r)
                    ;; Padded before it is propertised, not with a width in the
                    ;; format string: `format' has no `%-*s', and a face on the
                    ;; padding would underline trailing space.
                    (concat (propertize (car r) 'face
                                        'font-lock-variable-name-face)
                            (make-string (+ 2 (- w (length (car r)))) ?\s)
                            (cdr r)))
                  rows "\n")
       "\n"
       ;; Reported rather than swallowed.  A name past the table's limit is a
       ;; value that simply never appears, and a buffer that said nothing about
       ;; it would be lying by omission — the reader would go looking for a bug
       ;; in the program.  A flag and not a number: the only count the runtime
       ;; could keep is of write *attempts* that missed, and those happen every
       ;; frame, so one name too many would read as thousands.
       (if overflow
           (concat "\nthe table is full: some names found no slot,"
                   " and their values are not shown.\n"
                   "It holds 64.\n")
         "")))))

(defun flan-watch--paint (text)
  "Replace the watch buffer's contents with TEXT."
  (when-let* ((buf (get-buffer flan-watch-buffer)))
    (let ((tmp (get-buffer-create " *flan-watch-src*")))
      (with-current-buffer tmp
        (erase-buffer)
        (insert text))
      (with-current-buffer buf
        (let ((inhibit-read-only t))
          ;; `replace-buffer-contents' diffs rather than erasing, so point and
          ;; the window's scroll position survive every tick.  `erase-buffer'
          ;; and insert would yank the cursor to the top five times a second,
          ;; which makes the buffer unusable for the one thing you want to do
          ;; in it — look at a particular line while the program runs.
          (replace-buffer-contents tmp))))))

;;; The tick

(defun flan-watch--absorb (reply)
  "Paint REPLY, a watch answer from the daemon."
  (pcase (plist-get reply :status)
    ("ok"
     (setq flan-watch--rows
           (mapcar (lambda (r) (cons (nth 0 r) (nth 1 r)))
                   (plist-get reply :watch)))
     (flan-watch--paint
      (flan-watch--format flan-watch--rows (plist-get reply :overflow))))
    (_ (flan-watch--paint
        (format "error:\n%s\n" (or (plist-get reply :message) "refused"))))))

(defun flan-watch--settle ()
  "Collect an outstanding watch reply, blocking if it has not arrived.

Hung on `flan-dev-settle-hook', so an ordinary request never reads the watch
timer's reply as its own.  Blocking here is fine and blocking in the tick is
not: this runs inside something a person asked for, which already waits, and
what it waits for is a table read with nothing compiled behind it."
  (when flan-watch--pending
    (setq flan-watch--pending nil)
    (when-let* ((proc flan-dev--connection))
      (when (process-live-p proc)
        (ignore-errors (flan-watch--absorb (flan-dev--read-reply proc)))))))

(defun flan-watch--tick ()
  "Collect the last reply if it has come, then ask again.  Never blocks.

Deliberately not `flan-dev--request', which waits for its answer: a
synchronous call on a 0.2s timer stalls Emacs's UI every tick, and a timer is
the one caller that must not.  So this takes whatever has already arrived and
sends the next question, leaving at most one request in flight — the invariant
`flan-dev-settle-hook' exists to keep."
  (cond
   ;; The buffer is the subscription.  Killing it stops the timer and disarms
   ;; the table, so a program whose watch buffer is closed is back to paying a
   ;; load and a branch per watch call.
   ((not (get-buffer flan-watch-buffer)) (flan-watch-stop))
   ((not (process-live-p flan-dev--connection))
    (flan-watch--paint "error:\nnot connected to a running program\n")
    (flan-watch-stop))
   ;; Something else owns the connection this instant — an evaluation is
   ;; mid-flight.  Skipping is right: its `flan-dev-settle-hook' has already
   ;; taken any reply of ours, and the next tick is 0.2s away.
   (flan-dev--busy nil)
   (t
    (when flan-watch--pending
      (when-let* ((reply (flan-dev--take-reply flan-dev--connection)))
        (setq flan-watch--pending nil)
        (flan-watch--absorb reply)))
    (unless flan-watch--pending
      (condition-case nil
          (progn (flan-dev--send flan-dev--connection '(:op "watch"))
                 (setq flan-watch--pending t))
        (error (flan-watch-stop)))))))

;;; Commands

(define-derived-mode flan-watch-mode special-mode "flan-watch"
  "Major mode for the pinned watch buffer."
  (setq-local truncate-lines t))

;;;###autoload
(defun flan-watch ()
  "Open the watch buffer and start painting the running program's values."
  (interactive)
  (flan-dev--live-connection)
  ;; Arming is a message, not something the daemon infers.  The program is the
  ;; writer, so it has to be told somebody is looking — and while nobody is,
  ;; nothing writes the table at all, which is what makes a watch call in a
  ;; program nobody is debugging a load and a not-taken branch.
  (let ((r (flan-dev--request '(:op "watch-enable" :on t))))
    (unless (equal (plist-get r :status) "ok")
      (user-error "flan: %s" (or (plist-get r :message) "watch refused"))))
  (with-current-buffer (get-buffer-create flan-watch-buffer)
    (unless (eq major-mode 'flan-watch-mode) (flan-watch-mode)))
  ;; Painted before the first reply, rather than left blank until one arrives.
  ;; An empty buffer is the same picture as a broken one, and the likeliest
  ;; reason for it here is the honest one — the program is not calling into the
  ;; table — which is worth saying in words rather than by showing nothing.
  (flan-watch--paint (flan-watch--format nil 0))
  (add-hook 'flan-dev-settle-hook #'flan-watch--settle)
  (when flan-watch--timer (cancel-timer flan-watch--timer))
  (setq flan-watch--timer
        (run-with-timer 0 flan-watch-interval #'flan-watch--tick))
  (display-buffer flan-watch-buffer))

(defun flan-watch-stop ()
  "Stop painting, and tell the program to stop writing the table."
  (interactive)
  (when flan-watch--timer
    (cancel-timer flan-watch--timer)
    (setq flan-watch--timer nil))
  ;; Settle before disarming, or the disarm request reads the tick's reply.
  (flan-watch--settle)
  (remove-hook 'flan-dev-settle-hook #'flan-watch--settle)
  ;; Only on a connection that is already live, and this is the important half.
  ;; `flan-dev--request' *reconnects* — which is right for something a person
  ;; did and wrong here, because this is also called from the tick, and the
  ;; reason the tick calls it is that the connection has gone.  Reconnecting
  ;; from a timer would quietly erase the `lost' state that exists to be seen,
  ;; which `flan-dev.el' already forbids for its own poll timer.  And there is
  ;; nothing to disarm anyway: the table went with the program.
  (when (process-live-p flan-dev--connection)
    (ignore-errors (flan-dev--request '(:op "watch-enable" :on nil)))))

;;; Ghost text — not built, and what it would need

;; The author raised showing values *inline at the code they belong to* rather
;; than in a buffer of their own.  It is a better picture and it is a different
;; feature, so it is written down here rather than half-done.
;;
;; What the buffer needs is a name and a string.  Ghost text needs a *place*,
;; and nothing in the table has one: `(watch-i64 "ticks" ticks)' says what the
;; value is called, not where it was written.  Three things would have to be
;; added, and the first is the real one:
;;
;;   1. A source location per entry.  The runtime would have to carry a
;;      file:line:col alongside the name, which means the *caller* supplies it,
;;      which means the call site is generated rather than hand-written — i.e.
;;      the `(watch ...)' form in the checker, which is where a form's own
;;      location is already known.  A declare-c call cannot do it: the program
;;      would have to pass __FILE__ by hand and it would drift the moment the
;;      line moved.  So ghost text is gated on the same check.ml arm the
;;      composite renderer is.
;;
;;   2. Overlays keyed to that location, with `after-string', refreshed on the
;;      same timer.  Cheap once (1) exists; the work is invalidating them when
;;      the buffer is edited, since a line that moved leaves its overlay behind.
;;
;;   3. A rule for a watch inside a loop, which the buffer sidesteps by showing
;;      the last value written.  Inline, "the last of 4000 iterations" is
;;      usually not the interesting one, and there is no obvious better answer
;;      that does not become a UI for building a query — which is the thing
;;      this design exists to avoid.
;;
;; (3) is why this is a question and not a task.  (1) is why it cannot be
;; started here.

(provide 'flan-watch)
;;; flan-watch.el ends here