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

A class and each case of a data type are names on the definitions list

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 07:09:42 +07:00
parent 2e58880160
commit cf028e23ea
5 changed files with 162 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
TODO.org
View File

@ -1718,11 +1718,13 @@ with the selected frame's locals.
** TODO Hex, binary and an address on a primitive in the inspector
The last item of the Emacs batch besides the break buffer, and independent of it.
** TODO A defclass is not on the definitions list as a type, and a sum's cases are not drawn
A =defclass= is expanded away before the checker — a dyn map and a shape tag by
then — so there is no class table to read. A sum's cases are one symbol each and
the daemon answers with the type's name only. =CFn= also wants adding to the type
rule.
** DONE A defclass is not on the definitions list as a type, and a sum's cases are not drawn
CLOSED: [2026-09-25]
=defs= reads classes off the session's declarations, which still hold every
=defclass=, and lists each as kind =class= with its slots and location; its
constructor is not listed again as a =fn=. Each data case is a =case= row named
=Type.Case=, drawn whenever =data= is, and the data row's signature lists its
cases. =CFn= is in =flan-mode='s type rule.
** CANCELLED A flycheck checker, and a structured JSON report
CLOSED: [2026-09-20]

28
emacs/flan.el
View File

@ -1850,8 +1850,9 @@ other, and KIND is what tells it apart where that matters.")
"Which kinds of name to colour by what the running program says they are.
A list of kinds drawn from `flan--dynamic-faces': `macro', `fn', `var',
`const', `struct', `data', `union', `enum', `alias', `extern', `builtin'.
t draws all of them and nil draws none.
`const', `struct', `data', `union', `enum', `alias', `class', `extern',
`builtin'. t draws all of them and nil draws none. A data type's cases are
drawn when `data' is on the list.
The default is macros alone, which is the one kind a reader cannot work out
from the call itself — a macro does not evaluate its arguments, so the shape
@ -1916,7 +1917,11 @@ compiler has grown since, which is the point of asking rather than listing."
("data" . flan-type-face)
("union" . flan-type-face)
("enum" . flan-type-face)
("alias" . flan-type-face))
("alias" . flan-type-face)
;; A data type's case, `Shape.Rect', and a `defclass', which is a name
;; that constructs a value of that class.
("case" . flan-type-face)
("class" . 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
@ -1932,7 +1937,9 @@ The setting is written with symbols because that is what a user types; the
wire answers with strings."
(cond ((eq flan-font-lock-dynamically t) t)
((null flan-font-lock-dynamically) nil)
(t (and (memq (intern kind) flan-font-lock-dynamically) t))))
(t (and (memq (intern (if (equal kind "case") "data" kind))
flan-font-lock-dynamically)
t))))
(defvar flan--dynamic-face nil
"The face `flan--dynamic-match' found, read by the font-lock rule after it.")
@ -1973,10 +1980,10 @@ Leaves its face in `flan--dynamic-face' for the rule that calls this."
(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.
;; so the whole thing is one symbol. The daemon lists each case under
;; that full name, so the lookup above finds it. A dotted symbol it
;; does not list, such as a case that does not exist, has only its
;; type half drawn.
(unless face
(let ((dot (string-search "." sym)))
(when (and dot (> dot 0))
@ -2050,10 +2057,11 @@ Called for its effect on one buffer; `flan--dynamic-sync' does every buffer."
(message "flan: %d names" (length flan--defs)))
flan--defs)
(defconst flan--compiled-kinds '("fn" "macro")
(defconst flan--compiled-kinds '("fn" "macro" "class")
"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
compiled, installed and disassemblable exactly as a function is. So is a
class, whose name is its constructor `defn'. 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.")

32
emacs/test-flan-mode.el
View File

@ -485,7 +485,10 @@
("gravity" "const" "gravity f32" "" "")
("with-retry" "macro" "with-retry [args] Form" "" "")
("Pixel" "struct" "Pixel" "" "")
("Shape" "data" "Shape" "" "")
("Shape" "data" "Shape [Empty (Dot [x f64 y f64])]" "" "")
("Shape.Empty" "case" "Shape.Empty" "" "")
("Shape.Dot" "case" "(Shape.Dot [x f64 y f64])" "" "")
("point" "class" "point [x y]" "sand.flan:20:1" "")
("Key" "enum" "Key" "" "")
("sim/step" "fn" "sim/step [] ()" "sand.flan:9" "")
("a/draw" "fn" "a/draw [] ()" "" "")
@ -572,17 +575,30 @@
(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.
;; A constructor is `Type.Case' and is one symbol. The daemon lists each
;; case under that name, so the whole symbol is drawn, and it is drawn when
;; the data type is: a case is part of its type, not a kind to ask for apart.
(test-flan--check
"a constructor's type half is drawn"
(let ((flan-font-lock-dynamically t))
(eq (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" "Shape")
"a constructor is drawn whole, case half included"
(let ((flan-font-lock-dynamically '(data)))
(eq (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" ".Dot")
'flan-type-face)))
(test-flan--check
"and its case half is not"
(null (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" ".Dot")))
"and not when data types are not asked for"
(null (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" "Shape.Dot")))
(test-flan--check
"a case the program does not have draws only its type half"
(let ((flan-font-lock-dynamically t))
(and (eq (test-flan-mode--dyn-face "(match s (Shape.Nope) 1)" "Shape")
'flan-type-face)
(null (test-flan-mode--dyn-face "(match s (Shape.Nope) 1)" ".Nope")))))
(test-flan--check
"a class the program defines is drawn when classes are asked for"
(let ((flan-font-lock-dynamically '(class)))
(eq (test-flan-mode--dyn-face "(point 1 2)" "point") 'flan-type-face)))
(test-flan--check
"a name the program has never heard of is left alone"

62
lib/dev.ml
View File

@ -1446,6 +1446,21 @@ let defs t =
[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
(* The classes, off the session's declarations: [Classes.expand] turns a
[defclass] into its constructor [defn] before the checker runs, so the
class is not in [Tast.program] or the checker's environment, and the
declarations are the one place that still has it. Its constructor is
dropped from the [fn] rows for the macro rows' reason: one name, one row,
and [class] is what was written. *)
let classes =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (n, slots) -> Some (n, List.map fst slots, d.Ast.dloc)
| _ -> None)
t.session.Session.decls
in
let class_names = List.map (fun (n, _, _) -> n) classes in
let fns =
List.filter_map
(fun (f : Tast.fn) ->
@ -1456,6 +1471,7 @@ let defs t =
| None when List.mem f.Tast.name macro_names ->
Hashtbl.replace macro_locs f.Tast.name (Loc.to_string f.Tast.floc);
None
| None when List.mem f.Tast.name class_names -> None
| None ->
Some
(entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f)
@ -1550,9 +1566,53 @@ let defs t =
(fun name _ acc -> entry ~name ~kind ~sign:name ~loc:"" () :: acc)
tbl []
in
(* A data type's cases are names too: [Shape.Rect] is written at every
construction, and a [case] row is what lets an editor draw it and eldoc
show its fields. The data row's signature lists its cases in the order
and spelling of the [defdata]. *)
let case_sign label (v : Tast.variant) =
match v.Tast.vfields with
| [] -> label
| fs ->
Printf.sprintf "(%s [%s])" label
(String.concat " "
(List.map
(fun (f : Tast.field) ->
f.Tast.fname ^ " " ^ Types.to_string f.Tast.fty)
fs))
in
let datas =
Hashtbl.fold
(fun name (d : Tast.data) acc ->
let cases =
List.map
(fun (v : Tast.variant) ->
let full = name ^ "." ^ v.Tast.vname in
entry ~name:full ~kind:"case" ~sign:(case_sign full v)
~loc:"" ())
d.Tast.cases
in
entry ~name ~kind:"data"
~sign:
(Printf.sprintf "%s [%s]" name
(String.concat " "
(List.map (fun v -> case_sign v.Tast.vname v) d.Tast.cases)))
~loc:"" ()
:: cases
@ acc)
env.Check.datas []
in
let classes =
List.map
(fun (n, slots, loc) ->
entry ~name:n ~kind:"class"
~sign:(Printf.sprintf "%s [%s]" n (String.concat " " slots))
~loc:(Loc.to_string loc) ())
classes
in
List.sort compare
(of_table "struct" env.Check.structs
@ of_table "data" env.Check.datas
@ datas @ classes
@ of_table "union" env.Check.unions
@ of_table "enum" env.Check.enums
@ of_table "alias" env.Check.aliases)

52
test/test_dev.ml
View File

@ -2271,6 +2271,33 @@ let () =
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the inspect program never stopped"
else begin
(* A data type's cases are on [defs] under their full names, and the
type's own row lists them in the order the [defdata] does. *)
(let r = ask "(:op \"defs\")" in
let row name =
match Wire.field r "defs" with
| Some { Form.v = Form.List entries; _ } ->
List.find_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List
({ Form.v = Form.Str n; _ } :: { Form.v = Form.Str k; _ }
:: { Form.v = Form.Str s; _ } :: _)
when String.equal n name -> Some (k, s)
| _ -> None)
entries
| _ -> None
in
let want name kind sign =
match row name with
| Some (k, s) when k = kind && s = sign -> ()
| Some (k, s) -> fail "%s is on defs as (%s %S)" name k s
| None -> fail "defs did not mention %s" name
in
want "Shape" "data"
"Shape [Empty (Dot [x f64 y f64]) (Rect [w i32 h i32])]";
want "Shape.Empty" "case" "Shape.Empty";
want "Shape.Rect" "case" "(Shape.Rect [w i32 h i32])");
(* The slot travels by index and the index comes off the listing,
which is the fourth element of each entry. Reading it here rather
than writing 0 exercises the field the editor depends on, and keeps
@ -6519,6 +6546,31 @@ let () =
else begin
if !answered <> "1" then
fail "the method the program was built with answered %S" !answered;
(* A class is on [defs] as a class, with its slots and where it is
written, and its constructor is not listed a second time as a fn. *)
(let r = request c "(:op \"defs\")" in
match Wire.field r "defs" with
| Some { Form.v = Form.List entries; _ } ->
let rows name =
List.filter_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List
({ Form.v = Form.Str n; _ } :: { Form.v = Form.Str k; _ }
:: { Form.v = Form.Str s; _ }
:: { Form.v = Form.Str l; _ } :: _)
when String.equal n name -> Some (k, s, l)
| _ -> None)
entries
in
(match rows "point" with
| [ ("class", "point [x y]", loc) ]
when String.length loc > 0 && loc.[0] = '/' -> ()
| rs ->
fail "point is on defs as %s"
(String.concat "; "
(List.map (fun (k, s, l) -> k ^ " " ^ s ^ " " ^ l) rs)))
| _ -> fail "defs did not answer with a list");
(* A circle has no method yet, so the dispatch misses and the generic
signals NoMethod — the answer a program handles, spelled here as
the thing that makes the next step's success mean something. *)