.fln has let groups, grid[r c] indices and a not prefix, and a binding lines up under the let's first name.

This commit is contained in:
Joseph Ferano 2026-09-26 13:01:34 +07:00
commit 1243504ac6
13 changed files with 875 additions and 141 deletions

View File

@ -689,29 +689,10 @@ 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
space-separated single values; commas always work; an index with a bare operator
needs them, ~grid[r + 1, c]~.
** WAIT Calls without parentheses
Held 2026-09-26 by the author: F#-style ~f x y~ or Nim-style one-argument calls
without parentheses. Collides with space-separated vector and index elements.
** TODO RET inside an open call puts the closer at the statement's column
In a .fln buffer, ~if and(state.paused|)~ then RET leaves ~)~ at the ~if~'s column, so
the next argument cannot be typed where it belongs. A line inside open brackets,
closer-led or not, goes to the continuation column (aligned after the opening bracket).
** NEXT not is a prefix word
Decided 2026-09-26: .fln writes ~not x~ (binding like F#'s ~not~, tighter than
~and~/~or~, looser than comparisons); ~not(x)~ keeps working as a call.
** NEXT A let takes several bindings on indented lines
Decided 2026-09-26: lines indented under a ~let~ that are ~name = v~ or ~name: T = v~ are
more bindings of the same let; anything else there stays refused. flan convert writes
consecutive lets this way.
** DONE .fln has no loop or recur (decision 122)
Rules out ~loop~/~recur~ anywhere the .fln reader reads, ~quote~ included; loops are
~while~/~until~/~dotimes~/~for~. The Lisp syntax and its macros' expansions keep them.

View File

@ -1197,7 +1197,7 @@ Use `C-c C-g` if you need frames.
| `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 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-e` | same | the statement at point with its body and clauses, or the region's whole lines; on a `let` or one of its binding lines, the `let`, its bindings 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. 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). 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 |
| `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). After a `let` line, the column under its first name is offered second, for its next binding (`let a = 1` and `b = 2` under `a`); after such a binding line it comes first, and `DEL` steps out to the `let`'s column. 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. Inside open brackets, under the first element after the opener, or one level in from the opener's line when it ends that line; a line that starts with the closer goes there too, so `RET` in `and(a|)` leaves room for the next argument. The closer of a bracket that holds a lambda's block goes to the call's column |
| `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. 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.
- **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. A `let`'s binding lines, lined up under its first name, belong to the `let`. 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.

View File

@ -479,11 +479,56 @@ on its line, which is not the statement's."
(or (flan-fln--prev-code bol) (flan-fln--next-code bol))
bol)))
(defun flan-fln--let-line-p (l)
"Non-nil if the line L starts with `let', at any column."
(save-excursion (goto-char (flan-fln--first-char l)) (looking-at "let[ \t]")))
(defun flan-fln--binding-column (l)
"The column of the first name on the `let' line L: where the let's other
bindings line up. Nil when a tab sits before the name: a tab has no one
width, and the reader refuses it there."
(save-excursion
(goto-char (flan-fln--first-char l))
(skip-chars-forward "let")
(let ((from (point)))
(skip-chars-forward " \t")
(unless (save-excursion (search-backward "\t" from t))
(current-column)))))
(defun flan-fln--binding-shape-p (l &optional global)
"Non-nil if the joined line L reads as a binding: a name, `~x', a
`[...]' or `{...}' pattern or `(not)', then ` = ' or `: T = '. With
GLOBAL, a top-level let's line, `: T' alone too."
(save-excursion
(goto-char (flan-fln--first-char l))
(let ((end (flan-fln--joined-end l)))
(cond
((looking-at "[[{(]")
(let ((c (ignore-errors (scan-lists (point) 1 0))))
(and c (<= c end)
(progn (goto-char c) (looking-at "[ \t]+=\\(?:[ \t]\\|$\\)")))))
((looking-at "~?[^][ \t\n(){},;\":.~][^][ \t\n(){},;\":.]*\\(?:\\([ \t]+=\\(?:[ \t]\\|$\\)\\)\\|:[ \t]\\)")
(or (match-beginning 1) global
(flan-fln--find-top "[ \t]=\\(?:[ \t]\\|$\\)" (match-end 0) end)))))))
(defun flan-fln--binding-let (l)
"The `let' line whose binding the joined line L is, or nil.
Lines indented under a let whose value ends on its line are more bindings
of it (lib/indent_reader.ml's `binding_lines'), lined up with its first
name."
(and (not (flan-fln--continuation-p l))
(let ((p (flan-fln--parent l)))
(and p (flan-fln--let-line-p p)
(flan-fln--binding-shape-p l (zerop (flan-fln--indent-at p)))
(not (flan-fln--opener-p p (flan-fln--logical-end p)))
p))))
(defun flan-fln--line-statement (pos)
"The first line of the statement POS's line starts or continues.
A clause line answers for itself."
A clause line answers for itself; a let's binding line gives the let."
(let ((l (flan-fln--code-line-at pos)))
(and l (flan-fln--logical-start l))))
(and l (let ((s (flan-fln--logical-start l)))
(or (flan-fln--binding-let s) s)))))
(defun flan-fln--statement-start-at (pos)
"The first line of the statement at POS; a clause gives its header's."
@ -791,6 +836,9 @@ forms, where the clause line itself is not."
(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))
;; A let's binding line starts no form; its value is what runs there.
((let ((raw (flan-fln--logical-start (flan-fln--code-line-at pos))))
(and (flan-fln--binding-let raw) (flan-fln--binding-value raw))))
(t (let ((s (flan-fln--statement-start-at pos)))
(and s (or (flan-fln--merged-let-value s)
(flan-fln--statement-bounds s))))))))
@ -802,11 +850,19 @@ The reader merges consecutive lets into one binding vector, so a second
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))))))
(flan-fln--binding-value s))))
(defun flan-fln--binding-value (s)
"Bounds of the value the binding line S binds: after its `=' on the line,
or the block under it."
(let ((v (flan-fln--value-start s))
(end (flan-fln--joined-end s)))
(cond ((not (and v (< v end))) (flan-fln--body-bounds s))
;; `= match x', a lambda header: the value takes the lines under it.
((flan-fln--opener-p s (flan-fln--logical-end s))
(cons v (cdr (flan-fln--statement-bounds s))))
;; Otherwise the lines under a let are its other bindings.
(t (cons v end)))))
(defun flan-fln--clause-target (l)
"What a clause line L stops at: an elif's condition, else its block.
@ -1021,9 +1077,10 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does."
(skip-chars-backward " \t\n" first) (point))))))
(defun flan-fln--let-p (start)
"Non-nil if START's statement is a `let'.
"Non-nil if START's statement is a local `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."
header) or more bindings of it, and its names last to the end of the block
it is in."
(and (> (flan-fln--indent-at start) 0)
(save-excursion (goto-char (flan-fln--first-char start))
(looking-at "let[ \t]"))))
@ -1291,10 +1348,44 @@ whose brackets have closed is no block POS can join."
(unless (eql min 0) (push (cons 0 nil) out))
(nreverse out)))
(defun flan-fln--open-ended-p (l)
"Non-nil if the joined line L ends in a block still open at its end: a
trailing `fn(x) =>', `= match x', `= if c', `x =' or `f():', and not a
block lambda inside brackets, whose block closes with them."
(let ((last (flan-fln--logical-end l)))
(and (flan-fln--opener-p l last)
(= (car (save-excursion (syntax-ppss (flan-fln--code-end last))))
(car (save-excursion (syntax-ppss (flan-fln--first-char l))))))))
(defun flan-fln--bindings-ended-p (l)
"Non-nil if the line L, on a block column above, is a let's binding whose
value ended in an open block, so no binding and no clause may follow at its
column. An `if', `handler-case', `handler-bind' or `restart-case' value
still takes a clause there, and so does the line after an `elif', `on' or
`restart'; after an `else', nothing does."
(save-excursion
(goto-char (flan-fln--first-char l))
(cond
((flan-fln--clause-line-p l)
(and (looking-at "else\\_>")
(let ((h (flan-fln--clause-header l)))
(and (not (eq h l)) (flan-fln--binding-let h) (flan-fln--open-ended-p h)))))
(t (and (flan-fln--binding-let l) (flan-fln--open-ended-p l)
(let ((v (flan-fln--value-start l)))
(not (and v (progn (goto-char v)
(looking-at "\\(?:if\\|handler-case\\|handler-bind\\|restart-case\\)\\_>"))))))))))
(defun flan-fln--levels (pos)
"Columns TAB offers POS's line outside brackets, deepest first."
"Columns TAB offers POS's line outside brackets, deepest first.
Not the column of a let's binding whose value ended in an open block: that
block ends the let's bindings (lib/indent_reader.ml's `binding_lines'), and
the reader refuses any line there."
(let* ((prev (flan-fln--prev-code pos))
(stack (mapcar #'car (flan-fln--stack pos))))
(stack (mapcar #'car
(seq-remove (lambda (e)
(and (cdr e) (flan-fln--bindings-ended-p (cdr e))))
(flan-fln--stack pos))))
(owner (and prev (flan-fln--outside-block (flan-fln--logical-start prev) pos))))
(cond
;; A lambda's block goes under the line its `=>' ends, which may be a
;; line of a call wrapped inside its brackets.
@ -1304,6 +1395,15 @@ whose brackets have closed is no block POS can join."
(cons (+ (flan-fln--indent-at (flan-fln--logical-start prev))
flan-fln-indent-offset)
stack))
;; After a let's line, its next binding's column too, lined up with
;; its first name -- second, so RET after a let stays at its column.
;; After a binding line, that column is on the stack, first.
;; A block lambda whose brackets closed on the line above counts as
;; that let's line: its block is shut, and a binding may follow.
((and owner (flan-fln--let-line-p owner) (not (flan-fln--open-ended-p owner)))
(let ((b (flan-fln--binding-column owner)))
(if (or (null b) (memq b stack)) stack
(cons (car stack) (cons b (cdr stack))))))
(t stack))))
(defun flan-fln--block-levels (pos)
@ -1337,14 +1437,32 @@ brackets, which the reader refuses."
(car e))))
(flan-fln--stack pos)))))
(defun flan-fln--holds-block-p (open pos)
"Non-nil if a line between OPEN and POS's line ends in a `=>' directly
inside the bracket at OPEN: a lambda's block the bracket holds."
(save-excursion
(let ((bol (flan-fln--bol pos)) hit)
(goto-char open)
(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))
(eql (nth 1 (save-excursion (syntax-ppss (- end 2)))) open))
(setq hit t)))
(forward-line 1))
hit)))
(defun flan-fln--bracket-column (open)
"The column a line inside the bracket at OPEN goes to.
Under the first element when one follows the bracket on its line, one level
in from that line when none does -- the paren mode's rule for data and
calls alike. A line that starts with the closing bracket goes to the
opening line's column."
calls alike. A line that starts with the closing bracket goes there too, so
RET before the `)' of `and(a|)' leaves room to type the next argument where
it belongs. The one exception is the closer of a bracket that holds a
lambda's block: it ends that block, and goes to the opening line's column."
(save-excursion
(let ((closing (save-excursion (back-to-indentation) (looking-at "\\s)"))))
(let ((closing (and (save-excursion (back-to-indentation) (looking-at "\\s)"))
(flan-fln--holds-block-p open (point)))))
(goto-char open)
(if closing
(current-indentation)

View File

@ -173,6 +173,16 @@ comment():
0
let x = 3
twice(x) + 1
fn grp(k: i64) -> i64
let a = k + 1
b = a * 2
a + b
comment():
let u = 2
v = u * 5
u + v
")
(defun test-flan-fln-live--run (backend args)
@ -248,6 +258,12 @@ comment():
(test-flan--check (funcall name "C-c C-e on a bare let sends its scope with it")
(funcall shows "13"))
;; A let's bindings on the lines under it go with it, and read.
(funcall goto "v = u * 5")
(flan-fln-eval-statement)
(test-flan--check (funcall name "C-c C-e on a binding line sends its let's group and scope")
(funcall shows "12"))
;; A region of several statements reads as one (do ...).
(funcall goto "twice(4)")
(transient-mark-mode 1)
@ -411,7 +427,8 @@ comment():
("while y != 0" "a while, at its word")
("let r = x % y" "a while's block")
("until i > n" "an until, at its word")
("acc += i" "an until's block")))
("acc += i" "an until's block")
("b = a * 2" "a binding under a let, 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"

View File

@ -437,6 +437,40 @@ fn twice(n: i64) -> i64 = n * 2
(test-flan-fln--is "a free parenthesis marks the value inside it"
(plist-get r :pause) '(2 6))))
;;; A let's bindings on the lines under it
(defconst test-flan-fln--group
"fn f(p) -> i64
let a = 1
b = a + 1
{x .x} = p
g(a, b)
a + x
")
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "b = a")
(test-flan-fln--is "a binding line is part of its let's statement"
(test-flan-fln--thing 'flan-fln-statement)
"let a = 1\n b = a + 1\n {x .x} = p"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "{x .x}")
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
(test-flan-fln--is "C-c C-e on a binding line sends the group and its scope"
(test-flan-fln--sent-code r)
"let a = 1\n b = a + 1\n {x .x} = p\n g(a, b)\n a + x")))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "a + 1")
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
(test-flan-fln--is "C-u C-c C-c on a binding line marks its value"
(plist-get r :pause) '(3 11))))
(test-flan-fln--in (test-flan-fln--at "fn f()\n let a = 1\n (not) = 2\n g()\n" "(not)")
(test-flan-fln--is "a name in parentheses is a binding line"
(test-flan-fln--thing 'flan-fln-statement) "let a = 1\n (not) = 2"))
(test-flan-fln--in (test-flan-fln--at "let a: i32\n b: i64\n" "b:")
(test-flan-fln--is "a typed global with no value is one under a top-level let"
(test-flan-fln--thing 'flan-fln-statement) "let a: i32\n b: i64"))
(test-flan-fln--in (test-flan-fln--at "fn f()\n let f = fn(x) =>\n y = x\n y\n f\n" "y = x")
(test-flan-fln--is "a line of a lambda value's block is no binding"
(test-flan-fln--thing 'flan-fln-statement) "y = x"))
;;; Match arms, header lines, clauses, comments
(defconst test-flan-fln--arms
@ -883,12 +917,48 @@ defconst(k, 3)
(test-flan-fln--tabs " paint-at(i32(m.y) / cell-size,\n|i32(m.x))" 1) 11)
(test-flan-fln--is "inside a bracket with nothing after it, one level in"
(test-flan-fln--tabs " let v = [\n|1 2]" 1) 4)
(test-flan-fln--is "a closing bracket, at its opening line's column"
(test-flan-fln--tabs " let v = [\n 1 2\n|]" 1) 2)
(test-flan-fln--is "a closing bracket, at the bracket's own column"
(test-flan-fln--tabs " let v = [\n 1 2\n|]" 1) 4)
(test-flan-fln--is "a closer after RET in an open call, under the first argument"
(test-flan-fln--tabs " if and(state.paused\n|)" 1) 9)
(test-flan-fln--in "fn f()\n if and(state.paused|)\n"
(newline-and-indent)
(test-flan-fln--is "RET before the closer puts it under the first argument"
(list (current-indentation) (char-after)) '(9 ?\))))
(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)
(test-flan-fln--is "TAB after a let stays at its column first"
(test-flan-fln--tabs "fn f()\n let a = 1\n|" 1) 2)
(test-flan-fln--is "and offers its next binding's column, under the first name"
(test-flan-fln--tabs "fn f()\n let a = 1\n|" 2) 6)
(test-flan-fln--is "after a binding line, that column comes first"
(test-flan-fln--tabs "fn f()\n let a = 1\n b = 2\n|" 1) 6)
(test-flan-fln--is "and a binding written there stays"
(test-flan-fln--tabs "fn f()\n let a = 1\n| b = 2" 1) 6)
(test-flan-fln--is "at the top level too"
(test-flan-fln--tabs "let a = 1\n|" 2) 4)
(dolist (c '(("fn f()\n let a = 0\n g = fn(x) =>\n x + 1\n|" (8 2 0) "a lambda's block")
("fn f()\n let a = 1\n b = match a\n 1 -> 2\n|" (8 2 0) "a match's arms")
("let a = 0\n g = fn(x) =>\n x + 1\n|" (6 0) "a global's lambda block")
("fn f()\n let a = 1\n g = map(xs, fn(x) =>\n x + 1)\n|" (6 2 0)
"but a lambda's brackets closed, where the column stays")
("fn f(c)\n let a = 1\n b = if c\n 1\n else\n 2\n|" (8 2 0)
"an if's else block")
("fn f(c)\n let a = 1\n b = if c\n 1\n|" (8 6 2 0)
"but an if's block, where its else may go")
("fn f(c, d)\n let a = 1\n b = if c\n 1\n elif d\n 2\n|" (8 6 2 0)
"and an elif's block, where another clause may go")
("fn f()\n let g = map(xs, fn(x) =>\n x + 1)\n|" (2 6 0)
"a first binding's bracketed lambda offers the column")))
(test-flan-fln--is (format "no binding column after a binding's open block: %s" (nth 2 c))
(test-flan-fln--in (car c) (flan-fln--block-levels (point)))
(cadr c)))
(test-flan-fln--is "but not after a tab between let and its name"
(list (test-flan-fln--tabs "fn f()\n let\ta = 1\n|" 1)
(test-flan-fln--tabs "fn f()\n let\ta = 1\n|" 2))
'(2 0))
(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")

View File

@ -1449,8 +1449,53 @@ and let_lines n prs body =
| first :: more -> Source_text.tag t.loc.Loc.line first :: more
| [] -> []
in
(* A let whose body starts with another is one run of bindings: the reader
merges the two back whichever way they are written. *)
let rec absorb prs body =
match body with
| x :: rest when let_sugar x && !quasi = 0 ->
(match if rest = [] then Some x else flatten x rest with
| Some { v = Form.List (_ :: { v = Form.Vec bs; _ } :: inner); _ } ->
(match pairs bs with
| Some ps -> absorb (prs @ ps) inner
| None -> (prs, body))
| _ -> (prs, body))
| _ -> (prs, body)
in
let prs, body = absorb prs body in
let lines n b = let p, v = bind b in tagged b (value_lines n p v) in
List.concat_map (lines n) prs @ block n body
(* A binding that fits a line with a short value joins a group: the ones
after the first go on the lines under it, lined up with its name. *)
let short n b =
let p, v = bind b in
match value_lines n p v with
| [ l ] when String.length (at 0 v) <= 40 && not (!inside v) -> Some (tagged b [ l ])
| _ -> None
in
let under b =
let p, v = bind b in
let p = String.sub p 4 (String.length p - 4) in
match value_lines (n + 4) p v with
| [ l ] when String.length (at 0 v) <= 40 && not (!inside v) -> Some (tagged b [ l ])
| _ -> None
in
let rec emit = function
| [] -> []
| b :: rest ->
(match short n b with
| None -> lines n b @ emit rest
| Some first ->
let rec group acc = function
| b' :: rest' as all ->
(match under b' with
| Some l -> group (acc @ l) rest'
| None -> (acc, all))
| [] -> (acc, [])
in
let more, rest = group [] rest in
first @ more @ emit rest)
in
emit prs @ block n body
(* A .flan file that uses [loop] or [recur] has no indented spelling: the
indented syntax loops with [while], [until], [dotimes] and [for]. The

View File

@ -311,6 +311,73 @@ let lex ?(line = 1) ?(col = 1) ~file src : token list =
(* ── Layout ────────────────────────────────────────────────────────── *)
(* The text being read, so that a message quotes what the user wrote rather
than the paren form it became. Set for the length of one [read_all]. *)
let source : (string * string array) ref = ref ("", [||])
(* Line [l] of the text being read, trimmed, and the column its text starts
at. *)
let source_line l =
let _, lines = !source in
if l < 1 || l > Array.length lines then ("", 1)
else
let t = lines.(l - 1) in
let n = String.length t in
let rec first i = if i < n && t.[i] = ' ' then first (i + 1) else i in
(String.trim t, first 0 + 1)
(* A line under a let that is not at its first name's column [name_col]:
the fix is the let's line and this one, lined up. *)
let let_misaligned loc ~let_line ~name ~name_col =
let lt, lc = source_line let_line in
let bt, _ = source_line loc.Loc.line in
failk "let-align" loc
"this line starts at column %d, under the let on line %d, whose bindings \
line up with its first name, %s, at column %d. Move it to column %d:\n\n\
\ %s\n %s%s"
loc.Loc.col let_line name name_col name_col lt
(String.make (max 0 (name_col - lc)) ' ') bt
(* A line at a let's first name's column, after a value that took the
lines under the let: it is the value's, not one more binding. *)
let let_after_block loc ~let_line ~name =
let bt, _ = source_line loc.Loc.line in
failk "let-after-block" loc
"this line lines up as one more binding of the let on line %d, after %s, \
whose value is the block above it. A binding whose value is a block ends \
its let's bindings, so this one needs a let of its own, at that let's \
column:\n\n let %s"
let_line name bt
(* Whether the tokens from [i] start a line shaped as a binding: [name =],
[name:], a [[...]], [{...}] or [(op)] pattern, or [~x]. The alignment
advice is for such lines only; any other line under a let is some other
mistake. *)
let binding_shaped (arr : token array) i =
let n = Array.length arr in
let at k = if i + k < n then arr.(i + k).tok else EOF in
match at 0, at 1 with
| NAME s, (NAME "=" | COLON) -> s <> "" && s.[0] <> '.'
| (LB | LC | LP | UNQ), _ -> true
| _ -> false
(* A tab between [let] and its first name: the bindings under the let line
up with that name, and a tab has no one width to line up with. *)
let let_gap_tab (t : token) (nm : token) =
if t.loc.Loc.eline = nm.loc.Loc.line then begin
let _, lines = !source in
if nm.loc.Loc.line <= Array.length lines then
let line = lines.(nm.loc.Loc.line - 1) in
let a = t.loc.Loc.ecol - 1 and b = nm.loc.Loc.col - 1 in
if a >= 0 && b <= String.length line && b > a
&& String.contains (String.sub line a (b - a)) '\t' then
failk "tab" t.loc
"there is a tab between let and %s. The bindings under a let line up \
with its first name, and a tab has no one width, so put a space \
there: let %s"
(show nm.tok) (show nm.tok)
end
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
@ -474,6 +541,27 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
| _ -> ()
in
pop ();
(* Between a let's column and the block under it: a binding
meant for that let, if the let owns the block. *)
(if col <> List.hd !stack then
let first_on_line j =
j = 0 || arr.(j - 1).loc.Loc.eline < arr.(j).loc.Loc.line
in
let rec owner j =
if j < 0 then None
else if first_on_line j && arr.(j).loc.Loc.col <= List.hd !stack then
Some j
else owner (j - 1)
in
match owner (i - 1) with
| Some j when arr.(j).tok = NAME "let" && j + 1 < n
&& arr.(j).loc.Loc.col = List.hd !stack
&& binding_shaped arr i ->
let nm = arr.(j + 1) in
let let_line = arr.(j).loc.Loc.line and name = show nm.tok in
if col = nm.loc.Loc.col then let_after_block t.loc ~let_line ~name
else let_misaligned t.loc ~let_line ~name ~name_col:nm.loc.Loc.col
| _ -> ());
if col <> List.hd !stack then
failk "dedent" t.loc
"this line starts at column %d, between the block at column \
@ -644,12 +732,27 @@ let expect_name p s ~what =
| NAME n when n = s -> ignore (advance p)
| t -> failk "expected" (where_ p) "expected %s here, and found %s" what (show t)
(* The lets whose first value is being read, innermost first: the column
of the let's first name, the name, and the let's line. A line at that
column under the value's block looks like one more binding and is not. *)
let let_values : (int * string * int) list ref = ref []
(* 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);
(match (peek p).tok, !let_values with
| INDENT, (name_col, name, let_line) :: _ ->
let t = peek_at p 1 in
let shaped =
match t.tok, (peek_at p 2).tok with
| NAME _, (NAME "=" | COLON) | (LB | LC | LP | UNQ), _ -> true
| _ -> false
in
if t.loc.Loc.col = name_col && shaped then let_after_block t.loc ~let_line ~name
| _ -> ());
if (peek p).tok = INDENT then
failk "stray-indent" (peek_at p 1).loc
"this line is indented under %s, which takes no block. A call takes \
@ -663,6 +766,10 @@ let expect_eol p ~after =
| EOF -> ()
| _ -> stray p ~after
(* A target's first token, for a message: [(not)] is shown whole. *)
let text_of_tok (t : token) =
match t.tok with LP -> "the name in parentheses" | tk -> show tk
let check_name (t : token) s =
if String.contains s ':' then
failk "colon-in-name" t.loc
@ -674,9 +781,6 @@ let check_name (t : token) s =
| None -> s)
(* A form's own text, for the "after" half of a message. *)
(* The text being read, so that a message quotes what the user wrote rather
than the paren form it became. Set for the length of one [read_all]. *)
let source : (string * string array) ref = ref ("", [||])
let text_of (f : Form.t) =
let file, lines = !source in
@ -867,7 +971,7 @@ and postfix p =
loop (mk p l0 (Form.List (f :: args)), 12)
| LB ->
ignore (advance p);
let idx = items p RB t.loc ~what:"indices" ~head:(text_of f) in
let idx = index_items p t.loc ~head:(text_of f) in
loop (mk p l0 (Form.List (sym t.loc "at" :: f :: idx)), 12)
| NAME s when String.length s > 1 && s.[0] = '.' ->
ignore (advance p);
@ -909,6 +1013,30 @@ and primary p : Form.t * int =
ignore (advance p);
(sym l0 (op_sym s), 13)
end
else if s = "not" && nxt.sp && starts_value nxt.tok then begin
(* [a == not b]: [not] binds looser than the operator before it, so
it cannot start that operator's right side. The fix is the line
with the [not] and its operand in parentheses. *)
ignore (advance p);
let x, _ = not_ p in
let e = (last p).loc in
let _, lines = !source in
let fix =
if e.Loc.eline <> l0.Loc.line || l0.Loc.line > Array.length lines then
"(not " ^ text_of x ^ ")"
else
let line = lines.(l0.Loc.line - 1) in
let a = l0.Loc.col - 1 and b = e.Loc.ecol - 1 in
String.trim
(String.sub line 0 a ^ "(" ^ String.sub line a (b - a) ^ ")"
^ String.sub line b (String.length line - b))
in
failk "not-operand" l0
"not follows an operator here, and it binds looser than any \
operator but and and or, so it cannot start that operator's right \
side. Put it in parentheses with what it negates:\n\n %s"
fix
end
else
failk "operator-operand" l0
"%s is an operator, and nothing is on its left. As a value on its \
@ -1144,8 +1272,7 @@ 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. *)
(* [head] is the text of what is indexed, for [[ ]]'s message. *)
and items ?head p closer open_loc ~what =
and items p closer open_loc ~what =
let opener = if closer = RB then '[' else '(' in
let rec go acc =
let t = peek p in
@ -1176,15 +1303,77 @@ and items ?head 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: %s"
commas: f(a, b)"
(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 []
(* An index's values, [grid[r c]] or [grid[r + 1, c]]: separated as a
vector's elements are, by commas or, between single values only, by
spaces. The whole list is read before a mistake is named, so the fix can
be the index as written, commas put in. [head] is the text of what is
indexed. *)
and index_items p open_loc ~head =
let rec go acc =
let t = peek p in
match t.tok with
| RB -> ignore (advance p); List.rev acc
| EOF -> unclosed p '[' open_loc
| _ ->
let e, lvl = expr p in
(* The element as written, parentheses and all. *)
let src = text_of (Form.make (Form.Sym "") (span p t.loc)) in
let n = peek p in
match n.tok with
| COMMA -> ignore (advance p); go ((e, src, lvl, t.loc, Some n.loc) :: acc)
| RB -> ignore (advance p); List.rev ((e, src, lvl, t.loc, None) :: acc)
| EOF -> unclosed p '[' open_loc
(* [grid[i -1]]: most likely [i - 1] with its minus glued. *)
| (ATOM _ | NEG) when n.sp && (negative_literal n.tok || n.tok = NEG) ->
let x, _ = unary p in
let digits =
let s = text_of x in String.sub s 1 (String.length s - 1)
in
failk "glued-minus" n.loc
"%s is read as the value %s, right after %s with nothing between \
the minus and it. To subtract, space the minus: %s[%s - %s]. For \
two indices, separate them with a comma: %s[%s, %s]"
(text_of x) (text_of x) src head src digits head src (text_of x)
| tk when starts_value tk && n.sp -> go ((e, src, lvl, t.loc, None) :: acc)
| _ -> stray p ~after:(text_of e)
in
let xs = go [] in
let commas = List.exists (fun (_, _, _, _, c) -> c <> None) xs in
let spaces =
List.exists (fun (_, _, _, _, c) -> c = None) (match List.rev xs with _ :: r -> r | [] -> [])
in
let with_commas () =
Printf.sprintf "%s[%s]" head
(String.concat ", " (List.map (fun (_, s, _, _, _) -> s) xs))
in
if commas && spaces then begin
let at = match List.find_opt (fun (_, _, _, _, c) -> c <> None) xs with
| Some (_, _, _, _, Some l) -> l | _ -> open_loc
in
failk "mixed-separators" at
"these indices are separated some with commas and some with only \
spaces. Use one: %s%s"
(with_commas ())
(if List.for_all (fun (_, _, l, _, _) -> l >= 11) xs then
Printf.sprintf " or %s[%s]" head
(String.concat " " (List.map (fun (_, s, _, _, _) -> s) xs))
else "")
end;
(match List.find_opt (fun (_, _, l, _, _) -> l < 11) xs with
| Some (_, src, _, at, _) when spaces ->
failk "separate-elements" at
"%s has an operator in it and sits among indices separated by spaces, \
where only single values are. Separate the indices with commas: %s"
src (with_commas ())
| _ -> ());
List.map (fun (e, _, _, _, _) -> e) xs
(* [[a b c]] or [[a, b + 1]]: whitespace separates only single terms. *)
and vec_items p open_loc =
(* One separator per bracket: [1 2, 3] mixes them, and which elements the
@ -1545,10 +1734,27 @@ and value_line ?(block_ok = false) (s : st) ~after : Form.t =
| Form.List items -> mk p e.loc (Form.List (items @ body))
| _ -> mk p e.loc (Form.List (e :: body)))
| COMMA ->
failk "one-binding" (peek p).loc
let c = (peek p).loc in
(* On a let's line, the fix is the let's group: the rest of the line
under the first name. *)
let group =
let file, lines = !source in
if c.Loc.file <> file || c.Loc.line > Array.length lines then None
else
let line = lines.(c.Loc.line - 1) in
let head = String.trim (String.sub line 0 (c.Loc.col - 1)) in
let rest = String.trim (String.sub line c.Loc.col (String.length line - c.Loc.col)) in
if String.length head > 4 && String.sub head 0 4 = "let " && rest <> "" then
Some (Printf.sprintf ":\n\n %s\n %s" head rest)
else None
in
failk "one-binding" c
"%s is followed by a comma, and one line binds one name. Put each \
binding on its own line, one after the other"
binding on its own line%s"
(text_of e)
(match group with
| Some g -> ", the ones after the first under its name" ^ g
| None -> ", one after the other")
| _ -> lambda_block ~block_ok s e ~after:(text_of e)
(* Whether this line has a [then] at depth zero: a one-line if. *)
@ -1572,9 +1778,10 @@ and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after =
else expect_eol p ~after;
e
and let_stmt (s : st) : Form.t list =
(* One binding of a let, [x = v], [x: T = v] or [{a .x} = p], through the
end of its line (and the block its value takes). *)
and binding (s : st) : Form.t * Form.t =
let p = s.p in
let t = advance p in
let target, _ = unary p in
(* [let x: T = v] is [(let [x (the T v)])]: a let binding has no type slot
of its own, and [the] is the form that says what a value is. *)
@ -1595,6 +1802,103 @@ and let_stmt (s : st) : Form.t list =
Form.make (Form.List [ sym tyf.loc "the"; tyf; v ]) (span p tyf.loc)
| None -> v
in
(target, v)
(* The lines indented under a let, each one more binding of it: [let a = 1]
and under it [b = a + 1], lined up with [a]. Anything else there is
refused; [first] is the let's first target, for the message. *)
and binding_lines : 'a. ?global:bool -> st -> first:Form.t -> name_col:int -> one:(unit -> 'a) -> 'a list =
fun ?(global = false) s ~first ~name_col ~one ->
let p = s.p in
if (peek p).tok <> INDENT then []
else begin
ignore (advance p);
let misaligned (t : token) =
let_misaligned t.loc ~let_line:first.loc.Loc.line ~name:(text_of first)
~name_col
in
(* [block] is the binding before this line when its value ended in a
block still open at its end — a trailing [fn(x) =>], [match], [if],
[x =] or [f():] — which ends the let's bindings. A block lambda whose
brackets close after its block does not. *)
let rec go ?block acc =
match (peek p).tok with
| DEDENT -> ignore (advance p); List.rev acc
| EOF -> List.rev acc
| INDENT when binding_shaped p.toks (p.i + 1) -> misaligned (peek_at p 1)
| INDENT -> ignore (advance p); not_binding ()
| _ when binding_line ~global p ->
if (peek p).loc.Loc.col <> name_col then misaligned (peek p);
(match block with
| Some name -> let_after_block (peek p).loc ~let_line:first.loc.Loc.line ~name
| None -> ());
let t0 = peek p in
let x = one () in
(* The last token the value took, past its line's end. *)
let rec last_real k =
if k > 0 && p.toks.(k).tok = NEWLINE then last_real (k - 1) else k
in
let open_block = p.toks.(last_real (p.i - 1)).tok = DEDENT in
go ?block:(if open_block then Some (text_of_tok t0) else None) (x :: acc)
| _ -> not_binding ()
and not_binding () =
failk "let-block" (where_ p)
"this line is indented under let %s, and the only lines that go \
there are more bindings of the let, lined up with its first name:\n\n\
\ let a = 1\n b = a + 1\n\n\
A let's names last to the end of the block the let is in, so any \
other line after it goes at the let's column"
(text_of first)
in
go []
end
(* Whether the line at point is a binding: a name, a [[...]] or [{...}]
pattern, or an operator word in parentheses, [(not) = 3], then [=] or
[: T =]. [x += 1] and [f(x)] are not. A [global]'s line may be [x: T]
alone, as a top-level let's may. *)
and binding_line ?(global = false) p =
(* An [=] at the line's own depth, from token [k] on. *)
let rec eq k depth =
match (peek_at p k).tok with
| EOF | NEWLINE | INDENT | DEDENT -> false
| NAME "=" when depth = 0 -> true
| LP | LB | LC -> eq (k + 1) (depth + 1)
| RP | RB | RC -> eq (k + 1) (depth - 1)
| _ -> eq (k + 1) depth
in
match (peek p).tok with
| NAME s when s <> "" && s.[0] <> '.' && not (is_op_word s) ->
(match (peek_at p 1).tok with
| NAME "=" -> (peek_at p 1).sp
| COLON -> global || eq 2 0
| _ -> false)
(* [~g = a] in a template. *)
| UNQ -> eq 1 0
| LB | LC | LP ->
let rec close k depth =
match (peek_at p k).tok with
| EOF | NEWLINE -> false
| LP | LB | LC -> close (k + 1) (depth + 1)
| RP | RB | RC when depth = 1 -> (peek_at p (k + 1)).tok = NAME "="
| RP | RB | RC -> close (k + 1) (depth - 1)
| _ -> close (k + 1) depth
in
close 0 0
| _ -> false
and let_stmt (s : st) : Form.t list =
let p = s.p in
let t = advance p in
let_gap_tab t (peek p);
let name_col = (peek p).loc.Loc.col in
let (target, v) =
let_values := (name_col, text_of_tok (peek p), t.loc.Loc.line) :: !let_values;
Fun.protect ~finally:(fun () -> let_values := List.tl !let_values)
(fun () -> binding s)
in
let more = binding_lines s ~first:target ~name_col ~one:(fun () -> binding s) in
let own = List.concat_map (fun (a, b) -> [ a; b ]) ((target, v) :: more) in
let make bindings body =
let f =
mk p t.loc
@ -1609,17 +1913,10 @@ and let_stmt (s : st) : Form.t list =
match body with
| [ ({ Form.v = Form.List (_ :: { v = Form.Vec bs; _ } :: body); _ } as inner) ]
when List.memq inner s.lets ->
make (target :: v :: bs) body
| _ -> make [ target; v ] body
make (own @ bs) body
| _ -> make own body
in
(* A let has no block: its name lasts to the end of the block it is in. *)
if (peek p).tok = INDENT then
failk "let-block" (peek_at p 1).loc
"this line is indented under let %s, which takes no block. A let's \
name lasts to the end of the block the let is in, so the lines after \
it go at the let's column"
(text_of target)
else [ merged (stmts s) ]
[ merged (stmts s) ]
and stmt (s : st) : Form.t =
let p = s.p in
@ -1768,57 +2065,7 @@ and header (s : st) w : Form.t =
in
named (if w = "fn" then "defn" else "defn-")
(name :: Form.make (Form.Vec ps) lp.loc :: ret :: (where_clause @ body))
| "def" | "once" | "const" ->
(* A top-level [let] is read here too, as [def]: [w] is then "def" and
[t] the let. *)
let shown = match t.tok with NAME "let" -> "let" | _ -> w in
let name = name_tok p ~what:"the name being defined" in
let tyf =
match (peek p).tok with
| COLON -> ignore (advance p); Some (ty p)
| _ -> None
in
let v =
match (peek p).tok with
| NAME "=" ->
ignore (advance p);
Some (value_line s ~after:(shown ^ " " ^ text_of name ^ " ="))
| _ ->
expect_eol p ~after:(match tyf with Some f -> text_of f | None -> text_of name);
None
in
let head =
match w with "def" -> "def" | "once" -> "defonce" | _ -> "defconst"
in
if shown = "def" then
failk "def-is-let" l0
"a global is written with let, at the file's top level:\n\n let %s%s%s"
(text_of name)
(match tyf, v with
| Some t, _ -> ": " ^ text_of t
| None, None -> ": i32"
| None, Some _ -> "")
(match v, tyf with
| Some v, _ -> " = " ^ text_of v
| None, None -> " = 0"
| None, Some _ -> "");
let items =
match w, tyf, v with
| "const", None, Some v -> [ name; v ]
| "const", Some t, Some v -> [ name; t; v ]
| "const", _, None ->
failk "const-value" l0
"a const needs its value: const %s = 3" (text_of name)
| _, None, Some v -> [ name; sym name.loc "dyn"; v ]
| _, Some t, None -> [ name; t ]
| _, Some t, Some v -> [ name; t; v ]
| _, None, None ->
failk "def-empty" l0
"%s %s names neither a type nor a value. Give it one or both: %s %s: \
i32 = 0"
shown (text_of name) shown (text_of name)
in
named head items
| "def" | "once" | "const" -> def_form s w t l0
| "struct" | "union" ->
let name = name_tok p ~what:"the type's name" in
(* [struct Pt(x: i32, y: i32)]: the fields on the header's line, as a
@ -2314,6 +2561,68 @@ and header (s : st) w : Form.t =
named "quasiquote" [ e ])
| _ -> assert false
(* [let x = v] at the top level, [once x = v] or [const x = v], from the
name on: [t] is the word, and [l0] where the form starts. A top-level let
leaves the lines indented under it to [read_all], which reads each as one
more global. *)
and def_form (s : st) w (t : token) l0 : Form.t =
let p = s.p in
let named head items = mk p l0 (Form.List (sym l0 head :: items)) in
(* A top-level [let] is read here too, as [def]: [w] is then "def" and
[t] the let. *)
let shown = match t.tok with NAME "let" -> "let" | _ -> w in
let name = name_tok p ~what:"the name being defined" in
let tyf =
match (peek p).tok with
| COLON -> ignore (advance p); Some (ty p)
| _ -> None
in
let v =
match (peek p).tok with
| NAME "=" ->
ignore (advance p);
Some (value_line ~block_ok:(shown = "let") s
~after:(shown ^ " " ^ text_of name ^ " ="))
(* [let a: i32] with more globals under it. *)
| NEWLINE when shown = "let" && tyf <> None && (peek_at p 1).tok = INDENT ->
ignore (advance p); None
| _ ->
expect_eol p ~after:(match tyf with Some f -> text_of f | None -> text_of name);
None
in
let head =
match w with "def" -> "def" | "once" -> "defonce" | _ -> "defconst"
in
if shown = "def" then
failk "def-is-let" l0
"a global is written with let, at the file's top level:\n\n let %s%s%s"
(text_of name)
(match tyf, v with
| Some t, _ -> ": " ^ text_of t
| None, None -> ": i32"
| None, Some _ -> "")
(match v, tyf with
| Some v, _ -> " = " ^ text_of v
| None, None -> " = 0"
| None, Some _ -> "");
let items =
match w, tyf, v with
| "const", None, Some v -> [ name; v ]
| "const", Some t, Some v -> [ name; t; v ]
| "const", _, None ->
failk "const-value" l0
"a const needs its value: const %s = 3" (text_of name)
| _, None, Some v -> [ name; sym name.loc "dyn"; v ]
| _, Some t, None -> [ name; t ]
| _, Some t, Some v -> [ name; t; v ]
| _, None, None ->
failk "def-empty" l0
"%s %s names neither a type nor a value. Give it one or both: %s %s: \
i32 = 0"
shown (text_of name) shown (text_of name)
in
named head items
(* handler-case, handler-bind and restart-case take nothing on their own line. *)
and clause_header_end p w =
match (peek p).tok with
@ -2411,8 +2720,37 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
| EOF -> []
| DEDENT -> ignore (advance s.p); []
| NAME "let" when header_follow s.p "let" ->
let f = header s "def" in
f :: top ()
let t = peek s.p in
let_gap_tab t (peek_at s.p 1);
let name_col = (peek_at s.p 1).loc.Loc.col in
let f =
let_values := (name_col, text_of_tok (peek_at s.p 1), t.loc.Loc.line) :: !let_values;
Fun.protect ~finally:(fun () -> let_values := List.tl !let_values)
(fun () -> header s "def")
in
(* The lines indented under it are more globals, one each: a global
is one name, so a pattern there is refused. *)
let first = match f.v with Form.List (_ :: n :: _) -> n | _ -> f in
let more =
binding_lines ~global:true s ~first ~name_col ~one:(fun () ->
let l = peek s.p in
(match l.tok with
| LP ->
failk "global-pattern" l.loc
"a global's name is a plain name, and this line under let %s \
names an operator word in parentheses. Give the global \
another name"
(text_of first)
| LB | LC ->
failk "global-pattern" l.loc
"a global binds one name, and this line under let %s is a \
pattern. Bind the value to a name, and take it apart inside \
the function that uses it"
(text_of first)
| _ -> ());
def_form s "def" t l.loc)
in
f :: more @ top ()
| _ -> let f = stmt s in f :: top ()
in
let fs = if global_let then top () else stmts s in

View File

@ -145,6 +145,10 @@ Each item: the proposal, then the reason in one line.
the Lisp look for data and is refusable by shape. **Built** (in braces a
value may have an operator in it, `{.x a + 1, .y 2}`; the comma after it is
what is required).
- **Indices separate the same way.** `grid[r c]` and `grid[(r + 1) (c - 1)]`
are two indices each; `grid[r + 1, c]` needs its comma, and `grid[r + 1 c]`
is refused with the commas put in as the fix. `grid[i -1]` is refused as a
glued minus. **Built**; the printer writes indices with commas.
- **Struct literal:** `Vector2{.x 1, .y 2}` (brace glued to the name) reads
`(Vector2 {.x 1 .y 2})`. A bare `{.x 1}` is today's bare literal. `{:a 1}` is a
dyn map. **Built.**
@ -194,6 +198,8 @@ Each item: the proposal, then the reason in one line.
is `(get m :k)` and `m[:k] = v` puts. The paren spellings `(.name x)` and
`(at m :k)` mean the same. **Built.**
- **`and`, `or`, `not` are words**, since they are Flan's own names. **Built.**
`not` is a prefix word: `not a == b` is `not (a == b)`, `not a and b` is
`(not a) and b`, and `not(x)`, glued, is the call.
- **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`,
`max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type
called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.**
@ -202,9 +208,30 @@ Each item: the proposal, then the reason in one line.
- **`let x = v`** scopes to the end of its block and reads as
`(let [x v] rest…)`. Consecutive `let`s merge into one binding vector.
A `let` is always flat: a line indented deeper under `let x = v` is
refused. To end a `let`'s scope early, put it in a `do:` block.
The printer writes every `let` flat. A `let` with statements after it
A `let` takes more bindings on the lines indented under it, lined up with
its first name, each seeing the ones above:
```
let row = r + 1
col: i32 = c - 1
{x .x} = p
```
is `(let [row (+ r 1) col (the i32 (- c 1)) {x .x} p] rest…)`. A name
that is an operator word is written in parentheses, `(not) = 3`. A
binding at another column than the first name, or any other line indented
there, is refused, and so is a tab between `let` and its first name. A
binding whose value is a block (`= match x`, a lambda header, `=` and the
lines under it) is its let's last; the printer starts a new `let` after
one. A block lambda whose brackets close after its block,
`g = map(xs, fn(x) =>` over `x + 1)`, is not: its block is shut when the
value ends, and more bindings may follow. At the top level each such line is one more global, `(def col i32 …)`,
and may be `name: T` alone as a global's own line may; a pattern there is
refused, since a global binds one name. A `let` is otherwise flat: its scope is the rest of its
block. To end it early, put it in a `do:` block.
The printer writes every `let` flat, and a run of bindings whose values
are short (one line, 40 characters or fewer) as one `let` with the rest
under the first name; top-level globals stay one `let` each. A `let` with statements after it
takes them into its body; when one of them means an outer name the `let`
rebinds, the `let`'s is renamed (`x` to `x-2`, a name the top-level form
does not use; a struct pattern is written as `{x-2 .x}` pairs). A macro's

View File

@ -25,8 +25,8 @@ fn flush(field: Ptr(Vec(u8)), row: Ptr(Vec(str))) -> ()
fn parse-line(line: [const u8]) -> Vec(str)
let row = vec-new(str)
let field = vec-new(u8)
let state = State.start
field = vec-new(u8)
state = State.start
for i in range(length(line))
let c = line[i]
match state

View File

@ -61,7 +61,7 @@ fn eval-form(e, env) -> dyn
last
_ ->
let f = eval(op, env)
let arg = eval(e[1], env)
arg = eval(e[1], env)
eval(get(f, :body), extend(get(f, :env), get(f, :param), arg))
fn run(program) -> ()

View File

@ -40,8 +40,8 @@ fn show(l: Light) -> str
; whoever handles it may reset the light to red.
fn run(ticks: i32, presses: [const i32], fault-at: i32) -> ()
let l = Light.Red{.left 1, .walk false}
let p = 0
let t = 0
p = 0
t = 0
until :clock t >= ticks
let pressed = p < length(presses)
and presses[p] == t

View File

@ -18,9 +18,9 @@ fn letter?(c: u8) -> bool
; The words of text, lowercased, in order.
fn words(text: [const u8]) -> Vec([const u8])
let out = vec-new([const u8])
let lower = to-lower(text)
let i = 0
let n = length(lower)
lower = to-lower(text)
i = 0
n = length(lower)
while :scan i < n
until i >= n or letter?(lower[i])
i += 1
@ -67,11 +67,11 @@ fn main() -> i32
let {.word .n} = counts[i]
println(str(word), n)
let top: [3 i32] = [counts[0].n counts[1].n counts[2].n]
let [most & others] = top
[most & others] = top
println("most frequent seen", most, "times, then", others)
let total = i32(length(ws))
let distinct = i32(length(counts))
let g = grade(distinct, total)
distinct = i32(length(counts))
g = grade(distinct, total)
println(distinct, "of", total, "distinct:", describe(g))
let longest = reduce(slice(ws), slice(ws[0], 0, 0), fn(a, b) =>
if length(b) > length(a) then b else a)

View File

@ -424,6 +424,23 @@ let () =
over nothing. *)
if !ok < 390 then fail "round trip covered only %d files" !ok
(* Names that are operator words are written in parentheses, and a group
reads them back. *)
let () =
let src =
"(defn f [] () (let [a 1 not 2 and 3 or 4 + 5 - 6 < 7 = 8 mod 9 % 10 b 11] \
(g a not and or + - < = mod % b)))"
in
let forms = Reader.read_all ~file:"<ops>" src in
let text = Indent_printer.program ~source:src forms in
if not (Test_support.contains text " (not) = 2\n (and) = 3") then
fail "operator-word bindings printed %S" text;
match Indent_reader.read_all ~file:"<ops>.fln" text with
| back ->
if not (same_forms (List.map norm forms) (List.map norm back)) then
fail "operator-word bindings: %s" (describe_diff (List.map norm forms) (List.map norm back))
| exception e -> fail "operator-word bindings read back: %s\n%s" (diag_text e) text
(* ── Lexical edge cases ────────────────────────────────────────────── *)
(* [~global:false] reads as an expression the editor sends, where a [let] is
@ -532,6 +549,16 @@ let () =
reads "chain" "x = a < b < c" "(set x (< a b c))";
reads "left to right" "x = a - b + c" "(set x (+ (- a b) c))";
reads "precedence" "x = a or b and not c == d" "(set x (or a (and b (not (= c d)))))";
(* not is a prefix word, between and and the comparisons. *)
reads "not over a comparison" "x = not a == b" "(set x (not (= a b)))";
reads "not under and" "x = not a and b" "(set x (and (not a) b))";
reads "not twice" "x = not not a" "(set x (not (not a)))";
reads "not of a group" "x = not (a or b)" "(set x (not (or a b)))";
reads "not glued is a call" "x = not(a) or b" "(set x (or (not a) b))";
reads "not as a statement" "if not done\n go()" "(when (not done) (go))";
refuses "not after a comparison" "x = a == not b" "indent/not-operand" "parentheses with what it negates:\n\n x = a == (not b)";
refuses "not after arithmetic" "if 1 + not b and c\n g()" "indent/not-operand" "if 1 + (not b) and c";
refuses "not in a spaced vector" "x = [not a b]" "indent/separate-elements" "commas";
(* The bit operators: tighter than a comparison, looser than a shift, and
among themselves && then ^^ then ||. *)
reads "bit and under a comparison" "x = a && mask == 0"
@ -571,7 +598,7 @@ let () =
(* Statements. *)
reads "lets merge" "fn f() -> i32\n let a = 1\n let b = 2\n a + b"
"(defn f [] i32 (let [a 1 b 2] (+ a b)))";
refuses ~global:false "let with a block" "let a = 1\n a\nb" "indent/let-block" "go at the let's column";
refuses ~global:false "let with a block" "let a = 1\n a\nb" "indent/let-block" "goes at the let's column";
reads ~global:false "flat let" "let a = 1\na\nb" "(let [a 1] a b)";
reads "elif" "if a\n 1\nelif b\n 2\nelse\n 3" "(cond a 1 b 2 :else 3)";
reads "one-line if" "x = if a then 1 else 2" "(set x (if a 1 2))";
@ -689,6 +716,8 @@ let () =
refuses "two assignments" "if a then b = c = d" "indent/assign-in-test" "if a then b = c,";
refuses "a let-bound if with no block" "let r = if a > 1\nr" "indent/expected-block" "if a > 1 takes";
refuses "two bindings on a line" "let v: i32 = a, w = b" "indent/one-binding" "a is followed by a comma";
refuses "two bindings on a let's line" "fn f()\n let v = a, w = b\n v" "indent/one-binding"
"under its name:\n\n let v = a\n w = b";
reads ~global:false "a let-bound match" "let r = match a\n 1 -> 2\n _ -> 3\nr" "(let [r (match a 1 2 _ 3)] r)";
reads ~global:false "a let-bound if" "let q = if a\n 1\nelse\n 2\nq" "(let [q (if a 1 2)] q)";
reads ~global:false "a let-bound call with a block" "let v = foo(a):\n x\nv" "(let [v (foo a x)] v)";
@ -705,7 +734,7 @@ let () =
"(defmacro m [x] (quasiquote (+ (unquote x) 1)))";
reads ~global:false "typed let" "let x: i32 = 5\nx" "(let [x (the i32 5)] x)";
refuses "a let takes no block" "fn f() -> ()\n let x = 1\n g(x)\n h(x)"
"indent/let-block" "go at the let's column";
"indent/let-block" "goes at the let's column";
(* Mistakes carried over from other languages, answered in this one. *)
refuses "a block without the colon names the call" "with-allocator(a, b)\n g()"
"indent/stray-indent" "as in with-allocator(a, b):";
@ -739,8 +768,96 @@ let () =
"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]";
(* A let's bindings on the lines under it. *)
reads ~global:false "a let's bindings on indented lines" "let a = 1\n b = a + 1\n c: i32 = b\ng(c)"
"(let [a 1 b (+ a 1) c (the i32 b)] (g c))";
reads ~global:false "patterns among them" "let p = q()\n {x .x} = p\n [h & t] = xs\ng(x, h)"
"(let [p (q) {x .x} p [h & t] xs] (g x h))";
reads ~global:false "a block value last in a group" "let a = 1\n c = match a\n 1 -> 2\n _ -> 3\ng(c)"
"(let [a 1 c (match a 1 2 _ 3)] (g c))";
reads ~global:false "a let after a block value" "let a = 1\n b =\n f()\n a\nlet c = 2\ng(c)"
"(let [a 1 b (do (f) a) c 2] (g c))";
reads ~global:false "a let after a group merges into it" "let a = 1\n b = 2\nlet c = 3\ng(c)"
"(let [a 1 b 2 c 3] (g c))";
reads ~global:false "a group in a body" "fn f()\n let a = 1\n b = 2\n a + b"
"(defn f [] _ (let [a 1 b 2] (+ a b)))";
refuses ~global:false "a statement under a let" "let a = 1\n g(a)\nh()"
"indent/let-block" "b = a + 1";
refuses ~global:false "an assignment to a field under a let" "let a = p()\n a.x = 1\nh()"
"indent/let-block" "only lines that go there are more bindings";
refuses ~global:false "a compound assignment under a let" "let a = 1\n a += 1\nh()"
"indent/let-block" "let's column";
reads "a top-level group is several globals" "let a = 1\n b: i32 = 2\nfn f() = a"
"(def a dyn 1)\n(def b i32 2)\n(defn f [] _ a)";
refuses "a global group binds names" "let a = 1\n {x .x} = p"
"indent/global-pattern" "a global binds one name";
refuses "a statement under a global" "let a = 1\n f(a)"
"indent/let-block" "more bindings of the let";
reads "typed globals with no value in a group" "let a: i32\n b: i32\n c = 2"
"(def a i32)\n(def b i32)\n(def c dyn 2)";
reads "a group under a typed global with no value" "let a: i32 = 1\n b: i64"
"(def a i32 1)\n(def b i64)";
refuses ~global:false "a local binding with no value" "let a = 1\n b: i32\ng()"
"indent/let-block" "more bindings of the let";
(* A binding lines up with the let's first name. *)
refuses ~global:false "a binding right of the first name" "let x = 1\n y = 2\ng()"
"indent/let-align" "starts at column 7, under the let on line 1, whose bindings line up with its first name, x, at column 5. Move it to column 5:\n\n let x = 1\n y = 2";
refuses ~global:false "a binding left of the first name" "fn f()\n let x = 1\n y = 2\n z = 3\n g()"
"indent/let-align" "Move it to column 7";
refuses ~global:false "a binding deeper than the one above" "fn f()\n let x = 1\n y = 2\n z = 3\n g()"
"indent/let-align" "Move it to column 7";
refuses "a global binding out of line" "let x = 1\n y = 2"
"indent/let-align" "Move it to column 5";
(* A let whose value is a block takes no more bindings under it. *)
refuses "a binding after a lambda block" "fn f()\n let g = fn(x) =>\n x + 1\n y = 2\n g(y)"
"indent/let-after-block" "one more binding of the let on line 2, after g, whose value is the block above it";
refuses "a binding after a match's arms" "fn f(a)\n let g = match a\n 1 -> 2\n _ -> 3\n y = 2\n g"
"indent/let-after-block" "let of its own, at that let's column:\n\n let y = 2";
refuses "a binding after a deeper block" "fn f()\n let g =\n h()\n y = 2\n g"
"indent/let-after-block" "after g";
refuses "a binding after a later binding's block" "fn f()\n let a = 0\n g = fn(x) =>\n x\n h = 2\n h"
"indent/let-after-block" "one more binding of the let on line 2, after g, whose value is the block above it. A binding whose value is a block ends its let's bindings, so this one needs a let of its own, at that let's column:\n\n let h = 2";
(* A block lambda whose brackets close ends no group: its block is shut
when its value ends. *)
reads ~global:false "a binding after a later binding's bracketed lambda"
"let a = 1\n g = map(xs, fn(x) =>\n x + 1)\n h = 2\nh"
"(let [a 1 g (map xs (fn [x] (+ x 1))) h 2] h)";
reads ~global:false "a binding after a first binding's bracketed lambda"
"let g = map(xs, fn(x) =>\n x + 1)\n h = 2\nh"
"(let [g (map xs (fn [x] (+ x 1))) h 2] h)";
refuses "a binding after a later binding's match" "fn f()\n let a = 1\n b = match a\n 1 -> 2\n _ -> 3\n c = 4\n c"
"indent/let-after-block" "the let on line 2, after b";
refuses "a global after a global's block" "let a = 0\n g =\n h()\n b = 2"
"indent/let-after-block" "after g";
(* Only a line shaped as a binding gets the alignment advice. *)
refuses "a statement between a let and its lambda's block" "fn f()\n let g = fn(x) =>\n x + 1\n print(g)"
"indent/dedent" "belongs to neither";
refuses "an else between a let and its if's block" "fn f(c)\n let g = if c\n 1\n else\n 2\n g"
"indent/dedent" "belongs to neither";
refuses ~global:false "a statement deeper than a binding" "let x = 1\n y = 2\n g()\nh()"
"indent/let-block" "more bindings of the let";
(* A tab between let and its first name. *)
refuses "a tab after a local let" "fn f()\n let\ta = 1\n a" "indent/tab" "put a space there: let a";
refuses "a tab after a global let" "let \ta = 1" "indent/tab" "a tab between let and a";
(* Indices separate as a vector's elements do. *)
reads "indices separated by spaces" "x = grid[row col].color-idx"
"(set x (.color-idx (at grid row col)))";
reads "grouped indices separated by spaces" "x = grid[(r + 1) (c - 1)]"
"(set x (at grid (+ r 1) (- c 1)))";
reads "indices separated by commas" "x = grid[r + 1, c]" "(set x (at grid (+ r 1) c))";
reads "calls and fields as spaced indices" "x = grid[f(r) p.y]" "(set x (at grid (f r) (.y p)))";
reads "a negative literal first" "x = grid[-1 c]" "(set x (at grid -1 c))";
reads "a spaced index assigned" "grid[r c] = 1" "(set (at grid r c) 1)";
refuses "an operator among spaced indices" "x = grid[r + 1 c]"
"indent/separate-elements" "Separate the indices with commas: grid[r + 1, c]";
refuses "an operator last among spaced indices" "x = grid[r c - 1]"
"indent/separate-elements" "grid[r, c - 1]";
refuses "mixed index separators" "x = grid[r c, d]"
"indent/mixed-separators" "Use one: grid[r, c, d] or grid[r c d]";
refuses "a glued minus among indices" "x = grid[i -1]"
"indent/glued-minus" "grid[i - 1]";
refuses "a glued negation among indices" "x = grid[i -j]"
"indent/glued-minus" "grid[i, -j]";
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"
@ -797,6 +914,12 @@ let () =
| exception e -> fail "%s: %s" name (diag_text e)
in
prints "compound assignment" "(defn f [] () (set x (+ x 1)))" " x += 1";
prints "not as a word" "(defn f [] () (g (not (= a b)) (and (not x) y)))"
"g(not a == b, not x and y)";
prints "not of a lower operator in parentheses" "(defn f [] () (g (not (or a b))))"
"g(not (a or b))";
prints "not under a comparison in parentheses" "(defn f [] () (g (= (not a) b)))"
"g((not a) == b)";
prints "compound update" "(defn f [] () (update (at a (next)) + 1))"
" a[next()] += 1";
prints "arm statements" "(defn f [] () (match s 1 (break) _ (return 2)))"
@ -809,18 +932,18 @@ let () =
(* A let is always flat: it takes in the rest of its block. *)
prints "flat let" "(defn f [] () (let [j 1] (g j)) (h))" " let j = 1\n g(j)\n h()";
prints "a chain of lets, all flat" "(defn f [] () (let [a 1] (let [b 2] (g b)) (k a)) (h))"
" let a = 1\n let b = 2\n g(b)\n k(a)\n h()";
" let a = 1\n b = 2\n g(b)\n k(a)\n h()";
(* A later statement that means an outer name of the same spelling: the
let's own is renamed. *)
prints "a later outer name of the same spelling renames the let's"
"(defn f [x i32] () (let [x 1] (g x)) (h x))" " let x-2 = 1\n g(x-2)\n h(x)";
prints "the inner let of a chain renamed"
"(defn f [] () (let [a 1] (let [b 2] (g b)) (h b)))" " let a = 1\n let b-2 = 2\n g(b-2)\n h(b)";
"(defn f [] () (let [a 1] (let [b 2] (g b)) (h b)))" " let a = 1\n b-2 = 2\n g(b-2)\n h(b)";
prints "the binding's own value keeps the outer name"
"(defn f [x i32] () (let [x (+ x 1)] (g x)) (h x))" " let x-2 = x + 1\n g(x-2)\n h(x)";
prints "a later binding's value takes the new name"
"(defn f [x i32] () (let [x 1 y (+ x 1)] (g y)) (h x))"
" let x-2 = 1\n let y = x-2 + 1\n g(y)\n h(x)";
" let x-2 = 1\n y = x-2 + 1\n g(y)\n h(x)";
prints "the new name is one the function does not use"
"(defn f [x i32] () (let [x 1] (g x x-2)) (h x))" " let x-3 = 1\n g(x-3, x-2)\n h(x)";
prints "a later let of the same name is no mention"
@ -861,10 +984,10 @@ 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 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)";
" let x = 1\n x-2 = 2\n x-3 = 3\n g(x-3)\n g(x-2)\n g(x)";
prints "a macro that names the let's name keeps its scope"
"(defmacro show-it [] `(println it))\n(defn f [] () (let [it 1] (let [it 2] (show-it)) (show-it)))"
" let it = 1\n do:\n let it = 2\n show-it()\n show-it()";
@ -921,7 +1044,22 @@ let () =
"(let [a 1 ; first\n b 2] ; second";
prints "each binding keeps its comment, indented"
"(defn f [] i32\n (let [a 1 ; first\n b 2] ; second\n (+ a b)))"
" let a = 1 ; first\n let b = 2 ; second";
" let a = 1 ; first\n b = 2 ; second";
prints "a comment line between grouped bindings"
"(defn f [] i32\n (let [a 1\n ;; why b\n b 2]\n (+ a b)))"
" let a = 1\n ;; why b\n b = 2\n";
prints "a long value starts a let of its own"
"(defn f [] i32 (let [a 1 b (some-function-with-a-long-name alpha beta gamma) c 2] (+ a b c)))"
" let a = 1\n let b = some-function-with-a-long-name(alpha, beta, gamma)\n let c = 2\n";
prints "a block value ends the group"
"(defn f [] i32 (let [a 1 b 2 c (do (g) a) d 4 e 5] (+ a b c d e)))"
" let a = 1\n b = 2\n let c =\n g()\n a\n let d = 4\n e = 5\n";
prints "a block value starts and ends a let of its own"
"(defn f [] i32 (let [a 0 b 1 g (fn [x] (p x) x) h 2 k 3] (+ a h k)))"
" let a = 0\n b = 1\n let g = fn(x) =>\n p(x)\n x\n let h = 2\n k = 3\n";
prints "typed and pattern bindings in a group"
"(defn f [p dyn] i32 (let [a (the i32 1) {x .x} p [h & t] xs] (+ a x h)))"
" let a: i32 = 1\n {x .x} = p\n [h & t] = xs\n";
back "comments to parens" "; head\n\nfn main() -> i32\n ; why\n g() ; note\n 0"
"; head\n\n(defn main [] i32\n ; why\n (g) ; note\n 0)";
(* Written the way the corpus writes them. *)