diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index d25d5b47..37db0f53 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -493,19 +493,20 @@ bindings line up." (skip-chars-forward " \t") (current-column))) -(defun flan-fln--binding-shape-p (l) - "Non-nil if the joined line L reads as a binding: a name, `~x', or a -`[...]' or `{...}' pattern, then ` = ' or `: T = '." +(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 "[[{]") + ((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) + (or (match-beginning 1) global (flan-fln--find-top "[ \t]=\\(?:[ \t]\\|$\\)" (match-end 0) end))))))) (defun flan-fln--binding-let (l) @@ -514,9 +515,9 @@ 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)) - (flan-fln--binding-shape-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)))) diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 2d077612..359c9315 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -446,6 +446,12 @@ fn twice(n: i64) -> i64 = n * 2 (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")) diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 24ceb68d..28dd7c54 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -257,6 +257,44 @@ 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 with %s, the first name of the let on line %d, as one \ + more binding of it would. That let's value is the block under its line, \ + and a let whose value is a block takes no more bindings. Give this one a \ + let of its own, at that let's column:\n\n let %s" + name let_line bt + 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 @@ -420,6 +458,26 @@ 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 -> + 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 \ @@ -590,12 +648,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 \ @@ -609,6 +682,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 @@ -620,9 +697,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 @@ -770,6 +844,30 @@ and primary p : Form.t * int = ignore (advance p); (sym l0 (op_sym s), 10) 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 \ @@ -1547,17 +1645,24 @@ and binding (s : st) : Form.t * Form.t = (* 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. st -> first:Form.t -> one:(unit -> 'a) -> 'a list = - fun s ~first ~one -> +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 let rec go acc = match (peek p).tok with | DEDENT -> ignore (advance p); List.rev acc | EOF -> List.rev acc - | _ when binding_line p -> go (one () :: acc) + | INDENT -> misaligned (peek_at p 1) + | _ when binding_line ~global p -> + if (peek p).loc.Loc.col <> name_col then misaligned (peek p); + go (one () :: acc) | _ -> failk "let-block" (where_ p) "this line is indented under let %s, and the only lines that go \ @@ -1570,9 +1675,11 @@ and binding_lines : 'a. st -> first:Form.t -> one:(unit -> 'a) -> 'a list = go [] end -(* Whether the line at point is a binding: a name, or a [[...]] or [{...}] - pattern, then [=] or [: T =]. [x += 1] and [f(x)] are not. *) -and binding_line p = +(* 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 @@ -1586,11 +1693,11 @@ and binding_line p = | 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 -> eq 2 0 + | COLON -> global || eq 2 0 | _ -> false) (* [~g = a] in a template. *) | UNQ -> eq 1 0 - | LB | LC -> + | LB | LC | LP -> let rec close k depth = match (peek_at p k).tok with | EOF | NEWLINE -> false @@ -1605,8 +1712,13 @@ and binding_line p = and let_stmt (s : st) : Form.t list = let p = s.p in let t = advance p in - let (target, v) = binding s in - let more = binding_lines s ~first:target ~one:(fun () -> binding s) in + 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 = @@ -2317,6 +2429,9 @@ and def_form (s : st) w (t : token) l0 : Form.t = 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 @@ -2427,14 +2542,25 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src = | DEDENT -> ignore (advance s.p); [] | NAME "let" when header_follow s.p "let" -> let t = peek s.p in - let f = header s "def" in + 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 s ~first ~one:(fun () -> + 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 \ diff --git a/spec-syntax.md b/spec-syntax.md index bfbb0cf0..a4cd92d7 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -200,10 +200,14 @@ Each item: the proposal, then the reason in one line. {x .x} = p ``` - is `(let [row (+ r 1) col (the i32 (- c 1)) {x .x} p] rest…)`. Any other - line indented there is refused. At the top level each such line is one - more global, `(def col i32 …)`; a pattern there is refused, since a global - binds one name. A `let` is otherwise flat: its scope is the rest of its + 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. A let whose first value is a block (`= match x`, a + lambda header, `=` and the lines under it) takes no more bindings under + it. 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 diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 3ee7e4c8..801a7940 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -416,6 +416,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:"" 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:".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 @@ -531,7 +548,8 @@ let () = 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/operator-operand" "nothing is on its left"; + 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"; refuses "not-equal chain" "x = a != b != c" "indent/chained-not-equal" "!=(a, b, c)"; reads "not-equal call" "x = !=(a, b, c)" "(set x (!= a b c))"; @@ -718,6 +736,28 @@ let () = "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" "lines up with g, the first name of the let on line 2"; + 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" "lines up with g"; (* 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)))";