The Emacs client, and the loop is closed
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.
This commit is contained in:
parent
23b440db16
commit
56395edd59
61
NEXT.md
61
NEXT.md
@ -1,6 +1,11 @@
|
||||
# Where this is
|
||||
|
||||
**Dev loop steps 1, 2 and 3 are done** — see *The reload primitive* below. A list
|
||||
**The dev loop is closed.** `C-c C-c` in Emacs 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.
|
||||
|
||||
Steps 1, 2 and 3 are done — see *The reload primitive* below. A list
|
||||
of top-level forms can be recompiled and installed into a running process; call
|
||||
sites compiled before they existed follow them, and a `defn` or `defvar` the
|
||||
process was never built with can be added and then redefined again. That is the
|
||||
@ -41,6 +46,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅
|
||||
| `runtime/flan_dev.c` | **dev only: the by-name registry a run-time-new name needs** |
|
||||
| `vendor/raylib/` | **the raylib package: `raylib.flan`, `shim.c`, `link`** |
|
||||
| `vendor/agent/` | **the dev agent: a socket, a loader thread, install at a frame boundary** |
|
||||
| `emacs/` | **`flan-mode.el` and `flan-dev.el`: the editor half of the dev loop** |
|
||||
| `sand-sim/` | **the falling-sand simulation, with no raylib in it** |
|
||||
| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run \| reload \| dev` |
|
||||
| `test/test_flan.ml` | reader, parser and checker |
|
||||
@ -49,6 +55,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅
|
||||
| `test/test_agent.ml` | **a running program taking a redefinition over a socket** |
|
||||
| `test/test_session.ml` | **what a running process cannot be told, and recovering from a typo** |
|
||||
| `test/test_dev.ml` | **the daemon, driven the way an editor drives it** |
|
||||
| `test/test_emacs.ml` | **the client, driven against a real daemon and a real program** |
|
||||
| `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process |
|
||||
|
||||
```
|
||||
@ -615,13 +622,44 @@ first would fail for a reason that reads like a compiler bug — and it accepts
|
||||
with a timeout so that a program which has exited takes the daemon with it
|
||||
rather than leaving an editor waiting on a socket nobody is serving.
|
||||
|
||||
### The Emacs client
|
||||
|
||||
`emacs/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 bracket syntax (`[` and `{` are brackets, not symbol characters —
|
||||
every binding list and every type is written with them), the characters a Flan
|
||||
name may contain (`-`, `?`, `/`, `.`), and its keywords.
|
||||
|
||||
`emacs/flan-dev.el` is the client. There is no parser in it, which is the point
|
||||
of the protocol choice: `prin1` writes a request and `read` reads a reply.
|
||||
|
||||
| | |
|
||||
|---|---|
|
||||
| `C-c C-c` | the top-level form at point, recompiled and installed |
|
||||
| `C-c C-k` | the whole buffer, as **one** module |
|
||||
| `C-c C-z` / `C-c C-q` | connect (finds `.flan-dev.sock` upward) / disconnect |
|
||||
| `C-c C-d` | what the running program currently defines |
|
||||
|
||||
`C-c C-k` sends one module rather than a form at a time on purpose: a `defvar`
|
||||
and the function that uses it have to arrive in the same load, or the first
|
||||
refers to storage that does not exist yet.
|
||||
|
||||
**Framing is in bytes and Emacs counts characters.** Every length goes through
|
||||
`string-bytes` and the process is binary, or a single 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 would look like a corrupt protocol and appear
|
||||
only for some users. `test/test_emacs.ml` drives the real client against a real
|
||||
daemon for this 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.
|
||||
|
||||
An error comes back with a location and the client moves point to it when it is
|
||||
this buffer.
|
||||
|
||||
### What is left
|
||||
|
||||
`C-c C-c` works end to end today; what is missing is the two hops between an
|
||||
editor and it.
|
||||
|
||||
- **The Emacs client**, not a CIDER fork. Deliberately last: the protocol is
|
||||
mechanical once the daemon exists, and the client is where the taste is.
|
||||
- **A REPL buffer.** There is no `C-c C-z`-to-a-prompt, because there is
|
||||
nothing to type into it until expression eval exists.
|
||||
- **Expression eval** (`C-x C-e`) is a *different primitive* and is not built.
|
||||
Redefining a name installs a body; evaluating an expression means
|
||||
synthesizing a function around a form, calling it, and rendering the value.
|
||||
@ -693,11 +731,10 @@ primitive works.
|
||||
3. ~~**The agent, in C.**~~ **Done** — `vendor/agent/`, a listener thread that
|
||||
loads and a game thread that installs, and sand.flan polling at the top of
|
||||
its frame. See the section above.
|
||||
4. **The daemon and nREPL** (bencode over a socket; `eval`, `load-file`,
|
||||
`describe`, `interrupt`), then **5. the Emacs client** — a focused ~3–5k
|
||||
line client, not a CIDER fork. Deliberately last and deliberately separate:
|
||||
the protocol is mechanical once 1–3 exist, and the editor client is where
|
||||
the taste is.
|
||||
4. ~~**The daemon**~~ and ~~**5. the Emacs client**~~ — **both done**, and the
|
||||
protocol is s-expressions rather than nREPL's bencode; see the two sections
|
||||
above for why that changed. An nREPL front end can sit on the same
|
||||
`Session` if something else ever needs to talk to it.
|
||||
|
||||
**One decision left to settle before step 2**, because both change codegen and are
|
||||
painful to retrofit:
|
||||
|
||||
210
emacs/flan-dev.el
Normal file
210
emacs/flan-dev.el
Normal file
@ -0,0 +1,210 @@
|
||||
;;; 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
|
||||
112
emacs/flan-mode.el
Normal file
112
emacs/flan-mode.el
Normal file
@ -0,0 +1,112 @@
|
||||
;;; flan-mode.el --- Major mode for Flan -*- lexical-binding: t; -*-
|
||||
|
||||
;; Derived from lisp-mode, which is most of the work: Flan is s-expressions, so
|
||||
;; sexp motion, paren matching, `beginning-of-defun' and indentation all
|
||||
;; already do the right thing. What is left is what the language actually adds
|
||||
;; — its own literals and its own set of forms that indent like a body.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'lisp-mode)
|
||||
|
||||
;; The keymap binds them; loading the client is what defines them, and a user
|
||||
;; may well edit Flan without ever connecting to a running program.
|
||||
(declare-function flan-eval-defun "flan-dev")
|
||||
(declare-function flan-eval-buffer "flan-dev")
|
||||
(declare-function flan-connect "flan-dev")
|
||||
(declare-function flan-disconnect "flan-dev")
|
||||
(declare-function flan-describe "flan-dev")
|
||||
|
||||
(defgroup flan nil
|
||||
"Editing and evaluating Flan."
|
||||
:group 'languages
|
||||
:prefix "flan-")
|
||||
|
||||
(defconst flan--definers
|
||||
'("defn" "defvar" "defconst" "defstruct" "defunion" "defenum" "defalias"
|
||||
"declare" "import" "package")
|
||||
"Forms that introduce a top-level name.")
|
||||
|
||||
(defconst flan--special
|
||||
'("let" "if" "do" "while" "until" "dotimes" "loop" "match" "set" "return"
|
||||
"defer" "some" "none" "try" "zeroed" "uninit" "slice" "at" "len" "addr"
|
||||
"bytes" "cast" "true" "false" "nil")
|
||||
"Forms with meaning to the checker.")
|
||||
|
||||
(defvar flan-font-lock-keywords
|
||||
`((,(concat "(" (regexp-opt flan--definers t) "\\_>"
|
||||
"[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
|
||||
(1 font-lock-keyword-face)
|
||||
(2 font-lock-function-name-face nil t))
|
||||
(,(concat "(" (regexp-opt flan--special t) "\\_>") 1 font-lock-keyword-face)
|
||||
;; A keyword resolves against an enum at the call site, so it reads as a
|
||||
;; constant rather than as a string.
|
||||
("\\_<:\\(?:\\sw\\|\\s_\\)+" . font-lock-constant-face)
|
||||
;; The machine types, which are ordinary symbols but never anything else.
|
||||
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|Unit\\|Never\\|Ptr\\|Option\\)\\_>"
|
||||
. font-lock-type-face)
|
||||
("\\_<\\(?:0x[0-9a-fA-F]+\\|-?[0-9]+\\(?:\\.[0-9]+\\)?\\)\\_>"
|
||||
. font-lock-constant-face))
|
||||
"Font lock for `flan-mode'.")
|
||||
|
||||
(defvar flan-mode-syntax-table
|
||||
(let ((table (make-syntax-table lisp-mode-syntax-table)))
|
||||
;; Flan's own punctuation in names: a name may contain - ? > / and .
|
||||
(modify-syntax-entry ?? "_" table)
|
||||
(modify-syntax-entry ?! "_" table)
|
||||
(modify-syntax-entry ?/ "_" table)
|
||||
(modify-syntax-entry ?. "_" table)
|
||||
(modify-syntax-entry ?- "_" table)
|
||||
;; [ ] and { } are brackets, not symbol characters: every binding list and
|
||||
;; every type is written with them.
|
||||
(modify-syntax-entry ?\[ "(]" table)
|
||||
(modify-syntax-entry ?\] ")[" table)
|
||||
(modify-syntax-entry ?{ "(}" table)
|
||||
(modify-syntax-entry ?} "){" table)
|
||||
table)
|
||||
"Syntax table for `flan-mode'.")
|
||||
|
||||
(defvar flan-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
;; Autoloaded from flan-dev.el, so the client loads on first use.
|
||||
(define-key map (kbd "C-c C-c") #'flan-eval-defun)
|
||||
(define-key map (kbd "C-c C-k") #'flan-eval-buffer)
|
||||
(define-key map (kbd "C-c C-z") #'flan-connect)
|
||||
(define-key map (kbd "C-c C-q") #'flan-disconnect)
|
||||
(define-key map (kbd "C-c C-d") #'flan-describe)
|
||||
map)
|
||||
"Keymap for `flan-mode'.")
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode flan-mode prog-mode "Flan"
|
||||
"Major mode for editing Flan.
|
||||
|
||||
\\{flan-mode-map}"
|
||||
:syntax-table flan-mode-syntax-table
|
||||
(setq-local comment-start ";")
|
||||
(setq-local comment-start-skip ";+ *")
|
||||
(setq-local comment-add 1)
|
||||
(setq-local font-lock-defaults '(flan-font-lock-keywords))
|
||||
(setq-local indent-line-function #'lisp-indent-line)
|
||||
(setq-local lisp-indent-function #'flan-indent-function)
|
||||
(setq-local outline-regexp ";;;;+[ \t]*"))
|
||||
|
||||
(defun flan-indent-function (indent-point state)
|
||||
"Indent like Lisp, with Flan's body forms as special forms.
|
||||
INDENT-POINT and STATE are as for `lisp-indent-function'."
|
||||
(let ((open (elt state 1)))
|
||||
(or (and open
|
||||
(save-excursion
|
||||
(goto-char (1+ open))
|
||||
(let ((head (and (looking-at "\\(\\sw\\|\\s_\\)+")
|
||||
(match-string 0))))
|
||||
(when (member head '("defn" "let" "if" "while" "until"
|
||||
"dotimes" "match" "do" "loop" "defer"))
|
||||
(+ (current-column) 1)))))
|
||||
(lisp-indent-function indent-point state))))
|
||||
|
||||
;;;###autoload
|
||||
(add-to-list 'auto-mode-alist '("\\.flan\\'" . flan-mode))
|
||||
|
||||
(provide 'flan-mode)
|
||||
;;; flan-mode.el ends here
|
||||
76
emacs/test-flan-dev.el
Normal file
76
emacs/test-flan-dev.el
Normal file
@ -0,0 +1,76 @@
|
||||
;;; test-flan-dev.el --- Drive the client against a running program -*- lexical-binding: t; -*-
|
||||
|
||||
;; Run as: emacs -Q --batch -L emacs -l emacs/test-flan-dev.el -- <socket> <flan-file>
|
||||
;;
|
||||
;; This is the client half of test_dev.ml. The OCaml test proves the daemon
|
||||
;; answers correctly; this proves the elisp actually talks to it — the framing,
|
||||
;; the reply reader, and C-c C-c picking the right form out of a buffer. A
|
||||
;; protocol bug that only shows up under Emacs' coding systems would pass the
|
||||
;; OCaml test and fail here, which is the whole reason it exists.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'flan-mode)
|
||||
(require 'flan-dev)
|
||||
|
||||
(defvar test-flan--failures 0)
|
||||
|
||||
(defun test-flan--check (name ok)
|
||||
(if ok (message " ok %s" name)
|
||||
(setq test-flan--failures (1+ test-flan--failures))
|
||||
(message " FAIL %s" name)))
|
||||
|
||||
(let* ((args (cdr (member "--" command-line-args)))
|
||||
(socket (nth 0 args))
|
||||
(file (nth 1 args)))
|
||||
(find-file file)
|
||||
;; The copy comes out of a build directory, so it may arrive read-only.
|
||||
;; Set the flag directly: `read-only-mode' asks about the file on disk, and
|
||||
;; a question in a batch run is a hang waiting to happen.
|
||||
(setq buffer-read-only nil)
|
||||
(test-flan--check "flan-mode is on for a .flan file" (eq major-mode 'flan-mode))
|
||||
|
||||
(flan-connect socket)
|
||||
(test-flan--check "connected" (process-live-p flan-dev--connection))
|
||||
|
||||
(let ((r (flan-dev--request '(:op "describe"))))
|
||||
(test-flan--check "describe lists the program's functions"
|
||||
(member "step" (plist-get r :fns)))
|
||||
(test-flan--check "describe lists the program's globals"
|
||||
(member "ticks" (plist-get r :globals))))
|
||||
|
||||
;; C-c C-c on the form at point: put point inside `step' and send it. The
|
||||
;; text comes from the buffer, so this exercises `beginning-of-defun' against
|
||||
;; Flan's own syntax table as much as it does the wire.
|
||||
(goto-char (point-min))
|
||||
(search-forward "(defn step")
|
||||
(goto-char (match-beginning 0))
|
||||
(save-excursion
|
||||
(search-forward "(+ ticks 1)")
|
||||
(replace-match "(+ ticks 41)"))
|
||||
(let ((form (flan-dev--defun-at-point)))
|
||||
(test-flan--check "the form at point is the defn"
|
||||
(and (string-prefix-p "(defn step" (string-trim form))
|
||||
(string-match-p "41" form))))
|
||||
(flan-eval-defun)
|
||||
|
||||
;; And an error: the daemon answers with a location, the client raises.
|
||||
(let ((raised nil))
|
||||
(condition-case err
|
||||
(flan-dev--eval "(defn step [] i64 nonsense)" "form")
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(test-flan--check "a form that does not check is reported"
|
||||
(and raised (string-match-p "unknown name" raised))))
|
||||
|
||||
;; The session is not poisoned by that: a good form still lands.
|
||||
(flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")
|
||||
|
||||
(flan-disconnect)
|
||||
(test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
|
||||
|
||||
(if (zerop test-flan--failures)
|
||||
(message "flan-dev.el: all tests passed")
|
||||
(message "\n%d failure(s)" test-flan--failures)
|
||||
(kill-emacs 1)))
|
||||
|
||||
;;; test-flan-dev.el ends here
|
||||
@ -1,5 +1,5 @@
|
||||
(tests
|
||||
(names test_flan test_acceptance test_reload test_agent test_session test_dev)
|
||||
(names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs)
|
||||
(libraries flan unix)
|
||||
; The acceptance programs are part of the test corpus: if the reader, the
|
||||
; parser or the checker regresses on them we want to know here, not at the CLI.
|
||||
@ -16,4 +16,6 @@
|
||||
; The reload primitive's host: a C main that dlopens what Build.shared made.
|
||||
(file reload_host.c)
|
||||
; test_dev runs the compiler itself: flan dev launches and owns a program.
|
||||
(file %{workspace_root}/bin/main.exe)))
|
||||
(file %{workspace_root}/bin/main.exe)
|
||||
; The Emacs client, which test_emacs drives against a real daemon.
|
||||
(glob_files %{workspace_root}/emacs/*.el)))
|
||||
|
||||
76
test/test_emacs.ml
Normal file
76
test/test_emacs.ml
Normal file
@ -0,0 +1,76 @@
|
||||
(* The Emacs client, against a real daemon and a real running program.
|
||||
|
||||
test_dev.ml proves the daemon answers correctly. This proves the elisp
|
||||
actually talks to it, which is not the same claim: the framing is in bytes
|
||||
and Emacs counts characters, `beginning-of-defun' has to find a Flan
|
||||
top-level form through Flan's own syntax table, and a reply is read with
|
||||
`read'. A mistake in any of those passes the OCaml test and fails here.
|
||||
|
||||
Skipped, not failed, where there is no emacs — the compiler does not depend
|
||||
on one. *)
|
||||
|
||||
let scratch = Filename.get_temp_dir_name ()
|
||||
let tmp n = Filename.concat scratch ("flan-emacs-" ^ n)
|
||||
|
||||
let rec await ?(ms = 8000) f =
|
||||
if f () then true
|
||||
else if ms <= 0 then false
|
||||
else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end
|
||||
|
||||
let () =
|
||||
let have cmd = Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" cmd) = 0 in
|
||||
if not (have "emacs") then print_endline "emacs: skipped (no emacs on PATH)"
|
||||
else if not (have "clang" && have "llc") then
|
||||
print_endline "emacs: skipped (no clang or llc on PATH)"
|
||||
else begin
|
||||
let sock = tmp "dev.sock" and out = tmp "prog.out" in
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
|
||||
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||
let flan = "../bin/main.exe" in
|
||||
let pid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock |]
|
||||
Unix.stdin fd Unix.stderr
|
||||
in
|
||||
Unix.close fd;
|
||||
if not (await (fun () -> Sys.file_exists sock)) then begin
|
||||
print_endline "FAIL the daemon never listened";
|
||||
(try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
|
||||
exit 1
|
||||
end;
|
||||
(* A copy, because the test edits the buffer it sends from. Removed first
|
||||
and made writable after: the original comes out of a build directory
|
||||
read-only, so copying onto a leftover copy would fail and leave the old
|
||||
one in place. *)
|
||||
let buf = tmp "buf.flan" in
|
||||
(try Sys.remove buf with Sys_error _ -> ());
|
||||
ignore
|
||||
(Sys.command
|
||||
(Printf.sprintf "cp %s %s" (Filename.quote "programs/dev-loop.flan")
|
||||
(Filename.quote buf)));
|
||||
(try Unix.chmod buf 0o644 with Unix.Unix_error _ -> ());
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf
|
||||
"emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el -- %s %s 2>&1"
|
||||
(Filename.quote sock) (Filename.quote buf))
|
||||
in
|
||||
(* The client disconnects at the end, which is what ends the daemon. If it
|
||||
did not get that far — because it failed — nothing else will, so it is
|
||||
stopped here rather than left waiting on a socket nobody will use. *)
|
||||
if not (await ~ms:3000 (fun () ->
|
||||
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
||||
| 0, _ -> false
|
||||
| _ -> true
|
||||
| exception Unix.Unix_error _ -> true))
|
||||
then begin
|
||||
(try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
|
||||
end;
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; buf ];
|
||||
if code = 0 then print_endline "emacs: all tests passed"
|
||||
else begin
|
||||
Printf.printf "\nemacs client exited %d\n" code;
|
||||
exit 1
|
||||
end
|
||||
end
|
||||
Loading…
x
Reference in New Issue
Block a user