flan-fln-mode handles else after a one-line if, typed lambdas, restart report text and flat lets
This commit is contained in:
commit
15fc197f9d
@ -1195,9 +1195,9 @@ 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: 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-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 or its value on the line, 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 (a one-line `if c then a` with `else` under it included); 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 `let`, 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 |
|
||||
@ -1205,7 +1205,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 | a line at a valid column stays; an empty or misplaced line goes deepest; 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. One level deeper only after a line that opens a block: never after a `let`, unless its value goes on under it (`= match x`, `= if c`, a lambda header) |
|
||||
| `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 |
|
||||
@ -1219,7 +1219,7 @@ Use `C-c C-g` if you need frames.
|
||||
| — | `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
|
||||
them, a one-line `if c then a` and a `let s = if c` included. `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.
|
||||
|
||||
@ -1227,7 +1227,7 @@ enclosing statement, top-level form.
|
||||
- **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.
|
||||
- **clause**: one `else`/`elif`/`on`/`restart` line and its block, or the value on its line (`else x`).
|
||||
- **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
|
||||
|
||||
@ -258,6 +258,84 @@ A word, and only when a space or the end of the line follows it."
|
||||
(setq bol n))
|
||||
bol))
|
||||
|
||||
;;; Words at a line's own depth
|
||||
|
||||
(defun flan-fln--find-top (re beg end)
|
||||
"(BEG . END) of the first match of RE between BEG and END at BEG's bracket
|
||||
depth, outside strings and comments, or nil."
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(let ((depth (car (syntax-ppss beg))) hit)
|
||||
(while (and (not hit) (re-search-forward re end t))
|
||||
(let ((m (cons (match-beginning 0) (match-end 0))))
|
||||
(let ((s (save-excursion (syntax-ppss (car m)))))
|
||||
(if (and (= (car s) depth) (not (nth 8 s)))
|
||||
(setq hit m)
|
||||
(goto-char (cdr m))))))
|
||||
hit)))
|
||||
|
||||
(defun flan-fln--joined-end (l)
|
||||
"Where the code of the joined line starting at L ends."
|
||||
(flan-fln--code-end (flan-fln--logical-end l)))
|
||||
|
||||
(defun flan-fln--then (l)
|
||||
"Where the condition of the one-line if or elif at L ends, before its
|
||||
`then', or nil when the line has no `then' of its own."
|
||||
(let ((m (flan-fln--find-top "[ \t]+then[ \t]" (flan-fln--first-char l)
|
||||
(flan-fln--joined-end l))))
|
||||
(and m (car m))))
|
||||
|
||||
(defun flan-fln--clause-value (l)
|
||||
"Bounds of the value on the clause line L itself: `x' of `else x' or of
|
||||
`elif c then x'; nil when the clause's value is its block."
|
||||
(let ((end (flan-fln--joined-end l))
|
||||
(then (flan-fln--then l)))
|
||||
(save-excursion
|
||||
(goto-char (flan-fln--first-char l))
|
||||
(cond
|
||||
((and (looking-at "elif[ \t]") then)
|
||||
(goto-char then)
|
||||
(skip-chars-forward " \t")
|
||||
(forward-char 4)
|
||||
(skip-chars-forward " \t")
|
||||
(and (< (point) end) (cons (point) end)))
|
||||
((and (looking-at "else[ \t]+") (< (match-end 0) end))
|
||||
(cons (match-end 0) end))))))
|
||||
|
||||
(defun flan-fln--value-start (l)
|
||||
"Where the value of the joined line L starts, after its first `=' or
|
||||
`+=' at the line's own depth, or nil when it binds or assigns nothing."
|
||||
(let ((m (flan-fln--find-top "[ \t][-+*/]?=[ \t]+" (flan-fln--first-char l)
|
||||
(flan-fln--joined-end l))))
|
||||
(and m (cdr m))))
|
||||
|
||||
(defun flan-fln--lambda-header-p (pos end)
|
||||
"Non-nil if a lambda with its body under it starts at POS and runs to END:
|
||||
`fn(a, b)', or `fn(a: C, b) -> R', with no `= body' after it."
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(and (looking-at "fn(")
|
||||
(let ((close (ignore-errors (scan-lists (+ pos 2) 1 0))))
|
||||
(and close (<= close end)
|
||||
(progn (goto-char close) (skip-chars-forward " \t")
|
||||
(or (>= (point) end)
|
||||
(and (looking-at "->[ \t]")
|
||||
(not (flan-fln--find-top "[ \t]=[ \t]" (point) end))))))))))
|
||||
|
||||
(defun flan-fln--value-opens-p (l)
|
||||
"Non-nil if the value the joined line L binds or assigns goes on under it:
|
||||
`= match x', `= if c' with no `then', `= handler-case', `= restart-case', or
|
||||
a lambda header. These are the values lib/indent_reader.ml's `value_line'
|
||||
reads a block for, besides a bare `=' and a call ending in `:'."
|
||||
(let ((v (flan-fln--value-start l))
|
||||
(end (flan-fln--joined-end l)))
|
||||
(and v (< v end)
|
||||
(save-excursion
|
||||
(goto-char v)
|
||||
(or (looking-at "\\(?:match\\|handler-case\\|handler-bind\\|restart-case\\)\\(?:[ \t]\\|$\\)")
|
||||
(and (looking-at "if[ \t]") (not (flan-fln--then l)))
|
||||
(flan-fln--lambda-header-p v end))))))
|
||||
|
||||
;;; Statements
|
||||
|
||||
(defun flan-fln--statement-last (start &optional no-clauses)
|
||||
@ -614,22 +692,43 @@ forms, where the clause line itself is not."
|
||||
(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)))))))
|
||||
(and s (or (flan-fln--merged-let-value s)
|
||||
(flan-fln--statement-bounds s))))))))
|
||||
|
||||
(defun flan-fln--merged-let-value (s)
|
||||
"Bounds of the value of the `let' at S when the let before it takes it in.
|
||||
The reader merges consecutive lets into one binding vector, so a second
|
||||
`let b = 2' starts no form of its own; its value, or its value's block, is
|
||||
the form that runs where the line stands."
|
||||
(let ((p (and (flan-fln--let-p s) (flan-fln--sibling s -1))))
|
||||
(when (and p (flan-fln--let-p p))
|
||||
(let ((v (flan-fln--value-start s))
|
||||
(end (flan-fln--joined-end s)))
|
||||
(if (and v (< v end))
|
||||
(cons v (cdr (flan-fln--statement-bounds s)))
|
||||
(flan-fln--body-bounds s))))))
|
||||
|
||||
(defun flan-fln--clause-target (l)
|
||||
"What a clause line L stops at: an elif's condition, else its block."
|
||||
"What a clause line L stops at: an elif's condition, else its block.
|
||||
A one-line `else x' stops at x."
|
||||
(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))))
|
||||
(let ((end (flan-fln--joined-end l)))
|
||||
(cond
|
||||
((looking-at "elif[ \t]+")
|
||||
(cons (match-end 0) (or (flan-fln--then l) end)))
|
||||
((flan-fln--clause-value l))
|
||||
(t (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]+\\)?")
|
||||
;; A one-line if's `then' ends no condition worth sending alone: the
|
||||
;; line's last word is the value, and the if goes on to its clauses.
|
||||
(when (and (not (flan-fln--then l))
|
||||
(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))))))
|
||||
@ -684,7 +783,10 @@ a `(' -- a pattern's constructor, which binds nothing."
|
||||
;; of the name (`is_neg_char' in lib/indent_reader.ml): `-n' is n.
|
||||
(when (string-match "\\`-[a-zA-Z$_*]" n)
|
||||
(setq n (substring n 1)))
|
||||
(unless (and skip-heads (eq (char-after) ?\())
|
||||
;; Nor, in a pattern, a dotted name: `Dir.north' is a value to
|
||||
;; compare with, and only a bare name or `.x' binds.
|
||||
(unless (and skip-heads (or (eq (char-after) ?\()
|
||||
(string-match-p "\\`[^.]+\\." n)))
|
||||
(push n names)
|
||||
(dolist (part (split-string n "\\." t))
|
||||
(push part names)))))
|
||||
@ -818,11 +920,12 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does."
|
||||
(save-excursion (goto-char last) (end-of-line)
|
||||
(skip-chars-backward " \t\n" first) (point))))))
|
||||
|
||||
(defun flan-fln--bare-let-p (start)
|
||||
"Non-nil if START's statement is a `let' with no block of its own."
|
||||
(and (save-excursion (goto-char (flan-fln--first-char start))
|
||||
(looking-at "let[ \t]"))
|
||||
(= (flan-fln--statement-last start) (flan-fln--logical-end start))))
|
||||
(defun flan-fln--let-p (start)
|
||||
"Non-nil if START's statement is a `let'.
|
||||
A let takes no block: lines under it are its value's (`= match x', a lambda
|
||||
header), and its name lasts to the end of the block it is in."
|
||||
(save-excursion (goto-char (flan-fln--first-char start))
|
||||
(looking-at "let[ \t]")))
|
||||
|
||||
(defun flan-fln--block-rest (start)
|
||||
"START's statement and every statement after it in the same block."
|
||||
@ -837,20 +940,20 @@ 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."
|
||||
for a `let', with the rest of its block, which is its scope."
|
||||
(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))
|
||||
((flan-fln--let-p s) (flan-fln--block-rest s))
|
||||
(t (flan-fln--statement-bounds s)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun flan-fln-eval-statement (&optional arg)
|
||||
"Evaluate the statement at point, with its body and clauses.
|
||||
With an active region, the lines it touches instead. On a bare `let x = v',
|
||||
the `let' and the rest of its block, which is what it is in scope for; the
|
||||
With an active region, the lines it touches instead. On a `let', the
|
||||
`let' and the rest of its block, which is what it is in scope for; the
|
||||
span sent is flashed so the extent is visible. A declaration at column 0 is
|
||||
installed. ARG is as for \\[flan-fln-eval-last]."
|
||||
(interactive "P")
|
||||
@ -1032,17 +1135,24 @@ Before it at the same level, else out to the line that owns this block."
|
||||
(goto-char start)
|
||||
(back-to-indentation)
|
||||
(and (looking-at (concat (regexp-opt flan-fln--opener-words t)
|
||||
"\\([ \t]\\|$\\)"))
|
||||
(let ((w (match-string-no-properties 1))
|
||||
(alone (string= (match-string-no-properties 2) ""))
|
||||
(end (flan-fln--code-end last)))
|
||||
"\\(?:[ \t]\\|$\\)"))
|
||||
(let* ((w (match-string-no-properties 1))
|
||||
(w-end (match-end 1))
|
||||
(end (flan-fln--code-end last))
|
||||
(alone (>= w-end end)))
|
||||
(cond
|
||||
((member w '("defer" "quote")) alone)
|
||||
;; `else x' after an if's block is the whole else.
|
||||
((member w '("defer" "quote" "else")) alone)
|
||||
((member w '("fn" "fn-"))
|
||||
(not (re-search-forward "[ \t]=[ \t]" end t)))
|
||||
((member w '("if" "elif"))
|
||||
(not (re-search-forward "[ \t]then[ \t]" end t)))
|
||||
((member w '("if" "elif")) (not (flan-fln--then start)))
|
||||
(t t)))))
|
||||
;; `let r = match n', `x = if c', `fn f(x) = match x', a lambda
|
||||
;; header: the value goes on under the line.
|
||||
(flan-fln--value-opens-p start)
|
||||
;; A lambda header as a statement of its own.
|
||||
(flan-fln--lambda-header-p (flan-fln--first-char start)
|
||||
(flan-fln--code-end last))
|
||||
(save-excursion
|
||||
(goto-char (flan-fln--code-end last))
|
||||
(let ((bol (line-beginning-position)))
|
||||
@ -1050,9 +1160,7 @@ Before it at the same level, else out to the line that owns this block."
|
||||
(looking-back "[ \t]->" bol)
|
||||
;; `let x =' and `def colors =' with the value as a block,
|
||||
;; which the author's list leaves out and the reader reads.
|
||||
(looking-back "[ \t]=" bol)
|
||||
;; `let f = fn(x)' with its body under it.
|
||||
(looking-back "\\_<fn([^()]*)" bol))))))
|
||||
(looking-back "[ \t]=" bol))))))
|
||||
|
||||
(defun flan-fln--stack (pos)
|
||||
"The open block columns above POS's line, deepest first, as (COL . LINE)."
|
||||
@ -1077,15 +1185,21 @@ Before it at the same level, else out to the line that owns this block."
|
||||
|
||||
(defun flan-fln--clause-columns (word pos)
|
||||
"Columns of the lines above POS a clause WORD may sit under, deepest first."
|
||||
(let ((heads (cdr (assoc word flan-fln--clause-headers))))
|
||||
(let ((re (concat (regexp-opt (cdr (assoc word flan-fln--clause-headers)))
|
||||
"\\(?:[ \t]\\|$\\)")))
|
||||
(delq nil
|
||||
(mapcar (lambda (e)
|
||||
(and (cdr e)
|
||||
(save-excursion
|
||||
(goto-char (flan-fln--first-char (cdr e)))
|
||||
(and (looking-at (concat (regexp-opt heads)
|
||||
"\\(?:[ \t]\\|$\\)"))
|
||||
(car e)))))
|
||||
(let ((l (cdr e)))
|
||||
(and l
|
||||
(save-excursion
|
||||
(goto-char (flan-fln--first-char l))
|
||||
(or (looking-at re)
|
||||
;; `let s = if c' and `r = match x' take
|
||||
;; their clauses at the line's column.
|
||||
(and (flan-fln--value-opens-p l)
|
||||
(progn (goto-char (flan-fln--value-start l))
|
||||
(looking-at re)))))
|
||||
(car e))))
|
||||
(flan-fln--stack pos)))))
|
||||
|
||||
(defun flan-fln--bracket-column (open)
|
||||
@ -1410,6 +1524,33 @@ it, so a block pasted at another depth stays one block."
|
||||
(defconst flan-fln--name-re "\\([^][ \t\n(){},;\":]+\\)"
|
||||
"A declared name: a run up to a bracket, a space, or the colon of `x: T'.")
|
||||
|
||||
(defun flan-fln--return-type-matcher (limit)
|
||||
"Find the next return type up to LIMIT: after the `->' of a fn header, a
|
||||
lambda or a `Fn(...)' type, and not after a match arm's."
|
||||
(let (found)
|
||||
(while (and (not found)
|
||||
(re-search-forward "[ \t]->[ \t]+\\([$a-zA-Z][^][ \t\n(){},;\"=]*\\)"
|
||||
limit t))
|
||||
(let ((arrow (match-beginning 0)))
|
||||
(setq found (save-excursion
|
||||
(save-match-data
|
||||
(goto-char (line-beginning-position))
|
||||
(or (re-search-forward "\\(?:^[ \t]*fn-?[ \t]\\|\\_<C?[fF]n(\\)"
|
||||
arrow t)
|
||||
;; A header wrapped inside its parentheses: the
|
||||
;; `)' before the arrow closes a `fn f(' above.
|
||||
(progn
|
||||
(goto-char arrow)
|
||||
(skip-chars-backward " \t")
|
||||
(and (eq (char-before) ?\))
|
||||
(let ((open (ignore-errors (scan-lists (point) -1 0))))
|
||||
(and open
|
||||
(progn
|
||||
(goto-char open)
|
||||
(looking-back "\\(?:^[ \t]*fn-?[ \t]+[^][ \t\n(){},;\":]+\\|\\_<C?[fF]n\\)"
|
||||
(line-beginning-position)))))))))))))
|
||||
found))
|
||||
|
||||
(defvar flan-fln-font-lock-keywords
|
||||
`(;; The header words, at the start of a line and followed by a space or the
|
||||
;; end of it: `if(c, a)' is the fallback call and is not a header.
|
||||
@ -1421,6 +1562,14 @@ it, so a block pasted at another depth stays one block."
|
||||
1 font-lock-type-face)
|
||||
(,(concat "^\\(?:def\\|once\\|const\\)[ \t]+" flan-fln--name-re)
|
||||
1 font-lock-variable-name-face)
|
||||
;; A restart clause's name, `restart retry() "Try again"'.
|
||||
(,(concat "^[ \t]*restart[ \t]+" flan-fln--name-re)
|
||||
1 font-lock-function-name-face)
|
||||
;; A lambda's `fn', glued to its parameters.
|
||||
("\\(?:^\\|[ \t=(,]\\)\\(fn\\)(" 1 font-lock-keyword-face)
|
||||
;; An enum member written `Dir.north', a constant as `:north' is.
|
||||
("\\_<[A-Z][^][ \t\n(){},;\":.]*\\.[^][ \t\n(){},;\":.]+\\_>"
|
||||
. font-lock-constant-face)
|
||||
;; The words inside a line: `for i in range(n)', `if c then a else b', a
|
||||
;; `where' constraint.
|
||||
("[ \t]\\(then\\|else\\|in\\|where\\)[ \t]" 1 font-lock-keyword-face)
|
||||
@ -1432,7 +1581,7 @@ it, so a block pasted at another depth stays one block."
|
||||
("\\(?:^\\|[][ \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)
|
||||
(flan-fln--return-type-matcher 1 font-lock-type-face)
|
||||
;; The package half of a qualified name, as `flan-mode' draws it.
|
||||
("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face)
|
||||
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|dyn\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
|
||||
@ -1670,10 +1819,12 @@ below a form is not taken: it belongs to what follows."
|
||||
(bounds-of-thing-at-point 'flan-fln-statement))
|
||||
'line))
|
||||
(evil-define-text-object flan-fln-inner-clause (count &optional _beg _end _type)
|
||||
"A clause's block, its lines; a match arm's value when it is on the line."
|
||||
"A clause's block, its lines; the value on the line of a match arm, a
|
||||
one-line else or an elif's `then'."
|
||||
(let* ((c (flan-fln--clause-at (point)))
|
||||
(arm (and c (flan-fln--arm c)))
|
||||
(v (and arm (plist-get arm :value))))
|
||||
(v (if arm (plist-get arm :value)
|
||||
(and c (flan-fln--clause-value c)))))
|
||||
(if (and v (= (flan-fln--bol (car v)) c))
|
||||
(flan-fln--evil v 'exclusive)
|
||||
(flan-fln--evil (flan-fln--whole-lines (and c (flan-fln--body-bounds c)))
|
||||
|
||||
@ -52,6 +52,39 @@ fn pick(d: Dir) -> i64
|
||||
_ ->
|
||||
twice(3)
|
||||
|
||||
fn sign2(k: i64)
|
||||
if k < 0 then -1
|
||||
elif k == 0 then 0
|
||||
else 1
|
||||
|
||||
fn size(k: i64) -> i64
|
||||
if k < 10
|
||||
1
|
||||
else 2
|
||||
|
||||
fn lam(k: i64) -> i64
|
||||
let add = fn(a: i64, b: i64) -> i64 = a + b
|
||||
let dbl = fn(a: i64) -> i64
|
||||
a * 2
|
||||
add(dbl(k), 1)
|
||||
|
||||
fn rs() -> i64
|
||||
restart-case
|
||||
3
|
||||
restart retry() \"Try again\"
|
||||
4
|
||||
|
||||
fn t2(k: i64) -> i64
|
||||
let a = 1
|
||||
let b = 2
|
||||
let c: i64 = 3
|
||||
a + b + c + k
|
||||
|
||||
fn dir(d: Dir) -> i64
|
||||
match d
|
||||
Dir.north -> 7
|
||||
_ -> 8
|
||||
|
||||
comment():
|
||||
if 1 < 2 and
|
||||
3 < 4
|
||||
@ -59,6 +92,9 @@ comment():
|
||||
elif 1 > 2 or
|
||||
3 > 4
|
||||
0
|
||||
if 2 < 1 then 5
|
||||
elif 2 == 1 then 6
|
||||
else 7
|
||||
twice(4)
|
||||
if 2 > 1
|
||||
twice(2)
|
||||
@ -158,6 +194,27 @@ comment():
|
||||
(test-flan--check (funcall name "and moves to the next")
|
||||
(looking-at "if 2 > 1"))
|
||||
|
||||
;; A one-line if with its clauses on the lines under it.
|
||||
(funcall goto "if 2 < 1 then 5" t)
|
||||
(flan-fln-eval-last)
|
||||
(test-flan--check (funcall name "C-x C-e at the end of a one-line if that goes on evaluates the whole if")
|
||||
(funcall shows "7"))
|
||||
(funcall goto "elif 2 == 1")
|
||||
(flan-fln-eval-statement)
|
||||
(test-flan--check (funcall name "C-c C-e on a clause under a one-line if sends its if")
|
||||
(funcall shows "7"))
|
||||
;; The newer forms install from the buffer and run.
|
||||
(pcase-dolist (`(,needle ,call ,want)
|
||||
'(("fn sign2" "(sign2 0)" "0")
|
||||
("fn size" "(size 20)" "2")
|
||||
("fn lam" "(lam 3)" "7")
|
||||
("fn rs" "(rs)" "3")
|
||||
("fn dir" "(dir :north)" "7")))
|
||||
(funcall goto needle)
|
||||
(flan-fln-eval-defun)
|
||||
(test-flan--check (funcall name (format "C-c C-c installs %s" needle))
|
||||
(equal (funcall value call) want)))
|
||||
|
||||
;; 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
|
||||
@ -217,7 +274,17 @@ comment():
|
||||
("n < 2" "an if statement")
|
||||
("t = 0" "a let")
|
||||
("i in range" "a for")
|
||||
("+ i" "an assignment")))
|
||||
("+ i" "an assignment")
|
||||
("if k < 0 then" "a one-line if")
|
||||
("elif k" "a one-line elif, at its condition")
|
||||
("else 1" "a one-line else, at its value")
|
||||
("else 2" "a one-line else after a block, at its value")
|
||||
("a: i64, b" "a typed lambda, from its fn")
|
||||
("a * 2" "a typed lambda's block")
|
||||
("restart retry" "a restart with a report, at its block")
|
||||
("Dir.north" "an enum member's arm, at its value")
|
||||
("let b = 2" "a let the let above takes in, at its value")
|
||||
("let c: i64" "a typed one, at its value")))
|
||||
(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"
|
||||
|
||||
@ -584,6 +584,88 @@ comment:
|
||||
(test-flan-fln--is "on an on line, at its block"
|
||||
(test-flan-fln--pause-at "on Error") '(18 5))
|
||||
|
||||
;;; One-line ifs with clauses under them, typed lambdas, restarts
|
||||
|
||||
(defconst test-flan-fln--oneline
|
||||
"fn sign(n: i64)
|
||||
if n < 0 then -1
|
||||
elif n == 0 then 0
|
||||
else 1
|
||||
|
||||
fn size(n: i64) -> i64
|
||||
if n < 10
|
||||
1
|
||||
else 2
|
||||
|
||||
fn k(n: i64) -> i64
|
||||
let add = fn(a: i64, b) -> i64 = a + b
|
||||
let dbl = fn(a: Fn(i64) -> i64, b: i64) -> i64
|
||||
a(b) * 2
|
||||
let r = match n
|
||||
0 -> 1
|
||||
_ -> 2
|
||||
add(r, 1)
|
||||
")
|
||||
|
||||
(defun test-flan-fln--oneline-at (needle fn &optional at-end)
|
||||
"What FN sends with point at NEEDLE in the one-line program, or at the end
|
||||
of its line with AT-END."
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--oneline needle)
|
||||
(when at-end (end-of-line))
|
||||
(let ((r (test-flan-fln--sending (funcall fn))))
|
||||
(and r (list (test-flan-fln--sent-code r) (plist-get r :pause))))))
|
||||
|
||||
(test-flan-fln--is "an else under a one-line if belongs to its statement"
|
||||
(car (test-flan-fln--oneline-at "else 1" #'flan-fln-eval-statement))
|
||||
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
||||
(test-flan-fln--in (test-flan-fln--at test-flan-fln--oneline "elif n == 0")
|
||||
(test-flan-fln--is "and the clause is its line"
|
||||
(test-flan-fln--thing 'flan-fln-clause) "elif n == 0 then 0"))
|
||||
(test-flan-fln--is "C-x C-e at the end of a one-line if that goes on sends the whole if"
|
||||
(car (test-flan-fln--oneline-at "if n < 0" #'flan-fln-eval-last t))
|
||||
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
||||
(test-flan-fln--is "and at the end of a one-line elif"
|
||||
(car (test-flan-fln--oneline-at "elif n" #'flan-fln-eval-last t))
|
||||
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
||||
(test-flan-fln--is "an else x after a block if belongs to it too"
|
||||
(car (test-flan-fln--oneline-at "else 2" #'flan-fln-eval-statement))
|
||||
"if n < 10\n 1\n else 2")
|
||||
(test-flan-fln--is "C-u C-c C-c on a one-line elif stops at its condition"
|
||||
(cadr (test-flan-fln--oneline-at "elif n" (lambda () (flan-fln-eval-defun '(4)))))
|
||||
'(3 8))
|
||||
(test-flan-fln--is "and on a one-line else, at its value"
|
||||
(cadr (test-flan-fln--oneline-at "else 1" (lambda () (flan-fln-eval-defun '(4)))))
|
||||
'(4 8))
|
||||
(test-flan-fln--is "an else x after a block if too"
|
||||
(cadr (test-flan-fln--oneline-at "else 2" (lambda () (flan-fln-eval-defun '(4)))))
|
||||
'(9 8))
|
||||
(test-flan-fln--is "C-u C-c C-c on a let the let above takes in stops at its value"
|
||||
(test-flan-fln--in "fn t2(n: i64) -> i64\n let a = 1\n |let b = 2\n a + b + n\n"
|
||||
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
||||
'(3 11))
|
||||
(test-flan-fln--is "and at its block when the value is one"
|
||||
(test-flan-fln--in "fn t2(n: i64) -> i64\n let a = 1\n |let b =\n n + 1\n a + b\n"
|
||||
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
||||
'(4 5))
|
||||
(test-flan-fln--is "the first let of a run stops at the let"
|
||||
(test-flan-fln--in "fn t2(n: i64) -> i64\n n + 1\n |let a = 1\n a\n"
|
||||
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
||||
'(3 3))
|
||||
(test-flan-fln--is "C-c C-e on a let whose value is a block sends its scope with it"
|
||||
(car (test-flan-fln--oneline-at "let r" #'flan-fln-eval-statement))
|
||||
"let r = match n\n 0 -> 1\n _ -> 2\n add(r, 1)")
|
||||
(test-flan-fln--is "and on a typed lambda's let, its body and the let's scope"
|
||||
(car (test-flan-fln--oneline-at "let dbl" #'flan-fln-eval-statement))
|
||||
(substring test-flan-fln--oneline
|
||||
(string-search "let dbl" test-flan-fln--oneline)
|
||||
(1- (length test-flan-fln--oneline))))
|
||||
(test-flan-fln--is "an arm whose pattern is Dir.north binds nothing"
|
||||
(test-flan-fln--in "fn f(d: Dir) -> Dir\n match d\n Dir.north -> Dir.south\n"
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward "\n")
|
||||
(test-flan-fln--sent-code (test-flan-fln--sending (flan-fln-eval-last))))
|
||||
"Dir.south")
|
||||
|
||||
;;; Names and colours
|
||||
|
||||
(test-flan-fln--in "fn f(x: i64) -> i64\n comment:\n g(:key-r, x)\n 0x1F + 12\n"
|
||||
@ -606,6 +688,37 @@ comment:
|
||||
(test-flan--check "and the name before the colon is not a keyword"
|
||||
(null (funcall face "x:")))))
|
||||
|
||||
(test-flan-fln--in "fn f(d: Dir) -> i64
|
||||
let g = fn(a: Fn(i64) -> i64, b) -> Vec(i64)
|
||||
a(b)
|
||||
restart-case
|
||||
3
|
||||
restart retry(v: i32) \"Try again\"
|
||||
v
|
||||
match d
|
||||
Dir.north -> twice(1)
|
||||
Circle(r) -> r
|
||||
"
|
||||
(font-lock-ensure)
|
||||
(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 lambda's fn is a keyword" (funcall face "fn(a") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "its parameter's function type is a type" (funcall face "Fn(i64)") 'font-lock-type-face)
|
||||
(test-flan-fln--is "and its return type" (funcall face "Vec") 'font-lock-type-face)
|
||||
(test-flan-fln--is "a restart's name is drawn as a name" (funcall face "retry") 'font-lock-function-name-face)
|
||||
(test-flan-fln--is "its report as a string" (funcall face "\"Try") 'font-lock-string-face)
|
||||
(test-flan-fln--is "an enum member as a constant" (funcall face "Dir.north") 'font-lock-constant-face)
|
||||
(test-flan-fln--is "an arm's value is not a type" (funcall face "twice(1)") nil)
|
||||
(test-flan-fln--is "nor after a pattern with parentheses" (funcall face "r\n") nil)))
|
||||
(test-flan-fln--in "fn far(a: i64,\n b: i64) -> Point\n match a\n Some(x) -> Other\n"
|
||||
(font-lock-ensure)
|
||||
(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 wrapped fn header's return type is a type" (funcall face "Point") 'font-lock-type-face)
|
||||
(test-flan-fln--is "an arm's value after a call pattern is not" (funcall face "Other") nil)))
|
||||
|
||||
;;; Indentation
|
||||
|
||||
(defun test-flan-fln--tabs (text n)
|
||||
@ -660,6 +773,34 @@ comment:
|
||||
(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--is "never deeper after a let"
|
||||
(test-flan-fln--tabs "fn f()\n let r = 3\n|" 1) 2)
|
||||
(dolist (c '(("let r = match n" "a let's match")
|
||||
("let r = if c" "a let's if")
|
||||
("x = if c" "an assignment's if")
|
||||
("let r = handler-case" "a let's handler-case")
|
||||
("let f = fn(a, b)" "a lambda header")
|
||||
("let f = fn(a: i64, b) -> i64" "a typed lambda header")
|
||||
("let f = fn(g: Fn(i64) -> i64) -> Option(i64)" "one with a function type in it")
|
||||
("fn(a: i64) -> i64" "a typed lambda as a statement")))
|
||||
(test-flan-fln--is (format "unless its value goes on under it: %s" (cadr c))
|
||||
(test-flan-fln--tabs (concat "fn f()\n " (car c) "\n|") 1) 4))
|
||||
(test-flan-fln--is "but not a typed lambda with its body on the line"
|
||||
(test-flan-fln--tabs "fn f()\n let f = fn(a: i64) -> i64 = a\n|" 1) 2)
|
||||
(test-flan-fln--is "a one-line fn whose value is a match opens it"
|
||||
(test-flan-fln--tabs "fn f(x) = match x\n|" 1) 2)
|
||||
(test-flan-fln--is "no deeper after a one-line else"
|
||||
(test-flan-fln--tabs "fn f()\n if a\n b\n else c\n|" 1) 2)
|
||||
(test-flan-fln--is "nor after one that ends in a comment"
|
||||
(test-flan-fln--tabs "fn f()\n if a then b\n else c ; c\n|" 1) 2)
|
||||
(test-flan-fln--is "but deeper after an else alone with a comment"
|
||||
(test-flan-fln--tabs "fn f()\n if a\n b\n else ; c\n|" 1) 4)
|
||||
(test-flan-fln--is "after a one-line if, a new line stays at its column"
|
||||
(test-flan-fln--tabs "fn f()\n if a then b\n|" 1) 2)
|
||||
(test-flan-fln--is "else goes to a one-line if's column"
|
||||
(test-flan-fln--tabs "if a\n if b then c\n |else d" 1) 2)
|
||||
(test-flan-fln--is "and to a let's if"
|
||||
(test-flan-fln--tabs "fn f()\n let s = if c\n 1\n |else" 1) 2)
|
||||
|
||||
(test-flan-fln--in "fn f() -> ()\n while a\n b()\n |"
|
||||
(flan-fln-dedent-or-delete 1)
|
||||
@ -832,6 +973,12 @@ comment:
|
||||
"5")
|
||||
("yak" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
|
||||
" Some(_) -> 5\n")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--oneline "else 1")
|
||||
"1")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--oneline "elif n")
|
||||
"0")
|
||||
("yik" ,(test-flan-fln--at test-flan-fln--oneline "else 2")
|
||||
"2")
|
||||
("yid" ,(test-flan-fln--at test-flan-fln--settle "paint-at")
|
||||
,(substring test-flan-fln--settle
|
||||
(string-search "fn step" test-flan-fln--settle)))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user