.fln files open in flan-fln-mode, which evaluates, moves over, indents and edits their statements, clauses and top-level forms
This commit is contained in:
commit
3001aadff3
@ -1187,6 +1187,54 @@ Use `C-c C-g` if you need frames.
|
||||
|
||||
---
|
||||
|
||||
## Indented files (.fln)
|
||||
|
||||
`.fln` files open in `flan-fln-mode`. The session keys (`C-c C-b`, `C-c C-i`,
|
||||
`C-c C-k`, the REPL, watch, dape) work as in a `.flan` file; these differ.
|
||||
|
||||
| Holy | Evil | Does |
|
||||
|---|---|---|
|
||||
| `C-c C-c`, `C-M-x` | same | the top-level form: a declaration installed, anything else evaluated |
|
||||
| `C-u C-c C-c` | same | ...and stop at the innermost bracket group, else the statement on point's line: an elif's condition, an else's block, a match arm's value (`C-u C-u`: on entry) |
|
||||
| `C-x C-e` | same, cursor on the line's last character | at a line's end, the innermost statement ending there: a match arm's value, an if/elif/while condition, or the whole statement a header or clause line opens; elsewhere, the term before point |
|
||||
| `C-c C-e` | same | the statement at point with its body and clauses, or the region's whole lines; on a bare `let x = v`, the `let` and the rest of its block |
|
||||
| `C-c C-n` | same | `C-c C-e`, then move to the next statement |
|
||||
| `C-c C-s` | same | step through the top-level `fn` at point |
|
||||
| `C-c C-k` | same | the whole buffer |
|
||||
| `C-M-a` / `C-M-e` / `C-M-h` | `[[` / `]]` | top-level form: start, end, mark |
|
||||
| `M-a` / `M-e` | `(` / `)` | statement: start / end (`)`: start of the next) |
|
||||
| `C-M-u` | same | up to the enclosing bracket, or the line that owns the block |
|
||||
| `C-M-f` / `C-M-b` | same | brackets and terms, as everywhere |
|
||||
| `TAB` | same | a line at a valid column stays; an empty or misplaced line goes deepest; each repeat steps out a level |
|
||||
| `DEL` in indentation | same | drop one level |
|
||||
| `C-c <` / `C-c >` | `<` / `>` | shift the region's lines a level |
|
||||
| `M-<up>` / `M-<down>` | same | move the statement past its neighbour |
|
||||
| `M-<right>` / `M-<left>` | same | pull the next statement into this block / push its last one out |
|
||||
| `M-r` | same | replace the block's owner with the statement at point |
|
||||
| `M-k` | `das` | kill the statement's lines |
|
||||
| — | `ie` `ae` | term |
|
||||
| — | `is` `as` | statement (`as`: whole lines) |
|
||||
| — | `ii` `ai` | body / whole statement |
|
||||
| — | `ik` `ak` | clause's block / clause |
|
||||
| — | `id` `ad` | top-level form with the comment block directly above it (`ad`: and the empty lines after it, or before it for the last form) |
|
||||
|
||||
`else`, `elif`, `on` and `restart` snap to their header's column as you type
|
||||
them. `indent-region` and `C-y` move lines only as a block, never one line
|
||||
against another. expand-region steps term, group, statement, clause,
|
||||
enclosing statement, top-level form.
|
||||
|
||||
- **term**: a run with no space outside brackets — `f(a, b)`, `grid[r, c]`, `p.x`.
|
||||
- **group**: a bracket pair and what is inside it.
|
||||
- **statement**: a line, the deeper lines under it, lines inside brackets it leaves open, lines an operator continues, and `else`/`elif`/`on`/`restart` at its column. Blank and comment lines inside never end it.
|
||||
- **body**: a statement's own block, up to its first clause.
|
||||
- **clause**: one `else`/`elif`/`on`/`restart` line and its block.
|
||||
- **top-level form**: a column-0 line that is code, not a clause and not a continuation, through the last code line before the next one.
|
||||
|
||||
`flan-fln-indent-offset` (2) is one level. `flan-fln-smartparens` (`t`) turns
|
||||
on plain `smartparens-mode`, which pairs brackets and strings but not `'`.
|
||||
|
||||
---
|
||||
|
||||
## Full key reference
|
||||
|
||||
| Key | Does |
|
||||
@ -1267,6 +1315,7 @@ fix is to delete `-dev` from it.
|
||||
| File | What it is |
|
||||
|---|---|
|
||||
| `flan-mode.el` | the major mode: syntax, indentation, imenu, the keymap |
|
||||
| `flan-fln-mode.el` | the mode for indented `.fln` files: objects, keys, indentation |
|
||||
| `flan.el` | the client — the socket, evaluation, xref, eldoc, completion |
|
||||
| `flan-repl.el` | the `*flan-repl*` buffer |
|
||||
| `flan-watch.el` | watched values: the program pushes, this paints them in a buffer and inline |
|
||||
|
||||
@ -89,14 +89,14 @@ does and does not buy."
|
||||
:type '(repeat string))
|
||||
|
||||
(defun flan-dape--source ()
|
||||
"The .flan file this session is about.
|
||||
"The .flan or .fln file this session is about.
|
||||
The buffer's own file, or the nearest one up from it — so M-x flan-debug
|
||||
from a *compilation* buffer or a dired still has an answer."
|
||||
(or (and buffer-file-name
|
||||
(string-suffix-p ".flan" buffer-file-name)
|
||||
(string-match-p "\\.fla?n\\'" buffer-file-name)
|
||||
buffer-file-name)
|
||||
(car (directory-files default-directory t "\\.flan\\'"))
|
||||
(user-error "No .flan file here to debug")))
|
||||
(car (directory-files default-directory t "\\.fla?n\\'"))
|
||||
(user-error "No .flan or .fln file here to debug")))
|
||||
|
||||
(defun flan-dape--binary (source)
|
||||
"Where the debug build of SOURCE goes.
|
||||
@ -126,7 +126,7 @@ one made by `flan build'."
|
||||
;; can just read `buffer-file-name'. `dape' itself expects an already
|
||||
;; evaluated config, so `flan-debug' below must not hand it the raw entry.
|
||||
(defconst flan-dape-config
|
||||
'(modes (flan-mode)
|
||||
'(modes (flan-base-mode)
|
||||
ensure dape-ensure-command
|
||||
command-cwd dape-command-cwd
|
||||
compile (flan-dape--compile-command (flan-dape--source))
|
||||
@ -178,7 +178,7 @@ common case is one command rather than a config prompt."
|
||||
;; thing entirely.
|
||||
;;;###autoload
|
||||
(with-eval-after-load 'flan-mode
|
||||
(define-key (symbol-value 'flan-mode-map) (kbd "C-c C-g") #'flan-debug))
|
||||
(define-key (symbol-value 'flan-base-mode-map) (kbd "C-c C-g") #'flan-debug))
|
||||
|
||||
;;; --dev and --debug are different builds
|
||||
;;
|
||||
|
||||
1715
emacs/flan-fln-mode.el
Normal file
1715
emacs/flan-fln-mode.el
Normal file
File diff suppressed because it is too large
Load Diff
@ -439,19 +439,16 @@ For `syntax-propertize-function'."
|
||||
;; not. Either way forward, which is the whole of why this terminates.
|
||||
(goto-char (or fin from)))))
|
||||
|
||||
(defvar flan-mode-map
|
||||
;; The keys both syntaxes share: everything that talks to the running program
|
||||
;; about a name, a value or the session rather than about a piece of the text.
|
||||
;; The keys that pick text out of the buffer -- which form C-c C-c means --
|
||||
;; are each child mode's own, because what a form is differs between them.
|
||||
(defvar flan-base-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
;; Autoloaded from flan.el, so the client loads on first use.
|
||||
(define-key map (kbd "C-c C-c") #'flan-eval-defun)
|
||||
;; The same command on the binding SLIME and CIDER put it on. Emacs binds
|
||||
;; C-M-x to eval-defun only in `emacs-lisp-mode-map', so a mode derived
|
||||
;; from `lisp-mode' inherits nothing and the key is undefined — which
|
||||
;; reads as the client being broken rather than as the key being free.
|
||||
(define-key map (kbd "C-M-x") #'flan-eval-defun)
|
||||
(define-key map (kbd "C-c C-k") #'flan-eval-buffer)
|
||||
;; The stepper: the defn at point, installed to stop before each form.
|
||||
(define-key map (kbd "C-c C-s") #'flan-step-defun)
|
||||
(define-key map (kbd "C-x C-e") #'flan-eval-last-sexp)
|
||||
(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)
|
||||
@ -502,23 +499,45 @@ For `syntax-propertize-function'."
|
||||
;; because it is the one that works from any state.
|
||||
(define-key map (kbd "C-c C-M-x") #'flan-rerun)
|
||||
map)
|
||||
"Keymap for every Flan source buffer, `flan-mode' and `flan-fln-mode'.")
|
||||
|
||||
(defvar flan-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map flan-base-mode-map)
|
||||
(define-key map (kbd "C-c C-c") #'flan-eval-defun)
|
||||
;; The same command on the binding SLIME and CIDER put it on. Emacs binds
|
||||
;; C-M-x to eval-defun only in `emacs-lisp-mode-map', so a mode derived
|
||||
;; from `lisp-mode' inherits nothing and the key is undefined — which
|
||||
;; reads as the client being broken rather than as the key being free.
|
||||
(define-key map (kbd "C-M-x") #'flan-eval-defun)
|
||||
(define-key map (kbd "C-x C-e") #'flan-eval-last-sexp)
|
||||
map)
|
||||
"Keymap for `flan-mode'.")
|
||||
|
||||
;; The parent of both source modes. Everything the dev loop asks of a buffer
|
||||
;; -- is this Flan, set up eldoc and completion, draw the program's names,
|
||||
;; paint watched values -- asks it of this mode, so a .fln buffer gets it the
|
||||
;; same way a .flan buffer does. What each syntax reads as a form is its
|
||||
;; child's business.
|
||||
(define-derived-mode flan-base-mode prog-mode "Flan"
|
||||
"Parent mode of the Flan source modes, `flan-mode' and `flan-fln-mode'."
|
||||
(setq-local comment-start ";")
|
||||
(setq-local comment-start-skip ";+ *")
|
||||
(setq-local comment-add 1)
|
||||
;; Spaces. The whole corpus is written with them, and alignment that is
|
||||
;; correct here is alignment under a specific *column* — a tab makes that
|
||||
;; depend on a setting the file cannot carry. In a .fln file a tab in the
|
||||
;; indentation is an error besides.
|
||||
(setq-local indent-tabs-mode nil))
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode flan-mode prog-mode "Flan"
|
||||
(define-derived-mode flan-mode flan-base-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)
|
||||
;; Spaces. The whole corpus is written with them, and alignment that is
|
||||
;; correct here is alignment under a specific *column* — a tab makes that
|
||||
;; depend on a setting the file cannot carry.
|
||||
(setq-local indent-tabs-mode nil)
|
||||
(setq-local lisp-indent-function #'flan-indent-function)
|
||||
(setq-local outline-regexp ";;;;+[ \t]*")
|
||||
(setq-local imenu-generic-expression flan-imenu-generic-expression)
|
||||
@ -800,6 +819,12 @@ decision to `calculate-lisp-indent'."
|
||||
|
||||
;;;###autoload
|
||||
(add-to-list 'auto-mode-alist '("\\.flan\\'" . flan-mode))
|
||||
;; The indented syntax's mode lives in its own file; a buffer of it is the first
|
||||
;; thing that loads it.
|
||||
;;;###autoload
|
||||
(autoload 'flan-fln-mode "flan-fln-mode" nil t)
|
||||
;;;###autoload
|
||||
(add-to-list 'auto-mode-alist '("\\.fln\\'" . flan-fln-mode))
|
||||
|
||||
;;; The other Flan buffers under Evil
|
||||
|
||||
|
||||
@ -249,15 +249,19 @@ inline it has no modeline beside it to say so.")
|
||||
(let (bufs)
|
||||
(dolist (w (window-list-1 nil 'nomini t))
|
||||
(let ((b (window-buffer w)))
|
||||
(when (and (eq (buffer-local-value 'major-mode b) 'flan-mode)
|
||||
(when (and (provided-mode-derived-p (buffer-local-value 'major-mode b)
|
||||
'flan-base-mode)
|
||||
(not (memq b bufs)))
|
||||
(push b bufs))))
|
||||
bufs))
|
||||
|
||||
(defun flan-watch--ghost-sites ()
|
||||
"Watch call sites in the current buffer, as a list of (NAME . END-OF-LINE)."
|
||||
(let ((re (concat "(\\s-*" flan-watch-ghost-call-regexp
|
||||
"\\s-+\"\\([^\"\n]*\\)\""))
|
||||
;; Either syntax: `(watch "name" v)' in a .flan file, `watch("name", v)' in
|
||||
;; a .fln one, where the call is the name glued to its parenthesis.
|
||||
(let ((re (concat "\\(?:(\\s-*\\(?:" flan-watch-ghost-call-regexp "\\)\\s-+"
|
||||
"\\|\\_<\\(?:" flan-watch-ghost-call-regexp "\\)(\\s-*\\)"
|
||||
"\"\\([^\"\n]*\\)\""))
|
||||
(sites nil))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
||||
@ -986,7 +986,7 @@ refuses: callers cannot silently discard a running program's state."
|
||||
;; buffer is not what you meant — and it still only changes what is asked,
|
||||
;; never which file the unasked case picks.
|
||||
(let ((file (and buffer-file-name
|
||||
(string-suffix-p ".flan" buffer-file-name)
|
||||
(string-match-p "\\.fla?n\\'" buffer-file-name)
|
||||
(expand-file-name buffer-file-name))))
|
||||
(list (if (and file (not current-prefix-arg))
|
||||
file
|
||||
@ -1176,7 +1176,7 @@ the state with something to answer in it."
|
||||
|
||||
(defun flan-mode-line ()
|
||||
"The Flan connection indicator, for `mode-line-misc-info'."
|
||||
(when (derived-mode-p 'flan-mode 'flan-repl-mode)
|
||||
(when (derived-mode-p 'flan-base-mode 'flan-repl-mode)
|
||||
(pcase (flan-state)
|
||||
;; First, and it names the condition: a stopped program looks exactly
|
||||
;; like a running one from anywhere else in Emacs, and the whole reason
|
||||
@ -2141,7 +2141,7 @@ Leaves its face in `flan--dynamic-face' for the rule that calls this."
|
||||
(defun flan--dynamic-install ()
|
||||
"Add or remove the dynamic rules in the current buffer, and redraw it.
|
||||
Called for its effect on one buffer; `flan--dynamic-sync' does every buffer."
|
||||
(when (derived-mode-p 'flan-mode)
|
||||
(when (derived-mode-p 'flan-base-mode)
|
||||
;; Removed first in both branches, because adding is not idempotent: a
|
||||
;; second install would put the rule in twice and every refresh after that
|
||||
;; would add another.
|
||||
@ -2160,7 +2160,7 @@ Called for its effect on one buffer; `flan--dynamic-sync' does every buffer."
|
||||
|
||||
;; A file opened while a session is already up: the two moments the table is
|
||||
;; rebuilt are both in the past by then, so the buffer has to ask on its way in.
|
||||
(add-hook 'flan-mode-hook #'flan--dynamic-install)
|
||||
(add-hook 'flan-base-mode-hook #'flan--dynamic-install)
|
||||
|
||||
(defun flan--forget-defs ()
|
||||
"Drop what is known about the program's names."
|
||||
@ -2447,14 +2447,14 @@ someone editing Flan with no program running and this file never loaded."
|
||||
(setq-local mode-line-misc-info
|
||||
(append mode-line-misc-info '((:eval (flan-mode-line)))))))
|
||||
|
||||
(add-hook 'flan-mode-hook #'flan-setup)
|
||||
(add-hook 'flan-base-mode-hook #'flan-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-setup))))
|
||||
(when (derived-mode-p 'flan-base-mode) (flan-setup))))
|
||||
|
||||
;;; Evaluating
|
||||
|
||||
@ -2667,7 +2667,8 @@ columns already were, because a top-level form starts at column 1."
|
||||
.fln file, the paren reader's for anything else. Sent explicitly because the
|
||||
daemon cannot tell from `:file' — an expansion shown in parens is sent back
|
||||
under the name of the .fln file it came from."
|
||||
(if (and buffer-file-name (string-suffix-p ".fln" buffer-file-name))
|
||||
(if (or (derived-mode-p 'flan-fln-mode)
|
||||
(and buffer-file-name (string-suffix-p ".fln" buffer-file-name)))
|
||||
"indented"
|
||||
"paren"))
|
||||
|
||||
|
||||
@ -2034,6 +2034,11 @@ stopped program, which is the case where it should fire."
|
||||
(file-name-directory load-file-name))
|
||||
nil t)
|
||||
|
||||
;; The .fln mode: its objects, keys, indentation and text objects, from text.
|
||||
(load (expand-file-name "test-flan-fln.el"
|
||||
(file-name-directory load-file-name))
|
||||
nil t)
|
||||
|
||||
;; Ghost text, which is the same kind of thing: rows in, overlays out, and the
|
||||
;; buffer it reads is a fixture like any other reply here. Loaded for the same
|
||||
;; reason.
|
||||
|
||||
250
emacs/test-flan-fln-live.el
Normal file
250
emacs/test-flan-fln-live.el
Normal file
@ -0,0 +1,250 @@
|
||||
;;; test-flan-fln-live.el --- The .fln keys against a real daemon -*- lexical-binding: t; -*-
|
||||
|
||||
;; Loaded by test-flan.el, near its end, with `flan-command' already the
|
||||
;; compiler under test. test-flan-fln.el checks which text each key picks;
|
||||
;; this checks the reader accepts that text as a whole form, on both backends:
|
||||
;; a daemon of its own on a .fln file with no main, once on x86 and once on
|
||||
;; LLVM, each key sent at least once, and a pause mark the daemon must find.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'flan-fln-mode)
|
||||
|
||||
(declare-function test-flan--check "test-flan" (name ok))
|
||||
(declare-function test-flan--result "test-flan" ())
|
||||
(defvar test-flan-fln-live-dir)
|
||||
(defvar test-flan-fln-live-socket)
|
||||
|
||||
(defconst test-flan-fln-live--program
|
||||
"fn fib(n: i64) -> i64
|
||||
if n < 2
|
||||
n
|
||||
else
|
||||
fib(n - 1) + fib(n - 2)
|
||||
|
||||
fn twice(n: i64) -> i64 = n * 2
|
||||
|
||||
fn total(n: i32) -> i32
|
||||
let t = 0
|
||||
for i in range(n)
|
||||
t = t + i
|
||||
t
|
||||
|
||||
fn sign(n: i64) -> i64
|
||||
if n < 0
|
||||
-1
|
||||
elif n == 0
|
||||
0
|
||||
else
|
||||
1
|
||||
|
||||
enum Dir
|
||||
north
|
||||
south
|
||||
east
|
||||
|
||||
fn pick(d: Dir) -> i64
|
||||
match d
|
||||
:north -> 10
|
||||
:south -> 20
|
||||
:east -> 1 +
|
||||
2
|
||||
_ ->
|
||||
twice(3)
|
||||
|
||||
comment():
|
||||
if 1 < 2 and
|
||||
3 < 4
|
||||
twice(1)
|
||||
elif 1 > 2 or
|
||||
3 > 4
|
||||
0
|
||||
twice(4)
|
||||
if 2 > 1
|
||||
twice(2)
|
||||
else
|
||||
0
|
||||
let x = 3
|
||||
twice(x) + 1
|
||||
")
|
||||
|
||||
(defun test-flan-fln-live--run (backend args)
|
||||
(let* ((sock (concat test-flan-fln-live-socket "-fln-" backend))
|
||||
(file (expand-file-name (format "fln-live-%s.fln" backend)
|
||||
test-flan-fln-live-dir))
|
||||
(flan-daemon-args args)
|
||||
(name (lambda (s) (format "%s: %s" backend s)))
|
||||
(value (lambda (code)
|
||||
(plist-get (flan--request
|
||||
(list :op "eval-expr" :code code :file "<test>"))
|
||||
:value)))
|
||||
(goto (lambda (needle &optional after)
|
||||
(goto-char (point-min))
|
||||
(search-forward needle)
|
||||
(unless after (goto-char (match-beginning 0)))))
|
||||
(shows (lambda (v)
|
||||
(let ((r (test-flan--result)))
|
||||
(prog1 (and r (string-match-p (concat "=> " (regexp-quote v) "\\'")
|
||||
(string-trim r)))
|
||||
(flan-clear-result))))))
|
||||
(with-temp-file file (insert test-flan-fln-live--program))
|
||||
(ignore-errors (delete-file sock))
|
||||
(flan file sock)
|
||||
(test-flan--check (funcall name "a daemon starts on a .fln file")
|
||||
(process-live-p flan--connection))
|
||||
(unwind-protect
|
||||
(with-current-buffer (find-file-noselect file)
|
||||
(test-flan--check (funcall name "which opens in flan-fln-mode")
|
||||
(eq major-mode 'flan-fln-mode))
|
||||
|
||||
;; C-c C-c, from inside a fn changed in the buffer.
|
||||
(funcall goto "n * 2")
|
||||
(delete-char 5)
|
||||
(insert "n * 3")
|
||||
(flan-fln-eval-defun)
|
||||
(test-flan--check (funcall name "C-c C-c installs the fn at point")
|
||||
(equal (funcall value "(twice 7)") "21"))
|
||||
|
||||
;; C-x C-e at the end of a column-0 declaration.
|
||||
(funcall goto "n * 3")
|
||||
(delete-char 5)
|
||||
(insert "n * 4")
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e at the end of a column-0 fn installs it")
|
||||
(equal (funcall value "(twice 7)") "28"))
|
||||
|
||||
;; C-x C-e at the end of an inner statement: text from column 3.
|
||||
(funcall goto "twice(4)" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e sends the statement ending at point")
|
||||
(funcall shows "16"))
|
||||
|
||||
;; ...and inside a line, the term before point.
|
||||
(funcall goto "twice(4)")
|
||||
(let ((at (point)))
|
||||
(insert "fib(10) + ")
|
||||
(goto-char (+ at (length "fib(10)")))
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e inside a line sends the term before point")
|
||||
(funcall shows "55"))
|
||||
(delete-region at (+ at (length "fib(10) + "))))
|
||||
|
||||
;; C-c C-e on a clause: the whole if, from column 3, clauses and all.
|
||||
(funcall goto "else\n 0")
|
||||
(flan-fln-eval-statement)
|
||||
(test-flan--check (funcall name "C-c C-e on a clause sends its if, and it reads")
|
||||
(funcall shows "8"))
|
||||
|
||||
;; A bare let: it and the rest of its block, which is its scope.
|
||||
(funcall goto "let x = 3")
|
||||
(flan-fln-eval-statement)
|
||||
(test-flan--check (funcall name "C-c C-e on a bare let sends its scope with it")
|
||||
(funcall shows "13"))
|
||||
|
||||
;; A region of several statements reads as one (do ...).
|
||||
(funcall goto "twice(4)")
|
||||
(transient-mark-mode 1)
|
||||
(set-mark (point))
|
||||
(funcall goto "else\n 0" t)
|
||||
(flan-fln-eval-statement)
|
||||
(test-flan--check (funcall name "C-c C-e on a region of statements evaluates them in order")
|
||||
(funcall shows "8"))
|
||||
|
||||
;; C-c C-n sends and moves on.
|
||||
(funcall goto "twice(4)")
|
||||
(flan-fln-eval-statement-and-next)
|
||||
(test-flan--check (funcall name "C-c C-n sends the statement")
|
||||
(funcall shows "16"))
|
||||
(test-flan--check (funcall name "and moves to the next")
|
||||
(looking-at "if 2 > 1"))
|
||||
|
||||
;; The pause mark. What is sent is a line and column, and the daemon
|
||||
;; answers `:pause' only when a form the reader made starts exactly
|
||||
;; there (`Ast.mark_pause'). Each kind of target once, and one position
|
||||
;; a column off to show the answer can be no.
|
||||
;; C-x C-e on an arm's value, and on a condition line.
|
||||
(funcall goto ":south -> 20" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e at the end of a match arm evaluates its value")
|
||||
(funcall shows "20"))
|
||||
(funcall goto ":east -> 1 +" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e on an arm's wrapped value evaluates all of it")
|
||||
(funcall shows "3"))
|
||||
(funcall goto "if 1 < 2 and" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e on a wrapped condition evaluates all of it")
|
||||
(funcall shows "true"))
|
||||
;; An error on the wrapped line of a condition or value cut out
|
||||
;; mid-line is reported where it is in the buffer, column and all.
|
||||
(let ((refused
|
||||
(lambda (needle bad fix)
|
||||
(funcall goto needle t)
|
||||
(let ((line (1+ (line-number-at-pos))) col)
|
||||
(save-excursion
|
||||
(forward-line 1)
|
||||
(search-forward fix (line-end-position))
|
||||
(replace-match bad t t)
|
||||
(setq col (1+ (- (point) (line-beginning-position)
|
||||
(length (car (last (split-string bad " "))))))))
|
||||
(prog1 (list (condition-case err (progn (flan-fln-eval-last) nil)
|
||||
(user-error (error-message-string err)))
|
||||
(format ":%d:%d)" line col))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward bad)
|
||||
(replace-match fix t t)))))))
|
||||
(pcase-dolist (`(,what ,needle ,bad ,fix)
|
||||
'(("an if condition" "if 1 < 2 and" "3 < 4 4" "3 < 4")
|
||||
("an elif condition" "elif 1 > 2 or" "3 > 4 4" "3 > 4")
|
||||
("an arm's value" ":east -> 1 +" "2 2" "2")))
|
||||
(let ((r (funcall refused needle bad fix)))
|
||||
(test-flan--check
|
||||
(funcall name (format "an error on the wrapped line of %s is reported at its column" what))
|
||||
(and (car r) (string-suffix-p (cadr r) (car r))))
|
||||
(unless (and (car r) (string-suffix-p (cadr r) (car r)))
|
||||
(message " want ...%s\n got %S" (cadr r) (car r))))))
|
||||
(flan-clear-errors)
|
||||
(funcall goto "if 2 > 1" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e at the end of an if line evaluates the condition")
|
||||
(funcall shows "true"))
|
||||
(dolist (c '(("n - 1)" "a call, from its name")
|
||||
("elif n" "an elif, at its condition")
|
||||
("else\n 1" "an else, at its block")
|
||||
(":south -> 20" "a match arm, at its value")
|
||||
("_ ->" "a match arm, at its block")
|
||||
("n < 2" "an if statement")
|
||||
("t = 0" "a let")
|
||||
("i in range" "a for")
|
||||
("+ i" "an assignment")))
|
||||
(funcall goto (car c))
|
||||
(let ((reply (flan-fln-eval-defun '(4))))
|
||||
(test-flan--check (funcall name (format "C-u C-c C-c marks %s where the reader starts it"
|
||||
(cadr c)))
|
||||
(plist-get reply :pause)))
|
||||
(flan-fln-eval-defun))
|
||||
(test-flan--check (funcall name "and a plain C-c C-c takes the mark down")
|
||||
(null (flan--pause-overlays)))
|
||||
(funcall goto "fib(n - 1)")
|
||||
(let* ((b (flan-fln--toplevel-bounds (point)))
|
||||
(off (condition-case nil
|
||||
(plist-get (flan--eval (flan--text (car b) (cdr b)) "defn"
|
||||
nil nil (cons (1+ (point)) (+ 3 (point))))
|
||||
:pause)
|
||||
(user-error nil))))
|
||||
(test-flan--check (funcall name "a position one column off the call is not taken")
|
||||
(null off)))
|
||||
(flan-fln-eval-defun)
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer))
|
||||
;; Stopped whatever happened above: a daemon this started is its own to end.
|
||||
(flan-quit))
|
||||
(ignore-errors (delete-file sock))
|
||||
(ignore-errors (delete-file file))))
|
||||
|
||||
(message "\nthe .fln keys, against a daemon on each backend")
|
||||
(test-flan-fln-live--run "x86" nil)
|
||||
(test-flan-fln-live--run "llvm" '("--llvm"))
|
||||
|
||||
;;; test-flan-fln-live.el ends here
|
||||
952
emacs/test-flan-fln.el
Normal file
952
emacs/test-flan-fln.el
Normal file
@ -0,0 +1,952 @@
|
||||
;;; test-flan-fln.el --- The .fln mode, from written-out text -*- lexical-binding: t; -*-
|
||||
|
||||
;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
|
||||
;; test-flan-mode.el is: `emacs/*.el' is already that stanza's dependency.
|
||||
;; Nothing here needs a daemon; what the daemon makes of what these commands
|
||||
;; send is test-flan-fln-live.el's, run from test-flan.el.
|
||||
;;
|
||||
;; Every snippet is text; each check says where point is with a `|' written
|
||||
;; into it, which is removed before the check runs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'flan-fln-mode)
|
||||
(require 'flan)
|
||||
|
||||
(declare-function test-flan--check "test-flan-cider" (name ok))
|
||||
|
||||
(defmacro test-flan-fln--in (text &rest body)
|
||||
"Run BODY in a .fln buffer holding TEXT, point where TEXT has its `|'."
|
||||
(declare (indent 1))
|
||||
`(with-temp-buffer
|
||||
(insert ,text)
|
||||
(flan-fln-mode)
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "|" nil t)
|
||||
(delete-char -1))
|
||||
,@body))
|
||||
|
||||
(defun test-flan-fln--text (b)
|
||||
(and b (cdr b) (buffer-substring-no-properties (car b) (cdr b))))
|
||||
|
||||
(defun test-flan-fln--is (name got want)
|
||||
(test-flan--check name (equal got want))
|
||||
(unless (equal got want)
|
||||
(message " want %S\n got %S" want got)))
|
||||
|
||||
(defun test-flan-fln--thing (thing)
|
||||
(test-flan-fln--text (bounds-of-thing-at-point thing)))
|
||||
|
||||
(message "\nthe .fln mode")
|
||||
|
||||
;;; One parent
|
||||
|
||||
(test-flan--check "flan-mode is a flan-base-mode"
|
||||
(provided-mode-derived-p 'flan-mode 'flan-base-mode))
|
||||
(test-flan--check "flan-fln-mode is a flan-base-mode"
|
||||
(provided-mode-derived-p 'flan-fln-mode 'flan-base-mode))
|
||||
(test-flan--check ".fln opens in flan-fln-mode"
|
||||
(eq (cdr (assoc "\\.fln\\'" auto-mode-alist)) 'flan-fln-mode))
|
||||
(test-flan-fln--in "fn f() -> i32 = 1\n"
|
||||
(test-flan--check "a .fln buffer sends the indented syntax"
|
||||
(equal (flan--syntax) "indented"))
|
||||
(test-flan--check "and gets the client's completion, as a .flan one does"
|
||||
(memq #'flan-completion-at-point completion-at-point-functions))
|
||||
(test-flan--check "and the modeline indicator"
|
||||
(member '(:eval (flan-mode-line)) mode-line-misc-info))
|
||||
(test-flan--check "the shared keys reach it through the parent's map"
|
||||
(eq (key-binding (kbd "C-c C-b")) 'flan-cnr-show))
|
||||
(test-flan--check "and its own keys pick .fln forms"
|
||||
(and (eq (key-binding (kbd "C-c C-c")) 'flan-fln-eval-defun)
|
||||
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))))
|
||||
(require 'flan-watch)
|
||||
(let ((b (generate-new-buffer "ghost.fln")))
|
||||
(with-current-buffer b (flan-fln-mode))
|
||||
(switch-to-buffer b)
|
||||
(test-flan--check "watch paints ghost text in a shown .fln buffer"
|
||||
(memq b (flan-watch--ghost-buffers)))
|
||||
(with-current-buffer b
|
||||
(insert "fn f() -> ()\n watch-i64(\"x\", 1)\n")
|
||||
(test-flan--check "and finds a watch call written as a .fln call"
|
||||
(equal (mapcar #'car (flan-watch--ghost-sites)) '("x"))))
|
||||
(kill-buffer b))
|
||||
(require 'flan-dape)
|
||||
(test-flan--check "dape offers its config in any Flan buffer"
|
||||
(equal (plist-get flan-dape-config 'modes) '(flan-base-mode)))
|
||||
(let ((buffer-file-name "/tmp/x.fln"))
|
||||
(test-flan--check "and debugs the .fln file it was started from"
|
||||
(equal (flan-dape--source) "/tmp/x.fln")))
|
||||
|
||||
;;; The objects
|
||||
|
||||
(defconst test-flan-fln--settle
|
||||
"fn settle(row: i32, col: i32) -> ()
|
||||
let vel = f32(gravity) + velocity[row, col]
|
||||
while y > row
|
||||
if 0 == grid[y, col]
|
||||
grid[y, col] = grid[row, col]
|
||||
; a comment inside the body
|
||||
|
||||
return
|
||||
let left? = col > 0
|
||||
if left? or right?
|
||||
let side =
|
||||
if not left?
|
||||
1
|
||||
elif not right?
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1
|
||||
grid[y, col + side] = grid[row, col]
|
||||
y = y - 1
|
||||
velocity[row, col] = 0.0
|
||||
|
||||
; trailing comment, not part of the function
|
||||
|
||||
fn step() -> ()
|
||||
paint-at(i32(m.y) / cell-size,
|
||||
i32(m.x) / cell-size)
|
||||
if r >= 0 and r < rows - 1
|
||||
and c >= 0
|
||||
grid[r, c] = 1
|
||||
step()
|
||||
")
|
||||
|
||||
(defun test-flan-fln--at (text needle)
|
||||
"TEXT with a `|' before the first NEEDLE."
|
||||
(let ((i (string-search needle text)))
|
||||
(concat (substring text 0 i) "|" (substring text i))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if 0 == grid")
|
||||
(test-flan-fln--is "a statement takes its body, through blank and comment lines"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"if 0 == grid[y, col]
|
||||
grid[y, col] = grid[row, col]
|
||||
; a comment inside the body
|
||||
|
||||
return")
|
||||
(test-flan-fln--is "its body is the lines under its first"
|
||||
(test-flan-fln--thing 'flan-fln-body)
|
||||
"grid[y, col] = grid[row, col]
|
||||
; a comment inside the body
|
||||
|
||||
return"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not right")
|
||||
(test-flan-fln--is "on a clause, the statement is its header's, clauses and all"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"if not left?
|
||||
1
|
||||
elif not right?
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1")
|
||||
(test-flan-fln--is "and the clause is its own line and block"
|
||||
(test-flan-fln--thing 'flan-fln-clause)
|
||||
"elif not right?
|
||||
-1"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n elif")
|
||||
(test-flan-fln--is "a clause is not found from the header's own block"
|
||||
(test-flan-fln--thing 'flan-fln-clause) nil))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
||||
(test-flan-fln--is "from inside else's block, the clause is the else"
|
||||
(test-flan-fln--thing 'flan-fln-clause)
|
||||
"else
|
||||
if f32(rand()) < 0.5 then 1 else -1"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "let side =")
|
||||
(test-flan-fln--is "let x = with the value as a block"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"let side =
|
||||
if not left?
|
||||
1
|
||||
elif not right?
|
||||
-1
|
||||
else
|
||||
if f32(rand()) < 0.5 then 1 else -1"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
||||
(test-flan-fln--is "a line inside a bracket is part of its statement"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"paint-at(i32(m.y) / cell-size,
|
||||
i32(m.x) / cell-size)")
|
||||
(test-flan-fln--is "a term is glued, brackets and all"
|
||||
(test-flan-fln--thing 'flan-fln-term) "i32(m.x)")
|
||||
(test-flan-fln--is "a group is a bracket pair"
|
||||
(test-flan-fln--thing 'flan-fln-group)
|
||||
"(i32(m.y) / cell-size,
|
||||
i32(m.x) / cell-size)"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
||||
(test-flan-fln--is "an operator continuation line is part of its statement"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"if r >= 0 and r < rows - 1
|
||||
and c >= 0
|
||||
grid[r, c] = 1")
|
||||
(test-flan-fln--is "and not the start of the body"
|
||||
(test-flan-fln--thing 'flan-fln-body) "grid[r, c] = 1"))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "velocity[row, col] = 0.0")
|
||||
(test-flan-fln--is "a top-level form ends before trailing comment lines"
|
||||
(test-flan-fln--thing 'flan-fln-toplevel)
|
||||
(substring test-flan-fln--settle 0
|
||||
(+ (string-search "= 0.0" test-flan-fln--settle) 5))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "trailing comment")
|
||||
(test-flan--check "a comment between forms belongs to the form above"
|
||||
(string-prefix-p "fn settle"
|
||||
(test-flan-fln--thing 'flan-fln-toplevel))))
|
||||
|
||||
(test-flan-fln--in "; a header comment\n|\nfn f() -> i32 = 1\n"
|
||||
(test-flan-fln--is "before any form, the next one"
|
||||
(test-flan-fln--thing 'flan-fln-toplevel) "fn f() -> i32 = 1"))
|
||||
|
||||
(test-flan-fln--in "def xs = [1 2\n3 4]\n + 1\nfn|x() -> i32 = 1\n"
|
||||
(test-flan-fln--is "column 0 inside a bracket or after a leading operator is no form start"
|
||||
(save-excursion (beginning-of-defun)
|
||||
(buffer-substring-no-properties (point) (line-end-position)))
|
||||
"fnx() -> i32 = 1"))
|
||||
|
||||
(test-flan-fln--in "x = 1\nhandler-case\n f()\non E(c)\n nil\n|restart y\n"
|
||||
(test-flan--check "on and restart at column 0 are clauses, not forms"
|
||||
(progn (beginning-of-defun)
|
||||
(looking-at "handler-case"))))
|
||||
|
||||
(test-flan-fln--in "let on = 3\nfoo(x):|\n bar()\n"
|
||||
(test-flan-fln--is "a term ends before the trailing colon of a call's block"
|
||||
(test-flan-fln--text (flan-fln--term-before (point))) "foo(x)"))
|
||||
|
||||
(test-flan-fln--in "f(\\(, \\) , x.y)|\n"
|
||||
(test-flan-fln--is "a character literal is not a bracket"
|
||||
(test-flan-fln--text (flan-fln--term-before (point)))
|
||||
"f(\\(, \\) , x.y)"))
|
||||
|
||||
;;; Top-level motion
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " y = y - 1")
|
||||
(beginning-of-defun)
|
||||
(test-flan--check "C-M-a goes to the form's first line" (looking-at "fn settle"))
|
||||
(end-of-defun)
|
||||
(test-flan--check "C-M-e goes past its last code line, not its trailing comment"
|
||||
(save-excursion (forward-line -1)
|
||||
(looking-at " velocity\\[row, col\\] = 0.0")))
|
||||
(end-of-defun)
|
||||
(test-flan--check "and the next C-M-e ends the next form"
|
||||
(= (point) (point-max)))
|
||||
(goto-char (point-max))
|
||||
(beginning-of-defun)
|
||||
(test-flan--check "C-M-a from the end reaches the last form" (looking-at "fn step"))
|
||||
(mark-defun)
|
||||
(test-flan--check "C-M-h marks the form"
|
||||
(let ((m (buffer-substring (region-beginning) (region-end))))
|
||||
(and (string-prefix-p "fn step" (string-trim-left m "\n"))
|
||||
(string-suffix-p " step()\n" m)))))
|
||||
|
||||
;;; Statement motion
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " let left?")
|
||||
(flan-fln-backward-statement)
|
||||
(test-flan--check "M-a at a statement's start goes to the one before at its level"
|
||||
(looking-at "if 0 == grid"))
|
||||
(flan-fln-backward-statement)
|
||||
(test-flan--check "and out to the owner when there is none" (looking-at "while y"))
|
||||
(flan-fln-forward-statement)
|
||||
(test-flan--check "M-e goes to the end of the statement, body and all"
|
||||
(looking-back "y = y - 1" (line-beginning-position)))
|
||||
(flan-fln-forward-statement)
|
||||
(test-flan--check "and again, to the end of the next"
|
||||
(looking-back "= 0.0" (line-beginning-position))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1")
|
||||
(flan-fln-up)
|
||||
(test-flan--check "C-M-u goes to the line that owns the block"
|
||||
(looking-at "elif not right"))
|
||||
(flan-fln-up)
|
||||
(test-flan--check "and from there to its owner's" (looking-at "let side")))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "m.x)")
|
||||
(flan-fln-up)
|
||||
(test-flan--check "C-M-u inside a bracket goes to the bracket" (looking-at "(m.x)")))
|
||||
|
||||
;;; What each key sends
|
||||
|
||||
;; The request, captured where it leaves: the daemon's answer is the live
|
||||
;; test's business, and here what matters is which text went out and where
|
||||
;; it said the text starts.
|
||||
(defvar test-flan-fln--sent nil)
|
||||
|
||||
(defmacro test-flan-fln--sending (&rest body)
|
||||
`(progn
|
||||
(setq test-flan-fln--sent nil)
|
||||
(cl-letf (((symbol-function 'flan--request)
|
||||
(lambda (form) (push form test-flan-fln--sent)
|
||||
(list :status "ok" :value "0")))
|
||||
((symbol-function 'pulse-momentary-highlight-region) #'ignore))
|
||||
,@body)
|
||||
(car test-flan-fln--sent)))
|
||||
|
||||
(defun test-flan-fln--sent-code (req)
|
||||
(plist-get req :code))
|
||||
|
||||
(defconst test-flan-fln--prog
|
||||
"fn fib(n: i64) -> i64
|
||||
if n < 2
|
||||
n
|
||||
else
|
||||
fib(n - 1) + fib(n - 2)
|
||||
|
||||
comment():
|
||||
twice(4)
|
||||
let x = 3
|
||||
if x > 2
|
||||
twice(x)
|
||||
else
|
||||
0
|
||||
|
||||
fn twice(n: i64) -> i64 = n * 2
|
||||
")
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
|
||||
(test-flan--check "C-c C-s is the .fln stepper"
|
||||
(eq (key-binding (kbd "C-c C-s")) 'flan-fln-step-defun))
|
||||
(let ((r (test-flan-fln--sending (flan-fln-step-defun))))
|
||||
(test-flan--check "which installs the fn at point to step through"
|
||||
(and (equal (plist-get r :op) "eval")
|
||||
(eq (plist-get r :step) t)
|
||||
(string-prefix-p "fn fib" (test-flan-fln--sent-code r))
|
||||
(string-suffix-p "fib(n - 2)" (test-flan-fln--sent-code r))))))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
||||
(test-flan--check "and refuses what is not a declaration"
|
||||
(condition-case nil
|
||||
(progn (test-flan-fln--sending (flan-fln-step-defun)) nil)
|
||||
(user-error t))))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
||||
(test-flan--check "C-c C-c inside a fn installs the whole fn"
|
||||
(and (equal (plist-get r :op) "eval")
|
||||
(string-suffix-p "fib(n - 1) + fib(n - 2)"
|
||||
(test-flan-fln--sent-code r))
|
||||
(string-prefix-p "fn fib" (test-flan-fln--sent-code r))
|
||||
(equal (plist-get r :syntax) "indented")))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
||||
(test-flan--check "C-c C-c on a column-0 call evaluates it"
|
||||
(equal (plist-get r :op) "eval-expr"))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n let x")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "C-x C-e at a line's end sends the statement ending there"
|
||||
(and (equal (plist-get r :op) "eval-expr")
|
||||
(equal (test-flan-fln--sent-code r) "twice(4)")
|
||||
(equal (plist-get r :line) 8)
|
||||
(equal (plist-get r :col) 3)))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n else\n 0")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "the innermost one: the last line of a block, not the if"
|
||||
(equal (test-flan-fln--sent-code r) "twice(x)"))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "(4)")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "C-x C-e inside a line sends the term before point"
|
||||
(and (equal (test-flan-fln--sent-code r) "twice")
|
||||
(equal (plist-get r :col) 3)))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n\ncomment")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "at the end of a fn's last line, the innermost statement, not the fn"
|
||||
(equal (test-flan-fln--sent-code r) "fib(n - 1) + fib(n - 2)"))))
|
||||
|
||||
(test-flan-fln--in test-flan-fln--prog
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward "\n")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "a column-0 one-line fn at its end is installed"
|
||||
(and (equal (plist-get r :op) "eval")
|
||||
(string-suffix-p "fn twice(n: i64) -> i64 = n * 2"
|
||||
(test-flan-fln--sent-code r))))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "else\n 0")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
||||
(test-flan--check "C-c C-e on a clause sends its whole statement"
|
||||
(and (equal (test-flan-fln--sent-code r)
|
||||
"if x > 2\n twice(x)\n else\n 0")
|
||||
(equal (plist-get r :line) 10)
|
||||
(equal (plist-get r :col) 3)))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "let x = 3")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
||||
(test-flan--check "C-c C-e on a bare let sends it with the rest of its block"
|
||||
(equal (test-flan-fln--sent-code r)
|
||||
"let x = 3\n if x > 2\n twice(x)\n else\n 0"))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-statement-and-next))))
|
||||
(test-flan--check "C-c C-n sends the statement"
|
||||
(equal (test-flan-fln--sent-code r) "twice(4)"))
|
||||
(test-flan--check "and moves to the next" (looking-at "let x = 3"))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
||||
(transient-mark-mode 1)
|
||||
(set-mark (point))
|
||||
(search-forward "twice(x)")
|
||||
(forward-char -3)
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
||||
(test-flan--check "C-c C-e sends the region's whole lines"
|
||||
(equal (test-flan-fln--sent-code r)
|
||||
"twice(4)\n let x = 3\n if x > 2\n twice(x)"))))
|
||||
|
||||
;; The pause target. The position sent is where the reader starts the form,
|
||||
;; which for a call is its name and not its parenthesis; the live test checks
|
||||
;; the daemon finds a form there.
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n - 1)")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
||||
(test-flan-fln--is "C-u C-c C-c in a call marks the call, from its name"
|
||||
(plist-get r :pause) '(5 5))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "< 2")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
||||
(test-flan-fln--is "outside a bracket, the statement on point's line"
|
||||
(plist-get r :pause) '(2 3))))
|
||||
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n < 2")
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(16)))))
|
||||
(test-flan-fln--is "C-u C-u, the fn: stop on entry"
|
||||
(plist-get r :pause) '(1 1))))
|
||||
|
||||
(test-flan-fln--in "fn f(x: i64) -> i64\n g((x| + 1), [x 2])\n"
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
||||
(test-flan-fln--is "a free parenthesis marks the value inside it"
|
||||
(plist-get r :pause) '(2 6))))
|
||||
|
||||
;;; Match arms, header lines, clauses, comments
|
||||
|
||||
(defconst test-flan-fln--arms
|
||||
"fn pick(n: i64) -> i64
|
||||
let r = match n
|
||||
0 -> 10
|
||||
1 ->
|
||||
twice(1)
|
||||
twice(2)
|
||||
k -> k + 1
|
||||
if n < 0
|
||||
-1
|
||||
elif n == 0
|
||||
or n == 1
|
||||
0
|
||||
else
|
||||
r
|
||||
handler-case
|
||||
f()
|
||||
on Error(e)
|
||||
nil
|
||||
; a comment, twice(9)
|
||||
r
|
||||
|
||||
comment:
|
||||
twice(4)
|
||||
")
|
||||
|
||||
(defun test-flan-fln--last-at (needle &optional fn)
|
||||
"What FN, C-x C-e by default, sends with point at the end of NEEDLE's line."
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
|
||||
(end-of-line)
|
||||
(let ((r (test-flan-fln--sending (funcall (or fn #'flan-fln-eval-last)))))
|
||||
(and r (list (plist-get r :op) (test-flan-fln--sent-code r))))))
|
||||
|
||||
(test-flan-fln--is "C-x C-e at the end of a match arm sends its value"
|
||||
(test-flan-fln--last-at "0 -> 10") '("eval-expr" "10"))
|
||||
(test-flan-fln--is "at the end of an arm with a block, the block"
|
||||
(test-flan-fln--last-at "1 ->")
|
||||
'("eval-expr" "twice(1)\n twice(2)"))
|
||||
(test-flan-fln--is "an arm whose pattern binds a name sends the whole match"
|
||||
(cadr (test-flan-fln--last-at "k -> k"))
|
||||
(substring test-flan-fln--arms (string-search "let r" test-flan-fln--arms)
|
||||
(+ (string-search "k + 1" test-flan-fln--arms) 5)))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "twice(2)")
|
||||
(test-flan-fln--is "C-c C-e on an arm's block sends the block, not the arm"
|
||||
(test-flan-fln--sent-code
|
||||
(test-flan-fln--sending
|
||||
(search-backward "1 ->") (flan-fln-eval-statement)))
|
||||
"twice(1)\n twice(2)"))
|
||||
(test-flan-fln--is "C-x C-e at the end of an if line sends its condition"
|
||||
(test-flan-fln--last-at "if n < 0") '("eval-expr" "n < 0"))
|
||||
(test-flan-fln--is "and of an elif, all of its condition"
|
||||
(test-flan-fln--last-at "or n == 1")
|
||||
'("eval-expr" "n == 0\n or n == 1"))
|
||||
(test-flan-fln--is "and the same from the end of the condition's first line"
|
||||
(test-flan-fln--last-at "elif n == 0")
|
||||
'("eval-expr" "n == 0\n or n == 1"))
|
||||
|
||||
(defconst test-flan-fln--wrapped
|
||||
"fn f(o: Option(i64)) -> i64
|
||||
match o
|
||||
Some(_) -> 5
|
||||
Some(n) -> n + 1
|
||||
Some(m) -> 7
|
||||
None -> 1 +
|
||||
2
|
||||
if 1 < 2 and
|
||||
3 < 4
|
||||
x = 1 +
|
||||
2
|
||||
")
|
||||
|
||||
(defun test-flan-fln--wrapped-at (needle fn)
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped needle)
|
||||
(end-of-line)
|
||||
(let ((r (test-flan-fln--sending (funcall fn))))
|
||||
(and r (test-flan-fln--sent-code r)))))
|
||||
|
||||
(test-flan-fln--is "an arm's value wrapped onto a second line goes whole"
|
||||
(test-flan-fln--wrapped-at "None" #'flan-fln-eval-last)
|
||||
"1 +\n 2")
|
||||
(test-flan-fln--is "from its second line too"
|
||||
(test-flan-fln--wrapped-at " 2\n if" #'flan-fln-eval-last)
|
||||
"1 +\n 2")
|
||||
(test-flan-fln--is "and C-c C-e on it sends the same"
|
||||
(test-flan-fln--wrapped-at "None" #'flan-fln-eval-statement)
|
||||
"1 +\n 2")
|
||||
(test-flan-fln--is "a wrapped if condition, from the end of its first line"
|
||||
(test-flan-fln--wrapped-at "if 1 < 2" #'flan-fln-eval-last)
|
||||
"1 < 2 and\n 3 < 4")
|
||||
(test-flan-fln--is "a statement wrapped by an operator, from the end of its first line"
|
||||
(test-flan-fln--wrapped-at "x = 1 +" #'flan-fln-eval-last)
|
||||
"x = 1 +\n 2")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "None")
|
||||
(end-of-line)
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan-fln--is "a value cut mid-line says where its statement starts"
|
||||
(list (plist-get r :line) (plist-get r :col) (plist-get r :indent))
|
||||
'(6 13 5))))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "x = 1")
|
||||
(end-of-line)
|
||||
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
(test-flan--check "a whole statement does not" (null (plist-member r :indent)))))
|
||||
(test-flan-fln--is "an arm whose pattern binds nothing sends its value"
|
||||
(test-flan-fln--wrapped-at "Some(_)" #'flan-fln-eval-last) "5")
|
||||
(test-flan-fln--is "nor one whose value does not use what it binds"
|
||||
(test-flan-fln--wrapped-at "Some(m)" #'flan-fln-eval-last) "7")
|
||||
(dolist (c '(("Some(_v) -> _v + 1" "a name starting with _")
|
||||
("Some(éé) -> éé" "a name that is not ASCII")
|
||||
("Some(N) -> N" "a capitalised name")
|
||||
("Some(p) -> p.x" "a name used as a field's base")
|
||||
("Some(n) -> -n" "a name its value negates")
|
||||
("Some(p) -> -p.x" "a name whose field its value negates")))
|
||||
(test-flan-fln--in (concat "fn f(o: Option(i64)) -> i64\n match o\n " (car c) "\n")
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward "\n")
|
||||
(test-flan--check (format "an arm binding %s its value uses sends the match" (cadr c))
|
||||
(string-prefix-p "match o"
|
||||
(test-flan-fln--sent-code
|
||||
(test-flan-fln--sending (flan-fln-eval-last)))))))
|
||||
(test-flan--check "one whose value uses its binding sends the match"
|
||||
(string-prefix-p "match o"
|
||||
(test-flan-fln--wrapped-at "Some(n)" #'flan-fln-eval-last)))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "5")
|
||||
(test-flan-fln--is "a match arm is a clause"
|
||||
(test-flan-fln--thing 'flan-fln-clause) "Some(_) -> 5"))
|
||||
(test-flan-fln--is "at the end of an else line, the whole if"
|
||||
(cadr (test-flan-fln--last-at "else\n r"))
|
||||
"if n < 0\n -1\n elif n == 0\n or n == 1\n 0\n else\n r")
|
||||
(test-flan-fln--is "at the end of an on line, the whole handler-case"
|
||||
(cadr (test-flan-fln--last-at "on Error"))
|
||||
"handler-case\n f()\n on Error(e)\n nil")
|
||||
(test-flan-fln--is "at the end of a fn header, the fn, installed"
|
||||
(car (test-flan-fln--last-at "fn pick")) "eval")
|
||||
(test-flan-fln--is "at the end of comment:, the whole block"
|
||||
(test-flan-fln--last-at "comment:")
|
||||
'("eval-expr" "comment:\n twice(4)"))
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "; a comment")
|
||||
(end-of-line)
|
||||
(let ((r (test-flan-fln--sending
|
||||
(condition-case nil (flan-fln-eval-last) (user-error nil)))))
|
||||
(test-flan--check "C-x C-e on a comment line sends nothing from the comment"
|
||||
(null r))))
|
||||
|
||||
(defun test-flan-fln--pause-at (needle)
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
|
||||
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause)))
|
||||
|
||||
(test-flan-fln--is "C-u C-c C-c on an arm's pattern stops at its value"
|
||||
(test-flan-fln--pause-at "0 -> 10") '(3 10))
|
||||
(test-flan-fln--is "on an arm with a block, at the block"
|
||||
(test-flan-fln--pause-at "1 ->") '(5 7))
|
||||
(test-flan-fln--is "on an elif line, at its condition"
|
||||
(test-flan-fln--pause-at "elif") '(10 8))
|
||||
(test-flan-fln--is "and from its condition's continuation line too"
|
||||
(test-flan-fln--pause-at "or n == 1") '(10 8))
|
||||
(test-flan-fln--is "on an else line, at its block"
|
||||
(test-flan-fln--pause-at "else\n r") '(14 5))
|
||||
(test-flan-fln--is "on an on line, at its block"
|
||||
(test-flan-fln--pause-at "on Error") '(18 5))
|
||||
|
||||
;;; Names and colours
|
||||
|
||||
(test-flan-fln--in "fn f(x: i64) -> i64\n comment:\n g(:key-r, x)\n 0x1F + 12\n"
|
||||
(search-forward "x:")
|
||||
(backward-char 1)
|
||||
(test-flan-fln--is "a colon glued to a name is not part of it"
|
||||
(thing-at-point 'symbol t) "x")
|
||||
(search-forward "comment")
|
||||
(test-flan-fln--is "nor to a name that takes a block"
|
||||
(thing-at-point 'symbol t) "comment")
|
||||
(test-flan--check "font-lock draws the buffer without an error"
|
||||
(condition-case nil (progn (font-lock-ensure) t) (error nil)))
|
||||
(let ((face (lambda (needle)
|
||||
(save-excursion (goto-char (point-min)) (search-forward needle)
|
||||
(get-text-property (match-beginning 0) 'face)))))
|
||||
(test-flan-fln--is "a number is drawn as one" (funcall face "12") 'font-lock-number-face)
|
||||
(test-flan-fln--is "a keyword as a constant" (funcall face ":key-r") 'font-lock-constant-face)
|
||||
(test-flan-fln--is "a header word as a keyword" (funcall face "fn") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "a type after its colon" (funcall face "i64") 'font-lock-type-face)
|
||||
(test-flan--check "and the name before the colon is not a keyword"
|
||||
(null (funcall face "x:")))))
|
||||
|
||||
;;; Indentation
|
||||
|
||||
(defun test-flan-fln--tabs (text n)
|
||||
"The column TEXT's `|' line reaches after N TABs."
|
||||
(test-flan-fln--in text
|
||||
(let ((last-command nil) (this-command 'indent-for-tab-command))
|
||||
(dotimes (_ n)
|
||||
(indent-for-tab-command)
|
||||
(setq last-command 'indent-for-tab-command)))
|
||||
(current-indentation)))
|
||||
|
||||
(defconst test-flan-fln--nest
|
||||
"fn f() -> ()
|
||||
while a
|
||||
if b
|
||||
c()
|
||||
|")
|
||||
|
||||
(test-flan-fln--is "the first TAB after a block goes to its column"
|
||||
(test-flan-fln--tabs test-flan-fln--nest 1) 6)
|
||||
(test-flan-fln--is "each TAB after that steps out one"
|
||||
(list (test-flan-fln--tabs test-flan-fln--nest 2)
|
||||
(test-flan-fln--tabs test-flan-fln--nest 3)
|
||||
(test-flan-fln--tabs test-flan-fln--nest 4)
|
||||
(test-flan-fln--tabs test-flan-fln--nest 5))
|
||||
'(4 2 0 6))
|
||||
(test-flan-fln--is "a line of code already at a valid column stays there"
|
||||
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 2)
|
||||
(test-flan-fln--is "and a second TAB steps it out"
|
||||
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 2) 0)
|
||||
(test-flan-fln--is "a line of code at no valid column goes to the deepest"
|
||||
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 4)
|
||||
(test-flan-fln--is "after a header, one level deeper first"
|
||||
(test-flan-fln--tabs "fn f() -> ()\n while a\n|" 1) 4)
|
||||
(test-flan-fln--is "after a trailing colon too"
|
||||
(test-flan-fln--tabs "rl/with-drawing():\n|" 1) 2)
|
||||
(test-flan-fln--is "and after let x ="
|
||||
(test-flan-fln--tabs "def colors =\n|" 1) 2)
|
||||
(test-flan-fln--is "but not after a one-line fn"
|
||||
(test-flan-fln--tabs "fn f() -> i32 = 1\n|" 1) 0)
|
||||
(test-flan-fln--is "else goes to its if's column, whatever the depth"
|
||||
(test-flan-fln--tabs "if a\n if b\n c\n |else" 1) 2)
|
||||
(test-flan-fln--is "and a second TAB to the outer if's"
|
||||
(test-flan-fln--tabs "if a\n if b\n c\n |else" 2) 0)
|
||||
(test-flan-fln--is "on goes to its handler-case's"
|
||||
(test-flan-fln--tabs " handler-case\n f()\n |on E(c)" 1) 2)
|
||||
(test-flan-fln--is "inside a call, under its first argument"
|
||||
(test-flan-fln--tabs " paint-at(i32(m.y) / cell-size,\n|i32(m.x))" 1) 11)
|
||||
(test-flan-fln--is "inside a bracket with nothing after it, one level in"
|
||||
(test-flan-fln--tabs " let v = [\n|1 2]" 1) 4)
|
||||
(test-flan-fln--is "a closing bracket, at its opening line's column"
|
||||
(test-flan-fln--tabs " let v = [\n 1 2\n|]" 1) 2)
|
||||
(test-flan-fln--is "after a line ending in an operator, deeper than its statement"
|
||||
(test-flan-fln--tabs " if a and\n|b" 1) 4)
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n while a\n b()\n |"
|
||||
(flan-fln-dedent-or-delete 1)
|
||||
(test-flan-fln--is "backspace in the indentation drops one level"
|
||||
(current-indentation) 2)
|
||||
(flan-fln-dedent-or-delete 1)
|
||||
(test-flan-fln--is "and another" (current-indentation) 0))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n ab|"
|
||||
(flan-fln-dedent-or-delete 1)
|
||||
(test-flan-fln--is "backspace after text deletes a character"
|
||||
(buffer-substring (line-beginning-position) (point)) " a"))
|
||||
|
||||
(test-flan-fln--in "if a\n if b\n c\n els|"
|
||||
(let ((last-command-event ?e))
|
||||
(insert "e")
|
||||
(run-hooks 'post-self-insert-hook))
|
||||
(let ((last-command-event ?\s))
|
||||
(insert " ")
|
||||
(run-hooks 'post-self-insert-hook))
|
||||
(test-flan-fln--is "else snaps to its if as it is typed"
|
||||
(current-indentation) 2))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n if a\n b\n| c\n d\n"
|
||||
(indent-region (point) (point-max))
|
||||
(test-flan-fln--is "indent-region moves a block rigidly"
|
||||
(buffer-substring (point) (point-max))
|
||||
" c\n d\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |c\n"
|
||||
(indent-region (point-min) (point-max))
|
||||
(test-flan-fln--is "and leaves lines at valid columns alone"
|
||||
(buffer-string) "fn f() -> ()\n if a\n b\n c\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |\n"
|
||||
(kill-new "if x\n y\n else\n z")
|
||||
(flan-fln-yank)
|
||||
(test-flan-fln--is "a statement cut from its first character yanks as one block"
|
||||
(buffer-string)
|
||||
"fn f() -> ()\n if a\n b\n if x\n y\n else\n z\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n if a\n |\n"
|
||||
(kill-new " while x\n y\n")
|
||||
(flan-fln-yank)
|
||||
(test-flan-fln--is "whole lines yank at point's column"
|
||||
(buffer-string)
|
||||
"fn f() -> ()\n if a\n while x\n y\n\n"))
|
||||
|
||||
;;; Block editing
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n if a\n |b()\n c()\n d()\n"
|
||||
(flan-fln-slurp)
|
||||
(test-flan-fln--is "slurp pulls the next statement into the block"
|
||||
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n")
|
||||
(flan-fln-barf)
|
||||
(test-flan-fln--is "barf pushes the last one out again"
|
||||
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n |a()\n if x\n y\n b()\n"
|
||||
(flan-fln-move-statement-down)
|
||||
(test-flan-fln--is "a statement moves down past its sibling's whole block"
|
||||
(buffer-string) "fn f() -> ()\n if x\n y\n a()\n b()\n")
|
||||
(test-flan--check "and point moves with it" (looking-at "a()"))
|
||||
(flan-fln-move-statement-up)
|
||||
(test-flan-fln--is "and back up"
|
||||
(buffer-string) "fn f() -> ()\n a()\n if x\n y\n b()\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n when(c):\n if x\n |y\n"
|
||||
(flan-fln-raise-statement)
|
||||
(test-flan-fln--is "raise replaces the owner with the statement"
|
||||
(buffer-string) "fn f() -> ()\n when(c):\n y\n"))
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n |if x\n y\n else\n z\n b()\n"
|
||||
(flan-fln-kill-statement)
|
||||
(test-flan-fln--is "kill takes the whole statement's lines"
|
||||
(buffer-string) "fn f() -> ()\n b()\n")
|
||||
(test-flan-fln--is "into the kill ring" (current-kill 0)
|
||||
" if x\n y\n else\n z\n"))
|
||||
|
||||
;;; expand-region, where it is installed
|
||||
|
||||
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/expand-region-[0-9]*")
|
||||
(file-expand-wildcards "~/.emacs.d/elpa/expand-region-[0-9]*")))
|
||||
(load-path (append dirs load-path)))
|
||||
(if (not (require 'expand-region nil t))
|
||||
(message " skip expand-region (not installed)")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "right?\n -1")
|
||||
(transient-mark-mode 1)
|
||||
(let ((steps nil))
|
||||
(dotimes (_ 6)
|
||||
(er/expand-region 1)
|
||||
(push (buffer-substring-no-properties (region-beginning) (region-end)) steps))
|
||||
(setq steps (nreverse steps))
|
||||
(test-flan-fln--is "term, then statement's clause, then statement, then out"
|
||||
(mapcar (lambda (s) (car (split-string s "\n"))) steps)
|
||||
'("right?" "elif not right?" "if not left?" "let side ="
|
||||
"if left? or right?" "let left? = col > 0"))))))
|
||||
|
||||
;;; smartparens, where it is installed
|
||||
|
||||
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/smartparens-[0-9]*")
|
||||
(file-expand-wildcards "~/.emacs.d/elpa/smartparens-[0-9]*")
|
||||
(file-expand-wildcards "~/.config/emacs/elpa/dash-[0-9]*")
|
||||
(file-expand-wildcards "~/.emacs.d/elpa/dash-[0-9]*")))
|
||||
(load-path (append dirs load-path)))
|
||||
(if (not (require 'smartparens nil t))
|
||||
(message " skip smartparens (not installed)")
|
||||
;; A setup that puts sexp commands on the top-level keys, as the
|
||||
;; author's does.
|
||||
(define-key smartparens-mode-map (kbd "C-M-a") 'sp-backward-down-sexp)
|
||||
(define-key smartparens-mode-map (kbd "C-M-u") 'sp-backward-up-sexp)
|
||||
(let ((b (generate-new-buffer "sp.fln")))
|
||||
(switch-to-buffer b)
|
||||
(flan-fln-mode)
|
||||
(test-flan--check "smartparens is on in a .fln buffer" smartparens-mode)
|
||||
(test-flan--check "and C-M-a and C-M-u stay the mode's"
|
||||
(and (eq (key-binding (kbd "C-M-a")) 'beginning-of-defun)
|
||||
(eq (key-binding (kbd "C-M-u")) 'flan-fln-up)))
|
||||
(execute-kbd-macro "f(")
|
||||
(test-flan-fln--is "it pairs a bracket" (buffer-string) "f()")
|
||||
(erase-buffer)
|
||||
(execute-kbd-macro "'a")
|
||||
(test-flan-fln--is "and not a quote" (buffer-string) "'a")
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))
|
||||
(define-key smartparens-mode-map (kbd "C-M-a") nil)
|
||||
(define-key smartparens-mode-map (kbd "C-M-u") nil)))
|
||||
|
||||
;;; Under Evil
|
||||
|
||||
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/evil-[0-9]*")
|
||||
(file-expand-wildcards "~/.emacs.d/elpa/evil-[0-9]*")
|
||||
(file-expand-wildcards "~/.config/emacs/elpa/goto-chg-*")
|
||||
(file-expand-wildcards "~/.emacs.d/elpa/goto-chg-*")))
|
||||
(load-path (append dirs load-path)))
|
||||
(if (not (require 'evil nil t))
|
||||
(message " skip the .fln text objects (Evil is not installed)")
|
||||
(evil-mode 1)
|
||||
(unwind-protect
|
||||
(let ((yanked
|
||||
(lambda (text keys)
|
||||
(let ((b (generate-new-buffer "objects.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert text)
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(evil-normal-state)
|
||||
(goto-char (point-min))
|
||||
(search-forward "|")
|
||||
(delete-char -1)
|
||||
(execute-kbd-macro keys)
|
||||
(prog1 (substring-no-properties (current-kill 0))
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))))))
|
||||
(dolist (c `(("yiw" ,(test-flan-fln--at test-flan-fln--settle "settle(")
|
||||
"settle")
|
||||
("yie" ,(test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
||||
"i32(m.x)")
|
||||
("yis" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
||||
"if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1")
|
||||
("yas" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
||||
" if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1\n")
|
||||
("yii" ,(test-flan-fln--at test-flan-fln--settle "if not left")
|
||||
" 1\n")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
||||
" if f32(rand()) < 0.5 then 1 else -1\n")
|
||||
("yak" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
||||
" else\n if f32(rand()) < 0.5 then 1 else -1\n")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
|
||||
"5")
|
||||
("yak" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
|
||||
" Some(_) -> 5\n")
|
||||
("yid" ,(test-flan-fln--at test-flan-fln--settle "paint-at")
|
||||
,(substring test-flan-fln--settle
|
||||
(string-search "fn step" test-flan-fln--settle)))))
|
||||
(test-flan-fln--is (format "under Evil, %s" (car c))
|
||||
(funcall yanked (nth 1 c) (car c)) (nth 2 c)))
|
||||
(let ((deleted
|
||||
(lambda (keys needle)
|
||||
(let ((b (generate-new-buffer "delete.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert "fn f(x: i64) -> i64\n if x > 0\n a\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(evil-normal-state)
|
||||
(goto-char (point-min))
|
||||
(search-forward needle)
|
||||
(goto-char (match-beginning 0))
|
||||
(execute-kbd-macro keys)
|
||||
(prog1 (buffer-string)
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))))))
|
||||
(dolist (c '(("dak" "else"
|
||||
"fn f(x: i64) -> i64\n if x > 0\n a\n x\n\nfn g() -> i32 = 1\n")
|
||||
("das" "else"
|
||||
"fn f(x: i64) -> i64\n x\n\nfn g() -> i32 = 1\n")
|
||||
("dii" "if x"
|
||||
"fn f(x: i64) -> i64\n if x > 0\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
|
||||
("dad" "else" "fn g() -> i32 = 1\n")
|
||||
("dad" "fn g" "fn f(x: i64) -> i64\n if x > 0\n a\n else\n 3\n x\n")))
|
||||
(test-flan-fln--is (format "under Evil, %s leaves no blank line" (car c))
|
||||
(funcall deleted (car c) (nth 1 c)) (nth 2 c))))
|
||||
;; Comments: a block directly on a form is the form's; one a
|
||||
;; blank line away, or below it, is not.
|
||||
(let ((deleted
|
||||
(lambda (keys needle)
|
||||
(let ((b (generate-new-buffer "comments.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert "; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n"
|
||||
"; on g\nfn g() -> ()\n ; on b\n b()\n")
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(evil-normal-state)
|
||||
(goto-char (point-min))
|
||||
(search-forward needle)
|
||||
(goto-char (match-beginning 0))
|
||||
(execute-kbd-macro keys)
|
||||
(prog1 (buffer-string)
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))))))
|
||||
(dolist (c '(("dad" "a()"
|
||||
"; loose\n\n; after f\n\n; on g\nfn g() -> ()\n ; on b\n b()\n")
|
||||
("dad" "b()"
|
||||
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n")
|
||||
("did" "on g"
|
||||
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n")
|
||||
("das" "b()"
|
||||
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n; on g\nfn g() -> ()\n")))
|
||||
(test-flan-fln--is (format "under Evil, %s on %s keeps comments with their forms"
|
||||
(car c) (nth 1 c))
|
||||
(funcall deleted (car c) (nth 1 c)) (nth 2 c)))
|
||||
;; A lone comment belongs to no form: id and ad find nothing.
|
||||
(dolist (text '("fn a() -> i64\n 1\n\n; lone\n\nfn b() -> i64\n 2\n"
|
||||
"fn a() -> i64\n 1\n\n; lone\n"))
|
||||
(dolist (keys '("did" "dad"))
|
||||
(let ((b (generate-new-buffer "lone.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert text)
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(evil-normal-state)
|
||||
(goto-char (point-min))
|
||||
(search-forward "; lone")
|
||||
(goto-char (match-beginning 0))
|
||||
(ignore-errors (execute-kbd-macro keys))
|
||||
(test-flan-fln--is (format "under Evil, %s on a lone comment%s changes nothing"
|
||||
keys (if (string-suffix-p "lone\n" text) " at the end" ""))
|
||||
(buffer-string) text)
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))))
|
||||
;; A comment deeper than a form, at the end of its block, is
|
||||
;; that block's, not the next form's.
|
||||
(dolist (c '(("dad" "fn a" "fn a() -> i64\n 1\n ; end of a\nfn b() -> i64\n 2\n"
|
||||
"fn b() -> i64\n 2\n")
|
||||
("dad" "fn b" "fn a() -> i64\n 1\n ; end of a\nfn b() -> i64\n 2\n"
|
||||
"fn a() -> i64\n 1\n ; end of a\n")
|
||||
("das" "let y"
|
||||
"fn a(x: i64) -> i64\n if x > 0\n 1\n ; end of the if\n let y = 2\n y\n"
|
||||
"fn a(x: i64) -> i64\n if x > 0\n 1\n ; end of the if\n y\n")))
|
||||
(let ((b (generate-new-buffer "owned.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert (nth 2 c))
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(evil-normal-state)
|
||||
(goto-char (point-min))
|
||||
(search-forward (nth 1 c))
|
||||
(goto-char (match-beginning 0))
|
||||
(execute-kbd-macro (car c))
|
||||
(test-flan-fln--is (format "under Evil, %s on %s: a deeper comment stays with the block above"
|
||||
(car c) (nth 1 c))
|
||||
(buffer-string) (nth 3 c))
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer b))))
|
||||
(let ((b (generate-new-buffer "keys.fln")))
|
||||
(switch-to-buffer b)
|
||||
(insert "fn f() -> i32 = 1\n")
|
||||
(flan-fln-mode)
|
||||
(evil-initialize-state)
|
||||
(test-flan--check "under Evil, C-x C-e is still the mode's"
|
||||
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))
|
||||
(goto-char (point-min))
|
||||
(end-of-line)
|
||||
(backward-char)
|
||||
(test-flan--check "under Evil, C-x C-e counts the cursor's character"
|
||||
(= (flan-fln--point-for-last) (line-end-position)))
|
||||
(kill-buffer b)))
|
||||
(evil-mode -1))))
|
||||
|
||||
;;; test-flan-fln.el ends here
|
||||
@ -2492,6 +2492,13 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
||||
(ignore-errors (delete-file socket6))
|
||||
(ignore-errors (delete-file scratch)))
|
||||
|
||||
;; ── The .fln keys, against daemons of their own ────────────────────────
|
||||
(setq test-flan-fln-live-dir (file-name-directory file)
|
||||
test-flan-fln-live-socket socket)
|
||||
(load (expand-file-name "test-flan-fln-live.el"
|
||||
(file-name-directory load-file-name))
|
||||
nil t)
|
||||
|
||||
(if (zerop test-flan--failures)
|
||||
(message "flan.el: all tests passed")
|
||||
(message "\n%d failure(s)" test-flan--failures)
|
||||
|
||||
@ -4568,7 +4568,8 @@ let rec handle t req =
|
||||
| Some l, None -> Some (l, 1)
|
||||
| _ -> None
|
||||
in
|
||||
Source.with_code ~syntax ~at (fun () -> handle_op t req)
|
||||
let indent = Wire.int_field req "indent" in
|
||||
Source.with_code ?indent ~syntax ~at (fun () -> handle_op t req)
|
||||
|
||||
and handle_op t req =
|
||||
match Wire.string_field req "op" with
|
||||
|
||||
@ -249,7 +249,7 @@ let point (l : Loc.t) = { l with Loc.line = l.Loc.eline; col = l.Loc.ecol }
|
||||
(* NEWLINE, INDENT and DEDENT, at bracket depth zero only: inside ( [ { a
|
||||
line break is whitespace. A line continues the one before it when either
|
||||
side of the break is a spaced binary operator (spec §2 "Continuation"). *)
|
||||
let layout ?(snippet = false) ?(base = 1) (toks : token list) : token array =
|
||||
let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token array =
|
||||
let arr = Array.of_list toks in
|
||||
let n = Array.length arr in
|
||||
(* A snippet from the editor starts wherever it was written, and its first
|
||||
@ -258,6 +258,11 @@ let layout ?(snippet = false) ?(base = 1) (toks : token list) : token array =
|
||||
let out = ref [] in
|
||||
let add tok loc = out := { tok; loc; sp = true } :: !out in
|
||||
let stack = ref [ base ] in
|
||||
(* [indent] is the column of the statement a snippet was cut out of, when
|
||||
the snippet starts after that statement's first word (an elif's
|
||||
condition, an arm's value). Its first joined line continues as it does
|
||||
in the file: deeper than the statement, not than the cut. *)
|
||||
let first_line = ref true in
|
||||
let depth = ref 0 in
|
||||
let binop t = match t.tok with NAME s -> is_binop s | _ -> false in
|
||||
for i = 0 to n - 1 do
|
||||
@ -277,11 +282,16 @@ let layout ?(snippet = false) ?(base = 1) (toks : token list) : token array =
|
||||
&& arr.(i + 1).sp
|
||||
in
|
||||
let continues = (binop p && p.sp) || (binop t && spaced_after) in
|
||||
let top =
|
||||
match indent with
|
||||
| Some c when !first_line && List.length !stack = 1 -> min c (List.hd !stack)
|
||||
| _ -> List.hd !stack
|
||||
in
|
||||
(* A continuation line sits deeper than the statement it continues.
|
||||
One at or left of that statement's column is not read as joining
|
||||
it: that would pull a line into a block it was written outside
|
||||
of, silently. *)
|
||||
if continues && t.loc.Loc.col <= List.hd !stack then
|
||||
if continues && t.loc.Loc.col <= top then
|
||||
failk "continuation" t.loc
|
||||
"%s"
|
||||
(if binop t then
|
||||
@ -290,15 +300,16 @@ let layout ?(snippet = false) ?(base = 1) (toks : token list) : token array =
|
||||
line above, but it is not indented past the start of that \
|
||||
line (column %d). Indent it further to continue the line, \
|
||||
or give %s a value on its left"
|
||||
(show t.tok) (List.hd !stack) (show t.tok)
|
||||
(show t.tok) top (show t.tok)
|
||||
else
|
||||
Printf.sprintf
|
||||
"the line above ends with the operator %s, so this line \
|
||||
continues it, but it is not indented past the start of \
|
||||
that line (column %d). Indent it further, or finish the \
|
||||
line above"
|
||||
(show p.tok) (List.hd !stack));
|
||||
(show p.tok) top);
|
||||
if not continues then begin
|
||||
first_line := false;
|
||||
let at = point p.loc in
|
||||
add NEWLINE at;
|
||||
let col = t.loc.Loc.col in
|
||||
@ -1578,7 +1589,7 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list =
|
||||
|
||||
(** All top-level forms in a [.fln] source string. [col] is the column the
|
||||
text's top level starts at, 1 for a file. *)
|
||||
let read_all ?(line = 1) ?col ~file src =
|
||||
let read_all ?(line = 1) ?col ?indent ~file src =
|
||||
let snippet = col <> None in
|
||||
let col = Option.value col ~default:1 in
|
||||
let saved = !source in
|
||||
@ -1588,7 +1599,7 @@ let read_all ?(line = 1) ?col ~file src =
|
||||
(file, Array.of_list (String.split_on_char '\n'
|
||||
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
|
||||
Fun.protect ~finally:(fun () -> source := saved) (fun () ->
|
||||
let toks = layout ~snippet ~base:col (lex ~line ~col ~file src) in
|
||||
let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
|
||||
let s = { p = { toks; i = 0 }; lets = [] } in
|
||||
let fs = stmts s in
|
||||
(match (peek s.p).tok with
|
||||
|
||||
@ -33,15 +33,21 @@ type syntax = Paren | Indented
|
||||
let code_syntax = ref Paren
|
||||
let code_at : (int * int) option ref = ref None
|
||||
|
||||
(* The column of the statement editor code was cut out of, when the code
|
||||
starts after that statement's first word: see [Indent_reader.layout]. *)
|
||||
let code_indent : int option ref = ref None
|
||||
|
||||
let syntax_of_field = function
|
||||
| Some ("indented" | "fln") -> Indented
|
||||
| _ -> Paren
|
||||
|
||||
let with_code ~syntax ~at f =
|
||||
let s = !code_syntax and a = !code_at in
|
||||
let with_code ?indent ~syntax ~at f =
|
||||
let s = !code_syntax and a = !code_at and i = !code_indent in
|
||||
code_syntax := syntax;
|
||||
code_at := at;
|
||||
Fun.protect ~finally:(fun () -> code_syntax := s; code_at := a) f
|
||||
code_indent := indent;
|
||||
Fun.protect
|
||||
~finally:(fun () -> code_syntax := s; code_at := a; code_indent := i) f
|
||||
|
||||
(* The paren reader started at a line and column: [Reader.read_all] always
|
||||
starts at 1:1. *)
|
||||
@ -65,7 +71,7 @@ let read_code ?(expr = false) ~file code =
|
||||
match !code_syntax with
|
||||
| Paren -> read_paren ~line ~col ~file code
|
||||
| Indented ->
|
||||
(match Indent_reader.read_all ~line ~col ~file code with
|
||||
(match Indent_reader.read_all ~line ~col ?indent:!code_indent ~file code with
|
||||
| (first :: _ :: _ as forms) when expr ->
|
||||
let last = List.nth forms (List.length forms - 1) in
|
||||
let loc =
|
||||
|
||||
@ -365,6 +365,10 @@ Each step lands on its own, with `dune test --root .` green.
|
||||
`flan--pause-bounds` at `flan.el:2637-2660`) must equal the start
|
||||
location the reader gave that form. `Ast.mark_pause` matches exactly
|
||||
(`ast.ml:491-492`).
|
||||
|
||||
**Built** (`emacs/flan-fln-mode.el`; keys and objects in `emacs/MANUAL.md`,
|
||||
"Indented files"). A line ending in `=` or `fn(…)` also opens a block for
|
||||
TAB, and a body is its statement's own block, up to its first clause.
|
||||
6. **Return-type inference** in `Check`, with the recursion refusal and the
|
||||
stale-caller cause. This is independent of steps 1-5 once the marker exists.
|
||||
|
||||
|
||||
@ -495,6 +495,22 @@ let () =
|
||||
| [ _; _ ] -> ()
|
||||
| _ -> fail "a snippet with leading spaces"
|
||||
| exception e -> fail "a snippet with leading spaces: %s" (diag_text e));
|
||||
(* A condition cut out from after [elif ] at column 3: its wrapped line at
|
||||
column 8 is deeper than the elif, which is what the file says, though not
|
||||
deeper than the cut. [:indent] says where the statement starts; every
|
||||
location stays the buffer's own. *)
|
||||
Source.with_code ~indent:3 ~syntax:Source.Indented ~at:(Some (10, 8)) (fun () ->
|
||||
(match Source.read_code ~expr:true ~file:"<buf>" "x == 0 or\n x == 1" with
|
||||
| [ f ] -> span_is "a wrapped condition, cut mid-line" f (10, 8, 11, 14)
|
||||
| _ -> fail "a wrapped condition read as more than one form"
|
||||
| exception e -> fail "a wrapped condition: %s" (diag_text e));
|
||||
match Source.read_code ~expr:true ~file:"<buf>" "x == 0 or\n x == 1" with
|
||||
| _ -> fail "a continuation left of its statement was read"
|
||||
| exception Loc.Error _ -> ());
|
||||
Source.with_code ~syntax:Source.Indented ~at:(Some (10, 8)) (fun () ->
|
||||
match Source.read_code ~expr:true ~file:"<buf>" "x == 0 or\n x == 1" with
|
||||
| _ -> fail "without :indent, a wrapped line is measured from the cut"
|
||||
| exception Loc.Error _ -> ());
|
||||
Source.with_code ~syntax:Source.Paren ~at:(Some (7, 3)) (fun () ->
|
||||
match Source.read_code ~file:"<buf>" "(f 1)" with
|
||||
| [ f ] -> span_is "a paren snippet" f (7, 3, 7, 8)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user