diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index 8fbde9c8..8562928e 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -83,8 +83,14 @@ fine here. Brackets and strings are still paired." (defconst flan-fln--clause-words '("else" "elif" "on" "restart") "Words that start a clause of the statement above, at its column.") +;; What follows a word that starts a clause or a header: a space and not an +;; assignment, or the end of the line. `on = 2' assigns a variable named on, +;; as `assigns' in lib/indent_reader.ml reads it. +(defconst flan-fln--word-end-re + "\\(?:[ \t]+\\(?:[^-+*/= \t\n]\\|[-+*/]\\(?:[^=]\\|$\\)\\)\\|[ \t]*$\\)") + (defconst flan-fln--clause-re - "\\(else\\|elif\\|on\\|restart\\)\\(?:[ \t]\\|$\\)") + (concat "\\(else\\|elif\\|on\\|restart\\)" flan-fln--word-end-re)) (defconst flan-fln--clause-headers '(("else" "if" "elif") ("elif" "if" "elif") @@ -1137,7 +1143,7 @@ Before it at the same level, else out to the line that owns this block." (goto-char start) (back-to-indentation) (and (looking-at (concat (regexp-opt flan-fln--opener-words t) - "\\(?:[ \t]\\|$\\)")) + flan-fln--word-end-re)) (let* ((w (match-string-no-properties 1)) (w-end (match-end 1)) (end (flan-fln--code-end last)) @@ -1579,7 +1585,7 @@ lambda or a `Fn(...)' type, and not after a match arm's." (defvar flan-fln-font-lock-keywords `(;; The header words, at the start of a line and followed by a space or the ;; end of it: `if(c, a)' is the fallback call and is not a header. - (,(concat "^[ \t]*" (regexp-opt flan-fln--header-words t) "\\(?:[ \t]\\|$\\)") + (,(concat "^[ \t]*" (regexp-opt flan-fln--header-words t) flan-fln--word-end-re) 1 font-lock-keyword-face) (,(concat "^\\(fn-?\\|macro\\)[ \t]+" flan-fln--name-re) 2 font-lock-function-name-face) diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 892f4204..e2e098c1 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -886,6 +886,19 @@ defconst(k, 3) (test-flan-fln--tabs (concat "fn f()\n " (car c) "\n|") 1) 4)) (test-flan-fln--is "but not a typed lambda with its body on the line" (test-flan-fln--tabs "fn f()\n let f = fn(a: i64) -> i64 = a\n|" 1) 2) +(test-flan-fln--is "a 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" + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "on = 2") + (test-flan--check "nor is a clause word being assigned a clause" + (not (flan-fln--clause-line-p (line-beginning-position)))) + (test-flan-fln--is "or drawn as a keyword" + (get-text-property (match-beginning 0) 'face) nil) + (search-forward "data") + (test-flan-fln--is "and a header word assigned is not either" + (get-text-property (match-beginning 0) 'face) nil)) (test-flan-fln--is "a macro opens a block" (test-flan-fln--tabs "macro repeat(i, n, & body)\n|" 1) 2) (test-flan-fln--is "and a struct with a parent" diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index a253a00a..3acf6418 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -26,7 +26,7 @@ let reserved = [ "fn"; "fn-"; "def"; "once"; "const"; "struct"; "union"; "data"; "enum"; "import"; "if"; "elif"; "else"; "while"; "until"; "match"; "let"; "for"; "return"; "break"; "continue"; "defer"; "handler-case"; "handler-bind"; - "restart-case"; "quote"; "on"; "restart"; "macro"; "loop"; "type" ] + "restart-case"; "quote"; "on"; "restart" ] (* A symbol the reader gives back as itself when it is written bare. *) let name_ok s = @@ -544,7 +544,17 @@ let lead_word text = (* A statement whose text leads with a reserved word, parenthesised. *) let guard text = let w, spaced = lead_word text in - if spaced && List.mem w reserved then paren text else text + (* [data = 3]: a name being assigned is read as one, header word or not. *) + let assigned = + let k = String.length w + 1 in + List.exists + (fun op -> + let o = op ^ " " in + String.length text >= k + String.length o + && String.sub text k (String.length o) = o) + [ "="; "+="; "-="; "*="; "/=" ] + in + if spaced && List.mem w reserved && not assigned then paren text else text let stmts_of (f : Form.t) = match f.v with diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 104a303d..bfba39e1 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1048,8 +1048,15 @@ let is_lambda_candidate (e : Form.t) = 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 = + let n = peek_at p 1 in + n.sp && (match n.tok with NAME x -> x = "=" || List.mem_assoc x assign_ops | _ -> false) + let header_follow p s = let n = peek_at p 1 in + (not (assigns p)) && let plain_name = function | NAME x -> not (is_op_word x || x = "=" || List.mem_assoc x assign_ops) | _ -> false @@ -1344,6 +1351,7 @@ and stmt (s : st) : Form.t = let t = peek p in match t.tok with | NAME w when header_follow p w -> header s w + | NAME _ when assigns p -> expr_stmt s | NAME (("else" | "elif") as w) when else_if_above p t -> failk "orphan-else" t.loc "the else above took the one-line if after it as its value, so this %s \ @@ -1678,7 +1686,7 @@ and header (s : st) w : Form.t = let clauses ~oneline body = let rec elifs acc = match (peek p).tok with - | NAME "elif" -> + | NAME "elif" when not (assigns p) -> ignore (advance p); let c, _ = binary p 1 in (match (peek p).tok with @@ -1700,7 +1708,7 @@ and header (s : st) w : Form.t = let els_ = elifs [] in let else_ = match (peek p).tok with - | NAME "else" -> + | NAME "else" when not (assigns p) -> let et = advance p in (match (peek p).tok with | NEWLINE -> ignore (advance p); Some (et.loc, block s ~after:"else") @@ -1848,7 +1856,7 @@ and header (s : st) w : Form.t = let body = block s ~after:w in let rec clauses acc = match (peek p).tok, (peek_at p 1) with - | NAME "on", n when n.sp -> + | NAME "on", n when n.sp && not (assigns p) -> let ot = advance p in let head, _ = postfix p in let ty, var = @@ -1877,7 +1885,7 @@ and header (s : st) w : Form.t = let body = block s ~after:w in let rec clauses acc = match (peek p).tok, (peek_at p 1) with - | NAME "restart", n when n.sp -> + | NAME "restart", n when n.sp && not (assigns p) -> ignore (advance p); let name = name_tok p ~what:"the restart's name" in let lp = glued_lp p ~what:"the restart's parameters in parentheses" in diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 648cfbff..3dcca927 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -558,6 +558,11 @@ let () = reads "type alias" "type Row = Vec(i32)" "(defalias Row (Vec i32))"; reads "type alias of an array" "type V2 = [2 f32]" "(defalias V2 [2 f32])"; reads "a local named type" "type = 3" "(set type 3)"; + reads "a header word assigned" "data += 3" "(set data (+ data 3))"; + reads "a clause word assigned after its header" + "handler-case\n g()\non E(c)\n h(c)\non = 2" + "(handler-case (g) [(E [c] (h c))])\n(set on 2)"; + reads "an else assigned after an if" "if a\n b\nelse = 2" "(when a b)\n(set else 2)"; reads "a parent and no fields" "struct Io :parent Error" "(defstruct Io :parent Error)"; reads "macro" "macro repeat(i, n, & body)\n quote\n f(~i)\n ~@body" "(defmacro repeat [i n & body] (quasiquote (do (f (unquote i)) (unquote-splicing body))))"; @@ -827,6 +832,8 @@ let () = prints "a template's for keeps its unquotes" "(defmacro m [i n & body] `(dotimes [~i ~n] ~@body))" "for ~i in range(~n)"; prints "a macro" "(defmacro m [[a b] n & body] `(do ~@body))" "macro m([a b], n, & body)\n quote"; + prints "a header word assigned keeps no parentheses" + "(defn f [] () (set data 3) (set loop 4) (set on 5))" " data = 3\n loop = 4\n on = 5"; prints "a type alias" "(defalias Row (Vec i32))" "type Row = Vec(i32)"; prints "a struct with a parent" "(defstruct D :parent Io [free i64])" "struct D :parent Io\n free: i64";