eldoc, completion and M-. off one cached reply
All three want the same three facts about a name — what it is, what it looks like, and where it was written — so the daemon answers all three in one `defs` reply and the client keeps the last one. `defs` is its own op rather than more fields on `describe`. `describe` is what an editor *polls*: it is how the program's output gets drained, and the existing tests ask it in loops. Signatures riding on that would be paid for every time anyone glanced at the output buffer. This is asked once on connect and again after each accepted install, which is exactly when the answer can have changed — so a `defn` typed a second ago completes. It is a cache rather than a request per keystroke because of where these are called from: eldoc fires on an idle timer and completion inside redisplay, and neither may block on a socket or signal. Three refusals rather than three guesses. A global has no location because `Tast.global` carries no `Loc`, and searching the buffer for "(defvar ticks" instead would find the wrong one in a program of several files. The prelude is a string inside the compiler, so its location names a file nobody can visit. A short name that could be several of the program's package-qualified ones is ambiguous, and picking would be a guess about which function you meant — a name that is the tail of exactly *one* is not a guess, and resolves. Functions the checker invented — a lifted handler-bind clause, which carries an `fparent` — are left out entirely: nobody wrote that name, so completing it is noise and jumping to it is meaningless. And the daemon now makes its own source path absolute before building, because every location it reports derives from it. `flan dev src/game.flan` from a project root answered `src/game.flan:12:7`, which an editor can only resolve by guessing what it was relative to. lib/dev.ml is the only compiler file touched: a `defs` op, its three list builders, and the one `realpath` in `start`. Nothing existing changed shape — `describe`, `eval` and `eval-expr` answer byte for byte what they did.
This commit is contained in:
parent
9e7eba1479
commit
7118d6106d
48
NEXT.md
48
NEXT.md
@ -759,9 +759,26 @@ can sit on the same `Session` later; it should not have gated the editor.
|
||||
(:op "describe") → (:status "ok" :fns (…) :globals (…) :alive t)
|
||||
(:op "eval" :code "…" :file "/buf.flan") → (:status "ok" :names (…) :fns (…) :ms 19.0)
|
||||
→ (:status "error" :message "…" :loc "/buf.flan:1:19")
|
||||
(:op "defs") → (:status "ok" :defs ((name kind signature loc) …))
|
||||
(:op "close")
|
||||
```
|
||||
|
||||
`defs` is its own op rather than more fields on `describe`, because `describe`
|
||||
is what an editor *polls* — it is how the program's output is drained — and
|
||||
signatures on that would be paid for every time anyone glanced at the output
|
||||
buffer. It is asked once on connect and again after each accepted install.
|
||||
Four strings an editor reads with `read` and nothing else: eldoc, completion
|
||||
and find-definition want the same three facts about a name. `loc` is empty
|
||||
where there is none to give, because only `Tast.fn` carries one — an editor
|
||||
must refuse rather than go looking for the definition itself, which in a
|
||||
program of several files finds the wrong one. Parameter *names* are not in the
|
||||
Tast, so a signature is `step [i64 f32] i64`: types only.
|
||||
|
||||
The daemon makes its own source path absolute before building, because every
|
||||
location it reports derives from it. `flan dev src/game.flan` run from a
|
||||
project root otherwise answered `src/game.flan:12:7`, which an editor can only
|
||||
resolve by guessing which directory it was relative to.
|
||||
|
||||
An evaluation that declares nothing to install — a declaration the program
|
||||
already has, with no body and no new storage — is accepted and answered with
|
||||
`:note "nothing to install"` rather than by shipping an empty module. Building
|
||||
@ -809,6 +826,20 @@ of the protocol choice: `prin1` writes a request and `read` reads a reply.
|
||||
| `C-c C-o` | the running program's own output, in `*flan-output*` |
|
||||
| `C-c C-r` | a prompt on the running program (`*flan-repl*`) |
|
||||
| `C-c C-d` | what the running program currently defines |
|
||||
| `M-.` / `M-,` | where a name is written, through an `xref` backend |
|
||||
|
||||
eldoc, `completion-at-point` and `M-.` all read one cached `defs` reply rather
|
||||
than asking per keystroke: eldoc fires on an idle timer and completion inside
|
||||
redisplay, and neither may block on a socket or signal. The cache is refreshed
|
||||
at the two moments the answer can have changed — on connect, and after an
|
||||
evaluation the daemon accepted — so a `defn` just installed completes at once.
|
||||
|
||||
The modeline says whether there is a program on the other end, in three states.
|
||||
`lost` is a daemon that has gone away, which is ordinary rather than an error —
|
||||
`flan dev` ends when its program does — so the next request reconnects on the
|
||||
socket it was on. Strictly *before* a send, never after one: a connection that
|
||||
died mid-request may have died after the daemon ran what it was given, and
|
||||
resending would install it twice or evaluate a side-effecting expression twice.
|
||||
|
||||
`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
|
||||
@ -823,8 +854,21 @@ 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.
|
||||
An error comes back with a location and the client draws an overlay there, with
|
||||
the message beside the code, cleared the next time that buffer's evaluation is
|
||||
accepted. Two things had to be right first. **The column in a `:loc` is a byte
|
||||
offset**, because the reader walks the source a byte at a time — the same rule
|
||||
as the framing, in a different place, and `forward-char` with it put the marker
|
||||
as many columns right as the line had non-ASCII characters before it. And the
|
||||
daemon numbers lines from the start of what it was *sent*, so `C-c C-c` on a
|
||||
defn halfway down a buffer answered line 1 and every overlay would have sat on
|
||||
the file's first line; the client pads the form with leading newlines, which
|
||||
the reader skips, so the reply's line numbers are the buffer's own.
|
||||
|
||||
An accepted evaluation says which names landed and what the build cost, and
|
||||
flashes the region that was sent. Silent success is indistinguishable from
|
||||
silent failure, and `beginning-of-defun` may well have found a different form
|
||||
from the one point looked like it was in.
|
||||
|
||||
**The program's stdout is a pipe into the daemon**, and whatever it printed
|
||||
since the last reply rides along with the next one into `*flan-output*`. Having
|
||||
|
||||
@ -26,6 +26,9 @@
|
||||
(require 'seq)
|
||||
(require 'pcase)
|
||||
(require 'pulse)
|
||||
(require 'cl-lib)
|
||||
(require 'xref)
|
||||
(require 'eldoc)
|
||||
|
||||
(defgroup flan-dev nil
|
||||
"Talking to a running Flan program."
|
||||
@ -173,6 +176,9 @@ that quietly did nothing, which is why it is on."
|
||||
(t
|
||||
(condition-case err
|
||||
(progn (flan-dev--open flan-dev--socket)
|
||||
;; A restarted daemon is a rebuilt program: everything known
|
||||
;; about its names was about the last one.
|
||||
(flan-dev--forget-defs)
|
||||
(message "flan dev: reconnected to %s"
|
||||
(abbreviate-file-name flan-dev--socket)))
|
||||
(error
|
||||
@ -193,6 +199,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer."
|
||||
(unless socket (user-error "No %s found above this buffer" flan-dev-socket-name))
|
||||
(flan-dev--open socket)
|
||||
(let ((r (flan-dev--request '(:op "describe"))))
|
||||
(flan-dev-refresh-defs)
|
||||
(message "flan dev: connected to %s (%d functions, %d globals)"
|
||||
(abbreviate-file-name socket)
|
||||
(length (plist-get r :fns)) (length (plist-get r :globals))))
|
||||
@ -208,6 +215,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer."
|
||||
;; Forgotten, not kept: this was a deliberate disconnect, so the next
|
||||
;; request should say so rather than quietly reopening what was just closed.
|
||||
(setq flan-dev--socket nil)
|
||||
(flan-dev--forget-defs)
|
||||
(force-mode-line-update t)
|
||||
(message "flan dev: disconnected"))
|
||||
|
||||
@ -355,6 +363,188 @@ Returns non-nil when it put an overlay somewhere."
|
||||
(when (eq buf (current-buffer)) (goto-char beg))
|
||||
t)))))))
|
||||
|
||||
;;; What the program defines
|
||||
|
||||
;; eldoc, completion and find-definition all want the same three things about a
|
||||
;; name — what it is, what it looks like, and where it was written — so the
|
||||
;; daemon answers all three in one `defs' reply and this keeps the last one.
|
||||
;;
|
||||
;; It is a *cache* rather than a request per keystroke because of where these
|
||||
;; are called from: eldoc fires on an idle timer and completion inside the
|
||||
;; minibuffer's redisplay, and neither may block on a socket or signal. So
|
||||
;; they read this and nothing else, and it is refreshed at the two moments the
|
||||
;; answer can have changed — on connect, and after an evaluation the daemon
|
||||
;; accepted. A freshly installed `defn' completes immediately; nothing else
|
||||
;; can have appeared in between, because this editor is the only client.
|
||||
|
||||
(defvar flan-dev--defs nil
|
||||
"What the running program defines: a list of (NAME KIND SIGNATURE LOC).
|
||||
LOC is the empty string where the daemon has none to give.")
|
||||
|
||||
(defun flan-dev--forget-defs ()
|
||||
"Drop what is known about the program's names."
|
||||
(setq flan-dev--defs nil))
|
||||
|
||||
(defun flan-dev-refresh-defs ()
|
||||
"Ask the running program what it defines, and remember it."
|
||||
(interactive)
|
||||
(setq flan-dev--defs (plist-get (flan-dev--request '(:op "defs")) :defs))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "flan: %d names" (length flan-dev--defs)))
|
||||
flan-dev--defs)
|
||||
|
||||
(defun flan-dev--lookup (name)
|
||||
"The entry for NAME, or nil.
|
||||
|
||||
A name is looked up exactly first. Failing that, a buffer inside a package
|
||||
writes `settle' for what the program calls `sim/settle' — the alias is applied
|
||||
from the file's own package, which this end does not know — so a name that is
|
||||
the tail of exactly one program name resolves to it. Exactly one: several is
|
||||
ambiguous and resolving it by picking would be a guess about which function
|
||||
you meant."
|
||||
(or (assoc name flan-dev--defs)
|
||||
(let ((tail (concat "/" name)))
|
||||
(let ((hits (seq-filter (lambda (d) (string-suffix-p tail (car d)))
|
||||
flan-dev--defs)))
|
||||
(and (= 1 (length hits)) (car hits))))))
|
||||
|
||||
(defun flan-dev--ambiguous (name)
|
||||
"The entries whose name ends in NAME, when there is more than one."
|
||||
(let ((hits (seq-filter (lambda (d) (string-suffix-p (concat "/" name) (car d)))
|
||||
flan-dev--defs)))
|
||||
(and (> (length hits) 1) hits)))
|
||||
|
||||
;;; eldoc
|
||||
|
||||
(defun flan-dev--enclosing-head ()
|
||||
"The symbol heading the innermost form point is inside, or nil."
|
||||
(ignore-errors
|
||||
(save-excursion
|
||||
(let ((open (nth 1 (syntax-ppss))))
|
||||
(when open
|
||||
(goto-char (1+ open))
|
||||
(and (looking-at "\\(?:\\sw\\|\\s_\\)+") (match-string-no-properties 0)))))))
|
||||
|
||||
(defun flan-dev-eldoc-function (callback &rest _)
|
||||
"Give CALLBACK the signature of the name at point, from the running program.
|
||||
Falls back to the form point is inside, which is what you want while typing
|
||||
its arguments. Reads the cache only: eldoc runs on a timer and must not
|
||||
block on a socket or signal."
|
||||
(let* ((name (or (thing-at-point 'symbol t) (flan-dev--enclosing-head)))
|
||||
(d (and name (flan-dev--lookup name))))
|
||||
(when d
|
||||
(funcall callback
|
||||
(concat (propertize (nth 2 d) 'face 'font-lock-function-name-face)
|
||||
(pcase (nth 1 d)
|
||||
("fn" "")
|
||||
(k (concat " " k))))
|
||||
:thing (car d))
|
||||
t)))
|
||||
|
||||
;;; Completion
|
||||
|
||||
(defun flan-dev-completion-at-point ()
|
||||
"Complete the name at point against the running program's own names.
|
||||
Nothing is offered when nothing is known — an empty table would look like
|
||||
\"no such name\" rather than \"not connected\"."
|
||||
(when flan-dev--defs
|
||||
(let ((b (bounds-of-thing-at-point 'symbol)))
|
||||
(when b
|
||||
(list (car b) (cdr b)
|
||||
(mapcar #'car flan-dev--defs)
|
||||
:annotation-function
|
||||
(lambda (n) (let ((d (assoc n flan-dev--defs)))
|
||||
(and d (concat " " (nth 1 d)))))
|
||||
:company-docsig
|
||||
(lambda (n) (let ((d (assoc n flan-dev--defs))) (and d (nth 2 d))))
|
||||
;; Not exclusive: dabbrev and the like still have something to
|
||||
;; say about a name the program has not been told about yet.
|
||||
:exclusive 'no)))))
|
||||
|
||||
;;; Finding a definition
|
||||
|
||||
;; An xref backend rather than a command of its own, so M-. and M-, are what
|
||||
;; they always are. Its refusals are by name: the daemon has no location for a
|
||||
;; global, and the prelude is a string in the compiler rather than a file, and
|
||||
;; both of those must say so instead of opening an empty buffer.
|
||||
|
||||
(defun flan-dev-xref-backend ()
|
||||
"The xref backend for a buffer with a running Flan program behind it."
|
||||
(and flan-dev--defs 'flan))
|
||||
|
||||
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql flan)))
|
||||
(thing-at-point 'symbol t))
|
||||
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql flan)))
|
||||
(mapcar #'car flan-dev--defs))
|
||||
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql flan)) identifier)
|
||||
(let ((d (flan-dev--lookup identifier)))
|
||||
(cond
|
||||
((null d)
|
||||
(if-let ((hits (flan-dev--ambiguous identifier)))
|
||||
(user-error "flan: %s could be %s; write the one you mean"
|
||||
identifier (string-join (mapcar #'car hits) " or "))
|
||||
(user-error "flan: the running program defines no %s" identifier)))
|
||||
((equal (nth 3 d) "")
|
||||
;; Tast.global and Tast.extern carry no Loc, so there is nothing to go
|
||||
;; to. Guessing by searching for "(defvar ticks" would find the wrong
|
||||
;; one in a program of several files, which is worse than refusing.
|
||||
(user-error "flan: %s is a %s, and the daemon reports no location for one"
|
||||
(car d) (nth 1 d)))
|
||||
(t
|
||||
(let ((parts (flan-dev--parse-loc (nth 3 d))))
|
||||
(cond
|
||||
((null parts)
|
||||
(user-error "flan: the daemon gave %s an unreadable location: %s"
|
||||
(car d) (nth 3 d)))
|
||||
((string-match-p "\\`<.*>\\'" (nth 0 parts))
|
||||
;; The prelude is a string inside the compiler (lib/prelude.ml) and
|
||||
;; names itself <prelude>; anything in angle brackets is a
|
||||
;; placeholder the frontend made up, not a path.
|
||||
(user-error "flan: %s is defined in %s, which is not a file on disk"
|
||||
(car d) (nth 0 parts)))
|
||||
((not (file-name-absolute-p (nth 0 parts)))
|
||||
;; The daemon makes its own source path absolute, so anything
|
||||
;; relative arriving here came from somewhere that did not, and the
|
||||
;; directory it is relative to is the daemon's, not this one's.
|
||||
(user-error "flan: %s is at %s, relative to a directory this end does not know"
|
||||
(car d) (nth 0 parts)))
|
||||
((not (file-exists-p (nth 0 parts)))
|
||||
;; The prelude is a string inside the compiler (lib/prelude.ml), so
|
||||
;; its location names a file nobody can visit.
|
||||
(user-error "flan: %s is defined in %s, which is not a file on disk"
|
||||
(car d) (nth 0 parts)))
|
||||
(t
|
||||
(list (xref-make
|
||||
(nth 2 d)
|
||||
(xref-make-file-location
|
||||
(nth 0 parts) (nth 1 parts)
|
||||
;; A byte column, like every other one the daemon sends, but
|
||||
;; a top-level definition starts at column 1 and anything
|
||||
;; indenting it is ASCII, so the two agree here.
|
||||
(max 0 (1- (nth 2 parts)))))))))))))
|
||||
|
||||
;;; Wiring it into a buffer
|
||||
|
||||
(defun flan-dev-setup ()
|
||||
"Give this buffer eldoc, completion and M-. against the running program.
|
||||
Installed from here rather than from `flan-mode', which must keep working for
|
||||
someone editing Flan with no program running and this file never loaded."
|
||||
(add-hook 'completion-at-point-functions #'flan-dev-completion-at-point nil t)
|
||||
(add-hook 'xref-backend-functions #'flan-dev-xref-backend nil t)
|
||||
(add-hook 'eldoc-documentation-functions #'flan-dev-eldoc-function nil t)
|
||||
(eldoc-mode 1))
|
||||
|
||||
(add-hook 'flan-mode-hook #'flan-dev-setup)
|
||||
|
||||
;; Buffers that were already in flan-mode when this file loaded: the client is
|
||||
;; autoloaded on first use, so by the time it arrives the file being edited has
|
||||
;; long since had its mode hooks run.
|
||||
(dolist (b (buffer-list))
|
||||
(with-current-buffer b
|
||||
(when (derived-mode-p 'flan-mode) (flan-dev-setup))))
|
||||
|
||||
;;; Evaluating
|
||||
|
||||
;; An install that says nothing is indistinguishable from one that failed
|
||||
@ -382,6 +572,9 @@ of the tenth name tells you neither how many there were nor which."
|
||||
(value (plist-get reply :value)))
|
||||
;; Accepted, so whatever the last rejection marked is no longer true.
|
||||
(flan-dev-clear-errors)
|
||||
;; ...and a name that was just installed should complete, and have a
|
||||
;; signature, from this moment rather than from the next connect.
|
||||
(when (or fns names) (ignore-errors (flan-dev-refresh-defs)))
|
||||
(when flan-dev-echo-result
|
||||
(cond
|
||||
;; An expression's value, rendered inside the running program —
|
||||
|
||||
@ -56,6 +56,10 @@
|
||||
(setq-local comint-input-sender #'flan-repl--send)
|
||||
;; Nothing is echoed back by a process, because there is no process.
|
||||
(setq-local comint-process-echoes nil)
|
||||
;; The prompt gets completion, eldoc and M-. for the same names a buffer
|
||||
;; does, and against the same program: they read the client's cache, which
|
||||
;; is program-scoped, which is exactly what a prompt is.
|
||||
(flan-dev-setup)
|
||||
(setq-local font-lock-defaults '(flan-font-lock-keywords)))
|
||||
|
||||
(defun flan-repl--complete-p (text)
|
||||
|
||||
@ -193,6 +193,106 @@ is written instead — the real `message' call the real command makes."
|
||||
(test-flan--check "a short one is just named"
|
||||
(equal (flan-dev--names-phrase '("a" "b") "fallback") "a, b"))
|
||||
|
||||
;; `defs' is what eldoc, completion and M-. all read. One op answering all
|
||||
;; three, cached, because eldoc fires on an idle timer and completion inside
|
||||
;; redisplay, and neither may block on a socket.
|
||||
(test-flan--check "the program's names are known"
|
||||
(assoc "step" flan-dev--defs))
|
||||
(test-flan--check "with a signature"
|
||||
(equal (nth 2 (assoc "step" flan-dev--defs)) "step [] i64"))
|
||||
(test-flan--check "a global is known, and says it is one"
|
||||
(equal (nth 1 (assoc "ticks" flan-dev--defs)) "var"))
|
||||
(test-flan--check "so is an imported package's extern"
|
||||
(let ((d (assoc "agent/wait-raw" flan-dev--defs)))
|
||||
(and d (equal (nth 1 d) "extern"))))
|
||||
;; `step' was last installed from this buffer, so that is where the daemon
|
||||
;; says it is — which is also the check that the client's line padding put it
|
||||
;; on the line it is really on rather than on line 1.
|
||||
(test-flan--check "a fn carries where it is written"
|
||||
(equal (nth 3 (assoc "step" flan-dev--defs))
|
||||
(format "%s:%d:7" buffer-file-name
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "(defn step")
|
||||
(line-number-at-pos)))))
|
||||
|
||||
;; eldoc: the signature of the name at point, and of the form point is
|
||||
;; inside, which is what you want while typing arguments.
|
||||
(goto-char (point-min))
|
||||
(search-forward "(set ticks (step")
|
||||
(let ((said nil))
|
||||
(test-flan--check "eldoc answers for the name at point"
|
||||
(and (flan-dev-eldoc-function
|
||||
(lambda (s &rest _) (setq said s)))
|
||||
said (string-match-p "step \\[\\] i64" said))))
|
||||
(let ((said nil))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "(set ticks (step)")
|
||||
(backward-char 1) ; inside (step ...), not on the name
|
||||
(flan-dev-eldoc-function (lambda (s &rest _) (setq said s))))
|
||||
(test-flan--check "and for the form point is inside"
|
||||
(and said (string-match-p "step" said))))
|
||||
(let ((said nil))
|
||||
(with-temp-buffer
|
||||
(insert "not-a-flan-name")
|
||||
(flan-dev-eldoc-function (lambda (s &rest _) (setq said s))))
|
||||
(test-flan--check "and says nothing about a name the program has not got"
|
||||
(null said)))
|
||||
|
||||
;; Completion: the running program's names, through `completion-at-point'.
|
||||
(goto-char (point-min))
|
||||
(search-forward "(defn step")
|
||||
(let* ((capf (flan-dev-completion-at-point))
|
||||
(table (nth 2 capf)))
|
||||
(test-flan--check "completion offers the program's own names"
|
||||
(member "step" (all-completions "ste" table)))
|
||||
(test-flan--check "and the names an import brought in"
|
||||
(member "agent/wait" (all-completions "agent/" table)))
|
||||
(test-flan--check "and annotates each with what it is"
|
||||
(equal (funcall (plist-get (nthcdr 3 capf)
|
||||
:annotation-function)
|
||||
"ticks")
|
||||
" var")))
|
||||
|
||||
;; M-. through xref, so it is the key it always is.
|
||||
(let ((xs (xref-backend-definitions 'flan "step"))
|
||||
(line (save-excursion (goto-char (point-min))
|
||||
(search-forward "(defn step")
|
||||
(line-number-at-pos))))
|
||||
(test-flan--check "M-. finds where a function is written"
|
||||
(and (= 1 (length xs))
|
||||
(let ((l (xref-item-location (car xs))))
|
||||
(and (file-equal-p (xref-location-group l)
|
||||
buffer-file-name)
|
||||
(= (xref-location-line l) line))))))
|
||||
|
||||
;; And the two things it cannot do, refused by name with the reason rather
|
||||
;; than by opening an empty buffer.
|
||||
(let ((raised nil))
|
||||
(condition-case err (xref-backend-definitions 'flan "ticks")
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(test-flan--check "M-. on a global refuses, saying why"
|
||||
(and raised (string-match-p "ticks" raised)
|
||||
(string-match-p "no location" raised))))
|
||||
(let ((raised nil))
|
||||
(condition-case err (xref-backend-definitions 'flan "print-line")
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(test-flan--check "M-. into the prelude refuses, saying why"
|
||||
(and raised (string-match-p "prelude" raised)
|
||||
(string-match-p "not a file on disk" raised))))
|
||||
(let ((raised nil))
|
||||
(condition-case err (xref-backend-definitions 'flan "no-such-name")
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(test-flan--check "and so does a name the program does not have"
|
||||
(and raised (string-match-p "no no-such-name" raised))))
|
||||
|
||||
;; A name installed now must complete now, not after the next connect.
|
||||
(flan-dev--eval "(defn freshly-added [] i64 7)" "form")
|
||||
(test-flan--check "a name just installed is known immediately"
|
||||
(equal (nth 2 (assoc "freshly-added" flan-dev--defs))
|
||||
"freshly-added [] i64"))
|
||||
|
||||
;; The session is not poisoned by that: a good form still lands.
|
||||
(flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")
|
||||
|
||||
|
||||
65
lib/dev.ml
65
lib/dev.ml
@ -236,6 +236,64 @@ let describe t =
|
||||
t.session.Session.program.Tast.globals);
|
||||
":alive " ^ (if alive t then "t" else "nil") ]
|
||||
|
||||
(* [describe] answers what exists; this answers what each one *is*. Its own op
|
||||
rather than more fields on [describe], because [describe] is polled — an
|
||||
editor uses it to drain the program's output — and this is asked once on
|
||||
connect and again after each install. Putting signatures on the poll would
|
||||
pay for them every time anyone looked at the output buffer.
|
||||
|
||||
One entry per name: (name kind signature loc). Four strings, so the editor
|
||||
reads it with [read] and nothing here needs a new wire type. [loc] is empty
|
||||
where there is none to give — only [Tast.fn] carries one — and an editor
|
||||
that finds it empty must say so rather than guess a file.
|
||||
|
||||
Parameter *names* are not in the Tast, so a signature shows types only. *)
|
||||
let signature_of_fn (f : Tast.fn) =
|
||||
Printf.sprintf "%s [%s] %s" f.Tast.name
|
||||
(String.concat " " (List.map Types.to_string f.Tast.params))
|
||||
(Types.to_string f.Tast.ret)
|
||||
|
||||
let entry ~name ~kind ~sign ~loc =
|
||||
Wire.list [ Wire.quote name; Wire.quote kind; Wire.quote sign; Wire.quote loc ]
|
||||
|
||||
let defs t =
|
||||
let p = t.session.Session.program in
|
||||
let fns =
|
||||
List.filter_map
|
||||
(fun (f : Tast.fn) ->
|
||||
match f.Tast.fparent with
|
||||
(* A handler-bind clause the checker lifted out. Nobody wrote this
|
||||
name, so completing it is noise and jumping to it is meaningless. *)
|
||||
| Some _ -> None
|
||||
| None ->
|
||||
Some
|
||||
(entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f)
|
||||
~loc:(Loc.to_string f.Tast.floc)))
|
||||
p.Tast.fns
|
||||
in
|
||||
let globals =
|
||||
List.map
|
||||
(fun (g : Tast.global) ->
|
||||
entry ~name:g.Tast.gname
|
||||
~kind:(if g.Tast.gconst then "const" else "var")
|
||||
~sign:
|
||||
(Printf.sprintf "%s %s" g.Tast.gname (Types.to_string g.Tast.gty))
|
||||
~loc:"")
|
||||
p.Tast.globals
|
||||
in
|
||||
let externs =
|
||||
List.map
|
||||
(fun (e : Tast.extern) ->
|
||||
entry ~name:e.Tast.ename ~kind:"extern"
|
||||
~sign:
|
||||
(Printf.sprintf "%s [%s] %s" e.Tast.ename
|
||||
(String.concat " " (List.map Types.to_string e.Tast.eparams))
|
||||
(Types.to_string e.Tast.eret))
|
||||
~loc:"")
|
||||
p.Tast.externs
|
||||
in
|
||||
ok [ ":defs " ^ Wire.list (fns @ globals @ externs) ]
|
||||
|
||||
let handle t req =
|
||||
match Wire.string_field req "op" with
|
||||
| Some "eval" ->
|
||||
@ -255,6 +313,7 @@ let handle t req =
|
||||
eval_expr t ~code ~origin
|
||||
| None -> error "eval-expr needs :code")
|
||||
| Some "describe" -> describe t
|
||||
| Some "defs" -> defs t
|
||||
| Some "close" -> ok []
|
||||
| Some op -> error ("unknown op: " ^ op)
|
||||
| None -> error "no :op"
|
||||
@ -286,6 +345,12 @@ let serve t fd =
|
||||
|
||||
let start ~file ~sock =
|
||||
let t0 = Unix.gettimeofday () in
|
||||
(* Absolute, because every location this daemon ever reports is derived from
|
||||
it and an editor is not in this process's working directory. [flan dev
|
||||
src/game.flan] run from a project root would otherwise send back
|
||||
"src/game.flan:12:7", which the editor can only resolve by guessing which
|
||||
directory it was relative to. *)
|
||||
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
||||
let session, l = Session.create ~file in
|
||||
let dir =
|
||||
Filename.concat (Filename.get_temp_dir_name ())
|
||||
|
||||
@ -86,6 +86,46 @@ let () =
|
||||
let r = request c "(:op \"describe\")" in
|
||||
if status r <> "ok" then fail "describe: %s" (status r);
|
||||
|
||||
(* [defs] is its own op rather than more fields on [describe], because
|
||||
[describe] is what an editor polls to drain the program's output. It
|
||||
carries what eldoc, completion and find-definition each need: a kind,
|
||||
a signature, and where the name is written where that is knowable.
|
||||
An empty location is the honest answer for a global — Tast.global has
|
||||
no Loc — and an editor is expected to refuse rather than guess. *)
|
||||
let r = request c "(:op \"defs\")" in
|
||||
if status r <> "ok" then fail "defs: %s" (status r);
|
||||
(match Wire.field r "defs" with
|
||||
| Some { Form.v = Form.List entries; _ } ->
|
||||
let find name =
|
||||
List.find_map
|
||||
(fun (e : Form.t) ->
|
||||
match e.Form.v with
|
||||
| Form.List
|
||||
({ Form.v = Form.Str n; _ }
|
||||
:: { Form.v = Form.Str kind; _ }
|
||||
:: { Form.v = Form.Str sign; _ }
|
||||
:: { Form.v = Form.Str loc; _ } :: [])
|
||||
when String.equal n name -> Some (kind, sign, loc)
|
||||
| _ -> None)
|
||||
entries
|
||||
in
|
||||
(match find "step" with
|
||||
| Some ("fn", "step [] i64", loc) when String.length loc > 0 ->
|
||||
(* Absolute, because an editor is not in this process's working
|
||||
directory and cannot resolve a relative one. *)
|
||||
if loc.[0] <> '/' then fail "a fn's location is relative: %s" loc
|
||||
| Some (k, s, l) -> fail "step is described as (%s, %s, %s)" k s l
|
||||
| None -> fail "defs did not mention step");
|
||||
(match find "ticks" with
|
||||
| Some ("var", "ticks i64", "") -> ()
|
||||
| Some (k, s, l) -> fail "ticks is described as (%s, %s, %s)" k s l
|
||||
| None -> fail "defs did not mention ticks");
|
||||
(match find "agent/wait-raw" with
|
||||
| Some ("extern", _, _) -> ()
|
||||
| Some (k, _, _) -> fail "an extern is described as %s" k
|
||||
| None -> fail "defs did not mention an imported extern")
|
||||
| _ -> fail "defs did not answer with a list");
|
||||
|
||||
(* A form that does not check comes back as an error with a location,
|
||||
and must not disturb the session. *)
|
||||
let r = request c "(:op \"eval\" :code \"(defn step [] i64 nonsense)\" :file \"/tmp/buf.flan\")" in
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user