diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 872c6199..987fc20d 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -1186,8 +1186,8 @@ Use `C-c C-g` if you need frames. | 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 (`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; elsewhere, the term before point | +| `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-k` | same | the whole buffer | @@ -1195,7 +1195,7 @@ Use `C-c C-g` if you need frames. | `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 | deepest valid column first; each repeat steps out a level | +| `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-` / `M-` | same | move the statement past its neighbour | diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index d9182a64..56a43d0b 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -117,10 +117,13 @@ fine here. Brackets and strings are still paired." (let ((table (make-syntax-table))) ;; Name characters: a name is anything up to a delimiter (`is_delimiter' ;; in lib/reader.ml), so `key-pressed?', `dyn->f64' and `rl/draw-fps' are - ;; one symbol each. `:' too, so `:key-r' is one; the colon of `x: T' is - ;; glued to the name and is trimmed off a term where it matters. - (dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?: ?@ ?# ?^ ?| ?~)) + ;; one symbol each. + (dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~)) (modify-syntax-entry c "_" table)) + ;; Not `:', which ends `x: T' and `comment:': a name glued to it would + ;; otherwise read as `x:', a name nothing defines. A `:key' keyword is + ;; drawn by its own font-lock rule instead. + (modify-syntax-entry ?: "." table) (modify-syntax-entry ?\; "<" table) (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?\" "\"" table) @@ -473,9 +476,12 @@ For `end-of-defun-function'." (and (< beg end) (cons beg end)))))) (defun flan-fln--term-before (pos) - "Bounds of the term that ends at POS, spaces before POS skipped, or nil." + "Bounds of the term that ends at POS, spaces before POS skipped, or nil. +A comment is skipped too: nothing in one is a term." (save-excursion (goto-char pos) + (let ((s (syntax-ppss pos))) + (when (nth 4 s) (goto-char (nth 8 s)))) (skip-chars-backward " \t,") (let* ((end (point)) (beg (flan-fln--term-back end)) @@ -560,11 +566,82 @@ Two: B itself, which stops on entry." (t (or (flan-fln--pause-target (point) b) b)))) (defun flan-fln--pause-target (pos b) - (let ((g (flan-fln--group-bounds pos))) - (if (and g (cdr g) (> (car g) (car b))) - (cons (flan-fln--group-form-start (car g)) (cdr g)) - (let ((s (flan-fln--statement-start-at pos))) - (and s (flan-fln--statement-bounds s)))))) + "The form to stop at for point at POS inside the top-level form B. +Its start is where the reader starts that form, which is all the daemon +matches on: a match arm's value or block, not its pattern, which is no +form; an elif's condition and an else's, on's or restart's block, which are +forms, where the clause line itself is not." + (let* ((l (flan-fln--line-statement pos)) + (arm (and l (flan-fln--arm l))) + (g (flan-fln--group-bounds pos))) + (cond + ((and arm (< pos (plist-get arm :arrow))) (plist-get arm :value)) + ((and g (cdr g) (> (car g) (car b))) + (cons (flan-fln--group-form-start (car g)) (cdr g))) + (arm (plist-get arm :value)) + ((and l (flan-fln--clause-line-p l)) (flan-fln--clause-target l)) + (t (let ((s (flan-fln--statement-start-at pos))) + (and s (flan-fln--statement-bounds s))))))) + +(defun flan-fln--clause-target (l) + "What a clause line L stops at: an elif's condition, else its block." + (save-excursion + (goto-char (flan-fln--first-char l)) + (if (looking-at "elif[ \t]+") + (cons (match-end 0) (flan-fln--code-end (flan-fln--logical-end l))) + (flan-fln--body-bounds l)))) + +(defun flan-fln--condition (l) + "Bounds of the condition on the if, elif, while or until line L, or nil. +A loop's label, `while :outer c', is not part of it." + (save-excursion + (goto-char (flan-fln--first-char l)) + (when (looking-at "\\(?:if\\|elif\\|while\\|until\\)[ \t]+\\(?::[^ \t]+[ \t]+\\)?") + (let ((beg (match-end 0)) + (end (flan-fln--code-end (flan-fln--logical-end l)))) + (and (< beg end) (cons beg end)))))) + +(defun flan-fln--arm (l) + "The match arm whose joined line starts at L, or nil. +A plist: :arrow, where its ` -> ' starts; :value, the bounds of what follows +the arrow on the line, or of the block under it; :binds, non-nil when the +pattern names something, so the value cannot be evaluated alone." + (let ((parent (flan-fln--parent l))) + (when (and parent + (string-match-p "\\(?:\\`\\|[ \t]=[ \t]+\\)match\\(?:[ \t]\\|\\'\\)" + (buffer-substring-no-properties + (flan-fln--first-char parent) + (flan-fln--code-end parent)))) + (save-excursion + (let* ((start (flan-fln--first-char l)) + (last (flan-fln--code-end (flan-fln--logical-end l))) + (depth (car (syntax-ppss start))) + arrow) + (goto-char start) + (while (and (not arrow) + (re-search-forward "[ \t]\\(->\\)\\(?:[ \t]\\|$\\)" last t)) + (let ((ps (save-excursion (syntax-ppss (match-beginning 1))))) + (when (and (= (car ps) depth) (not (nth 8 ps))) + (setq arrow (match-beginning 1))))) + (when arrow + (let* ((pat (string-trim (buffer-substring-no-properties start arrow))) + (vbeg (save-excursion (goto-char (+ arrow 2)) + (skip-chars-forward " \t") (point))) + (value (if (< vbeg last) (cons vbeg last) + (flan-fln--body-bounds l)))) + (and value + (list :arrow arrow :value value + :binds (or (string-match-p "[([{]" pat) + (and (string-match-p "\\`[a-z][^ \t]*\\'" pat) + (not (member pat flan--constants))))))))))))) + +(defun flan-fln--arm-to-send (l arm) + "What evaluating the match arm at L sends: its value, or, when its pattern +binds a name the value uses, the whole match." + (if (plist-get arm :binds) + (flan-fln--statement-bounds + (flan-fln--statement-start-at (flan-fln--parent l))) + (plist-get arm :value))) ;;;###autoload (defun flan-fln-eval-defun (&optional arg) @@ -609,13 +686,34 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does." (interactive "P") (flan-fln--client) (let* ((end (flan-fln--point-for-last)) - (st (and (>= end (flan-fln--code-end end)) - (flan-fln--statement-ending-at end)))) - (if st - (flan-fln--send (car st) (cdr st) arg flan--declaration-heads) + (at-end (and (>= end (flan-fln--code-end end)) + (not (flan-fln--blank-p end)))) + (l (and at-end (flan-fln--line-statement end))) + ;; Point ends the line L starts, joined lines included. + (l-end (and l (= (flan-fln--bol end) (flan-fln--logical-end l)))) + (arm (and l-end (flan-fln--arm l))) + (st (and at-end (not arm) (flan-fln--statement-ending-at end))) + (opens (and l-end (not st) (not arm) + (or (flan-fln--clause-line-p l) + (/= (flan-fln--statement-last l) + (flan-fln--logical-end l)))))) + (cond + (arm (let ((b (flan-fln--arm-to-send l arm))) + (flan-fln--send (car b) (cdr b) arg flan--declaration-heads))) + (st (flan-fln--send (car st) (cdr st) arg flan--declaration-heads)) + ;; The end of a line that opens a block: its last word is not what was + ;; meant. A condition is a value of its own; anything else is sent + ;; with its block, a clause with the statement it belongs to. + ((and opens (flan-fln--condition l)) + (let ((c (flan-fln--condition l))) + (flan--eval-expression (car c) (cdr c) arg))) + (opens + (let ((b (flan-fln--statement-bounds (flan-fln--clause-header l)))) + (flan-fln--send (car b) (cdr b) arg flan--declaration-heads))) + (t (let ((tb (flan-fln--term-before end))) (unless tb (user-error "flan: no form before point to evaluate")) - (flan--eval-expression (car tb) (cdr tb) arg))))) + (flan--eval-expression (car tb) (cdr tb) arg)))))) (defun flan-fln--snap-lines (beg end) "BEG..END widened to whole lines, less leading blank lines and trailing space." @@ -650,10 +748,13 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does." (defun flan-fln--statement-to-send (pos) "The statement at POS as sent by `C-c C-e': with its body and clauses, and for a bare `let x = v', with the rest of its block, which is its scope." - (let ((s (flan-fln--statement-start-at pos))) - (and s (if (flan-fln--bare-let-p s) - (flan-fln--block-rest s) - (flan-fln--statement-bounds s))))) + (let* ((l (flan-fln--line-statement pos)) + (arm (and l (flan-fln--arm l))) + (s (flan-fln--statement-start-at pos))) + (cond (arm (flan-fln--arm-to-send l arm)) + ((null s) nil) + ((flan-fln--bare-let-p s) (flan-fln--block-rest s)) + (t (flan-fln--statement-bounds s))))) ;;;###autoload (defun flan-fln-eval-statement (&optional arg) @@ -936,7 +1037,10 @@ opening line's column." (t (flan-fln--levels (point)))))))))) (defun flan-fln-indent-line () - "Indent the line to a block column: the deepest first, then out one per TAB." + "Indent the line to a block column. +A line with text at a valid column stays there: its column is its meaning, +and a TAB pressed to see where it goes must not change it. An empty line +goes to the deepest column. Each repeated TAB then steps out one." (let* ((cands (flan-fln--indent-candidates (point))) (cur (current-indentation)) (target @@ -945,6 +1049,10 @@ opening line's column." (eq last-command 'indent-for-tab-command) (memq cur cands)) (or (cadr (memq cur cands)) (car cands))) + ((and (memq cur cands) + (not (save-excursion (beginning-of-line) + (looking-at-p "[ \t]*$")))) + cur) (t (car cands))))) (if (null target) 'noindent @@ -1231,7 +1339,7 @@ it, so a block pasted at another depth stays one block." (,(concat "\\_<" (regexp-opt flan--constants t) "\\_>") 1 font-lock-constant-face) ;; A keyword. `x:' is a name with a colon glued on, not one. - ("\\_<:[^][ \t\n(){},;\":]+" . font-lock-constant-face) + ("\\(?:^\\|[][ \t(){},]\\)\\(:[^][ \t\n(){},;\":]+\\)" 1 font-lock-constant-face) ;; A type: after the `: ' of an annotation and after `-> '. ("[^ \t\n:]:[ \t]+\\([$a-zA-Z][^][ \t\n(){},;\"=]*\\)" 1 font-lock-type-face) ("[ \t]->[ \t]+\\([$a-zA-Z][^][ \t\n(){},;\"=]*\\)" 1 font-lock-type-face) @@ -1242,7 +1350,7 @@ it, so a block pasted at another depth stays one block." ("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face) ;; A character literal, `\c' or `\space'. ("\\\\\\(?:space\\|newline\\|tab\\|return\\|[^ \t\n]\\)" . font-lock-string-face) - ("\\_<-?[0-9][0-9a-fA-FxX_.]*\\_>" . font-lock-number-face)) + ("\\_<-?[0-9][0-9a-fA-FxX_.]*\\_>" . 'font-lock-number-face)) "Font lock for `flan-fln-mode'.") (defvar flan-fln-imenu-generic-expression @@ -1350,18 +1458,21 @@ that says so and otherwise is its own." ;;; Evil (defun flan-fln--evil (b type) - (if b (evil-range (car b) (cdr b) type) (error "No object here"))) + ;; A line range is handed over already whole -- from a line's start to the + ;; start of the line after it -- and marked expanded, so Evil neither + ;; stretches it to one more line nor leaves the last newline behind. + (cond ((null b) (error "No object here")) + ((eq type 'line) (evil-range (car b) (cdr b) 'line :expanded t)) + (t (evil-range (car b) (cdr b) type)))) (defun flan-fln--whole-lines (b) - (and b (cons (flan-fln--bol (car b)) (flan-fln--code-end (cdr b))))) + "B's lines, from the start of the first to the start of the line after." + (and b (flan-fln--lines (flan-fln--bol (car b)) (flan-fln--bol (cdr b))))) (defun flan-fln--with-trailing-blanks (b) - "B's lines and the blank lines after them." - (and b (let ((n (flan-fln--next-code (cdr b)))) - (cons (car b) (if n - (save-excursion (goto-char n) (forward-line -1) - (line-end-position)) - (point-max)))))) + "B's whole lines and the blank lines after them." + (and b (let ((n (flan-fln--next-code (1- (cdr b))))) + (cons (car b) (or n (point-max)))))) (defun flan-fln--term-around (b) "B and the spaces after it, or before it when none follow." diff --git a/emacs/test-flan-fln-live.el b/emacs/test-flan-fln-live.el index baa55f00..e1ce594e 100644 --- a/emacs/test-flan-fln-live.el +++ b/emacs/test-flan-fln-live.el @@ -30,6 +30,26 @@ fn total(n: i32) -> i32 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 + _ -> + twice(3) + comment(): twice(4) if 2 > 1 @@ -134,7 +154,20 @@ comment(): ;; 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 "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") diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index bd3ef497..dbc8fc67 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -408,6 +408,118 @@ fn twice(n: i64) -> i64 = n * 2 (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 "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) @@ -434,6 +546,12 @@ fn twice(n: i64) -> i64 = n * 2 (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" @@ -629,6 +747,30 @@ fn twice(n: i64) -> i64 = n * 2 (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"))) + (test-flan-fln--is (format "under Evil, %s leaves no blank line" (car c)) + (funcall deleted (car c) (nth 1 c)) (nth 2 c)))) (let ((b (generate-new-buffer "keys.fln"))) (switch-to-buffer b) (insert "fn f() -> i32 = 1\n")