Joseph Ferano
56395edd59
C-c C-c recompiles the top-level form at point and installs it in a running
program at that program's next frame boundary. Verified against sand: an
unsaved buffer edit to game-draw, and 240 consecutive frames drew it.
flan-mode.el derives from prog-mode with lisp-mode's syntax table, which is
most of the work - Flan is s-expressions, so sexp motion, paren matching,
beginning-of-defun and indentation are already right. What it adds is Flan's
own brackets ([ and { are brackets and not symbol characters, since every
binding list and every type is written with them), the characters a name may
contain, and its keywords.
flan-dev.el has no parser in it, which is what the protocol choice bought:
prin1 writes a request, read reads a reply. C-c C-k sends a buffer as one
module rather than a form at a time, because a defvar and the function using it
have to arrive in the same load or the first refers to storage that does not
exist yet. An error comes back with a location and point moves there.
Framing is in bytes and Emacs counts characters, so every length goes through
string-bytes and the process is binary. Otherwise one non-ASCII character in a
buffer puts the reply stream out of step by exactly as many bytes as the
payload has of them - a bug that reads as a corrupt protocol and only appears
for some people. test_emacs.ml drives the real client against a real daemon for
that reason: it is not the same claim as the daemon answering correctly, and a
mistake in the framing, in beginning-of-defun over Flan's syntax table, or in
the reply reader passes test_dev.ml and fails here.
211 lines
8.5 KiB
EmacsLisp
211 lines
8.5 KiB
EmacsLisp
;;; flan-dev.el --- Talk to a running Flan program -*- lexical-binding: t; -*-
|
|
|
|
;; The editor half of Flan's dev loop. `flan dev program.flan' compiles the
|
|
;; program, launches it, and listens on .flan-dev.sock beside the source; this
|
|
;; connects to that socket and sends it forms.
|
|
;;
|
|
;; C-c C-c recompiles the top-level form at point and installs it in the
|
|
;; running program, at that program's next frame boundary. Call sites compiled
|
|
;; before the new body existed follow it, and the program's state — its globals
|
|
;; — is untouched. C-c C-k does the same for a whole buffer.
|
|
;;
|
|
;; The protocol is one s-expression per message, length framed. That is why
|
|
;; there is no parser here: `prin1' writes a request and `read' reads a reply.
|
|
;;
|
|
;; Not implemented, because it does not exist on the other side: evaluating an
|
|
;; expression. Redefining a name installs a body; evaluating an expression
|
|
;; means synthesising a function around a form, calling it, and rendering the
|
|
;; value, which is a different primitive.
|
|
|
|
;;; Code:
|
|
|
|
(require 'subr-x)
|
|
|
|
(defgroup flan-dev nil
|
|
"Talking to a running Flan program."
|
|
:group 'flan
|
|
:prefix "flan-dev-")
|
|
|
|
(defcustom flan-dev-socket-name ".flan-dev.sock"
|
|
"Name of the socket `flan dev' listens on, looked for up from the buffer."
|
|
:type 'string)
|
|
|
|
(defcustom flan-dev-echo-result t
|
|
"Whether a successful evaluation reports in the echo area."
|
|
:type 'boolean)
|
|
|
|
(defvar flan-dev--connection nil
|
|
"The open connection, or nil.")
|
|
|
|
(defvar flan-dev--socket nil
|
|
"Path of the socket `flan-dev--connection' is connected to.")
|
|
|
|
;;; Wire
|
|
|
|
;; Framing is a decimal byte count, a newline, then that many bytes. A message
|
|
;; carries Flan source, which contains newlines, so a line-oriented protocol
|
|
;; would need an escape layer that this does not. Lengths are in *bytes*, so
|
|
;; every measurement goes through `string-bytes' and the process is raw-text —
|
|
;; a multibyte identifier would otherwise put the reply stream out of step by
|
|
;; exactly as many bytes as the payload has non-ASCII characters.
|
|
|
|
(defun flan-dev--send (proc form)
|
|
"Send FORM to PROC as one framed message."
|
|
(let* ((payload (encode-coding-string (prin1-to-string form) 'utf-8 t)))
|
|
(process-send-string proc (format "%d\n%s" (length payload) payload))))
|
|
|
|
(defun flan-dev--read-reply (proc)
|
|
"Block until PROC sends one complete framed message, and read it."
|
|
(with-current-buffer (process-buffer proc)
|
|
(let ((deadline (+ (float-time) 30)))
|
|
;; The header first: digits up to a newline.
|
|
(while (and (not (save-excursion (goto-char (point-min))
|
|
(re-search-forward "\\`\\([0-9]+\\)\n" nil t)))
|
|
(< (float-time) deadline))
|
|
(accept-process-output proc 0.05))
|
|
(goto-char (point-min))
|
|
(unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
|
|
(error "flan dev: no reply"))
|
|
(let* ((n (string-to-number (match-string 1)))
|
|
(body-start (point)))
|
|
(while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n)
|
|
(< (float-time) deadline))
|
|
(accept-process-output proc 0.05))
|
|
(let* ((end (byte-to-position (+ (position-bytes body-start) n)))
|
|
(text (decode-coding-string
|
|
(encode-coding-string (buffer-substring-no-properties
|
|
body-start end)
|
|
'utf-8 t)
|
|
'utf-8))
|
|
(form (car (read-from-string text))))
|
|
(delete-region (point-min) end)
|
|
form)))))
|
|
|
|
(defun flan-dev--request (form)
|
|
"Send FORM to the connected program and return its reply."
|
|
(let ((proc (flan-dev--live-connection)))
|
|
(flan-dev--send proc form)
|
|
(flan-dev--read-reply proc)))
|
|
|
|
;;; Connection
|
|
|
|
(defun flan-dev--find-socket ()
|
|
"Find the daemon's socket by walking up from the current buffer."
|
|
(let ((dir (locate-dominating-file
|
|
(or buffer-file-name default-directory)
|
|
flan-dev-socket-name)))
|
|
(and dir (expand-file-name flan-dev-socket-name dir))))
|
|
|
|
(defun flan-dev--live-connection ()
|
|
"The open connection, or signal an error saying how to get one."
|
|
(unless (and flan-dev--connection
|
|
(process-live-p flan-dev--connection))
|
|
(error "Not connected: M-x flan-connect, or start `flan dev program.flan'"))
|
|
flan-dev--connection)
|
|
|
|
;;;###autoload
|
|
(defun flan-connect (&optional socket)
|
|
"Connect to a `flan dev' daemon listening on SOCKET.
|
|
With no argument, look for `flan-dev-socket-name' up from this buffer."
|
|
(interactive
|
|
(list (or (flan-dev--find-socket)
|
|
(read-file-name "flan dev socket: "))))
|
|
(unless socket (user-error "No %s found above this buffer" flan-dev-socket-name))
|
|
(when (process-live-p flan-dev--connection)
|
|
(delete-process flan-dev--connection))
|
|
(let ((buf (get-buffer-create " *flan-dev*")))
|
|
(with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil))
|
|
(setq flan-dev--connection
|
|
(make-network-process
|
|
:name "flan-dev" :buffer buf :family 'local :service socket
|
|
:coding 'binary :noquery t))
|
|
(setq flan-dev--socket socket))
|
|
(let ((r (flan-dev--request '(:op "describe"))))
|
|
(message "flan dev: connected to %s (%d functions, %d globals)"
|
|
(abbreviate-file-name socket)
|
|
(length (plist-get r :fns)) (length (plist-get r :globals))))
|
|
flan-dev--connection)
|
|
|
|
(defun flan-disconnect ()
|
|
"Close the connection, which also ends the daemon and its program."
|
|
(interactive)
|
|
(when (process-live-p flan-dev--connection)
|
|
(ignore-errors (flan-dev--request '(:op "close")))
|
|
(delete-process flan-dev--connection))
|
|
(setq flan-dev--connection nil)
|
|
(message "flan dev: disconnected"))
|
|
|
|
(defun flan-describe ()
|
|
"Report what the running program currently defines."
|
|
(interactive)
|
|
(let ((r (flan-dev--request '(:op "describe"))))
|
|
(message "flan dev: %s, %d functions, %d globals"
|
|
(if (plist-get r :alive) "running" "exited")
|
|
(length (plist-get r :fns)) (length (plist-get r :globals)))))
|
|
|
|
;;; Evaluating
|
|
|
|
(defun flan-dev--report (reply what)
|
|
"Report REPLY, describing WHAT was sent."
|
|
(if (equal (plist-get reply :status) "ok")
|
|
(let ((fns (plist-get reply :fns))
|
|
(names (plist-get reply :names)))
|
|
(when flan-dev-echo-result
|
|
(message "%s installed in %.0fms"
|
|
(if fns (string-join fns ", ")
|
|
(if names (string-join names ", ") what))
|
|
(or (plist-get reply :ms) 0))))
|
|
;; The daemon reports where, so put point there when it is this buffer.
|
|
(let ((loc (plist-get reply :loc))
|
|
(msg (plist-get reply :message)))
|
|
(when (and loc (string-match "\\`\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)\\'" loc))
|
|
(let ((file (match-string 1 loc))
|
|
(line (string-to-number (match-string 2 loc)))
|
|
(col (string-to-number (match-string 3 loc))))
|
|
(when (and buffer-file-name (file-equal-p file buffer-file-name))
|
|
(goto-char (point-min))
|
|
(forward-line (1- line))
|
|
(forward-char (max 0 (1- col))))))
|
|
(user-error "flan: %s" (or msg "rejected")))))
|
|
|
|
(defun flan-dev--eval (code what)
|
|
"Send CODE to the running program. WHAT names it for the echo area."
|
|
(flan-dev--report
|
|
(flan-dev--request
|
|
;; buffer-file-name so an error points at the file being edited rather than
|
|
;; at the daemon's placeholder.
|
|
(list :op "eval" :code code :file (or buffer-file-name "<buffer>")))
|
|
what))
|
|
|
|
(defun flan-dev--defun-at-point ()
|
|
"The text of the top-level form containing or preceding point."
|
|
(save-excursion
|
|
(end-of-defun)
|
|
(let ((end (point)))
|
|
(beginning-of-defun)
|
|
(buffer-substring-no-properties (point) end))))
|
|
|
|
;;;###autoload
|
|
(defun flan-eval-defun ()
|
|
"Recompile the top-level form at point and install it in the running program."
|
|
(interactive)
|
|
(flan-dev--eval (flan-dev--defun-at-point) "form"))
|
|
|
|
;;;###autoload
|
|
(defun flan-eval-buffer ()
|
|
"Recompile every top-level form in this buffer and install them together.
|
|
One module, not one per form: a var and the function that uses it have to
|
|
arrive in the same load or the first refers to storage that does not exist."
|
|
(interactive)
|
|
(flan-dev--eval (buffer-substring-no-properties (point-min) (point-max))
|
|
(buffer-name)))
|
|
|
|
;;;###autoload
|
|
(defun flan-eval-region (start end)
|
|
"Recompile the top-level forms between START and END."
|
|
(interactive "r")
|
|
(flan-dev--eval (buffer-substring-no-properties start end) "region"))
|
|
|
|
(provide 'flan-dev)
|
|
;;; flan-dev.el ends here
|