A wrapped condition or arm value is sent whole and reads as it does in the file, an arm whose value uses nothing its pattern binds sends that value, a match arm is a clause object, and dad on the last form takes the blank lines before it
This commit is contained in:
parent
267e84bada
commit
c3ba4c9e08
@ -42,6 +42,9 @@
|
||||
(declare-function flan--eval "flan" (code what &optional start end pause))
|
||||
(declare-function flan--eval-expression "flan" (start end arg))
|
||||
(declare-function flan--text "flan" (start end))
|
||||
(declare-function flan--text-at "flan" (start end))
|
||||
(declare-function flan--report "flan" (reply what &optional at))
|
||||
(declare-function flan--request "flan" (form))
|
||||
(defvar flan--declaration-heads)
|
||||
(defvar flan--defun-heads)
|
||||
;; Set buffer-locally when the packages are there; declared so the setq-local
|
||||
@ -331,7 +334,8 @@ A clause line owns its own block, so it can be the answer."
|
||||
(flan-fln--span first (flan-fln--statement-last start t)))))
|
||||
|
||||
(defun flan-fln--clause-at (pos)
|
||||
"The clause line whose clause holds POS, the innermost one, or nil."
|
||||
"The clause line whose clause holds POS, the innermost one, or nil.
|
||||
A match arm is a clause too: its pattern line and its value or block."
|
||||
(let* ((line (flan-fln--line-statement pos))
|
||||
(p line)
|
||||
(limit (and line (1+ (flan-fln--indent-at line))))
|
||||
@ -339,7 +343,7 @@ A clause line owns its own block, so it can be the answer."
|
||||
(while (and p (not hit))
|
||||
(let ((i (flan-fln--indent-at p)))
|
||||
(when (< i limit)
|
||||
(if (flan-fln--clause-line-p p)
|
||||
(if (or (flan-fln--clause-line-p p) (flan-fln--arm p))
|
||||
(setq hit p)
|
||||
(setq limit i)))
|
||||
(setq p (and (> limit 0)
|
||||
@ -544,6 +548,36 @@ or the fallback call's name, `defmethod(', must read as one of HEADS,
|
||||
(defun flan-fln--client ()
|
||||
(require 'flan))
|
||||
|
||||
(defun flan-fln--cut-text (beg end)
|
||||
"The text BEG..END, as the reader must see it when BEG is mid-line.
|
||||
A condition or an arm's value starts after `elif ' or `-> ', and a line that
|
||||
continues it is indented past the statement's start in the file but perhaps
|
||||
not past the value's own column, which the reader, seeded at that column,
|
||||
requires. So every line after the first moves right by the width of what
|
||||
was cut off in front of the first; errors on the first line keep their
|
||||
exact column."
|
||||
(let* ((text (buffer-substring-no-properties beg end))
|
||||
(delta (save-excursion
|
||||
(goto-char beg)
|
||||
(- (current-column) (current-indentation)))))
|
||||
(if (<= delta 0)
|
||||
text
|
||||
(replace-regexp-in-string "\n" (concat "\n" (make-string delta ?\s))
|
||||
text t t))))
|
||||
|
||||
(defun flan-fln--eval-expression (beg end arg)
|
||||
"Evaluate BEG..END as an expression, as `flan--eval-expression' does, with
|
||||
the text shaped by `flan-fln--cut-text'."
|
||||
(flan--report
|
||||
(flan--request
|
||||
(let ((at (flan--text-at beg end)))
|
||||
(append (list :op "eval-expr" :code (flan-fln--cut-text beg end)
|
||||
:file (or buffer-file-name "<buffer>"))
|
||||
(cdr at)
|
||||
(when arg (list :pause t)))))
|
||||
"expression"
|
||||
end))
|
||||
|
||||
(defun flan-fln--send (beg end arg heads)
|
||||
"Send BEG..END: installed when it is a declaration at column 0, else run.
|
||||
HEADS says which heads count as declarations. ARG is a prefix: on a
|
||||
@ -552,7 +586,7 @@ the stop-here flag."
|
||||
(let ((head (flan-fln--declaration-head-at beg heads)))
|
||||
(if head
|
||||
(flan--eval (flan--text beg end) head beg end (and arg (cons beg end)))
|
||||
(prog1 (flan--eval-expression beg end arg)
|
||||
(prog1 (flan-fln--eval-expression beg end arg)
|
||||
(pulse-momentary-highlight-region beg end)))))
|
||||
|
||||
(defun flan-fln--pause-bounds (b arg)
|
||||
@ -631,9 +665,36 @@ pattern names something, so the value cannot be evaluated alone."
|
||||
(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)))))))))))))
|
||||
:binds (flan-fln--uses-any-p
|
||||
(flan-fln--pattern-names pat)
|
||||
(buffer-substring-no-properties
|
||||
(car value) (cdr value))))))))))))
|
||||
|
||||
(defconst flan-fln--name-char "[:alnum:]_?!*/$<>=%+-"
|
||||
"The characters a name is made of, for a character class.")
|
||||
|
||||
(defun flan-fln--pattern-names (pat)
|
||||
"The names pattern PAT binds: its lowercase words that are not constants,
|
||||
fields, keywords, constructors or `_'."
|
||||
(let ((re (concat "\\(?:\\`\\|[^" flan-fln--name-char ".:]\\)"
|
||||
"\\([a-z][" flan-fln--name-char "]*\\)"))
|
||||
(start 0) names)
|
||||
(while (string-match re pat start)
|
||||
(let ((n (match-string 1 pat)))
|
||||
(setq start (match-end 1))
|
||||
(unless (or (member n flan--constants)
|
||||
(and (< start (length pat)) (memq (aref pat start) '(?\( ?.))))
|
||||
(push n names))))
|
||||
names))
|
||||
|
||||
(defun flan-fln--uses-any-p (names text)
|
||||
"Non-nil if TEXT has any of NAMES as a whole name."
|
||||
(seq-some (lambda (n)
|
||||
(string-match-p (concat "\\(?:\\`\\|[^" flan-fln--name-char ".]\\)"
|
||||
(regexp-quote n)
|
||||
"\\(?:\\'\\|[^" flan-fln--name-char "]\\)")
|
||||
text))
|
||||
names))
|
||||
|
||||
(defun flan-fln--arm-to-send (l arm)
|
||||
"What evaluating the match arm at L sends: its value, or, when its pattern
|
||||
@ -686,6 +747,16 @@ 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))
|
||||
;; A line the next one continues -- an operator at either side of
|
||||
;; the break, or a bracket left open -- ends where the whole joined
|
||||
;; line does, not at its last word.
|
||||
(end (if (and (>= end (flan-fln--code-end end))
|
||||
(not (flan-fln--blank-p end))
|
||||
(let ((n (flan-fln--next-code end)))
|
||||
(and n (flan-fln--continuation-p n))))
|
||||
(flan-fln--code-end
|
||||
(flan-fln--logical-end (flan-fln--logical-start end)))
|
||||
end))
|
||||
(at-end (and (>= end (flan-fln--code-end end))
|
||||
(not (flan-fln--blank-p end))))
|
||||
(l (and at-end (flan-fln--line-statement end)))
|
||||
@ -706,7 +777,7 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does."
|
||||
;; 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)))
|
||||
(flan-fln--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)))
|
||||
@ -1470,9 +1541,16 @@ that says so and otherwise is its own."
|
||||
(and b (flan-fln--lines (flan-fln--bol (car b)) (flan-fln--bol (cdr b)))))
|
||||
|
||||
(defun flan-fln--with-trailing-blanks (b)
|
||||
"B's whole lines and the blank lines after them."
|
||||
"B's whole lines and the blank lines after them.
|
||||
With none after -- the last form -- the blank lines before it instead, as
|
||||
Vim's `dap' does, so the buffer does not end in empty lines."
|
||||
(and b (let ((n (flan-fln--next-code (1- (cdr b)))))
|
||||
(cons (car b) (or n (point-max))))))
|
||||
(if n
|
||||
(cons (car b) n)
|
||||
(let ((p (flan-fln--prev-code (car b))))
|
||||
(cons (if p (save-excursion (goto-char p) (line-beginning-position 2))
|
||||
(car b))
|
||||
(point-max)))))))
|
||||
|
||||
(defun flan-fln--term-around (b)
|
||||
"B and the spaces after it, or before it when none follow."
|
||||
@ -1516,10 +1594,14 @@ that says so and otherwise is its own."
|
||||
(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."
|
||||
(flan-fln--evil (let ((c (flan-fln--clause-at (point))))
|
||||
(flan-fln--whole-lines (and c (flan-fln--body-bounds c))))
|
||||
'line))
|
||||
"A clause's block, its lines; a match arm's value when it is on the line."
|
||||
(let* ((c (flan-fln--clause-at (point)))
|
||||
(arm (and c (flan-fln--arm c)))
|
||||
(v (and arm (plist-get arm :value))))
|
||||
(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)))
|
||||
'line))))
|
||||
(evil-define-text-object flan-fln-a-clause (count &optional _beg _end _type)
|
||||
"A clause: its line and its block."
|
||||
(flan-fln--evil (flan-fln--whole-lines
|
||||
|
||||
@ -47,10 +47,15 @@ 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)
|
||||
twice(4)
|
||||
if 2 > 1
|
||||
twice(2)
|
||||
@ -159,6 +164,14 @@ comment():
|
||||
(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"))
|
||||
(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")
|
||||
|
||||
@ -460,9 +460,58 @@ comment:
|
||||
"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--is "and of an elif, all of its condition, the wrapped line moved right by what was cut off"
|
||||
(test-flan-fln--last-at "or n == 1")
|
||||
'("eval-expr" "n == 0\n 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, moved right"
|
||||
(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--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")
|
||||
(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")
|
||||
@ -742,6 +791,10 @@ comment:
|
||||
" 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)))))
|
||||
@ -768,7 +821,8 @@ comment:
|
||||
"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" "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))))
|
||||
(let ((b (generate-new-buffer "keys.fln")))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user