JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

.fln lambdas are written with =>, and one with a block can sit last inside a call's brackets

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 06:10:12 +07:00
commit 06eaf738b9
13 changed files with 840 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
TODO.org
View File

@ -643,11 +643,10 @@ awaiting confirmation, and the build order. Rules out Parinfer, wisp and
sweet-expressions, and a simplified in-paren syntax — all thin the parens
without removing them.
** NEXT Lambdas are written with =>
Decided 2026-09-26: a lambda's body follows ~=>~, and ~=>~ is its only spelling
(~fn(a) = x~ is refused for a lambda; named functions keep ~=~). A header ending in ~=>~
takes an indented block even inside brackets, closing where the brackets close:
~sort-by(xs, fn(a, b) =>~ plus a block.
** DONE Lambdas are written with =>
CLOSED: [2026-09-26]
A block lambda inside brackets is the last thing in them, its block ending where they close: a comma
after it (so a second block lambda, or one not last) is refused, and the fix names it with ~let~.
** NEXT Indices separate like vector elements
Decided 2026-09-26: ~grid[r c]~ and ~grid[(r + 1) (c - 1)]~ read like a vector's

4
emacs/MANUAL.md
View File

@ -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. 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`, `= loop i = 0`, a lambda header) |
| `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`, `= loop i = 0`, a lambda header). After a line ending in `=>`, one level in from that line, inside brackets too; a line of that block keeps to the block's columns |
| `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 |
@ -1225,7 +1225,7 @@ 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.
- **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. A lambda's block inside brackets, `sort-by(xs, fn(a, b) =>` and the lines under it, is part of the call's statement, and each of its lines is a statement too: `C-c C-e` or `C-u C-c C-c` there takes that line, not the call, and never the call's closing `)` at the end of it.
- **body**: a statement's own block, up to its first clause.
- **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.

184
emacs/flan-fln-mode.el
View File

@ -25,7 +25,8 @@
;; leaves open, the lines an operator continues, and the
;; `else'/`elif'/`on'/`restart' clauses at its own column. Blank
;; and comment lines inside never end it; trailing ones are not
;; part of it.
;; part of it. A `=>' ending a line inside brackets opens a
;; lambda's block there, whose lines are statements again.
;; body a statement's own block: the deeper lines under its first line,
;; up to its first clause.
;; clause one `else'/`elif'/`on'/`restart' line and its block.
@ -234,15 +235,63 @@ fine here. Brackets and strings are still paired."
(setq hit (line-beginning-position)))
hit)))
(defun flan-fln--closer-line-p (pos)
"Non-nil if POS's line starts inside a bracket with the bracket's closer."
(save-excursion
(let ((s (syntax-ppss (flan-fln--bol pos))))
(and (nth 1 s) (not (nth 3 s))
(progn (goto-char (flan-fln--bol pos))
(skip-chars-forward " \t")
(looking-at "\\s)"))))))
(defun flan-fln--lambda-arrow (pos)
"The `=>' whose block POS's line is in, when that block is inside brackets.
A `=>' ending a line inside a bracket opens a block there, which lasts until
the bracket closes (lib/indent_reader.ml's `layout'): a line inside the same
bracket after it is a statement of that block, not a continuation. A line
that starts with the bracket's closer is not in the block.
Each call scans the lines from the open bracket to POS, so walking a long
bracketed literal line by line costs the square of its length."
(save-excursion
(let* ((bol (flan-fln--bol pos))
(s (syntax-ppss bol))
(open (nth 1 s)))
(when (and open (not (nth 3 s)) (not (flan-fln--closer-line-p bol)))
(goto-char open)
(let (hit)
(while (and (not hit) (< (line-end-position) bol))
(let ((end (flan-fln--code-end (point))))
(goto-char end)
(when (and (looking-back "[ \t]=>" (line-beginning-position))
(= (nth 1 (save-excursion (syntax-ppss (- end 2)))) open))
(setq hit (- end 2))))
(forward-line 1))
hit)))))
(defun flan-fln--bracketed-p (pos)
"Non-nil if POS's line is inside a bracket or a string, where a line break
is only a space: not in a lambda's block."
(and (flan-fln--in-open-p pos) (not (flan-fln--lambda-arrow pos))))
(defun flan-fln--continuation-p (pos)
"Non-nil if POS's line continues the line above it.
Inside a bracket or a string, after a line that ends in a spaced operator, or
starting with one: the reader's three ways a line break is not a new line."
(or (flan-fln--in-open-p pos)
starting with one: the reader's three ways a line break is not a new line.
Not a line of a lambda's block inside brackets, which is a statement."
(or (flan-fln--bracketed-p pos)
(flan-fln--starts-with-op-p pos)
(let ((p (flan-fln--prev-code pos)))
(and p (flan-fln--ends-in-op-p p)))))
(defun flan-fln--continues-p (pos start)
"Non-nil if POS's line continues the statement that starts at START.
A line that starts with the closer of a bracket opened before START closes
something START is inside, a lambda's block's call, and is not START's."
(and (flan-fln--continuation-p pos)
(not (and (flan-fln--closer-line-p pos)
(< (nth 1 (save-excursion (syntax-ppss (flan-fln--bol pos))))
(flan-fln--bol start))))))
(defun flan-fln--clause-line-p (pos)
"Non-nil if POS's line starts a clause: else, elif, on or restart.
A word, and only when a space or the end of the line follows it."
@ -255,16 +304,21 @@ A word, and only when a space or the end of the line follows it."
(defun flan-fln--logical-start (pos)
"The first line of the line POS is on, after continuation lines are joined."
(let ((bol (flan-fln--bol pos)) p)
(while (and (flan-fln--continuation-p bol)
(setq p (flan-fln--prev-code bol)))
(setq bol p))
(while (cond
;; A closer's line belongs with the line its bracket opens on,
;; not with a lambda's block just above it.
((flan-fln--closer-line-p bol)
(setq bol (flan-fln--bol (nth 1 (save-excursion (syntax-ppss bol))))))
((and (flan-fln--continuation-p bol)
(setq p (flan-fln--prev-code bol)))
(setq bol p))))
bol))
(defun flan-fln--logical-end (pos)
"The last line of the joined line whose first line is POS's."
(let ((bol (flan-fln--bol pos)) n)
(let* ((bol (flan-fln--bol pos)) (start bol) n)
(while (and (setq n (flan-fln--next-code bol))
(flan-fln--continuation-p n))
(flan-fln--continues-p n start))
(setq bol n))
bol))
@ -295,10 +349,18 @@ depth, outside strings and comments, or nil."
(flan-fln--joined-end l))))
(and m (car m))))
(defun flan-fln--value-end (l)
"Where a value written on the joined line L ends: at the line's code end,
or, when the line ends in `=>', at the end of the lambda's block under it."
(let ((last (flan-fln--logical-end l)))
(if (flan-fln--ends-in-arrow-p last)
(cdr (flan-fln--span l (flan-fln--statement-last l t)))
(flan-fln--code-end last))))
(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))
(let ((end (flan-fln--value-end l))
(then (flan-fln--then l)))
(save-excursion
(goto-char (flan-fln--first-char l))
@ -319,18 +381,23 @@ depth, outside strings and comments, or nil."
(flan-fln--joined-end l))))
(and m (cdr m))))
(defun flan-fln--ends-in-arrow-p (pos)
"Non-nil if POS's line ends in `=>': a lambda's header, its block under it."
(save-excursion
(let ((end (flan-fln--code-end pos)))
(goto-char end)
(and (not (nth 8 (syntax-ppss end)))
(looking-back "[ \t]=>" (line-beginning-position))))))
(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."
`fn(a, b) =>', or `fn(a: C, b) -> R =>', with nothing after the `=>'."
(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))))))))))
(progn (goto-char end) (looking-back "[ \t]=>" close)))))))
(defun flan-fln--value-opens-p (l)
"Non-nil if the value the joined line L binds or assigns goes on under it:
@ -357,6 +424,8 @@ line's own block only."
(last (flan-fln--logical-end start))
(next (flan-fln--next-code last)))
(while (and next
(not (and (flan-fln--closer-line-p next)
(not (flan-fln--continues-p next start))))
(or (> (flan-fln--indent-at next) indent)
(flan-fln--continuation-p next)
(and (not no-clauses)
@ -366,9 +435,26 @@ line's own block only."
next (flan-fln--next-code last)))
last))
(defun flan-fln--trim-closers (beg end)
"END, less the closers before it whose brackets open before BEG.
The last statement of a lambda's block inside a call ends with the call's `)'
on its line, which is not the statement's."
(save-excursion
(goto-char end)
(let (done)
(while (not done)
(skip-chars-backward " \t" beg)
(let ((open (and (> (point) beg) (memq (char-before) '(?\) ?\] ?\}))
(nth 1 (save-excursion (syntax-ppss (1- (point))))))))
(if (and open (< open beg))
(backward-char 1)
(setq done t))))
(point))))
(defun flan-fln--span (start last)
"(BEG . END) from the text of START's line to the code end of LAST's."
(cons (flan-fln--first-char start) (flan-fln--code-end last)))
(let ((beg (flan-fln--first-char start)))
(cons beg (flan-fln--trim-closers beg (flan-fln--code-end last)))))
(defun flan-fln--statement-bounds (start)
"Bounds of the statement whose first line is START."
@ -698,7 +784,11 @@ forms, where the clause line itself is not."
(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)))
;; Not the brackets a lambda's block is in: a line of the block is a
;; statement of its own.
((and g (cdr g) (> (car g) (car b))
(not (let ((a (flan-fln--lambda-arrow pos)))
(and a (< (car g) a) (< a pos)))))
(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))
@ -770,7 +860,7 @@ pattern names something, so the value cannot be evaluated alone."
(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)
(value (if (< vbeg last) (cons vbeg (flan-fln--value-end l))
(flan-fln--body-bounds l))))
(and value
(list :arrow arrow :value value
@ -1175,15 +1265,27 @@ Before it at the same level, else out to the line that owns this block."
(let ((bol (line-beginning-position)))
(or (looking-back ":" bol)
(looking-back "[ \t]->" bol)
;; A lambda's header, at the top of a line or inside brackets.
(looking-back "[ \t]=>" bol)
;; `let x =' and `let colors =' at the top level with the value as a block,
;; which the author's list leaves out and the reader reads.
(looking-back "[ \t]=" bol))))))
(defun flan-fln--outside-block (p pos)
"P, or when P's line is in a lambda's block inside brackets that POS is not
inside, the first line of the statement that block's `=>' is in: a block
whose brackets have closed is no block POS can join."
(let ((a (flan-fln--lambda-arrow p)))
(if (and a (not (memq (nth 1 (save-excursion (syntax-ppss (flan-fln--bol p))))
(nth 9 (save-excursion (syntax-ppss (flan-fln--bol pos)))))))
(flan-fln--outside-block (flan-fln--logical-start a) pos)
p)))
(defun flan-fln--stack (pos)
"The open block columns above POS's line, deepest first, as (COL . LINE)."
(let ((p (flan-fln--prev-code pos)) out (min most-positive-fixnum))
(while p
(setq p (flan-fln--logical-start p))
(setq p (flan-fln--outside-block (flan-fln--logical-start p) pos))
(let ((i (flan-fln--indent-at p)))
(when (< i min) (push (cons i p) out) (setq min i)))
(setq p (and (> min 0) (flan-fln--prev-code p))))
@ -1194,11 +1296,28 @@ Before it at the same level, else out to the line that owns this block."
"Columns TAB offers POS's line outside brackets, deepest first."
(let* ((prev (flan-fln--prev-code pos))
(stack (mapcar #'car (flan-fln--stack pos))))
(if (and prev (flan-fln--opener-p (flan-fln--logical-start prev) prev))
(cons (+ (flan-fln--indent-at (flan-fln--logical-start prev))
flan-fln-indent-offset)
stack)
stack)))
(cond
;; A lambda's block goes under the line its `=>' ends, which may be a
;; line of a call wrapped inside its brackets.
((and prev (flan-fln--ends-in-arrow-p prev))
(cons (+ (flan-fln--indent-at prev) flan-fln-indent-offset) stack))
((and prev (flan-fln--opener-p (flan-fln--logical-start prev) prev))
(cons (+ (flan-fln--indent-at (flan-fln--logical-start prev))
flan-fln-indent-offset)
stack))
(t stack))))
(defun flan-fln--block-levels (pos)
"Columns TAB offers POS's line at a block's level, deepest first.
In a lambda's block inside brackets, only those right of the line its `=>'
ends: a line at or left of it would be outside the block, still inside the
brackets, which the reader refuses."
(let ((arrow (flan-fln--lambda-arrow pos)))
(if (not arrow)
(flan-fln--levels pos)
(let ((base (flan-fln--indent-at arrow)))
(or (seq-filter (lambda (c) (> c base)) (flan-fln--levels pos))
(list (+ base flan-fln-indent-offset)))))))
(defun flan-fln--clause-columns (word pos)
"Columns of the lines above POS a clause WORD may sit under, deepest first."
@ -1243,19 +1362,20 @@ opening line's column."
(let ((s (syntax-ppss (point))))
(cond
((nth 3 s) nil)
((> (car s) 0) (list (flan-fln--bracket-column (nth 1 s))))
((and (> (car s) 0) (not (flan-fln--lambda-arrow (point))))
(list (flan-fln--bracket-column (nth 1 s))))
(t
(let ((prev (flan-fln--prev-code (point))))
(cond
((null prev) (list 0))
((save-excursion (back-to-indentation) (looking-at flan-fln--clause-re))
(or (flan-fln--clause-columns (match-string-no-properties 1) (point))
(flan-fln--levels (point))))
(flan-fln--block-levels (point))))
((or (flan-fln--starts-with-op-p (point))
(flan-fln--ends-in-op-p prev))
(list (+ (flan-fln--indent-at (flan-fln--logical-start prev))
flan-fln-indent-offset)))
(t (flan-fln--levels (point))))))))))
(t (flan-fln--block-levels (point))))))))))
(defun flan-fln-indent-line ()
"Indent the line to a block column.
@ -1301,11 +1421,13 @@ Never re-indents a line against the others: the columns are the program."
(if (and (= arg 1) (not (use-region-p))
(> (current-column) 0)
(= (current-column) (current-indentation))
(not (flan-fln--in-open-p (point))))
(not (flan-fln--bracketed-p (point))))
(let ((cur (current-indentation)))
(indent-line-to (or (seq-find (lambda (c) (< c cur))
(flan-fln--levels (point)))
0)))
(flan-fln--block-levels (point)))
;; A lambda's block inside brackets has no
;; level left of its own.
(if (flan-fln--lambda-arrow (point)) cur 0))))
(let ((cmd (or (command-remapping 'delete-backward-char)
#'delete-backward-char)))
(setq this-command cmd)
@ -1323,7 +1445,7 @@ Run when the word is finished by a space or a newline."
(if nl (line-end-position) (point)))))
(when (and (string-match "\\`[ \t]*\\(else\\|elif\\|on\\|restart\\)[ \t]*\\'"
text)
(not (flan-fln--in-open-p (point))))
(not (flan-fln--bracketed-p (point))))
(let ((cols (flan-fln--clause-columns (match-string 1 text) (point))))
(when (and cols (not (memq (current-indentation) cols)))
(indent-line-to (car cols))))))))
@ -1630,6 +1752,8 @@ lambda or a `Fn(...)' type, and not after a match arm's."
1 font-lock-function-name-face)
;; A lambda's `fn', glued to its parameters.
("\\(?:^\\|[ \t=(,]\\)\\(fn\\)(" 1 font-lock-keyword-face)
;; And the `=>' its body follows.
("[ \t]\\(=>\\)\\(?:[ \t]\\|$\\)" 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)

34
emacs/test-flan-fln-live.el
View File

@ -63,11 +63,22 @@ fn size(k: i64) -> i64
else 2
fn lam(k: i64) -> i64
let add = fn(a: i64, b: i64) -> i64 = a + b
let dbl = fn(a: 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 app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)
fn lam2(k: i64) -> i64
let a = 1
let b = app(k, fn(x) =>
let y = x + a
y)
let c = fn(z: i64) -> i64 =>
z * 2
c(b)
fn rs() -> i64
restart-case
3
@ -141,6 +152,9 @@ comment():
elif 1 > 2 or
3 > 4
0
app(5, fn(a) =>
a * 3
)
if 2 < 1 then 5
elif 2 == 1 then 6
else 7
@ -257,6 +271,7 @@ comment():
'(("fn sign2" "(sign2 0)" "0")
("fn size" "(size 20)" "2")
("fn lam" "(lam 3)" "7")
("fn lam2" "(lam2 3)" "8")
("fn rs" "(rs)" "3")
("fn dir" "(dir :north)" "7")
("struct Oops" "(oops-code)" "7")
@ -347,6 +362,16 @@ comment():
(unless (and (car r) (string-suffix-p (cadr r) (car r)))
(message " want ...%s\n got %S" (cadr r) (car r))))))
(flan-clear-errors)
;; A lambda's block inside a call's brackets: the call goes whole
;; from its header line, and reads.
(funcall goto "app(5")
(flan-fln-eval-statement)
(test-flan--check (funcall name "C-c C-e on a call with a block lambda sends it whole, and it reads")
(funcall shows "15"))
(funcall goto "app(5, fn(a) =>" t)
(flan-fln-eval-last)
(test-flan--check (funcall name "C-x C-e at the end of its header line too")
(funcall shows "15"))
(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")
@ -366,6 +391,11 @@ comment():
("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")
("x) =>" "a block lambda in a call, from its fn")
("let y = x" "a statement in a block lambda's block")
("y)" "the block's last statement, less the call's closer")
("let b = app" "a merged let's call with a block lambda, at its value")
("let c = fn" "a merged let's block lambda, at its value")
("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")

118
emacs/test-flan-fln.el
View File

@ -598,8 +598,8 @@ fn size(n: i64) -> i64
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
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
@ -689,7 +689,7 @@ of its line with AT-END."
(null (funcall face "x:")))))
(test-flan-fln--in "fn f(d: Dir) -> i64
let g = fn(a: Fn(i64) -> i64, b) -> Vec(i64)
let g = fn(a: Fn(i64) -> i64, b) -> Vec(i64) =>
a(b)
restart-case
3
@ -876,16 +876,16 @@ defconst(k, 3)
("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")
("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")
("let r = loop i = 0, acc = 1" "a let's loop")
("loop i = 0, acc = 1" "a loop")
("fn(a: i64) -> i64" "a typed lambda as a statement")))
("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--tabs "fn f()\n let f = fn(a: i64) -> i64 => a\n|" 1) 2)
(test-flan-fln--is "a header word being assigned opens nothing"
(test-flan-fln--tabs "fn f()\n for = 1\n|" 1) 2)
(test-flan-fln--in "fn f()\n handler-case\n g()\n on E(c)\n h(c)\n on = 2\n data += 1\n"
@ -1029,6 +1029,108 @@ defconst(k, 3)
(buffer-string)
"fn f() -> ()\n if a\n while x\n y\n\n"))
;;; A lambda's block inside brackets
(defconst test-flan-fln--lam
"fn f(xs) -> i64
let n = 1
sort-by(xs, fn(a, b) =>
let d = a - b
d < n)
map(xs, fn(x) =>
g(x)
x
)
h(n)
")
(defun test-flan-fln--lam-at (needle fn &optional at-end)
"What FN sends with point at NEEDLE in the lambda program, or at the end of
its line with AT-END."
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam 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--in (test-flan-fln--at test-flan-fln--lam "sort-by")
(test-flan-fln--is "a call with a block lambda is one statement, block and closer too"
(test-flan-fln--thing 'flan-fln-statement)
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
(test-flan-fln--is "its body is the lambda's block, less the call's closer"
(test-flan-fln--thing 'flan-fln-body)
"let d = a - b\n d < n"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam "d < n")
(test-flan-fln--is "a line of the block is a statement of its own, less the closer"
(test-flan-fln--thing 'flan-fln-statement) "d < n"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam " )")
(test-flan-fln--is "a closer on a line of its own belongs to the call"
(test-flan-fln--thing 'flan-fln-statement)
"map(xs, fn(x) =>\n g(x)\n x\n )"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam " x\n")
(test-flan-fln--is "and not to the statement above it"
(test-flan-fln--thing 'flan-fln-statement) "x"))
(test-flan-fln--is "C-c C-e on the header sends the call, block and all"
(car (test-flan-fln--lam-at "sort-by" #'flan-fln-eval-statement))
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
(test-flan-fln--is "and C-x C-e at the header's end"
(car (test-flan-fln--lam-at "sort-by" #'flan-fln-eval-last t))
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
(test-flan-fln--is "C-x C-e at the end of the block's last line sends its statement"
(car (test-flan-fln--lam-at "d < n" #'flan-fln-eval-last t))
"d < n")
(test-flan-fln--is "C-c C-e on a line of the block sends that statement"
(car (test-flan-fln--lam-at "g(x)" #'flan-fln-eval-statement))
"g(x)")
(dolist (c '(("let d" (4 5) "a statement in the block, where the reader starts it")
("g(x)" (7 5) "one in a block with its closer on a line of its own")
("a, b)" (3 15) "the lambda, from its fn")
("xs, fn(a" (3 3) "the call, from its name")))
(test-flan-fln--is (format "C-u C-c C-c marks %s" (nth 2 c))
(cadr (test-flan-fln--lam-at (car c) (lambda () (flan-fln-eval-defun '(4)))))
(cadr c)))
(test-flan-fln--is "TAB after a => inside brackets goes one level in"
(test-flan-fln--tabs "fn f()\n sort-by(xs, fn(a, b) =>\n|" 1) 4)
(test-flan-fln--is "and a line of the block stays in it"
(test-flan-fln--tabs "fn f()\n sort-by(xs, fn(a, b) =>\n g(a)\n| a < b)" 1) 4)
(test-flan-fln--is "under a header on a wrapped argument line, in from that line"
(test-flan-fln--tabs "f(a,\n fn(b) =>\n|" 1) 4)
(test-flan-fln--is "a closer on its own line goes to the call's column"
(test-flan-fln--tabs "fn f()\n m(xs, fn(x) =>\n x\n|)" 1) 2)
(test-flan-fln--is "after the block's brackets close, its column is no longer offered"
(list (test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 1)
(test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 2)
(test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 3))
'(0 2 0))
(test-flan-fln--is "inside a bracket in the block, under its first argument"
(test-flan-fln--tabs "fn f()\n m(xs, fn(x) =>\n g(x,\n|y))" 1) 6)
(test-flan-fln--in "fn f()\n m(xs, fn(x) => x)\n"
(font-lock-ensure)
(test-flan-fln--is "=> is a keyword"
(save-excursion (goto-char (point-min)) (search-forward "=>")
(get-text-property (match-beginning 0) 'face))
'font-lock-keyword-face))
(defconst test-flan-fln--lam-arm
"fn f(n: i64) -> i64
match n
1 -> app(1, fn(a) =>
a * 2)
_ -> 0
")
(test-flan-fln--is "C-x C-e at the end of an arm whose value ends in => sends the value, block and all"
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam-arm "1 ->")
(end-of-line)
(test-flan-fln--sent-code (test-flan-fln--sending (flan-fln-eval-last))))
"app(1, fn(a) =>\n a * 2)")
(test-flan-fln--is "and C-u C-c C-c on its pattern stops at the value"
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam-arm "1 ->")
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
'(3 10))
(test-flan-fln--is "an else whose value ends in => takes the block too"
(test-flan-fln--in "fn f(c)\n if c\n g()\n |else app(1, fn(a) =>\n a)\n"
(test-flan-fln--text (flan-fln--clause-value (line-beginning-position))))
"app(1, fn(a) =>\n a)")
;;; Block editing
(test-flan-fln--in "fn f() -> ()\n if a\n |b()\n c()\n d()\n"

4
lib/check.ml
View File

@ -6500,7 +6500,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
"nothing here says what this fn's parameters are — an fn takes \
its types from the position it is written in. Pass it where a \
Fn(T, ...) -> R is expected, or name the type where it is \
bound: let f: Fn(T, ...) -> R = fn(...)"
bound: let f: Fn(T, ...) -> R = fn(...) => ..."
else
fail loc
"nothing here says what this fn's parameters are — an fn takes \
@ -8653,7 +8653,7 @@ and array_build ctx loc ns elem ~pre ~element =
[n T] the literal is, since an array literal is never a slice. *)
and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) =
let ty = resolve ctx.env t in
(* A typed .fln lambda, [fn(c: C) -> bool = ...], reads as [(the (Fn [C]
(* A typed .fln lambda, [fn(c: C) -> bool => ...], reads as [(the (Fn [C]
bool) (fn ...))]; where a CFn of the same signature is wanted, the
literal is that CFn, as an untyped one would be. *)
let ty =

173
lib/indent_printer.ml
View File

@ -74,6 +74,11 @@ let is_sym s (f : Form.t) = match f.v with Form.Sym x -> x = s | _ -> false
[let] there takes in what follows it and no one-argument [and] is dropped. *)
let quasi = ref 0
(* While [hole_lines] looks for where a lambda sits in a line, the lambda is
printed as [hole_sym], at a lambda's level. *)
let hole = ref false
let hole_sym = "\003lambda\003"
let in_quasi (f : Form.t) k =
match f.v with
| Form.List ({ v = Form.Sym "quasiquote"; _ } :: _) ->
@ -296,6 +301,7 @@ let flatten (f : Form.t) (rest : Form.t list) =
one-line [if] or a lambda. *)
let rec expr (f : Form.t) : string * int =
match f.v with
| Form.Sym s when !hole && s = hole_sym -> (s, 0)
| Form.Sym s -> sym f s
| Form.Kw k ->
if kw_ok k then (":" ^ k, 10) else unprintable f "a keyword with no spelling"
@ -420,10 +426,10 @@ and list f h args =
(s ^ fst (expr m), 9)
| Form.Sym "the", _ when (match typed_lambda f with Some (_, [ _ ]) -> true | _ -> false) ->
(match typed_lambda f with
| Some (head, [ body ]) -> (head ^ " = " ^ unit_text body, 0)
| Some (head, [ body ]) -> (head ^ " => " ^ unit_text body, 0)
| _ -> assert false)
| Form.Sym "fn", [ { v = Form.Vec ps; _ }; body ] when List.for_all sym_param ps ->
("fn(" ^ commas ps ^ ") = " ^ unit_text body, 0)
("fn(" ^ commas ps ^ ") => " ^ unit_text body, 0)
| Form.Sym "if", [ c; a; b ] ->
("if " ^ at 1 c ^ " then " ^ inline_text ~lvl:1 a ^ " else " ^ inline_text b, 0)
| _ -> call ()
@ -718,9 +724,12 @@ and plain n (f : Form.t) : string list =
| _ -> head_text h ^ "(" ^ commas fixed ^ "):"
in
[ ind n ^ guard opener ] @ block ~seq (n + 2) rest
| _ when n + String.length text > width && fst (expr f) = text ->
wrapped n "" f
| _ -> one)
| _ ->
match hole_lines ~guarded:true n "" f with
| Some ls -> ls
| None ->
if n + String.length text > width && fst (expr f) = text then wrapped n "" f
else one)
| _ -> one
(* A call too long for its line, broken after commas inside its
@ -776,6 +785,131 @@ and wrapped n prefix (f : Form.t) =
go (ind n ^ open_) [] ts
| _ -> [ ind n ^ prefix ^ at 0 f ]
(* A lambda as its header, [fn(a, b)] or [fn(a: C) -> R], and its body. *)
and lambda_parts (f : Form.t) =
match typed_lambda f with
| Some _ as l -> l
| None ->
match f.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body))
when List.for_all sym_param ps ->
Some ("fn(" ^ commas ps ^ ")", body)
| _ -> None
(* A lambda body that reads better as a block under [=>] than on the line:
several statements, or one that is a statement. *)
and block_body (body : Form.t list) =
match body with
| [ { v = Form.List ({ v = Form.Sym h; _ } :: _); _ } ] ->
List.mem h sugar_heads && h <> "if" && h <> "update"
| [ _ ] -> false
| _ -> true
(* A lambda that takes a block: one whose body does, or has a comment in
it, or holds a lambda that takes one. *)
and wants_block (l : Form.t) body =
let rec holds (x : Form.t) =
match lambda_parts x with
| Some (_, b) -> wants_block x b
| None ->
match x.v with
| Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> false
| Form.List xs | Form.Vec xs | Form.Map xs -> List.exists holds xs
| _ -> false
in
block_body body || !inside l || List.exists holds body
(* A block under [=>]: a body that is one [do] is its statements, written
straight under the header rather than in a [do:] of their own. *)
and lambda_block n body =
match body with
| [ { Form.v = Form.List ({ v = Form.Sym "do"; _ } :: (_ :: _ :: _ as ss)); _ } ] -> block (n + 2) ss
| _ -> block (n + 2) body
(* A line holding a lambda that takes its block there: [prefix] and the
line's text up to the lambda, [fn(x) =>], the block under it, and what
followed the lambda on the line at the end of the block's last line. The
reader ends a block inside brackets where they close, so the lambda must
be the last thing in its brackets: what follows it starts with a closer.
Each lambda in [f], outside the others, is tried in turn, a lambda that
wants a block (several statements, a statement, a comment inside) or any
when the line is too long; its place is found by printing the line with
a placeholder where it stands. [guarded]: the text is a statement's. *)
and hole_lines ?(guarded = false) n prefix (f : Form.t) =
let rec cands (x : Form.t) =
if lambda_parts x <> None then [ x ]
else
match x.v with
| Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> []
| Form.List xs | Form.Vec xs | Form.Map xs -> List.concat_map cands xs
| _ -> []
in
let inner =
match f.v with
| Form.List xs | Form.Vec xs | Form.Map xs -> List.concat_map cands xs
| _ -> []
in
if inner = [] then None
else
let long = lazy (n + String.length prefix + String.length (fst (expr f)) > width) in
let rec subst (l : Form.t) (x : Form.t) =
if x == l then Form.make (Form.Sym hole_sym) l.loc
else
match x.v with
| Form.List xs -> { x with v = Form.List (List.map (subst l) xs) }
| Form.Vec xs -> { x with v = Form.Vec (List.map (subst l) xs) }
| Form.Map xs -> { x with v = Form.Map (List.map (subst l) xs) }
| _ -> x
in
let find t =
let k = String.length hole_sym in
let rec go i =
if i + k > String.length t then None
else if String.sub t i k = hole_sym then Some i
else go (i + 1)
in
go 0
in
let rec try_ = function
| [] -> None
| (l : Form.t) :: rest ->
let head, body = Option.get (lambda_parts l) in
if not (wants_block l body || Lazy.force long) then try_ rest
else begin
hole := true;
let t =
Fun.protect ~finally:(fun () -> hole := false)
(fun () -> fst (expr (subst l f)))
in
let t = if guarded then guard t else t in
match find t with
| Some i
when (let j = i + String.length hole_sym in
j < String.length t && (t.[j] = ')' || t.[j] = ']' || t.[j] = '}')) ->
let j = i + String.length hole_sym in
let post = String.sub t j (String.length t - j) in
let ls = lambda_block n body in
let ls =
match List.rev ls with
| last :: before -> List.rev ((last ^ post) :: before)
| [] -> ls
in
Some ((ind n ^ prefix ^ String.sub t 0 i ^ head ^ " =>") :: ls)
| _ -> try_ rest
end
in
try_ inner
(* [prefix = fn(a) =>] or [prefix = f(x, fn(a) =>] and a lambda's block,
when the value is a lambda that takes one or ends a bracket with one. *)
and lambda_value n prefix (v : Form.t) =
match lambda_parts v with
| Some (head, body)
when wants_block v body
|| n + String.length prefix + 3 + String.length (fst (expr v)) > width ->
Some ((ind n ^ prefix ^ " = " ^ head ^ " =>") :: lambda_block n body)
| _ -> hole_lines n (prefix ^ " = ") v
(* [prefix = v], or [prefix =] and the value as an indented block when it is
too long for the line. *)
and value_lines n prefix (v : Form.t) =
@ -789,15 +923,13 @@ and value_lines n prefix (v : Form.t) =
else if loop_head v <> None then
let head, body = Option.get (loop_head v) in
[ ind n ^ prefix ^ " = " ^ head ] @ block (n + 2) body
else if n + String.length inline <= width then [ ind n ^ inline ]
else
match lambda_value n prefix v with
| Some ls -> ls
| None ->
if n + String.length inline <= width then [ ind n ^ inline ]
else
match v.v with
| _ when typed_lambda v <> None ->
let head, body = Option.get (typed_lambda v) in
[ ind n ^ prefix ^ " = " ^ head ] @ block (n + 2) body
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body))
when List.for_all sym_param ps ->
[ ind n ^ prefix ^ " = fn(" ^ commas ps ^ ")" ] @ block (n + 2) body
| Form.List ({ v = Form.Sym h; _ } :: _)
when not (List.mem h sugar_heads || h = "fn" || h = "if") ->
wrapped n (prefix ^ " = ") v
@ -840,7 +972,8 @@ and sugar n (f : Form.t) : string list option =
Some [ i ^ guard (inline_text f) ]
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] ->
let line = i ^ guard (assign_text t v) in
if String.length line <= width then Some [ line ]
if String.length line <= width && lambda_value n (guard (at 9 t)) v = None
then Some [ line ]
else Some (value_lines n (guard (at 9 t)) v)
| Form.List [ { v = Form.Sym "if"; _ }; c; a; b ] ->
let simple (x : Form.t) =
@ -912,7 +1045,10 @@ and sugar n (f : Form.t) : string list option =
((i ^ "for " ^ lbl ^ v ^ " in range(" ^ commas bs ^ ")") :: block (n + 2) body)
| _ -> None)
| Form.List [ { v = Form.Sym "return"; _ } ] -> Some [ i ^ "return" ]
| Form.List [ { v = Form.Sym "return"; _ }; v ] -> Some [ i ^ "return " ^ at 0 v ]
| Form.List [ { v = Form.Sym "return"; _ }; v ] ->
(match hole_lines n "return " v with
| Some ls -> Some ls
| None -> Some [ i ^ "return " ^ at 0 v ])
| Form.List [ { v = Form.Sym (("break" | "continue") as w); _ } ] -> Some [ i ^ w ]
| Form.List [ { v = Form.Sym (("break" | "continue") as w); _ }; { v = Form.Kw k; _ } ]
when kw_ok k ->
@ -974,9 +1110,9 @@ and sugar n (f : Form.t) : string list option =
@ List.concat_map Option.get cs)
| Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] ->
Some ((i ^ "quote") :: slot (n + 2) x)
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ :: _ as body))
when List.for_all sym_param ps ->
Some ((guard (i ^ "fn(" ^ commas ps ^ ")")) :: block (n + 2) body)
| _ when (match lambda_parts f with Some (_, body) -> wants_block f body | None -> false) ->
let head, body = Option.get (lambda_parts f) in
Some ((i ^ head ^ " =>") :: lambda_block n body)
| Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ }
:: { v = Form.Vec ps; _ } :: ret :: body)
when def_name name ->
@ -1006,7 +1142,8 @@ and sugar n (f : Form.t) : string list option =
| Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
(* A call that takes a block is a statement, not a value. *)
not (List.mem h sugar_heads) && body_split hf args = None
| _ -> true)
&& lambda_value (n + 2) "" x = None
| _ -> lambda_value (n + 2) "" x = None)
&& String.length head + 3 + String.length (at 0 x) <= width
&& not (!inside f) ->
Some [ head ^ " = " ^ unit_text x ]

327
lib/indent_reader.ml
View File

@ -261,35 +261,82 @@ 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"). *)
side of the break is a spaced binary operator (spec §2 "Continuation").
The one exception is a lambda's block. A [=>] that ends its line inside
brackets opens a block there: the lines under it are laid out as they
would be at depth zero, against a base of their own (the column the [=>]
line starts at), until the bracket around the lambda closes. That closer
ends the block, whether it ends the block's last line or has a line of
its own. The block is the last thing in its brackets: a comma after it,
or a line back at the header's column, is refused. *)
type frame = {
f_base : int;
f_stack : int list;
f_opens : token list; (* the brackets open around the lambda *)
f_arrow : token; (* the [=>] that opened the block *)
}
let lambda_not_last (fr : frame) (t : token) =
failk "lambda-block-last" t.loc
"%s follows the block of the lambda on line %d, inside the same \
brackets. A lambda with a block is the last thing in its brackets, and \
its block ends where they close. Name the lambda with a let first and \
pass the name:\n\n\
\ let f = fn(a) =>\n ...\n g(f, x)"
(if t.tok = COMMA then "a comma" else show t.tok) fr.f_arrow.loc.Loc.line
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
line is its base: a later line may not go left of it. *)
let base = if snippet && n > 0 then arr.(0).loc.Loc.col else base in
line is its base: a later line may not go left of it. One cut from the
middle of a line (see [indent]) has that line's start as its base, so a
block under the line, a [let]'s [match] arms or a lambda's, reads as it
does in the file. *)
let base =
ref (if snippet && n > 0 then
match indent with
| Some c -> min c arr.(0).loc.Loc.col
| None -> arr.(0).loc.Loc.col
else base)
in
let out = ref [] in
let add tok loc = out := { tok; loc; sp = true } :: !out in
let stack = ref [ base ] 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
(* The brackets open in the current layout, innermost first. A lambda's
block starts with none, and [frames] holds what it interrupted. *)
let opens = ref [] in
let frames = ref [] in
let binop t = match t.tok with NAME s -> is_binop s | _ -> false in
let closer t = match t.tok with RP | RB | RC -> true | _ -> false in
(* The column [i]'s line starts at. *)
let line_col i =
let rec go j =
if j > 0 && arr.(j - 1).loc.Loc.eline = arr.(i).loc.Loc.line then go (j - 1) else j
in
arr.(go i).loc.Loc.col
in
for i = 0 to n - 1 do
let t = arr.(i) in
(if i = 0 then begin
if t.loc.Loc.col <> base then
if t.loc.Loc.col <> !base && indent = None then
failk "unexpected-indent" t.loc
"the first line starts at column %d, and a file's top-level lines \
start at column %d. Remove the indentation"
t.loc.Loc.col base
t.loc.Loc.col !base
end
else
let p = arr.(i - 1) in
if !depth = 0 && t.loc.Loc.line > p.loc.Loc.eline then begin
(* The closer that ends a lambda's block takes the block's end with
it, below: the line break before it is nothing. *)
let ends_block = !frames <> [] && !opens = [] && closer t in
if !opens = [] && t.loc.Loc.line > p.loc.Loc.eline && not ends_block then begin
let spaced_after =
i + 1 < n && arr.(i + 1).loc.Loc.line = t.loc.Loc.line
&& arr.(i + 1).sp
@ -324,15 +371,33 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
if not continues then begin
first_line := false;
let at = point p.loc in
add NEWLINE at;
let col = t.loc.Loc.col in
(* Inside a lambda's brackets, a line at or left of the line its
header is on would be a statement beside the lambda. *)
(match !frames with
(* Left of the block's own column, after the block: the next
element of the brackets, which the block must end. *)
| fr :: _ when List.length !stack > 1
&& col < List.nth !stack (List.length !stack - 2) ->
lambda_not_last fr t
| fr :: _ when col <= !base ->
if t.tok = COMMA then lambda_not_last fr t
else
failk "lambda-block-left" t.loc
"this line starts at column %d and is still inside the \
brackets of the lambda on line %d, whose block is indented \
past column %d. Indent it into the block, or close the \
brackets at the end of the block's last line"
col fr.f_arrow.loc.Loc.line !base
| _ -> ());
add NEWLINE at;
let top = List.hd !stack in
if col > top then begin
stack := col :: !stack;
add INDENT at
end
else if col < top then begin
if col < base then
if col < !base then
failk "dedent" t.loc
"%s"
(if snippet then
@ -342,11 +407,11 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
edge, and no later line can go left of it: send the \
enclosing form, or line this up at column %d or right \
of it"
col base base
col !base !base
else
Printf.sprintf
"this line starts at column %d, left of the top level at \
column %d" col base);
column %d" col !base);
let closed = ref top in
let rec pop () =
match !stack with
@ -368,12 +433,46 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
end
end
end);
(match !frames with
(* A comma at the top of a lambda's block, on one of the block's lines. *)
| fr :: _ when !opens = [] && t.tok = COMMA -> lambda_not_last fr t
(* The closer of the brackets a lambda's block is in: the block ends. *)
| fr :: rest when !opens = [] && closer t ->
let at = point arr.(i - 1).loc in
add NEWLINE at;
List.iter (fun _ -> add DEDENT at) (List.tl !stack);
base := fr.f_base;
stack := fr.f_stack;
opens := fr.f_opens;
frames := rest
| _ -> ());
out := t :: !out;
(match t.tok with
| LP | LB | LC -> incr depth
| RP | RB | RC -> if !depth > 0 then decr depth
| LP | LB | LC -> opens := t :: !opens
| RP | RB | RC -> (match !opens with _ :: r -> opens := r | [] -> ())
| NAME "=>" when !opens <> [] && i + 1 < n
&& arr.(i + 1).loc.Loc.line > t.loc.Loc.eline ->
frames := { f_base = !base; f_stack = !stack; f_opens = !opens; f_arrow = t }
:: !frames;
(* A snippet cut from the middle of a line starts where its line
does in the file, [indent], not where the cut does. *)
base :=
(match indent with
| Some c when t.loc.Loc.line = arr.(0).loc.Loc.line -> min c (line_col i)
| _ -> line_col i);
stack := [ !base ];
opens := []
| _ -> ())
done;
(match !frames with
| fr :: _ ->
let o = match fr.f_opens with o :: _ -> o | [] -> fr.f_arrow in
failk "unclosed" o.loc
~notes:[ Loc.note (point arr.(n - 1).loc) "the input ends here, still inside it" ]
"unclosed %s: the block of the lambda on line %d ends where this \
bracket closes"
(show o.tok) fr.f_arrow.loc.Loc.line
| [] -> ());
(if n > 0 then
let at = point arr.(n - 1).loc in
add NEWLINE at;
@ -384,11 +483,17 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
(* ── Parsing ───────────────────────────────────────────────────────── *)
type p = { toks : token array; mutable i : int }
(* [closed] is where a lambda's block that ended its statement stopped:
the block took the line's end with it, so a check for that end passes
there. *)
type p = { toks : token array; mutable i : int; mutable closed : int }
(* Set below [params] and [ty], which the expression parser comes before. *)
let typed_fn_expr : (p -> Form.t * int) ref = ref (fun _ -> assert false)
(* A block's statements, for a lambda's; set once the statement parser is. *)
let block_of : (p -> Form.t list) ref = ref (fun _ -> assert false)
let peek p = p.toks.(p.i)
let peek_at p k = p.toks.(min (p.i + k) (Array.length p.toks - 1))
let advance p =
@ -487,6 +592,7 @@ let expect_name p s ~what =
(* The end of a line that is not followed by a block. *)
let expect_eol p ~after =
if p.i = p.closed then () else
match (peek p).tok with
| NEWLINE ->
ignore (advance p);
@ -637,7 +743,7 @@ and postfix p =
loop (mk p l0 (Form.List (f :: args)), 9)
| LB ->
ignore (advance p);
let idx = items p RB t.loc ~what:"indices" in
let idx = items p RB t.loc ~what:"indices" ~head:(text_of f) in
loop (mk p l0 (Form.List (sym t.loc "at" :: f :: idx)), 9)
| NAME s when String.length s > 1 && s.[0] = '.' ->
ignore (advance p);
@ -785,36 +891,83 @@ and inline_stmt p : Form.t =
mk p t.loc (compound eq.loc (List.assoc op assign_ops) e v (span p e.loc))
| _ -> unit_slot p i0 t e
(* [fn(a, b) = body] is a lambda; [fn(...)] followed by anything else is the
(* [fn(a, b) => body] is a lambda; [fn(...)] followed by anything else is the
fallback call spelling of [(fn ...)]. *)
and fn_expr p =
if typed_lambda p then !typed_fn_expr p else
let t = advance p in
let lp = advance p in
let args = items p RP lp.loc ~what:"parameters" in
match (peek p).tok with
| NAME "=" ->
let rp = last p in
let names = List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) args in
let header () = "fn(" ^ String.concat ", " (List.map text_of args) ^ ")" in
let n = peek p in
match n.tok with
| NAME "=>" ->
ignore (advance p);
let ps = lambda_params args in
let i0 = p.i and t0 = peek p in
let body, _ = expr p in
let body = unit_slot p i0 t0 body in
let body = lambda_body p ~header:(header ()) in
(mk p t.loc
(Form.List
[ sym t.loc "fn"; Form.make (Form.Vec ps) (span_of_list lp.loc args); body ]),
(sym t.loc "fn" :: Form.make (Form.Vec ps) (span_of_list lp.loc args) :: body)),
0)
| NAME "=" when names -> lambda_equals p (header ())
| NAME w when names && glued_arrow w -> lambda_glued n (header ()) w
| NEWLINE when names && (peek_at p 1).tok = INDENT ->
lambda_arrow (peek_at p 2).loc (header ())
(* Inside brackets a line break is no token: the next line's first token
is what follows. *)
| tk when names && n.loc.Loc.line > rp.loc.Loc.eline && starts_value tk ->
lambda_arrow n.loc (header ())
| _ -> (mk p t.loc (Form.List (sym t.loc "fn" :: args)), 9)
(* A lambda with a block written inside a call's brackets, where no block can
open. The fix shown is the typed form, since a lambda bound by [let] has
no call to take its types from; [header] is [fn(a: T) -> R] or the
header as written. *)
and lambda_in_brackets : 'a. Loc.t -> string -> 'a = fun at header ->
failk "lambda-block-in-brackets" at
"a lambda's block cannot go inside brackets, where a line break is only \
a space. Name it first, with its types and the block under it:\n\n\
\ let f = %s\n ...\n\n\
and pass f, or write it on one line: %s = value"
(* What follows a lambda's [=>]: a value on the line, or the indented block
under it. [header] is the lambda's header as written, for a message. *)
and lambda_body p ~header =
match (peek p).tok, (peek_at p 1).tok with
| NEWLINE, INDENT ->
ignore (advance p);
let body = !block_of p in
p.closed <- p.i;
body
| (NEWLINE | EOF | DEDENT), _ ->
failk "lambda-body" (where_ p)
"the line ends after %s =>, and the lambda's body is not under it. Put \
the body after the =>, or on the lines under it, indented:\n\n\
\ %s =>\n ..."
header header
| _ ->
let i0 = p.i and t0 = peek p in
let body, _ = expr p in
[ unit_slot p i0 t0 body ]
(* [fn(a) = x]: a lambda written with a named function's [=]. *)
and lambda_equals : 'a. p -> string -> 'a = fun p header ->
let eq = advance p in
let body =
match expr p with
| b, _ -> text_of b
| exception _ -> "..."
in
failk "lambda-equals" eq.loc
"a lambda's body follows =>, and this one has =, which is how a named \
function is written. Write:\n\n %s => %s"
header body
(* [fn(a) =>x]: the body glued to the arrow reads as one name. *)
and glued_arrow w = String.length w > 2 && String.sub w 0 2 = "=>"
and lambda_glued : 'a. token -> string -> string -> 'a = fun t header w ->
failk "lambda-arrow-space" t.loc
"%s is one name, with nothing between => and the body. Put a space \
after the arrow: %s => %s"
w header (String.sub w 2 (String.length w - 2))
(* A lambda header with lines under it and no [=>]. *)
and lambda_arrow : 'a. Loc.t -> string -> 'a = fun at header ->
failk "lambda-arrow" at
"the lines under %s are a lambda's body only after =>. End the header \
with it:\n\n %s =>\n ..."
header header
(* Whether the [fn(] at point has a [:] among its parameters or a [->]
@ -852,7 +1005,8 @@ and lambda_params args =
(* Comma-separated values up to [closer]. [const T] is two elements without a
comma, for [Ptr(const u8)]: const is a reserved word in a type and never a
value. *)
and items p closer open_loc ~what =
(* [head] is the text of what is indexed, for [[ ]]'s message. *)
and items ?head p closer open_loc ~what =
let opener = if closer = RB then '[' else '(' in
let rec go acc =
let t = peek p in
@ -871,22 +1025,7 @@ and items p closer open_loc ~what =
| EOF -> unclosed p opener open_loc
| _ ->
let n = peek p in
let block_lambda =
match e.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: ps) ->
List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) ps
&& n.loc.Loc.line > e.loc.Loc.eline
| _ -> false
in
if block_lambda then
let names =
match e.v with
| Form.List (_ :: ps) -> List.map text_of ps
| _ -> []
in
lambda_in_brackets n.loc
("fn(" ^ String.concat ", " (List.map (fun x -> x ^ ": T") names) ^ ") -> R")
else if starts_value n.tok && n.sp && not (negative_literal n.tok)
if starts_value n.tok && n.sp && not (negative_literal n.tok)
&& n.loc.Loc.line > e.loc.Loc.eline then
(* Most often the bracket was never closed: the next statement
has been read as one more argument. *)
@ -898,8 +1037,11 @@ and items p closer open_loc ~what =
else if starts_value n.tok && n.sp && not (negative_literal n.tok) then
failk "missing-comma" n.loc
"%s follows %s with no comma between them. Separate %s with \
commas: f(a, b)"
commas: %s"
(show n.tok) (text_of e) what
(match head with
| Some h -> Printf.sprintf "%s[%s, %s]" h (text_of e) (show n.tok)
| None -> "f(a, b)")
else stray p ~after:(text_of e))
in
go []
@ -1042,12 +1184,6 @@ let blk (s : st) l (ss : Form.t list) =
| (first : Form.t) :: _ -> mk s.p first.loc (Form.List (sym first.loc "do" :: ss))
| [] -> mk s.p l (Form.List [ sym l "do" ])
let is_lambda_candidate (e : Form.t) =
match e.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: args) ->
List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) args
| _ -> false
(* The word at the head of the line is a variable being assigned, [data = 3]
or [on += 1], whatever else it could start. *)
let assigns p =
@ -1171,11 +1307,10 @@ let named_params p (lp : token) =
in
go []
(* [fn(a: C, b) -> R = body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the
(* [fn(a: C, b) -> R => body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the
paren [fn] takes its parameters' types from where it is written, and [the]
is the form that says what a value is, as in [let x: T = v]. An untyped
parameter is dyn, as in a definition, and the return type is required. A
block body is added by [lambda_block]. *)
parameter is dyn, as in a definition, and the return type is required. *)
let () = typed_fn_expr := fun p ->
let t = advance p in
let lp = advance p in
@ -1185,18 +1320,22 @@ let () = typed_fn_expr := fun p ->
| _ -> ([], [])
in
let names, tys = split ps in
let params_text () =
String.concat ", "
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys)
in
let r =
match (peek p).tok with
| NAME "->" -> ignore (advance p); ty p
| _ ->
failk "lambda-return" (where_ p)
"a lambda that states its parameters' types states its return type \
too: fn(%s) -> R = value"
(String.concat ", "
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys))
too: fn(%s) -> R => value"
(params_text ())
in
let header () = "fn(" ^ params_text () ^ ") -> " ^ text_of r in
let fty = mk p lp.loc (Form.List [ sym t.loc "Fn"; Form.make (Form.Vec tys) lp.loc; r ]) in
let vec = Form.make (Form.Vec names) lp.loc in
let wrap body =
@ -1204,26 +1343,21 @@ let () = typed_fn_expr := fun p ->
mk p t.loc (Form.List (sym t.loc "fn" :: vec :: body)) ])
in
match (peek p).tok with
| NAME "=" ->
| NAME "=>" ->
ignore (advance p);
let i0 = p.i and t0 = peek p in
let body, _ = expr p in
(wrap [ unit_slot p i0 t0 body ], 0)
| NEWLINE when (peek_at p 1).tok = INDENT -> (wrap [], 0)
let body = lambda_body p ~header:(header ()) in
(wrap body, 0)
| NAME "=" -> lambda_equals p (header ())
| NAME w when glued_arrow w -> lambda_glued (peek p) (header ()) w
| NEWLINE when (peek_at p 1).tok = INDENT -> lambda_arrow (peek_at p 2).loc (header ())
(* Inside brackets a line break is no token: the next line's first token
is what follows. *)
| tk when (peek p).loc.Loc.line > (last p).loc.Loc.eline && tk <> EOF ->
let header =
"fn(" ^ String.concat ", "
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys)
^ ") -> " ^ text_of r
in
lambda_in_brackets (peek p).loc header
lambda_arrow (peek p).loc (header ())
| _ ->
failk "lambda-body" (where_ p)
"a lambda's body follows = on its line, or is the block under it"
"a lambda's body follows => on its line, or is the block under it: \
%s => value" (header ())
let rec stmts (s : st) : Form.t list =
let p = s.p in
@ -1298,33 +1432,13 @@ and then_on_line p =
in
go 1 0
(* The end of a statement's line, which a lambda's block may already have
taken. *)
and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after =
let p = s.p in
match e.v with
(* A typed lambda waiting for its block, from [typed_fn_expr]. *)
| Form.List [ ({ v = Form.Sym "the"; _ } as th); fty;
({ v = Form.List [ ({ v = Form.Sym "fn"; _ } as fh); ({ v = Form.Vec _; _ } as vec) ]; _ } as fn_) ]
when (peek p).tok = NEWLINE && (peek_at p 1).tok = INDENT ->
ignore (advance p);
let body = block s ~after in
mk p e.loc (Form.List [ th; fty; { fn_ with v = Form.List (fh :: vec :: body) } ])
| _ ->
if is_lambda_candidate e && (last p).tok = RP && (peek p).tok = NEWLINE
&& (peek_at p 1).tok = INDENT
then begin
ignore (advance p);
let body = block s ~after in
match e.v with
| Form.List (h :: args) ->
mk p e.loc
(Form.List (h :: Form.make (Form.Vec args) (span_of_list e.loc args) :: body))
| _ -> assert false
end
else begin
if block_ok && (peek p).tok = NEWLINE then ignore (advance p)
else expect_eol p ~after;
e
end
if block_ok && p.i <> p.closed && (peek p).tok = NEWLINE then ignore (advance p)
else expect_eol p ~after;
e
and let_stmt (s : st) : Form.t list =
let p = s.p in
@ -2116,6 +2230,7 @@ and clause_end p head =
(* The end of a header line whose block must follow. *)
and expect_line_end p ~after =
if p.i = p.closed then () else
match (peek p).tok with
| NEWLINE -> ignore (advance p)
| _ -> stray p ~after
@ -2140,6 +2255,8 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list =
go []
end
let () = block_of := fun p -> block { p; lets = [] } ~after:"=>"
(** 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 ?indent ?(global_let = true) ~file src =
@ -2153,7 +2270,7 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
Fun.protect ~finally:(fun () -> source := saved) (fun () ->
let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
let s = { p = { toks; i = 0 }; lets = [] } in
let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in
(* At the top level, a [let] is a global, [(def x dyn v)]: a let there has
no block to be local to. Not in an expression the editor sends, where
a let is the statement it is in a body. *)

40
spec-syntax.md
View File

@ -117,10 +117,10 @@ Each item: the proposal, then the reason in one line.
trailing block is allowed. Make it parser-driven, the way GDScript's
`push_multiline` is (`gdscript_parser.cpp` 658-672, 3695-3770), not a paren
counter in the lexer, or a block inside a call can't work.
*Built as a depth counter instead: inside brackets a line break is always
whitespace, so no block opens inside a call's parentheses (§3.1's blocks all
open after the `)`; a lambda with a block body is a statement or a value,
`let f = fn(x)` plus a block).*
*Built as a depth counter instead: inside brackets a line break is
whitespace, with one exception. A `=>` that ends a line inside brackets opens
a lambda's block there, laid out as at the top level against the column its
line starts at, and the block ends where the enclosing bracket closes.*
- **Continuation outside brackets:** a line that starts with a spaced infix
operator (`+`, `and`, `==`, …) continues the previous line; so does a line
after one that ends in a spaced infix operator. (F# `LexFilter.fs` 360-380,
@ -267,11 +267,28 @@ Each item: the proposal, then the reason in one line.
- **Unit:** `()` as a statement reads `(do)`; in a type it is `()`. **Built**;
inside an expression `()` stays `()`, and the printer writes a lone `()`
statement as `(())`. A bare `()` in a one-line body slot (`fn f() -> () = ()`,
`_ -> ()`, `fn() = ()`, `then ()`) is a statement too, and reads `(do)`.
- **Lambda:** `fn(i, j) = i * 10 + j`, or `fn(i, j)` plus a block. **Built**;
`_ -> ()`, `fn() => ()`, `then ()`) is a statement too, and reads `(do)`.
- **Lambda:** `fn(i, j) => i * 10 + j`, or `fn(i, j) =>` plus a block. **Built**;
its parameters are bare names, as `(fn [i j] …)` wants, with no `dyn`.
`fn(…)` followed by anything else is the fallback call. A lambda may state
its types, `fn(a: C, b) -> bool = …` or plus a block (section 3, item 7).
its types, `fn(a: C, b) -> bool => …` or plus a block (section 3, item 7).
`=>` is a lambda's only spelling: `fn(a) = x` and a lambda header with a
block under it and no `=>` are refused, with the `=>` form as the fix.
Named functions keep `=`. A block lambda may sit inside brackets:
```
sort-by(slice(xs), fn(a, b) =>
let d = a.n - b.n
d < 0)
```
The block ends where the brackets close, with the `)` at the end of its
last line or on a line of its own at the call's column. It is the last
thing in them: a comma after the block is refused (so a call takes one
block lambda, as its last argument; name any other with `let`), as is a
line inside the brackets at or left of the column the `=>` line starts at.
Block lambdas nest, each block ending at its own brackets. `flan convert`
writes a call whose last argument is a lambda with a block this way.
### Definitions
@ -401,16 +418,15 @@ Settled 2026-09-26, after writing programs by hand (`test/syntax/handwritten/`):
is refused at its last line: the first `else` took `if b then y` as its
value, and the chain is `if a then x else if b then y else z` on one line,
or `elif b then y` on the second.
7. **Typed lambdas.** `fn(a: C, b) -> R = body`, or plus a block, reads
7. **Typed lambdas.** `fn(a: C, b) -> R => body`, or plus a block, reads
`(the (Fn [C dyn] R) (fn [a b] body))`: the paren `fn` has no typed
parameters, and `the` is how a value states its type, as in
`let x: T = v`. An untyped parameter is `dyn`; the return type is
required. Where a `CFn` of the same signature is wanted, the literal is
that `CFn`; at a generic's `CFn($t) -> $t` parameter the literal is a
`CFn` at its own types, which bind `$t` as any argument's would. The
printer writes that form back as the typed lambda. A block lambda cannot
sit inside a call's brackets; the refusal shows the typed `let` form to
bind it with.
printer writes that form back as the typed lambda. A typed block lambda
sits inside brackets as an untyped one does.
8. **`Dir.north` is the enum member `:north`**, in a value and in a match
pattern, in both syntaxes. `:north` stays. A local named `Dir` shadows the
enum as a local shadows any global: `Dir.north` is then its field.
@ -478,7 +494,7 @@ Each step lands on its own, with `dune test --root .` green.
(`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
"Indented files"). A line ending in `=` or `=>` 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.

4
test/syntax/handwritten/inventory.fln
View File

@ -51,7 +51,7 @@ fn main() -> i32
let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3),
stock/item("gears", 1250, 7), stock/item("belts", 899, 0)]
let rules = [Rule{.label "reorder", .applies low?},
Rule{.label "valuable", .applies fn(it) = stock/value(it) > 5000}]
Rule{.label "valuable", .applies fn(it) => stock/value(it) > 5000}]
let frame = arena-new(4096)
repeat(pass, 2):
runs += 1
@ -75,7 +75,7 @@ fn main() -> i32
println("sign bits", stock/sign-bit(-2.5), stock/sign-bit(2.5),
"masked", bit-and(-total, 0xFF))
let big = 1000
println("worth over", big, count-if(slice(items), fn(it) = stock/value(it) > big))
println("worth over", big, count-if(slice(items), fn(it) => stock/value(it) > big))
expect(total == 407, "407 on even rows")
expect(runs == 2, "two runs")
0

10
test/syntax/handwritten/ring.fln
View File

@ -60,7 +60,7 @@ fn repeat-apply(f: CFn($t) -> $t, x: $t, n: i32) -> $t
v = f(v)
v
fn halve-all(x: $t) -> $t where numeric?($t) = repeat-apply(fn(a: $t) -> $t = a / 2, x, 3)
fn halve-all(x: $t) -> $t where numeric?($t) = repeat-apply(fn(a: $t) -> $t => a / 2, x, 3)
fn main() -> i32
let r: Ring(5, i32) = zeroed()
@ -80,16 +80,16 @@ fn main() -> i32
let d = distinct(slice(samples))
println("distinct", slice(d))
free(d)
let big = filter(slice(samples), fn(x) = x >= 7)
println("seven and up", slice(big), "sum", reduce(slice(big), 0, fn(a, b) = a + b))
let big = filter(slice(samples), fn(x) => x >= 7)
println("seven and up", slice(big), "sum", reduce(slice(big), 0, fn(a, b) => a + b))
free(big)
let rs = [Reading{.sensor 2, .value 40} Reading{.sensor 1, .value 15}
Reading{.sensor 3, .value 22}]
sort-by(slice(rs), fn(a, b) = a.value < b.value)
sort-by(slice(rs), fn(a, b) => a.value < b.value)
for i in range(length(rs))
println("sensor", rs[i].sensor, rs[i].value)
let raw: [4 u32] = [1 2 3 4]
let p = Ptr(u8)(addr(raw[0]))
println("checksum", checksum(p, 16))
println("doubled", repeat-apply(fn(a: i32) -> i32 = a * 2, 1, 10), "halved", halve-all(800.0))
println("doubled", repeat-apply(fn(a: i32) -> i32 => a * 2, 1, 10), "halved", halve-all(800.0))
0

4
test/syntax/handwritten/words.fln
View File

@ -58,7 +58,7 @@ fn main() -> i32
let text = "The cat saw the dog. The dog didn't see the cat, but the bird saw both!"
let ws = words(bytes-view(text))
let counts = tally(slice(ws))
let by-count = fn(a: Count, b: Count) -> bool
let by-count = fn(a: Count, b: Count) -> bool =>
if a.n != b.n
return a.n > b.n
bytes<?(a.word, b.word)
@ -73,7 +73,7 @@ fn main() -> i32
let distinct = i32(length(counts))
let g = grade(distinct, total)
println(distinct, "of", total, "distinct:", describe(g))
let longest = reduce(slice(ws), slice(ws[0], 0, 0), fn(a, b) =
let longest = reduce(slice(ws), slice(ws[0], 0, 0), fn(a, b) =>
if length(b) > length(a) then b else a)
println("longest", str(longest))
let short = 0 < length(longest) < 5

147
test/test_syntax.ml
View File

@ -58,7 +58,8 @@ let describe_diff a b =
[let] takes in the statements after it (the printer's flat [let]; with
every [let] name unique by now, nothing after it can mean one of them). A
[(do x)] whose [x] is a [let] is [x], a [let] whose whole body is another
[let] is the merged [let], and [(and x)] and [(or x)] are [x]. The flat
[let] is the merged [let], [(fn [a] (do x y))] is [(fn [a] x y)], and
[(and x)] and [(or x)] are [x]. The flat
[let] and the one-argument [and] stop at a quote or quasiquote: data, or
a template whose unquotes could name anything. *)
@ -203,6 +204,12 @@ let rec shape ?(q = false) (f : Form.t) : Form.t =
| [ { v = Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs2; _ } :: body2); _ } ] ->
Form.List (h :: Form.make (Form.Vec (List.map sh bs @ bs2)) loc :: body2)
| body -> Form.List (h :: Form.make (Form.Vec (List.map sh bs)) loc :: body))
(* A lambda whose body is one [do] is the lambda of its statements:
the printer writes them straight under [=>]. *)
| Form.List [ ({ v = Form.Sym "fn"; _ } as h); ({ v = Form.Vec _; _ } as ps);
{ v = Form.List ({ v = Form.Sym "do"; _ } :: (_ :: _ :: _ as ss)); _ } ]
when not q ->
(sh { f with v = Form.List (h :: ps :: ss) }).v
| Form.List (({ v = Form.Sym "handler-case"; _ } as h) :: body :: ({ v = Form.Vec cls; _ } as cv) :: more) ->
Form.List (h :: sh body :: { cv with v = Form.Vec (List.map clause cls) }
:: List.map sh more)
@ -547,8 +554,8 @@ let () =
reads "quote block"
"defmacro(m, [x & ys]):\n quote\n f(~x)\n ~@ys"
"(defmacro m [x & ys] (quasiquote (do (f (unquote x)) (unquote-splicing ys))))";
reads "lambda" "g = fn(i, j) = i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))";
reads "lambda with a block" "g = fn(i)\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))";
reads "lambda" "g = fn(i, j) => i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))";
reads "lambda with a block" "g = fn(i) =>\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))";
reads "where" "fn s(xs: [$t]) -> () where ordered?($t) = f(xs)"
"(defn s [xs [$t]] () {:where (ordered? $t)} (f xs))";
reads "data" "data Shape\n Circle(r: f32)\n Empty"
@ -650,10 +657,51 @@ let () =
refuses "field with =" "p = P{x = 1}" "indent/brace-field" "{.x value}";
refuses "field with a colon" "p = P{x: 1}" "indent/brace-field" "no colon";
refuses "a dotted range" "for i in 0..10\n g(i)" "indent/dot-range" "range(0, 10)";
refuses "a block lambda inside a call" "sort-by(xs, fn(a, b)\n a < b)"
"indent/lambda-block-in-brackets" "let f = fn(a: T, b: T) -> R";
refuses "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)"
"indent/lambda-block-in-brackets" "let f = fn(a: C, b: C) -> bool";
(* A lambda's block inside brackets ends where they close. *)
reads "a block lambda inside a call" "sort-by(xs, fn(a, b) =>\n let c = a + 1\n c < b)"
"(sort-by xs (fn [a b] (let [c (+ a 1)] (< c b))))";
reads "its closer on a line of its own" "sort-by(xs, fn(a, b) =>\n a < b\n)\ng()"
"(sort-by xs (fn [a b] (< a b)))\n(g)";
reads "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool =>\n a < b)"
"(sort-by xs (the (Fn [C C] bool) (fn [a b] (< a b))))";
reads "nested block lambdas"
"map(xs, fn(x) =>\n let ys = map(x, fn(y) =>\n if y > 0\n y\n else\n 0)\n sum(ys))"
"(map xs (fn [x] (let [ys (map x (fn [y] (if (> y 0) y 0)))] (sum ys))))";
reads "a block lambda on a wrapped argument line" "f(a,\n fn(b) =>\n g(b)\n h(b))"
"(f a (fn [b] (g b) (h b)))";
reads "a block lambda in a vector" "x = [1, fn(b) =>\n b]" "(set x [1 (fn [b] b)])";
reads ~global:false "a call after a block lambda's call" "let v = f(fn(a) =>\n a)\ng(v)"
"(let [v (f (fn [a] a))] (g v))";
refuses "a block lambda is the last argument" "sort-by(fn(a, b) =>\n a < b, xs)"
"indent/lambda-block-last" "let f = fn(a) =>";
refuses "one block lambda to a call" "f(fn(a) =>\n a\n, fn(b) =>\n b)"
"indent/lambda-block-last" "on line 1";
refuses "a line back at the header's column" "f(fn(a) =>\n a\nb)"
"indent/lambda-block-last" "b follows the block of the lambda on line 1";
refuses "an element after a block lambda, left of its block" "m = {:a fn(x) =>\n x\n :b 2}"
"indent/lambda-block-last" ":b follows the block";
refuses "a block's first line not indented" "f(fn(a) =>\na)"
"indent/lambda-block-left" "Indent it into the block";
refuses "a block lambda's brackets left open" "f(fn(a) =>\n a\n"
"indent/unclosed" "ends where this bracket closes";
refuses "indices with no comma" "x = grid[row col].color-idx"
"indent/missing-comma" "Separate indices with commas: grid[row, col]";
refuses "arguments with no comma" "x = f(a b)"
"indent/missing-comma" "Separate arguments with commas: f(a, b)";
refuses "a body glued to =>" "x = fn(a) =>a"
"indent/lambda-arrow-space" "fn(a) => a";
refuses "a lambda written with =" "x = fn(a, b) = a + b"
"indent/lambda-equals" "fn(a, b) => a + b";
refuses "a typed lambda written with =" "x = fn(a: C) -> bool = a.n > 1"
"indent/lambda-equals" "fn(a: C) -> bool => a.n > 1";
refuses "a block lambda with no =>" "let f = fn(a)\n a\nf"
"indent/lambda-arrow" "fn(a) =>";
refuses "a block lambda with no => inside a call" "sort-by(xs, fn(a, b)\n a < b)"
"indent/lambda-arrow" "fn(a, b) =>";
refuses "a typed block lambda with no => inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)"
"indent/lambda-arrow" "fn(a: C, b: C) -> bool =>";
refuses "a => with nothing under it" "let f = fn(a) =>\nf"
"indent/lambda-body" "fn(a) =>";
refuses "an else after else-if on one line" "if a then x\nelse if b then y\nelse z"
"indent/orphan-else" "Write that line as elif";
refuses "else deeper than a one-line if" "if a then b\n else c"
@ -668,17 +716,17 @@ let () =
"(cond a b c d e (do (f) (g)) :else (h))";
refuses "else left of a one-line if" "while x\n if a then b\nelse c"
"indent/orphan-else" "goes at the if's column";
reads "a typed lambda" "f = fn(a: C, b) -> bool = a.n < b"
reads "a typed lambda" "f = fn(a: C, b) -> bool => a.n < b"
"(set f (the (Fn [C dyn] bool) (fn [a b] (< (.n a) b))))";
reads ~global:false "a typed lambda with a block" "let f = fn(x: i32) -> i32\n let y = x + 1\n y\ng(f)"
reads ~global:false "a typed lambda with a block" "let f = fn(x: i32) -> i32 =>\n let y = x + 1\n y\ng(f)"
"(let [f (the (Fn [i32] i32) (fn [x] (let [y (+ x 1)] y)))] (g f))";
refuses "a typed lambda states its return type" "f = fn(a: C) = a"
"indent/lambda-return" "fn(a: C) -> R = value";
"indent/lambda-return" "fn(a: C) -> R => value";
reads "a restart's report on its header"
"restart-case\n go()\nrestart retry(n: i32) \"Try again\"\n n"
"(restart-case (go) (retry [n i32] :report \"Try again\" n))";
reads "a bare () in a body slot does nothing"
"fn f() -> () = ()\nfn g(x) -> ()\n match x\n 1 -> h()\n _ -> ()\n k = fn() = ()"
"fn f() -> () = ()\nfn g(x) -> ()\n match x\n 1 -> h()\n _ -> ()\n k = fn() => ()"
"(defn f [] () (do))\n(defn g [x dyn] () (match x 1 (h) _ (do)) (set k (fn [] (do))))";
reads "a parenthesised () stays a value" "x = (())" "(set x ())";
reads "a template's for takes an unquoted variable"
@ -758,7 +806,7 @@ let () =
prints "comment is a body in order" "(comment (let [a 1] (g a)) (h))" "comment:\n let a = 1\n g(a)\n h()";
prints "a later lambda keeps the outer name"
"(defn f [] i32 (let [x 1] (let [x 5] (g x)) (app (fn [y] (+ x y)) 2)))"
" let x = 1\n let x-2 = 5\n g(x-2)\n app(fn(y) = x + y, 2)";
" let x = 1\n let x-2 = 5\n g(x-2)\n app(fn(y) => x + y, 2)";
prints "a renamed name renamed again counts on"
"(defn f [] () (let [x 1] (let [x 2] (let [x 3] (g x)) (g x)) (g x)))"
" let x = 1\n let x-2 = 2\n let x-3 = 3\n g(x-3)\n g(x-2)\n g(x)";
@ -848,7 +896,53 @@ let () =
"(defn f [a bool b bool c bool] bool (or (and a b) c))" "= (a and b) or c";
prints "a typed lambda prints as one"
"(defn f [] () (let [g (the (Fn [C] bool) (fn [c] (> (.n c) 3)))] (h g)))"
"let g = fn(c: C) -> bool = c.n > 3";
"let g = fn(c: C) -> bool => c.n > 3";
(* A lambda with a block as a call's last argument prints inside the call,
and reads back as it was. *)
let round name src want =
prints name src want;
let forms = Reader.read_all ~file:"<p>" src in
let text = Indent_printer.program ~source:src forms in
match Indent_reader.read_all ~file:"<p>" text with
| back ->
if not (same_forms forms back) then
fail "%s: read back %s from %S" name (describe_diff forms back) text
| exception e -> fail "%s: its text is refused: %s\n%s" name (diag_text e) text
in
round "a one-line lambda" "(defn f [] () (h (fn [a] (+ a 1)) 2))" "= h(fn(a) => a + 1, 2)";
round "a block lambda as a call's last argument"
"(defn f [] () (sort-by xs (fn [a b] (g a) (< a b))))"
" sort-by(xs, fn(a, b) =>\n g(a)\n a < b)";
round "one closer for a call in a call"
"(defn f [] () (println (run (fn [] (g) 1))))" " println(run(fn() =>\n g()\n 1))";
round "a typed block lambda in a call"
"(defn f [] () (h (the (Fn [C] bool) (fn [c] (g c) (> (.n c) 3)))))"
" h(fn(c: C) -> bool =>\n g(c)\n c.n > 3)";
round "a let's call with a block lambda"
"(defn f [] () (let [v (m xs (fn [x] (g x) x))] (h v)))"
" let v = m(xs, fn(x) =>\n g(x)\n x)\n h(v)";
round "nested block lambdas"
"(defn f [] () (m xs (fn [x] (let [y (m x (fn [z] (g z) z))] (h y)))))"
" m(xs, fn(x) =>\n let y = m(x, fn(z) =>\n g(z)\n z)\n h(y))";
round "a block lambda inside an expression, the line going on after it"
"(defn f [] i64 (+ (ap 1 (fn [x] (g x) x)) 1))" " ap(1, fn(x) =>\n g(x)\n x) + 1";
round "one in a lambda that fits on its line"
"(defn f [] i64 (ap 1 (fn [x] (ap x (fn [y] (g y) y)))))"
" ap(1, fn(x) =>\n ap(x, fn(y) =>\n g(y)\n y))";
round "a struct literal's last field"
"(defn f [] i64 (let [o (Ops {.k 1 .run (fn [x] (g x) x)})] (.k o)))"
" let o = Ops{.k 1, .run fn(x) =>\n g(x)\n x}";
round "a returned call"
"(defn f [] i64 (return (ap 2 (fn [x] (g x) x))))" " return ap(2, fn(x) =>\n g(x)\n x)";
round "a let in a lambda inside a call's argument"
"(defn f [] i64 (println (call0 (fn [] (let [n 0] (set n 1) n)))) 0)"
" println(call0(fn() =>\n let n = 0\n n = 1\n n))";
prints "a body that is one do goes straight under =>"
"(defn f [] i64 (call0 (fn [] (do (g 1) 2))))" " call0(fn() =>\n g(1)\n 2)";
round "a block lambda not last keeps the fallback"
"(defn f [] () (r (fn [a b] (g a) b) 0))" "= r(fn([a b], g(a), b), 0)";
round "a lambda bound by let"
"(defn f [] () (let [k (fn [a] (g a) a)] (k 1)))" " let k = fn(a) =>\n g(a)\n a\n k(1)";
prints "a restart's report goes on its header"
"(defn f [] i32 (restart-case (go) (retry [] :report \"Try again\" 7)))"
"restart retry() \"Try again\"\n 7";
@ -900,7 +994,7 @@ let () =
prints "a let-bound loop" "(defn f [] i32 (let [r (loop [i 0] (recur i))] r))"
" let r = loop i = 0\n recur(i)";
prints "a lambda as a loop's value is parenthesised"
"(defn f [] () (loop [g (fn [x] x) n 0] (recur g n)))" "loop g = (fn(x) = x), n = 0"
"(defn f [] () (loop [g (fn [x] x) n 0] (recur g n)))" "loop g = (fn(x) => x), n = 0"
(* ── Spans, for pause marks and error overlays ──────────────────────── *)
@ -1107,8 +1201,8 @@ let () =
[ "it has to be written: i32(x)" ];
refused "unknown-type.fln" "fn f(p: Keyword) -> i32 = 0\n\nfn main() -> i32 = 0\n"
[ "unknown type Keyword" ];
refused "untyped-lambda.fln" "fn main() -> i32\n let f = fn(a)\n a\n 0\n"
[ "let f: Fn(T, ...) -> R = fn(...)" ];
refused "untyped-lambda.fln" "fn main() -> i32\n let f = fn(a) =>\n a\n 0\n"
[ "let f: Fn(T, ...) -> R = fn(...) =>" ];
refused "plusplus.fln" "fn main() -> i32\n let x = 1\n x++\n x\n"
[ "write ++(x) or x += 1" ];
refused "plusplus-global.fln" "once g = 0\n\nfn main() -> i32\n g--\n 0\n"
@ -1138,25 +1232,28 @@ let () =
fail "map-key.fln: %d errors, wanted one" (List.length ds)
| exception _ -> ()
| _ -> ());
(* The fix the lambda-in-brackets refusal shows compiles, with its
placeholders filled in. *)
(* The fix a block lambda with no => is shown compiles, inside the call. *)
(match read "sort-by(xs, fn(a, b)\n a.n < b.n)" with
| _ -> fail "lambda in brackets: read"
| exception Loc.Error d ->
let header =
let m = d.Loc.dmsg in
let i = String.index m '=' + 2 in
let i = String.index m '\n' + 6 in
String.sub m i (String.index_from m i '\n' - i)
in
let header =
String.concat "C" (String.split_on_char 'T' header)
|> String.split_on_char 'R' |> String.concat "bool"
in
checks "lambda-fix.fln"
("struct C\n n: i32\n\nfn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n"
^ " let f = " ^ header ^ "\n a.n < b.n\n sort-by(slice(xs), f)\n xs[0].n\n"));
^ " sort-by(slice(xs), " ^ header ^ "\n a.n < b.n)\n xs[0].n\n"));
(* A typed block lambda inside a call, a closer on its own line, and one
nested in another's block. *)
checks "block-lambdas.fln"
("struct C\n n: i32\n\nfn app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)\n\n"
^ "fn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n"
^ " sort-by(slice(xs), fn(a: C, b: C) -> bool =>\n let d = a.n - b.n\n d < 0)\n"
^ " let k = app(2, fn(a) =>\n let b = app(a, fn(c) =>\n c * 10\n )\n b + 1)\n"
^ " i32(k) + xs[0].n\n");
refused "cfn-captures.fln"
"fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) = k)\n"
"fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) => k)\n"
[ "so it is a Fn(Option(i32)) -> i32 and not a CFn(Option(i32)) -> i32" ];
refused "defvar.fln" "defvar(x, 1)\n\nfn main() -> i32 = 0\n"
[ "once x = 1 initialises once"; "def x = 1 re-initialises" ]