From cf028e23ea725fde3c1f567596adc3b655bc8c75 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 07:09:42 +0700 Subject: [PATCH] A class and each case of a data type are names on the definitions list --- TODO.org | 12 ++++---- emacs/flan.el | 28 ++++++++++++------- emacs/test-flan-mode.el | 32 +++++++++++++++------ lib/dev.ml | 62 ++++++++++++++++++++++++++++++++++++++++- test/test_dev.ml | 52 ++++++++++++++++++++++++++++++++++ 5 files changed, 162 insertions(+), 24 deletions(-) diff --git a/TODO.org b/TODO.org index 422648a4..9997215c 100644 --- a/TODO.org +++ b/TODO.org @@ -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] diff --git a/emacs/flan.el b/emacs/flan.el index 72a4dae4..1db19f22 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -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.") diff --git a/emacs/test-flan-mode.el b/emacs/test-flan-mode.el index e166a299..e7e2f887 100644 --- a/emacs/test-flan-mode.el +++ b/emacs/test-flan-mode.el @@ -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" diff --git a/lib/dev.ml b/lib/dev.ml index 693575a2..2628ee7f 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index 5be18307..6e4ca1a8 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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. *)