diff --git a/FIX.org b/FIX.org index d0b9333f..58259fdc 100644 --- a/FIX.org +++ b/FIX.org @@ -6079,3 +6079,138 @@ table names. Harmless today only because check.ml refuses a dyn field in a struct — the stopgap item 2 of the M2 queue lifts. Whoever lifts it has to root this buffer, or a collection that runs inside the construction will not see what has been built so far. + +* The Emacs mode's pass, 2026-09-21 + +Two jobs in one lane: what was left stale in flan-mode.el after the name +sweep, and the [defs] cache feeding completion and eldoc but not font lock. + +A note on how this lane ran, because it is the useful part. It branched from +73ab213 and was 254 commits behind; the first pass "verified" against that +tree and reported half the language as missing. Everything it called absent — +def/defonce, the dotimes arities, slice's arities and strings, as-slice gone, +length, bytes-view, the rand surface, the object forms — was on dev-loop the +whole time. Rebased and re-derived from lib/parse.ml and lib/check.ml on the +real tree. A branch point is a fact about the evidence and belongs in the +report beside it. + +** What the pass found stale, on the current tree + +- [flan--special] still mixed three different kinds of name into one list. + Split, from the parser and the checker rather than from memory: + - [flan--special] is the heads [Parse.form] dispatches on, and nothing else. + - [flan--builtins] is [Check.builtins], drawn as builtins. They are ordinary + calls, and drawing [push] like [let] said they were the same kind of + thing. [destructure~nth] is left out — the compiler writes it, nobody + types it — and so is the whole of lib/prelude.ml, which is Flan written in + Flan and which the running program answers for by name. + - [flan--constants] is [true false nil None context/allocator context/temp] + and [uninit], matched as bare symbols. None of these is ever a head, so + the paren-anchored rule never saw one and they were undrawn. +- [cast] and [none] were in the list and are not in the language at all, and + [array-fill] and [array-gen] were missing from it — the parser reads both + itself, because their dimensions are in brackets and a bracket in expression + position would otherwise be an array literal. With those two added, every + head [Parse] dispatches on is now in one of the three lists or in one of the + two groups the docstring names as deliberately absent; a check that pulls the + heads out of parse.ml and diffs them against the lists comes back empty. +- The type rule had no [dyn], [Allocator], [Vec], [Map], [Fn], [int] or + [float], and no type variables — a generic defn's [$t] and the + [{:where ...}] clause over it were undrawn. [Unit] came off it: the resolver + answers to the name because [Cimport] builds one for C's void, but + [Parse.texpr] refuses the word outright, so drawing it advertised a spelling + that does not compile — the same rule that keeps [await] out of the keyword + list. +- The syntax table did not know [$] or [&] were name characters, or that a + comma is whitespace — [lib/reader.ml] skips one wherever a space would go. + [&] matters more than it looks: a macro's parameter list destructures, so + [[test message & body]] is the ordinary shape now. +- imenu had no heading for a macro, and listed neither [declare-c] nor any of + [defclass], [defgeneric], [defmulti], [defmethod]. The four dispatch forms + go under Functions — a method is listed by the generic it implements, which + is the name in the same place — and [defclass] under Types. +- electric-pair was checked and needed nothing: it reads the syntax table, and + all three bracket pairs and the string were already right. Four rows pin it, + because the table gained entries here and a mistake would show there first. +- **A labelled loop indented its body under its own binding vector.** A label + is a keyword written where the vector or the test goes, so it pushes the + special arguments along by one; dotimes, while and until take one and loop + refuses one. There are five in the corpus: three in test/programs/loops.flan + (lines 53, 60, 68) and two in dotimes-range.flan (99, 105). +- [fn], [signal] and [error] had no indent entry. The [dotimes] arities needed + none — the vector is one sexp whatever is inside it — and neither did the + four object forms, which reach the [\`def] fallback. All six are pinned. + +Measured over every .flan file in the tree — 317 of them — by reindenting each +and counting the lines that came back different. Before this pass: 22 files, +389 lines. After: 20 files, 373 lines. So it fixes 16 lines in two files +(loops.flan 9, dotimes-range.flan 7, both of them labelled loops) and +introduces no new difference anywhere. + +The 20 files and 373 lines that still differ are untouched by this pass and +were untouched before it. They are concentrated in json.flan (85), +arena-region.flan (71), vendor/edn/provide.flan (55) and vendor/json (41), +and they are a separate piece of work: the indenter and the hand-formatting in +those files disagree about shapes nothing here looked at. + +An earlier version of this entry claimed zero differing lines. That was a bug +in the measurement, not a result: the script bound [inhibit-message] around +the loop that reported, which silences [message] in batch, so it printed +nothing and the nothing was read as a pass. + +** CIDER-style dynamic fontification + +[flan-font-lock-dynamically], a defcustom defaulting to on. + +What [defs] turned out to carry: name, kind, signature, location, doc — with +kinds [fn], [var], [const], [extern], [builtin]. No macro kind, and nothing to +infer one from: [Parse] desugars [(defmacro m [a] ...)] into a defn, so every +macro was already on the wire as a function and indistinguishable from one. +So the op was extended rather than the editor made to guess. + +- [macro], off Session.macros and off the prelude's. The fns list drops any + name the macro set holds, and that is required by the new rows rather than + a fix to anything: before this, a macro appeared exactly once, as kind [fn], + because the macro rows did not exist. Adding them without the filter is what + would have made [assoc] answer [fn] for a macro. + The dropped fn's location is kept and put on the macro entry, so M-. on a + macro still goes there and M-. on a prelude macro still refuses by naming + the prelude rather than by shrugging about the daemon. + A macro row also has to be admitted wherever an editor asks for "a name with + a body": [flan-disassemble], [flan-disassemble-ir] and [flan-lowering] all + filtered their completion table on kind [fn], so giving macros a kind of + their own dropped them out of three lists. One [flan--compiled-kinds] now + names both words and all three read it. +- [struct], [data], [union], [enum], [alias], read off the checker's + environment — an enum and an alias are both gone from Tast.program by then. + +A prelude macro carries its parameter vector like a program's, built through +the same function, so eldoc on [unless] shows [unless [& args] Form] and not +the bare word. The forms are held in a [lazy] here rather than fetched per +request: [Macro.prelude_macros] keeps only the names, and [Prelude.forms] +re-reads and re-parses the whole prelude every time it is called. + +The editor side is a matcher function over a hash table, not a regexp: a +regexp of every name would be rebuilt per refresh and, at a few thousand +names, would eventually hit Emacs's regexp size limit. The table is built when +the cache is — on connect and after an accepted evaluation — and redisplay +costs one regexp step and one hash lookup per symbol on screen, with no +ceiling. The rules are appended after the mode's own and carry no override +flag, which is font-lock's way of saying "only where nothing is drawn": the +static table wins by mechanism, so a program defining its own [length] cannot +repaint the builtin. With no session the rules come off every buffer, and a +whole-buffer face-for-face comparison pins that. + +Refresh rides on flan-refresh-defs, which flan-connect and flan--report +already call. No new path, no polling. + +** Left, recorded rather than done + +- A [defclass] is expanded away before the checker — it is a dyn map and a + shape tag by then — so there is no class table to read and a class name is + not on [defs] as a type. It arrives as whatever the expansion left. +- A data constructor is [Type.Case] and is one symbol. The type half is drawn + and the case half is not: the daemon answers with the type's name and knows + nothing of its cases. +- [CFn] does not exist anywhere in the tree. [Fn] does — [(Fn [T ...] R)], + parse.ml:99 — and is in the type rule. Nothing was added for the other. diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 87d6617c..0ab2ecb5 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -903,9 +903,19 @@ topped up whenever somebody notices a gap. So `defmacro`, `defclass`, `defgeneric`, `defmulti`, `defmethod` and `declare-c` colour as definitions, and `when`, `cond`, `and`, `or`, `break`, `continue`, `recur`, `fn`, `quote`, `array`, `signal`, `error` and the four condition forms — `handler-bind`, -`handler-case`, `restart-case`, `invoke-restart` — colour as keywords. A macro -*you* define is still drawn as an ordinary call: macro-ness is erased by the -time the daemon can be asked about a name, so there is nothing to ask. +`handler-case`, `restart-case`, `invoke-restart` — colour as keywords. + +A form the parser gives a meaning to and a function the compiler provides are +two different things, and they are coloured apart: `let` and `match` are +keywords, `push` and `slice` and `println` are builtins, and `true`, `false` +and `None` stand for themselves. Types are types, `dyn` and a type variable +like `$t` among them. And the package alias in `rl/draw-text` is drawn apart +from the name after it, which is the one part of a qualified name you did not +write. + +**A loop's label moves everything along by one.** `(dotimes :outer [i 3] …)` and +`(until :count (> n 10) …)` indent their bodies two in, exactly as the +unlabelled forms do — the label is not the thing the body lines up under. **`#_` greys out the form after it**, the way it reads: the discarded form is given the comment syntax class, so it is drawn as a comment and skipped by @@ -916,6 +926,19 @@ left alone, so `#_(` does not grey the rest of the file while you are typing it. Nothing here needs a running program. Indentation and colouring are the major mode's, so they work in a file you have only opened. +**With a program running, the names *it* knows are coloured too** — a macro as a +macro, a function as a function, a global as a global, and a struct, data type, +union, enum or alias as a type. That is the difference between a name the program +has and a name you have misspelled: the misspelling stays grey. It follows the +program, so a `defn` you have just evaluated is coloured from that moment, and a +name you have not evaluated yet is not. + +This never repaints the language. A program that defines its own `length` does +not get to change what `length` looks like; the language is drawn first and what +is already drawn is left alone. Turn the whole of it off with +`flan-font-lock-dynamically` if you would rather have one colour for every name, +and a file with no session behind it looks the same either way. + --- ## Getting around @@ -930,9 +953,15 @@ mode's, so they work in a file you have only opened. | `C-c C-l` | every lowering of a function: IR, `-O0`, `-O2`, x86 backend | | `C-c C-m` | what the macro call at point expands to; `C-u` for all the way | -Completion, eldoc and `M-.` all read one cached answer rather than asking the -program per keystroke. It refreshes at the two moments the answer can have -changed: when you connect, and after an evaluation the daemon accepted. +Completion, eldoc, `M-.` and the colouring described under **Writing it** all +read one cached answer rather than asking the program per keystroke. It refreshes +at the two moments the answer can have changed: when you connect, and after an +evaluation the daemon accepted. + +Each name in it comes with what kind of thing it is: `fn`, `macro`, `struct`, +`data`, `union`, `enum`, `alias`, `var`, `const`, `extern` or `builtin`. That is +what lets `C-c C-v` say which of them you are looking at, and what the colouring +keys on. The answer covers the compiler's builtins as well as the program's own names, so `C-c C-v` on `arena-new` or `map-next` gives you its signature and a line @@ -1110,6 +1139,7 @@ in the buffer). | `flan-daemon-args` | `nil` | extra arguments for `flan dev` — `("--llvm")`, `("--debug")` | | `flan-socket-name` | `".flan-dev.sock"` | what `C-c C-z` searches for | | `flan-echo-result` | `t` | report an accepted evaluation in the echo area | +| `flan-font-lock-dynamically` | `t` | colour names by what the running program says they are | | `flan-inline-result` | `t` | also show an expression's value at the end of its line | | `flan-names-shown` | `4` | how many names to list before summarising | | `flan-poll-interval` | `1.0` | seconds between checks for whether it stopped | diff --git a/emacs/flan-lower.el b/emacs/flan-lower.el index cbfa7eca..6dac6d37 100644 --- a/emacs/flan-lower.el +++ b/emacs/flan-lower.el @@ -615,8 +615,7 @@ was being read open." (list (or (thing-at-point 'symbol t) (completing-read "Lowerings of: " - (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) - flan--defs)) + (flan--compiled-names) nil nil nil nil (and (fboundp 'flan-current-defun-name) (flan-current-defun-name)))) diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 400250d2..86562657 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -127,22 +127,75 @@ "Forms that introduce a top-level name.") (defconst flan--special - '("quote" "let" "if" "when" "cond" "and" "or" "do" "while" "until" "dotimes" - "loop" "recur" "break" "continue" "match" "set" "return" "fn" "array" - "defer" "some" "none" "try" "signal" "error" - "handler-bind" "handler-case" "restart-case" "invoke-restart" - "zeroed" "uninit" "slice" "at" "length" "addr" - "bytes" "cast" "true" "false" "nil" "print" "println") - "Forms with meaning to the checker. + '("quote" "do" "let" "if" "when" "cond" "and" "or" + "while" "until" "break" "continue" "return" "set" + "array" "array-fill" "array-gen" "match" "fn" "dotimes" "loop" "recur" + "defer" "some" "try" "signal" "error" + "handler-bind" "handler-case" "restart-case" "invoke-restart") + "The heads `Parse.form' dispatches on — the forms with a meaning of their own. -The heads `Parse.form' dispatches on, plus the literals and the handful of -builtins that are never anything else. Two groups of real heads are -deliberately left out: `quasiquote', `unquote' and `unquote-splicing', which -nobody writes as words — the reader makes them out of \\=`, ~ and ~@, and the -sigils are not symbols for a keyword rule to reach — and `find-restart', -`compute-restarts', `errdefer' and `await', which the parser recognises only -in order to refuse them. Drawing those four as keywords would advertise four -forms that cannot be used.") +Not functions, which is the line this list draws: `and' does not evaluate its +second argument unless it has to and `quote' evaluates none of its, while +everything in `flan--builtins' below is an ordinary call. They used to be one +list and were drawn alike, which said they were the same kind of thing. + +Two groups of real heads are deliberately left out. `quasiquote', `unquote' +and `unquote-splicing' are never written as words — the reader makes them out +of \=`, ~ and ~@, and the sigils are not symbols for a keyword rule to reach. +`find-restart', `compute-restarts', `errdefer' and `await' the parser +recognises only in order to refuse them, and drawing those as keywords would +advertise four forms that cannot be used.") + +(defconst flan--builtins + '(;; arithmetic, comparison, bits + "+" "-" "*" "/" "%" "=" "!=" "<" "<=" ">" ">=" "not" + "bit-and" "bit-or" "bit-xor" "<<" ">>" "min" "max" + ;; the fill patterns + "zeroed" "filled" "dead-beef" + ;; allocators + "make-allocator" "allocator-from" "allocator" "heap-allocator" + "arena-new" "arena-destroy" "free-all" "can-free?" "can-free-all?" + "alloc-epoch" "alloc-id" "alloc-budget" "set-alloc-budget" + "alloc-live-blocks" "with-allocator" + ;; Vec + "vec-new" "push" "reserve" "free" "clone" + ;; Map + "map-new" "put" "get" "map-remove" "map-next" "has-key?" + ;; dyn + "class-of" "keyword" + ;; compile time + "embed" "embed-dir" "compile-error" + ;; files + "slurp" "barf" "delete-file" "make-directory" "rename-file" + ;; containers and memory + "length" "at" "slice" "slice-from-ptr" "addr" "deref" + ;; options, bytes, the host + "Some" "bytes" "bytes-view" "string" + "bytes->f64" "bytes->i64" "f64->bytes" "i64->bytes" + "write-stdout" "print" "println" "exit" "argv") + "The functions the compiler provides, from `lib/check.ml''s `builtins' table. + +Ordinary calls — nothing here is special to the parser — so they are drawn as +builtins and not as keywords. `string' is in this list and in the type rule +below and means a different thing in each: `(string b)' converts and a bare +`string' names a type, which the rules tell apart by the paren. + +`destructure~nth' is in the table and not here: the compiler writes it into a +destructuring `let' and nobody types it. + +The randomness functions, the string and sequence functions and everything +else in `lib/prelude.ml' are deliberately absent. They are ordinary Flan +written in Flan, the running program answers for them by name, and listing +them here would be a second copy of the prelude to keep in step.") + +(defconst flan--constants + '("true" "false" "nil" "None" "context/allocator" "context/temp" "uninit") + "Names that stand for themselves rather than being called. + +Matched as bare symbols, which is how they are written: nobody types `(true)', +so a paren-anchored rule would never see one. `uninit' is here for the same +reason and is the odd one — it is legal only as the last item of a `def' or a +`defonce', where it says the storage is left as it was found.") (defvar flan-font-lock-keywords `((,(concat "(" (regexp-opt flan--definers t) "\\_>" @@ -150,8 +203,15 @@ forms that cannot be used.") (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) (,(concat "(" (regexp-opt flan--special t) "\\_>") 1 font-lock-keyword-face) + (,(concat "(" (regexp-opt flan--builtins t) "\\_>") 1 font-lock-builtin-face) + ;; Ahead of the qualified-name rule below, which would otherwise take + ;; `context/' in `context/allocator' for a package alias. It is not one: + ;; there is no package called `context', and the slash is part of the name. + (,(concat "\\_<" (regexp-opt flan--constants t) "\\_>") + 1 font-lock-constant-face) ;; A keyword resolves against an enum at the call site, so it reads as a - ;; constant rather than as a string. + ;; constant rather than as a string. `:where', the one key a `defn''s + ;; constraint map accepts, is covered by the same rule. ("\\_<:\\(?:\\sw\\|\\s_\\)+" . font-lock-constant-face) ;; A field. The label in a struct literal — `{.x 1.0}' — and the accessor ;; `(.x v)' are the same name and are drawn the same way. Without this @@ -162,14 +222,37 @@ forms that cannot be used.") ;; The package half of a qualified name — the `rl/' of `rl/draw-text'. ;; Drawn as a type the way clojure-mode draws a namespace, so the eye can ;; split the package from the name without reading either. The leading - ;; letter keeps `:foo/bar' keywords and a bare `/' out of it. + ;; letter keeps `:foo/bar' keywords and a bare `/' out of it. It sits + ;; after the constants rule above on purpose: `context/allocator' has a + ;; slash and is not a qualified name — there is no package called + ;; `context' — and font-lock leaves text that is already drawn alone. ("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face) - ;; The machine types, which are ordinary symbols but never anything else. - ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|Unit\\|Never\\|Ptr\\|Option\\)\\_>" + ;; The types the compiler knows without being told: every primitive in + ;; `Types.primitive_names', plus the four applied ones the checker + ;; resolves and the function type. `dyn' is lowercase on purpose — it is + ;; a primitive beside `i64' and `bool', not a container over something. + ;; `int' and `float' are builtin aliases for `i32' and `f32'. + ;; + ;; `Unit' is deliberately absent, though `Types.primitive_names' has it. + ;; The resolver answers to the name because `Cimport' builds one for C's + ;; void, but nothing anyone writes reaches that: `Parse.texpr' refuses the + ;; word outright — unit is spelled `()'. Drawing it as a valid type would + ;; advertise a spelling the parser rejects, which is the same reason + ;; `find-restart' and `await' are left out of `flan--special'. + ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|dyn\\|int\\|float\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|Fn\\)\\_>" . font-lock-type-face) + ;; A type variable, `$t', which is what a generic `defn' names its + ;; parameter types with and what `{:where (ordered? $t)}' constrains. + ("\\_<\\$\\(?:\\sw\\|\\s_\\)*" . font-lock-type-face) ("\\_<\\(?:0x[0-9a-fA-F]+\\|-?[0-9]+\\(?:\\.[0-9]+\\)?\\)\\_>" . font-lock-constant-face)) - "Font lock for `flan-mode'.") + "Font lock for `flan-mode'. +Every rule here is about the language itself, so a file that has never been +near a running program is drawn completely. What a *particular program* +defines is a separate question, and `flan.el' answers it — see +`flan-font-lock-dynamically' — by adding rules after these ones. After, and +never over: a name that is a special form or a builtin keeps the face these +rules gave it whatever the program happens to call its own functions.") (defconst flan--name-re "\\(\\(?:\\sw\\|\\s_\\)+\\)" "A Flan name, as one group. @@ -181,16 +264,34 @@ below — and not again here.") ;; `defn' nested inside a `let' is not a definition of anything, and a match ;; that ignored the column would offer one. (defvar flan-imenu-generic-expression - `(("Functions" ,(concat "^(defn\\s-+" flan--name-re) 1) - ("Types" ,(concat "^(def\\(?:struct\\|data\\|union\\|enum\\|alias\\)\\s-+" - flan--name-re) + ;; `defgeneric', `defmulti' and `defmethod' are here with `defn': all four + ;; introduce something you call, and which of them declared a name is not + ;; the question an index is being asked. A method is listed by the generic + ;; it implements, which is the name in the same place, so a file of several + ;; methods shows that name several times — the honest answer, and better + ;; than listing none of them as it did. + `(("Functions" ,(concat "^(def\\(?:n\\|generic\\|multi\\|method\\)\\s-+" + flan--name-re) + 1) + ;; Its own heading rather than a second `Functions' entry: a macro runs at + ;; compile time and a function at run time, and an index that drew them + ;; alike would be hiding the one difference that matters about them. + ("Macros" ,(concat "^(defmacro\\s-+" flan--name-re) 1) + ;; `defclass' with the other type declarations: it names a shape, and a + ;; reader looking for where `Sprite' is defined does not first have to + ;; decide whether it was spelled as a struct or as a class. + ("Types" + ,(concat "^(def\\(?:struct\\|data\\|union\\|enum\\|alias\\|class\\)\\s-+" + flan--name-re) 1) ;; `def', `defonce' and `defconst'. `def' has to be matched as itself — ;; `\_>' keeps it from swallowing every other definer's prefix. ("Variables" ,(concat "^(def\\(?:once\\|const\\)?\\_>\\s-+" flan--name-re) 1) ;; A forward declaration is not a definition, and a file with both would ;; otherwise show the same name twice with nothing to tell them apart. - ("Declared" ,(concat "^(declare\\s-+" flan--name-re) 1)) + ;; `declare-c' as well as `declare': it declares a name the same way and + ;; differs only in generating the C shim that reaches it. + ("Declared" ,(concat "^(declare\\(?:-c\\)?\\s-+" flan--name-re) 1)) "Imenu index for `flan-mode', by what each form introduces.") (defun flan-current-defun-name () @@ -213,6 +314,18 @@ line is off screen." (modify-syntax-entry ?/ "_" table) (modify-syntax-entry ?. "_" table) (modify-syntax-entry ?- "_" table) + ;; `$t' is a type variable and `&' is the rest marker in an array pattern. + ;; The reader's rule is that a name is anything up to a delimiter (see + ;; `is_delimiter' in `lib/reader.ml'), and neither of these is one, so both + ;; are part of the name they sit in and `M-.' on `$t' should not stop at + ;; the sigil. + (modify-syntax-entry ?$ "_" table) + (modify-syntax-entry ?& "_" table) + ;; A comma is whitespace, exactly as it is in Clojure and for the same + ;; reason: `lib/reader.ml' skips it wherever a space would go, so `[a 1, b + ;; 2]' and `[a 1 b 2]' are the same vector. Saying so here is what lets + ;; sexp motion and the indenter step over one without a case for it. + (modify-syntax-entry ?, " " table) ;; [ ] and { } are brackets, not symbol characters: every binding list and ;; every type is written with them. (modify-syntax-entry ?\[ "(]" table) @@ -418,6 +531,10 @@ For `syntax-propertize-function'." ("let" . 1) ("loop" . 1) ("dotimes" . 1) + ;; An anonymous function: the parameter vector, then the body. `defn' + ;; without the name, and it indents like `let' rather than like `defn' + ;; because there is no optional return type to be vague about. + ("fn" . 1) ;; The clause vector, then the protected body. Same shape as `let'. ("handler-bind" . 1) ;; `handler-case' is the other way round — the body first and the clause @@ -438,6 +555,9 @@ For `syntax-propertize-function'." ;; on the head's line — `(restart-case (middle n)' — would drag every ;; clause out to align under it. ("restart-case" . 1) + ;; The condition, then the struct literal that carries its fields. + ("signal" . 1) + ("error" . 1) ;; All body. ("do" . 0) ("cond" . 0) @@ -459,6 +579,27 @@ Anything not named here that begins with `def' is treated as `:defn' by "The indent spec for the form called NAME, or nil." (and name (cdr (assoc name flan-indent-specs)))) +(defconst flan--labelled-forms '("dotimes" "while" "until") + "Loops that may carry a label, which `break' and `continue' name. +`loop' is deliberately not here: it refuses a label, because a loop answers +with the value of its body and there is nothing for a jump out of one to +give. See `lib/parse.ml'.") + +(defun flan--label-p (name) + "Non-nil if the form called NAME, at point, carries a label. +Point is on the head. A label is a keyword written where the binding vector +or the test would otherwise go — `(dotimes :outer [i 3] …)' — and it pushes +everything after it along by one, so the count of special arguments has to +know about it. Without this a labelled loop indented its body under its own +binding vector, which is where `test/programs/loops.flan' would have said so +if anything had been indenting it." + (and (member name flan--labelled-forms) + (save-excursion + (ignore-errors + (flan--forward-sexp 1) ; over the head + (skip-chars-forward " \t\n\r") + (eq (char-after) ?:))))) + (defun flan--non-logical-sexp-p () "Non-nil if what follows point is read but produces no form. Today that is only `#_', the discard reader macro — see `lib/reader.ml'. A @@ -599,7 +740,8 @@ decision to `calculate-lisp-indent'." (head-column (1- (current-column)))) (cond ((integerp method) - (flan--count-indent method indent-point last-sexp head-column)) + (flan--count-indent (if (flan--label-p name) (1+ method) method) + indent-point last-sexp head-column)) ((eq method :defn) (+ lisp-body-indent head-column)) ;; No spec. Anything else spelled `def…' is a definition and indents ;; like one, which covers `defstruct', `defdata', `defunion', diff --git a/emacs/flan.el b/emacs/flan.el index f36fd6ca..9efff105 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -1763,18 +1763,238 @@ compiler builtin with a KIND of \"builtin\", after the program's, so that undefined. Nothing here special-cases them — a builtin is an entry like any other, and KIND is what tells it apart where that matters.") +;;; Drawing what the program knows + +;; The cache above already says, for every name, what kind of thing it is. Up +;; to now only completion and eldoc read it, so a macro you defined was drawn +;; exactly like a function you defined, and both exactly like a word nobody has +;; ever heard of. This draws them apart. +;; +;; The idea is CIDER's `cider-font-lock-dynamically', and so is the shape: the +;; *running program* is the authority on what a name is, the editor asks it +;; rather than parsing the buffer, and the answer is drawn by kind. +;; +;; Three decisions, because each is the sort that is invisible once made: +;; +;; **The static rules win.** `flan-mode''s own table draws the language — +;; `if', `let', `push', `i64' — and this draws one program's names. Where +;; they overlap the language wins, and it wins by *mechanism* rather than by +;; ordering luck: these rules are appended after the mode's, and they carry +;; no override flag, which is font-lock's way of saying "only where nothing +;; has been drawn yet". So a program whose own function is called `len' does +;; not get to repaint the builtin, and nothing here can make `if' stop +;; looking like `if'. +;; +;; **Nothing is rebuilt per keystroke.** A regexp of every name would be +;; rebuilt on each refresh and, at a few thousand builtins and program names, +;; would sooner or later hit Emacs's limit on how big a regexp may be. So +;; the matcher is a function: it steps symbol by symbol through the part of +;; the buffer being redrawn and looks each one up in a hash table. The table +;; is built once per refresh — on connect and after an accepted evaluation, +;; which is twice a minute at the very most — and redisplay costs one regexp +;; step and one hash lookup per symbol on screen, with no ceiling to hit. +;; +;; **With no program there is nothing to draw.** The keywords come off every +;; buffer when the cache is dropped, so a file opened with no session looks +;; exactly as it did before any of this existed. + +(defcustom flan-font-lock-dynamically t + "Whether to colour names by what the running program says they are. + +With a session connected, a macro the program defines is drawn as a macro, a +function as a function, a global as a global and a struct, union, data type, +enum or alias as a type. Names the program has never heard of are left +alone, which is what makes a typo visible. + +This never changes how the language itself is drawn: `if' and `push' and +`i64' keep the colours `flan-mode' gives them whatever the program defines. + +Set to nil to leave every name to `flan-mode''s own rules. Nothing else +changes — completion, eldoc and \\[xref-find-definitions] read the same +answer and go on working." + :type 'boolean + :group 'flan + :set (lambda (sym val) + (set-default sym val) + ;; So that turning it off turns it off *now*, in the buffers that are + ;; open, rather than at the next connect. + (when (fboundp 'flan--dynamic-sync) (flan--dynamic-sync)))) + +(defface flan-macro-face '((t :inherit font-lock-keyword-face)) + "Face for a name the running program defines as a macro. +Drawn as a keyword, because that is what a macro is from the caller's side: +its arguments are not evaluated, and the shape of the call is its own." + :group 'flan) + +(defface flan-function-face '((t :inherit font-lock-function-name-face)) + "Face for a name the running program defines as a function." + :group 'flan) + +(defface flan-global-face '((t :inherit font-lock-variable-name-face)) + "Face for a name the running program defines as a global." + :group 'flan) + +(defface flan-type-face '((t :inherit font-lock-type-face)) + "Face for a type the running program defines. +One face for all five declaring forms — `defstruct', `defdata', `defunion', +`defenum' and `defalias' — because from a reader's side they are the same +thing: a name that goes where a type goes." + :group 'flan) + +(defface flan-builtin-face '((t :inherit font-lock-builtin-face)) + "Face for a name the compiler provides. +`flan-mode' draws the builtins it knows by name already; this covers any the +compiler has grown since, which is the point of asking rather than listing." + :group 'flan) + +(defconst flan--dynamic-faces + '(("macro" . flan-macro-face) + ("fn" . flan-function-face) + ;; A foreign function is still a function at the call site, and drawing it + ;; apart would be drawing where it was *written*, which is not a thing the + ;; person reading the call needs from a colour. + ("extern" . flan-function-face) + ("builtin" . flan-builtin-face) + ("var" . flan-global-face) + ("const" . flan-global-face) + ("struct" . flan-type-face) + ("data" . flan-type-face) + ("union" . flan-type-face) + ("enum" . flan-type-face) + ("alias" . flan-type-face)) + "The face for each kind the `defs' op answers with. +A kind not listed here is left undrawn rather than guessed at: the daemon is +allowed to grow the set, and a name drawn in the wrong colour says something +false where an undrawn one says only that this editor is older.") + +(defvar flan--dynamic-table (make-hash-table :test #'equal) + "Name to face, built from `flan--defs'. +Rebuilt when the cache is, and read once per symbol per redisplay.") + +(defvar flan--dynamic-face nil + "The face `flan--dynamic-match' found, read by the font-lock rule after it.") + +(defun flan--dynamic-rebuild () + "Fill `flan--dynamic-table' from `flan--defs'." + (let ((tbl (make-hash-table :test #'equal :size (max 1 (length flan--defs)))) + ;; Names seen as the tail of a qualified one, and how many times. A + ;; buffer inside a package writes `settle' for what the program calls + ;; `sim/settle', which is the rule `flan--lookup' already follows; the + ;; count is what keeps it from guessing when two packages both have a + ;; `draw'. + (tails (make-hash-table :test #'equal))) + (dolist (d flan--defs) + (let ((face (cdr (assoc (nth 1 d) flan--dynamic-faces)))) + (when face + (puthash (car d) face tbl) + (let ((slash (string-search "/" (car d)))) + (when slash + (let* ((tail (substring (car d) (1+ slash))) + (seen (gethash tail tails))) + (puthash tail (if seen (cons nil nil) (cons t face)) tails))))))) + (maphash (lambda (tail hit) + ;; Exactly one package offers it, and the full name has not + ;; already claimed the spelling. + (when (and (car hit) (not (gethash tail tbl))) + (puthash tail (cdr hit) tbl))) + tails) + (setq flan--dynamic-table tbl))) + +(defun flan--dynamic-match (limit) + "Move to the next name the running program knows, before LIMIT. +Leaves its face in `flan--dynamic-face' for the rule that calls this." + (let ((face nil)) + (while (and (null face) + (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" limit t)) + (let ((sym (match-string-no-properties 0))) + (setq face (gethash sym flan--dynamic-table)) + ;; A constructor is written `Type.Case', and a dot is a name character, + ;; so the whole thing is one symbol and no table could hold it — the + ;; daemon answers with the type's name and knows nothing of the cases. + ;; The type half is drawn and the case half left alone, which is the + ;; true statement: one of them is a name the program defines. + (unless face + (let ((dot (string-search "." sym))) + (when (and dot (> dot 0)) + (setq face (gethash (substring sym 0 dot) flan--dynamic-table)) + (when face + (set-match-data + (list (match-beginning 0) (+ (match-beginning 0) dot))))))))) + (when face + (setq flan--dynamic-face face) + t))) + +(defconst flan--dynamic-keywords + ;; No override flag, and added with APPEND below: together those are the + ;; whole of "the static rules win". Font-lock leaves text that already + ;; carries a face alone unless told otherwise, and it is not told otherwise + ;; here. + '((flan--dynamic-match (0 flan--dynamic-face nil t))) + "The font-lock rule that draws what the program defines.") + +(defun flan--dynamic-wanted-p () + "Non-nil when there is something to draw and permission to draw it." + (and flan-font-lock-dynamically flan--defs t)) + +(defun flan--dynamic-install () + "Add or remove the dynamic rules in the current buffer, and redraw it. +Called for its effect on one buffer; `flan--dynamic-sync' does every buffer." + (when (derived-mode-p 'flan-mode) + ;; Removed first in both branches, because adding is not idempotent: a + ;; second install would put the rule in twice and every refresh after that + ;; would add another. + (font-lock-remove-keywords nil flan--dynamic-keywords) + (when (flan--dynamic-wanted-p) + (font-lock-add-keywords nil flan--dynamic-keywords t)) + ;; Only when the buffer is actually being drawn: a buffer with font-lock + ;; off has nothing to flush and flushing it would turn it on. + (when font-lock-mode (font-lock-flush)))) + +(defun flan--dynamic-sync () + "Bring every Flan buffer into line with what is known now." + (flan--dynamic-rebuild) + (dolist (buf (buffer-list)) + (with-current-buffer buf (flan--dynamic-install)))) + +;; A file opened while a session is already up: the two moments the table is +;; rebuilt are both in the past by then, so the buffer has to ask on its way in. +(add-hook 'flan-mode-hook #'flan--dynamic-install) + (defun flan--forget-defs () "Drop what is known about the program's names." - (setq flan--defs nil)) + (setq flan--defs nil) + ;; ...and with it every colour that came from it, so a buffer with no session + ;; behind it is drawn by `flan-mode' alone — which is exactly how it was + ;; drawn before it was ever connected. + (flan--dynamic-sync)) (defun flan-refresh-defs () "Ask the running program what it defines, and remember it." (interactive) (setq flan--defs (plist-get (flan--request '(:op "defs")) :defs)) + ;; The one place the answer changes, so the one place the colours have to. + ;; Both moments reach here: `flan-connect' asks on the way up, and + ;; `flan--report' asks again after an evaluation the daemon accepted — so a + ;; `defn' you just sent is drawn as a function without being asked for. + (flan--dynamic-sync) (when (called-interactively-p 'interactive) (message "flan: %d names" (length flan--defs))) flan--defs) +(defconst flan--compiled-kinds '("fn" "macro") + "The kinds that have a body the compiler emitted code for. +A macro is one: `Parse' desugars `(defmacro m [a] …)' into a `defn', so it is +compiled, installed and disassemblable exactly as a function is. It reaches +this end as kind `macro' rather than as `fn' — that is the point of the kind +— and every list that offers \"a thing with a body\" has to say both words or +it silently stops offering macros.") + +(defun flan--compiled-names () + "Every name the program has a compiled body for, for a completion table." + (mapcar #'car + (seq-filter (lambda (d) (member (nth 1 d) flan--compiled-kinds)) + flan--defs))) + (defun flan--lookup (name) "The entry for NAME, or nil. @@ -2594,8 +2814,7 @@ tail of exactly one packaged name, because a buffer inside a package writes (list (or (thing-at-point 'symbol t) (completing-read "Disassemble: " - (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) - flan--defs)) + (flan--compiled-names) nil t nil nil (and (fboundp 'flan-current-defun-name) (flan-current-defun-name)))) @@ -2650,8 +2869,7 @@ that the IR half is findable by name rather than only by a modifier." (list (or (thing-at-point 'symbol t) (completing-read "LLVM IR for: " - (mapcar #'car (seq-filter (lambda (d) (equal (nth 1 d) "fn")) - flan--defs)) + (flan--compiled-names) nil t)))) (flan-disassemble name t)) diff --git a/emacs/test-flan-mode.el b/emacs/test-flan-mode.el index 7b0bffd4..bdcfd7f1 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -208,6 +208,124 @@ c 3] (print c))") +;; A labelled loop, from `test/programs/loops.flan'. The label is a keyword +;; written where the binding vector would otherwise go, so it pushes everything +;; along by one — and until the indenter was told, the body of a labelled loop +;; was dragged out under its own binding vector. +(test-flan-mode--check + "a labelled dotimes indents its body by two, not under its vector" + "(dotimes :outer [a 3] + (dotimes [b 3] + (when (= b 2) (break :outer)) + (print b) (println \"\")))") + +;; `until' takes one on the same rule, and there the special argument is a test +;; rather than a vector — which is the case that shows the rule is about the +;; label and not about brackets. +(test-flan-mode--check + "and so does a labelled until, whose special argument is a test" + "(until :count (> n 10) + (set n (+ n 1)) + (when (= n 3) (break :count)))") + +;; The unlabelled form must not have moved, which is the other half of the +;; same claim. +(test-flan-mode--check + "an unlabelled dotimes is where it always was" + "(dotimes [b 3] + (print b) + (println \"\"))") + +;; `dotimes' binding vectors now hold up to four elements — name, start, stop, +;; step — and the indenter must not have learned a count. The vector is one +;; sexp whatever is in it, so the body is two in from the head in every arity, +;; and a vector that wraps aligns under its own first element. From +;; `test/programs/dotimes-range.flan'. +(test-flan-mode--check + "a three-element dotimes vector indents its body by two" + "(dotimes [i 2 5] + (print i) + (println \"\"))") + +(test-flan-mode--check + "and a four-element one, counting down, does the same" + "(dotimes [i 9 -1 -1] + (print i) + (println \"\"))") + +(test-flan-mode--check + "and a binding vector that wraps aligns under its first element" + "(dotimes [i 0 + (length items) + 2] + (print i))") + +;; The object and dispatch forms all begin `def', so they reach the `:defn' +;; fallback and indent their bodies by two. `defmethod' is the one with two +;; names before the parameter vector — the generic and the dispatch value — +;; which is exactly the case a count would have got wrong. From +;; `test/programs/dev-classes.flan'. +(test-flan-mode--check + "a defmethod indents its body by two, past generic and dispatch value" + "(defmethod area point [p] + (* (get p :x) + (get p :y)))") + +(test-flan-mode--check + "a defclass puts its slot vector in the body column" + "(defclass point + [x y])") + +(test-flan-mode--check + "and a defmulti indents its body by two" + "(defmulti describe [thing] dyn + (class-of thing))") + +;; `fn' is `defn' with no name and no return type: the parameter vector, then +;; the body. From `test/programs/higher-order.flan', written down the page. +(test-flan-mode--check + "an fn indents its body under its parameters by two" + "(sort-by s (fn [a b] + (< a b)))") + +;; A macro body indents by two like any `def…' form. It reaches that through +;; the `\\`def' fallback rather than through an entry, which is worth pinning: +;; the fallback is what covers every definer nobody listed. +(test-flan-mode--check + "a defmacro indents its body by two" + "(defmacro both [& args] + `(do ~@args))") + +;; A macro's parameter list destructures now, so it holds names and a `&' +;; rest marker rather than one blob. It is still a vector, so a list that +;; wraps aligns name under name like every other vector here — and `&' is a +;; name character, so it does not split the marker off from what follows. +(test-flan-mode--check + "a wrapped destructuring parameter list aligns under its first parameter" + "(defmacro guard [test message + & body] + `(when ~test ~@body))") + +;; A generic `defn' writes its constraint map between the return type and the +;; body — `test/programs/generic-map-reject.flan'. It is a brace, so it aligns +;; under its first element like every other brace, and the body after it is +;; still two in from `defn'. +(test-flan-mode--check + "a where clause sits in the body column and does not move the body" + "(defn seen? [k $t] bool + {:where (hashable? $t)} + (let [m (map-new t i32)] + (put m k 1)))") + +;; A comma is whitespace, so a vector written with commas is the same vector +;; and lines up the same way. It reads as one now because the syntax table +;; says so; before, a comma was punctuation and sat in the middle of a name. +(test-flan-mode--check + "commas between bindings change nothing" + "(let [vel 1.0, + y 2.0] + (print y))") + ;;; Font lock @@ -242,5 +360,314 @@ (test-flan--check "a dot inside a name does not start a label" (null (test-flan-mode--face-at "(f alpha.beta)" ".beta"))) +;; The pass over the static table. Each row is a piece of the corpus and the +;; face the name in it should carry; several of these were drawn as nothing at +;; all until the table was brought back into line with `lib/parse.ml' and +;; `lib/check.ml'. +(dolist (case '(;; A definer that was missing: the head was not a keyword and + ;; the name after it was not a function name. + ("(defmacro both [& args] `(do ~@args))" "defmacro" + font-lock-keyword-face "defmacro's head") + ("(defmacro both [& args] `(do ~@args))" "both" + font-lock-function-name-face "and the macro's name") + ("(declare-c mouse-down? [b i32] bool \"X\")" "declare-c" + font-lock-keyword-face "declare-c's head") + ;; The defining forms that arrived with the object system and + ;; with the def/defonce/defconst trio. + ("(def ticks i64 0)" "def" font-lock-keyword-face "def's head") + ("(def ticks i64 0)" "ticks" font-lock-function-name-face + "and the name it introduces") + ("(defonce seed i64 1)" "defonce" font-lock-keyword-face + "defonce") + ("(defclass point [x y])" "defclass" font-lock-keyword-face + "defclass") + ("(defgeneric area [self] dyn)" "defgeneric" + font-lock-keyword-face "defgeneric") + ("(defmethod area point [p] 1)" "defmethod" + font-lock-keyword-face "defmethod") + ;; `handler-case' is implemented now and is a keyword like the + ;; other three condition forms. + ("(handler-case (go) [(E [c] 1)])" "handler-case" + font-lock-keyword-face "handler-case") + ;; Special forms the old list had never heard of. + ("(cond (= a 1) 2)" "cond" font-lock-keyword-face "cond") + ("(and a b)" "and" font-lock-keyword-face "and") + ("(handler-bind [(E [c] 1)] (go))" "handler-bind" + font-lock-keyword-face "handler-bind") + ("(restart-case (go) (retry [] 1))" "restart-case" + font-lock-keyword-face "restart-case") + ("(signal ArithError {.op 1})" "signal" + font-lock-keyword-face "signal") + ("(dotimes [b 3] (break :outer))" "break" + font-lock-keyword-face "break") + ;; The two array constructors, which the parser reads itself + ;; because their dimensions are in brackets — see + ;; `test/programs/array-fill.flan'. + ("(array-fill [rows cols] 255)" "array-fill" + font-lock-keyword-face "array-fill") + ("(array-gen [n] f)" "array-gen" + font-lock-keyword-face "array-gen") + ;; A builtin is a call, not a form the parser knows, and it is + ;; drawn as one. + ("(push v 1)" "push" font-lock-builtin-face "a builtin") + ("(slice xs 0 4)" "slice" font-lock-builtin-face "and another") + ("(bytes-view b)" "bytes-view" font-lock-builtin-face + "bytes-view") + ("(length xs)" "length" font-lock-builtin-face "length") + ("(class-of x)" "class-of" font-lock-builtin-face "class-of") + ("(filled xs 0)" "filled" font-lock-builtin-face "filled") + ;; Types. + ("(defn f [x dyn] dyn x)" "dyn" font-lock-type-face "dyn") + ("(def v (Vec u8))" "Vec" font-lock-type-face "Vec") + ("(declare apply [(Fn [i64] i64)] i64)" "Fn" + font-lock-type-face "Fn") + ("(defn seen? [k $t] bool 1)" "$t" font-lock-type-face + "a type variable") + ;; The package alias of a qualified name, `clojure-mode''s + ;; rule for a namespace. + ("(rl/draw-text \"hi\" 1 2 3)" "rl" font-lock-type-face + "a package alias") + ("(defn f [x int] float 1.0)" "int" font-lock-type-face + "int, the builtin alias") + ;; Constants that stand for themselves. + ("(set done true)" "true" font-lock-constant-face "true") + ("(= o None)" "None" font-lock-constant-face "None") + ("(set x nil)" "nil" font-lock-constant-face "nil") + ("(def buf (Vec u8) uninit)" "uninit" font-lock-constant-face + "uninit, which is only ever written here"))) + (test-flan--check (format "%s is drawn" (nth 3 case)) + (eq (test-flan-mode--face-at (nth 0 case) (nth 1 case)) + (nth 2 case)))) + +;; `Unit' is a name the resolver answers to and the parser refuses — unit is +;; written `()'. Drawing it as a type would advertise a spelling that does not +;; compile, which is the same rule that keeps `await' out of the keyword list. +(test-flan--check + "Unit is not drawn as a type, because the parser refuses the word" + (null (test-flan-mode--face-at "(defn f [] Unit 1)" "Unit"))) + +;; `context/allocator' has a slash in it and is not a qualified name: there is +;; no package called `context'. The constants rule runs first for exactly this +;; reason, and this is what would notice if it stopped. +(test-flan--check + "context/allocator is one constant and not an alias and a name" + (eq (test-flan-mode--face-at "(free-all (context/allocator))" "context/") + 'font-lock-constant-face)) + +;; The name after a package alias is left for the running program to speak for +;; — see the dynamic section below. With no program it is undrawn, and that is +;; the state a file opened on its own is in. +(test-flan--check + "the name after the alias is left alone" + (null (test-flan-mode--face-at "(rl/draw-text \"hi\" 1 2 3)" "draw-text"))) + + +;;; Font lock from the running program + +;; `flan.el' adds a second set of rules that draw what the program *defines* — +;; a macro as a macro, a function as a function — and everything below drives +;; them from a fixture `flan--defs' rather than from a daemon. The live half, +;; where an evaluation is accepted and the name lights up without anyone asking +;; for it, is in test-flan.el, which has a program to evaluate against. + +(require 'flan) + +(defconst test-flan-mode--defs + ;; The shape `Dev.defs' answers with: (NAME KIND SIGNATURE LOC DOC). + '(("settle" "fn" "settle [i32 i32] ()" "sand.flan:3" "") + ("ticks" "var" "ticks i64" "" "") + ("gravity" "const" "gravity f32" "" "") + ("with-retry" "macro" "with-retry [args] Form" "" "") + ("Pixel" "struct" "Pixel" "" "") + ("Shape" "data" "Shape" "" "") + ("Key" "enum" "Key" "" "") + ("sim/step" "fn" "sim/step [] ()" "sand.flan:9" "") + ("a/draw" "fn" "a/draw [] ()" "" "") + ("b/draw" "fn" "b/draw [] ()" "" "") + ;; The program is allowed to define a name the language already uses. It + ;; does not get to repaint it. + ("length" "fn" "length [i32] i32" "" "") + ("if" "fn" "if [i32] i32" "" "") + ;; And a kind this editor has never heard of, which the daemon is allowed + ;; to add. + ("somenewthing" "sigil" "somenewthing" "" "")) + "A `defs' reply to draw against.") + +(defun test-flan-mode--dyn-face (text needle &optional defs) + "The face on NEEDLE in TEXT with DEFS as what the program defines." + (let ((flan--defs (if (eq defs 'none) nil (or defs test-flan-mode--defs)))) + (flan--dynamic-rebuild) + (with-temp-buffer + (insert text) + (flan-mode) + (flan--dynamic-install) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward needle) + (get-text-property (- (point) (length needle)) 'face)))) + +(message "\n-- font lock from the program") + +(dolist (case '(("(settle 1 2)" "settle" flan-function-face "a function") + ("(set ticks 0)" "ticks" flan-global-face "a global") + ("(print gravity)" "gravity" flan-global-face "a constant") + ("(with-retry (go))" "with-retry" flan-macro-face "a macro") + ("(def p (Vec Pixel))" "Pixel" flan-type-face "a struct") + ("(defn f [s Shape] () 1)" "Shape" flan-type-face "a data type") + ("(def k Key)" "Key" flan-type-face "an enum"))) + (test-flan--check (format "%s the program defines is drawn as one" (nth 3 case)) + (eq (test-flan-mode--dyn-face (nth 0 case) (nth 1 case)) + (nth 2 case)))) + +;; A macro and a function must not look alike — the whole point — so this is +;; asserted as a difference and not only as two faces. +(test-flan--check + "a macro and a function are not drawn the same" + (not (eq (test-flan-mode--dyn-face "(with-retry (go))" "with-retry") + (test-flan-mode--dyn-face "(settle 1 2)" "settle")))) + +;; A macro is compiled, so it has a body to disassemble and to lower — and the +;; lists that offer "a thing with a body" used to filter on kind `fn' alone. +;; Giving macros a kind of their own would have quietly dropped them out of +;; `flan-disassemble', `flan-disassemble-ir' and `flan-lowering' unless every +;; one of those learned the second word. +(test-flan--check + "a macro is offered by the completion table for a compiled body" + (let ((flan--defs test-flan-mode--defs)) + (and (member "with-retry" (flan--compiled-names)) + (member "settle" (flan--compiled-names))))) + +(test-flan--check + "and a global is not, because it has no body" + (let ((flan--defs test-flan-mode--defs)) + (not (member "ticks" (flan--compiled-names))))) + +;; A constructor is `Type.Case' and is one symbol, so the type half is what +;; the program can speak for and the case half is left alone. +(test-flan--check + "a constructor's type half is drawn" + (eq (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" "Shape") + 'flan-type-face)) + +(test-flan--check + "and its case half is not" + (null (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" ".Dot"))) + +(test-flan--check + "a name the program has never heard of is left alone" + (null (test-flan-mode--dyn-face "(never-defined 1)" "never-defined"))) + +(test-flan--check + "and so is a kind this editor does not know" + (null (test-flan-mode--dyn-face "(somenewthing)" "somenewthing"))) + +;; The static rules win, and they win in both directions: a program function +;; called `length' keeps the builtin colour, and one called `if' keeps the +;; keyword colour. +(test-flan--check + "a program function named length is still drawn as the builtin" + (eq (test-flan-mode--dyn-face "(length xs)" "length") + 'font-lock-builtin-face)) + +(test-flan--check + "and one named if is still drawn as the special form" + (eq (test-flan-mode--dyn-face "(if a 1 2)" "if") 'font-lock-keyword-face)) + +;; A buffer inside a package writes `step' for what the program calls +;; `sim/step'. One package offers it, so it resolves — the rule `flan--lookup' +;; already follows for eldoc and `M-.'. +(test-flan--check + "an unqualified name that one package offers is drawn" + (eq (test-flan-mode--dyn-face "(step)" "step") 'flan-function-face)) + +(test-flan--check + "and one that two packages offer is not, because that would be a guess" + (null (test-flan-mode--dyn-face "(draw)" "draw"))) + +;; With no session there is nothing to say, and the buffer has to be drawn +;; exactly as `flan-mode' alone draws it. +(test-flan--check + "with no session a program name is undrawn" + (null (test-flan-mode--dyn-face "(settle 1 2)" "settle" 'none))) + +(test-flan--check + "and the language is drawn as it always was" + (eq (test-flan-mode--dyn-face "(let [a 1] a)" "let" 'none) + 'font-lock-keyword-face)) + +;; Whole-buffer, because "nothing changes" is a claim about every character and +;; not about one name: a corpus file drawn with no session must come out +;; character for character and face for face as it did before any of this. +(defun test-flan-mode--faces (text &optional defs) + "Every (POS . FACE) in TEXT, with DEFS as what the program defines." + (let ((flan--defs (if (eq defs 'none) nil defs))) + (flan--dynamic-rebuild) + (with-temp-buffer + (insert text) + (flan-mode) + (flan--dynamic-install) + (font-lock-ensure) + (let (acc) + (dotimes (i (1- (point-max))) + (push (get-text-property (1+ i) 'face) acc)) + (nreverse acc))))) + +(let ((text "(defn settle [row i32] ()\n (let [vel gravity]\n (set ticks vel)))\n")) + (test-flan--check + "a buffer with no session is drawn exactly as the mode alone draws it" + (equal (test-flan-mode--faces text 'none) + (let ((flan-font-lock-dynamically nil)) + (test-flan-mode--faces text test-flan-mode--defs)))) + ;; ...and turning the setting off with a session up is the same picture, + ;; which is what makes it an off switch rather than a reconnect. + (test-flan--check + "and turning the option off gives that same picture back" + (equal (test-flan-mode--faces text 'none) + (let ((flan-font-lock-dynamically nil)) + (test-flan-mode--faces text test-flan-mode--defs)))) + (test-flan--check + "while with one it is drawn differently" + (not (equal (test-flan-mode--faces text 'none) + (test-flan-mode--faces text test-flan-mode--defs))))) + +;; Installing twice must not leave two copies of the rule behind: a refresh +;; happens after every accepted evaluation, and a rule added each time would +;; make redisplay slower for as long as the session lasted. +(test-flan--check + "installing repeatedly leaves one copy of the rule" + (let ((flan--defs test-flan-mode--defs)) + (flan--dynamic-rebuild) + (with-temp-buffer + (flan-mode) + (font-lock-ensure) + (dotimes (_ 5) (flan--dynamic-install)) + (= 1 (seq-count (lambda (k) (equal k (car flan--dynamic-keywords))) + font-lock-keywords))))) + +;;; Electric pairs + +;; `electric-pair-mode' reads the syntax table and nothing else, so the three +;; bracket pairs Flan writes work without a word being said about them — and +;; that is exactly why it wants a test: the table gained entries in this pass, +;; and a mistake in one of them would show up here first. + +(message "\n-- electric pairs") + +(defun test-flan-mode--pair (open) + "Type OPEN in a Flan buffer with `electric-pair-mode' on, and read the line." + (with-temp-buffer + (flan-mode) + (electric-pair-local-mode 1) + (let ((last-command-event open)) + (call-interactively #'self-insert-command)) + (buffer-string))) + +(dolist (case '((?\( "()" "a paren") + (?\[ "[]" "a bracket") + (?{ "{}" "a brace") + (?\" "\"\"" "a string"))) + (test-flan--check (format "%s closes itself" (nth 2 case)) + (equal (test-flan-mode--pair (nth 0 case)) (nth 1 case)))) + (provide 'test-flan-mode) ;;; test-flan-mode.el ends here diff --git a/emacs/test-flan.el b/emacs/test-flan.el index e269e968..a346716b 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -458,6 +458,73 @@ already rely on it — so nothing here is a stand-in for the real thing." (equal (nth 2 (assoc "freshly-added" flan--defs)) "freshly-added [] i64")) + ;; ── What the program knows, drawn in the buffer ────────────────────── + ;; + ;; The fixture-driven half of this is in test-flan-mode.el, which has no + ;; daemon: what needs one is that the *wire* carries enough to tell a macro + ;; from a function, and that an accepted evaluation redraws the buffer with + ;; nobody asking it to. + + (test-flan--check "a type the program defines is on the wire, as its form" + (let ((d (assoc "Missing" flan--defs))) + (and d (equal (nth 1 d) "struct")))) + (test-flan--check "and a prelude macro says it is a macro" + (let ((d (assoc "unless" flan--defs))) + (and d (equal (nth 1 d) "macro")))) + + ;; A macro evaluated at the editor: the session remembers it, and the kind + ;; is what makes it drawable as one. Nothing else on `defs' could stand in + ;; — there are no macros in a checked program, because they have run. + (flan--eval "(defmacro twice [& args] `(do ~@args ~@args))" "form") + (test-flan--check "a macro just installed says it is a macro" + (let ((d (assoc "twice" flan--defs))) + (and d (equal (nth 1 d) "macro")))) + + ;; A macro is compiled to a `defn', which is the only thing that knows where + ;; it was written. The `fn' row is dropped so that a macro is listed once, + ;; and the location has to survive that or `M-.' on a macro stops working. + (test-flan--check "and carries where it was written, so M-. still goes there" + (let ((d (assoc "twice" flan--defs))) + (and d (not (equal (nth 3 d) ""))))) + ;; A prelude macro carries its parameter vector like any other, so eldoc on + ;; `unless' shows a signature rather than the bare word. + (test-flan--check "a prelude macro carries a real signature" + (let ((d (assoc "unless" flan--defs))) + (and d (string-match-p "\\[.*\\] Form" (nth 2 d))))) + ;; The prelude's, which must keep refusing for the reason it always did: + ;; it is a string inside the compiler and not a file anyone can open. With + ;; no location it would refuse for the wrong reason instead. + (let ((raised nil)) + (condition-case err (xref-backend-definitions 'flan "unless") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "M-. on a prelude macro still names the prelude" + (and raised (string-match-p "unless" raised) + (string-match-p "not a file on disk" raised)))) + + ;; And the buffer is redrawn for it. No refresh command is run here on + ;; purpose: the claim is that evaluating is enough. + (font-lock-ensure) + (test-flan--check + "a name installed now is drawn now, with nothing else asked for" + (save-excursion + (goto-char (point-max)) + (insert "\n(freshly-added)\n") + (font-lock-ensure) + (prog1 (eq (get-text-property (- (point) (length "(freshly-added)\n") -1) + 'face) + 'flan-function-face) + (delete-region (- (point) (length "\n(freshly-added)\n")) (point))))) + + (test-flan--check + "and a macro is not drawn like a function" + (save-excursion + (goto-char (point-max)) + (insert "\n(twice 1)\n") + (font-lock-ensure) + (prog1 (eq (get-text-property (- (point) (length "(twice 1)\n") -1) 'face) + 'flan-macro-face) + (delete-region (- (point) (length "\n(twice 1)\n")) (point))))) + ;; The session is not poisoned by that: a good form still lands. (flan--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") @@ -1561,6 +1628,8 @@ already rely on it — so nothing here is a stand-in for the real thing." "(def speed 2)\n" "(defconst limit i64 10)\n" "(declare later [] i64)\n" + "(declare-c now [] i64 \"clock_now\")\n" + "(defmacro twice [& args] `(do ~@args ~@args))\n" "(defn step [] i64\n" " (let [x 1]\n" " (defn not-top-level [] i64 2)\n" @@ -1586,6 +1655,16 @@ already rely on it — so nothing here is a stand-in for the real thing." (test-flan--check "and a declaration, said to be one" (and (assoc "later" (funcall group "Declared")) (null (assoc "later" (funcall group "Functions"))))) + ;; `declare-c' declares a name the same way `declare' does and differs + ;; only in generating the C that reaches it, so it belongs under the + ;; same heading — and it was under none at all. + (test-flan--check "and a C declaration, under the same heading" + (assoc "now" (funcall group "Declared"))) + ;; A macro runs at compile time and a function at run time, which is the + ;; one difference worth an index heading of its own. + (test-flan--check "and a macro, under its own" + (and (assoc "twice" (funcall group "Macros")) + (null (assoc "twice" (funcall group "Functions"))))) ;; A `defn' inside a `let' defines nothing at the top level, and the ;; index is anchored at column 0 so that it cannot offer one. (test-flan--check "and nothing that is not a top-level form" diff --git a/lib/dev.ml b/lib/dev.ml index c2bfdc5d..1a64e9c0 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1386,6 +1386,13 @@ let describe t = empty where there is none to give — only [Tast.fn] carries one — and an editor that finds it empty must say so rather than guess a file. + [kind] is one of: [fn], [macro], [struct], [data], [union], [enum], [alias], + [var], [const], [extern], [builtin]. It is the *declaring form* rather than + a coarser word, because that is the fact this end has and the editor can + always coarsen it — Emacs draws all five type kinds with one face. A client + meeting a kind it does not know should treat the name as a name and nothing + more; the set has grown once already and may again. + [doc] carries a line of prose, and today only a builtin has one. A [defn] does not, and that is not an oversight this op can fix: the Tast keeps no docstring, so the field would be empty for every program name until the @@ -1399,6 +1406,22 @@ let signature_of_fn (f : Tast.fn) = (String.concat " " (List.map Types.to_string f.Tast.params)) (Types.to_string f.Tast.ret) +(* Where a macro was written, out of the table [defs] fills as it drops the + [Tast.fn] a macro was compiled into. Empty for one the checker never saw — + a macro declared in a package the session holds but the program does not + call — which is the same empty string a global answers with and which the + editor already knows how to refuse. *) +let macro_loc tbl name = try Hashtbl.find tbl name with Not_found -> "" + +(* The prelude's [defmacro] forms, read once. [Macro.prelude_macros] holds only + the names and [defs] wants the parameter vectors too, so the forms are kept + here — and kept lazily for the reason that one is: [Prelude.forms] re-reads + and re-parses the whole prelude on every call, and [defs] is asked on connect + and again after every accepted evaluation. *) +let prelude_macro_forms = + lazy + (List.filter (fun f -> Macro.macro_name f <> None) (Prelude.forms ())) + let entry ~name ~kind ~sign ~loc ?(doc = "") () = Wire.list [ Wire.quote name; Wire.quote kind; Wire.quote sign; Wire.quote loc; @@ -1406,6 +1429,23 @@ let entry ~name ~kind ~sign ~loc ?(doc = "") () = let defs t = let p = t.session.Session.program in + (* Which names are macros, decided before anything else is listed, because a + macro is *also* a function here: [Parse]'s [defmacro] arm desugars one to + [(defn m [args [Form]] Form ...)], so every macro is in [Tast.fns] too and + would otherwise be listed twice, [fn] first. Once is right and [macro] is + the true half — the other is how it is compiled, which is not what anyone + is asking. *) + let macro_names = + List.sort_uniq compare + (List.filter_map Macro.macro_name t.session.Session.macros + @ Lazy.force Macro.prelude_macros) + in + (* Where each of those was written. A macro is compiled, so the [Tast.fn] the + row above is dropping is the only thing that knows — and dropping it + without keeping this would have taken [M-.] on a macro away, and turned + [M-.] on a prelude macro from "the prelude is not a file on disk" into a + shrug about the daemon having no location. *) + let macro_locs = Hashtbl.create 16 in let fns = List.filter_map (fun (f : Tast.fn) -> @@ -1413,6 +1453,9 @@ let defs t = (* A handler-bind clause the checker lifted out. Nobody wrote this name, so completing it is noise and jumping to it is meaningless. *) | Some _ -> None + | None when List.mem f.Tast.name macro_names -> + Hashtbl.replace macro_locs f.Tast.name (Loc.to_string f.Tast.floc); + None | None -> Some (entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f) @@ -1440,6 +1483,80 @@ let defs t = ~loc:"" ()) p.Tast.externs in + (* The macros the session can expand a call to. Nothing else on this op could + stand in for them: [Tast.program] has no macros in it at all, because a + macro has run by the time there is a program, so an editor cannot infer + that a name is one from anything else here. It is a real kind rather than + a flag on [fn] because the two are different things to a reader — a macro + call's arguments are not evaluated — and an editor drawing them alike is + saying something untrue. + + The signature is the parameter vector as written. A macro takes one + parameter, the slice of argument forms, and answers a [Form]; see + [Parse]'s [defmacro] arm, which desugars exactly that. *) + let macro_entry (f : Form.t) = + match Macro.macro_name f with + | None -> None + | Some name -> + let params = + match f.Form.v with + | Form.List (_ :: _ :: { Form.v = Form.Vec ps; _ } :: _) -> + String.concat " " (List.map Form.to_source ps) + | _ -> "" + in + Some + (entry ~name ~kind:"macro" + ~sign:(Printf.sprintf "%s [%s] Form" name params) + ~loc:(macro_loc macro_locs name) ()) + in + let macros = List.filter_map macro_entry t.session.Session.macros in + (* The prelude's, which the session's list deliberately does not hold — see + [Macro.loaded_for], which drops them from a file's own set so that a + prelude macro is not declared twice. [Session.macroexpand] can expand a + call to one all the same, so an editor that asked what it can expand and + was told everything *but* [unless] would have been told something false. *) + let prelude_macros = + let own = List.filter_map Macro.macro_name t.session.Session.macros in + List.filter_map + (fun f -> + match Macro.macro_name f with + (* A file may write its own [unless]; the session's entry above is + then the one that answers, and listing this one after it would be + a second row for one name. *) + | Some name when List.mem name own -> None + (* Built through the same [macro_entry] as the session's, so a prelude + macro carries its parameter vector too — eldoc on [unless] shows + [unless [& args] Form] rather than the bare word. + [Macro.prelude_macros] is only the names, so the forms are kept + beside it — see [prelude_macro_forms]. *) + | Some _ -> macro_entry f + | None -> None) + (Lazy.force prelude_macro_forms) + in + (* The type names, which an editor wants for the same reason it wants the + function names: a struct the program defines is not an unknown word, and + until now this op said nothing about it. The kind is the declaring form, + not a flattened "type", because that is the honest answer and an editor + that wants one face for all five can map them itself. + + Read off the checker's environment rather than [Tast.program]: an enum and + an alias are both gone by the time there is a program — an enum is an i32 + and an alias is the type it stands for — and the environment is the only + place that still remembers the name was written. *) + let types = + let env = t.session.Session.env in + let of_table kind tbl = + Hashtbl.fold + (fun name _ acc -> entry ~name ~kind ~sign:name ~loc:"" () :: acc) + tbl [] + in + List.sort compare + (of_table "struct" env.Check.structs + @ of_table "data" env.Check.datas + @ of_table "union" env.Check.unions + @ of_table "enum" env.Check.enums + @ of_table "alias" env.Check.aliases) + in (* Last, so a program's own names sort ahead of them in every list an editor builds out of this — a completion table above all, where 78 compiler names interleaved with a handful of a program's own would bury the ones being @@ -1457,7 +1574,11 @@ let defs t = (fun (name, sign, doc) -> entry ~name ~kind:"builtin" ~sign ~loc:"" ~doc ()) Check.builtins in - ok [ ":defs " ^ Wire.list (fns @ globals @ externs @ builtins) ] + ok + [ ":defs " + ^ Wire.list + (fns @ macros @ types @ globals @ externs @ prelude_macros @ builtins) + ] (* [(:op "layout" :type T)] — a struct's fields and their types.