diff --git a/TODO.org b/TODO.org index 02617bc5..c7718d71 100644 --- a/TODO.org +++ b/TODO.org @@ -650,27 +650,10 @@ Decided 2026-09-26: a lambda's body follows ~=>~, and ~=>~ is its only spelling takes an indented block even inside brackets, closing where the brackets close: ~sort-by(xs, fn(a, b) =>~ plus a block. -** NEXT A type alias is written type Row = Vec(i32) -Decided 2026-09-26: .fln reads ~type Name = T~ as ~(defalias Name T)~, and the printer -writes it back. - -** TODO flan check prints every definition of a file that checks -A clean =flan check= lists the whole prelude (about 170 lines). Clean should print -nothing, or only the file's own definitions behind a flag. - -** NEXT Classes and methods have .fln syntax -Decided 2026-09-26: ~class Lambda(param, body, env)~, ~generic describe(v) -> dyn~, -~method describe(f: Lambda)~ plus a block (the class as the parameter's type), -~multi kind(v) -> dyn = type-of(v)~, ~method kind(v) when :int~ plus a block. - ** NEXT A top-level let is a global Decided 2026-09-26: in .fln ~let x = v~ at column 0 reads ~(def x v)~ and replaces ~def~, which is refused with that fix; ~once~ and ~const~ stay. -** NEXT A struct fits on one line -Decided 2026-09-26: ~struct Pt(x: i32, y: i32)~ beside the block form, like a data -case; union and a struct with a parent too. - ** TODO Hard-coded code in messages is still paren syntax in a .fln file Types follow the code's syntax now (=Types.spell=). Hints written into a message's text — =(Ptr %s)=, =(clone v)=, =(the T x)= in most of =check.ml= and =parse.ml=, the diff --git a/bin/main.ml b/bin/main.ml index 0a6184cd..2da76c62 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -226,9 +226,14 @@ let no_gc_flag = "--no-gc" downstream that it ran. *) let warn_memory_flag = "--warn-memory" +(* [flan check --defs]: every definition the checked program holds, prelude + included. Off by default, so a file that checks prints nothing. *) +let defs_flag = "--defs" + let flags = [ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag; - x86_flag; llvm_flag; no_annotate_flag; no_gc_flag; warn_memory_flag ] + x86_flag; llvm_flag; no_annotate_flag; no_gc_flag; warn_memory_flag; + defs_flag ] (* The warnings, where errors go. Printed one to a location in the repo's standard [file:line:col:] shape, with the squiggle [Loc.entry] draws, so @@ -355,6 +360,7 @@ let () = files | _ :: "check" :: args when List.exists (fun a -> not (is_flag a)) args -> let warn_memory = List.mem warn_memory_flag args in + let defs = List.mem defs_flag args in let files = List.filter (fun a -> not (is_flag a)) args in List.iter (fun path -> @@ -366,26 +372,28 @@ let () = program that checked, which is what leaves the exit status alone. *) if warn_memory then print_memory_warnings ~file:path p; - List.iter - (fun (g : Flan.Tast.global) -> - Printf.printf "%s %s %s\n" - (* The three defining forms, told apart the way the compiler - tells them apart: [gconst] is the image, and [grerun] is - what a re-run does to the storage. A listing that called - both mutable forms one name could not answer the question - someone runs [flan check] on a dev file to ask. *) - (if g.gconst then "defconst" - else if g.grerun then "def" else "defonce") - g.gname (Flan.Types.to_string g.gty)) - p.globals; - List.iter - (fun (f : Flan.Tast.fn) -> - if not (Flan.Check.internal_name f.name) then - Printf.printf "defn %s : (Fn [%s] %s) %d slots\n" f.name - (String.concat " " - (List.map Flan.Types.to_string f.params)) - (Flan.Types.to_string f.ret) (Array.length f.slots)) - p.fns)) + if defs then begin + List.iter + (fun (g : Flan.Tast.global) -> + Printf.printf "%s %s %s\n" + (* The three defining forms, told apart the way the compiler + tells them apart: [gconst] is the image, and [grerun] is + what a re-run does to the storage. A listing that called + both mutable forms one name could not answer the question + someone runs [flan check] on a dev file to ask. *) + (if g.gconst then "defconst" + else if g.grerun then "def" else "defonce") + g.gname (Flan.Types.to_string g.gty)) + p.globals; + List.iter + (fun (f : Flan.Tast.fn) -> + if not (Flan.Check.internal_name f.name) then + Printf.printf "defn %s : (Fn [%s] %s) %d slots\n" f.name + (String.concat " " + (List.map Flan.Types.to_string f.params)) + (Flan.Types.to_string f.ret) (Array.length f.slots)) + p.fns + end)) files (* The generated C, for looking at. A wrong FFI binding is wrong in the wrapper, and the wrapper is not on disk anywhere — [Build] hands the text @@ -982,7 +990,7 @@ let () = | None -> code)) | _ -> prerr_endline - "usage: flan (read|parse|check|emit|shim) ...\n flan check ... [--warn-memory]\n flan emit [--x86] [--dev] [--debug] [--no-bounds-checks]\n\ + "usage: flan (read|parse|check|emit|shim) ...\n flan check ... [--warn-memory] [--defs]\n flan emit [--x86] [--dev] [--debug] [--no-bounds-checks]\n\ \ flan import-c [package.flan...] [clang flags...]\n\ \ flan generate-c \n\ \ flan build [-o out] [-O0|-O1|-O2|-O3] \ diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index 3afbb17e..a27a1000 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -97,7 +97,7 @@ fine here. Brackets and strings are still paired." '("fn" "fn-" "def" "once" "const" "struct" "union" "data" "enum" "import" "if" "elif" "else" "while" "until" "for" "match" "let" "return" "break" "continue" "defer" "handler-case" "handler-bind" "restart-case" "on" - "restart" "quote" "macro" "loop")) + "restart" "quote" "macro" "loop" "type")) ;; The headers whose block follows on the lines under them. `defer' and ;; `quote' open one only when nothing follows them on the line; `fn' does not @@ -112,7 +112,7 @@ fine here. Brackets and strings are still paired." '(("fn" . "defn") ("fn-" . "defn-") ("def" . "def") ("once" . "defonce") ("const" . "defconst") ("struct" . "defstruct") ("data" . "defdata") ("enum" . "defenum") ("union" . "defunion") ("import" . "import") - ("macro" . "defmacro")) + ("macro" . "defmacro") ("type" . "defalias")) "Each declaration header word, and the paren head it reads as.") ;;; Syntax @@ -1560,7 +1560,10 @@ lambda or a `Fn(...)' type, and not after a match arm's." 1 font-lock-keyword-face) (,(concat "^\\(fn-?\\|macro\\)[ \t]+" flan-fln--name-re) 2 font-lock-function-name-face) - (,(concat "^\\(?:struct\\|data\\|union\\|enum\\)[ \t]+" flan-fln--name-re) + (,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\)[ \t]+" flan-fln--name-re) + 1 font-lock-type-face) + ;; An alias's type, `type Row = Vec(i32)'. + (,(concat "^type[ \t]+[^][ \t\n(){},;\":]+[ \t]+=[ \t]+" flan-fln--name-re) 1 font-lock-type-face) ;; A condition's parent, `struct DiskFull :parent IoError'. (,(concat "^struct[ \t]+[^][ \t\n(){},;\":]+[ \t]+:parent[ \t]+" flan-fln--name-re) @@ -1600,7 +1603,7 @@ lambda or a `Fn(...)' type, and not after a match arm's." (defvar flan-fln-imenu-generic-expression `(("Functions" ,(concat "^fn-?[ \t]+" flan-fln--name-re) 1) ("Macros" ,(concat "^\\(?:macro[ \t]+\\|defmacro(\\)" flan-fln--name-re) 1) - ("Types" ,(concat "^\\(?:struct\\|data\\|union\\|enum\\)[ \t]+" flan-fln--name-re) 1) + ("Types" ,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\)[ \t]+" flan-fln--name-re) 1) ("Variables" ,(concat "^\\(?:def\\|once\\|const\\)[ \t]+" flan-fln--name-re) 1)) "Imenu index for `flan-fln-mode'.") @@ -1610,7 +1613,7 @@ lambda or a `Fn(...)' type, and not after a match arm's." (when s (save-excursion (goto-char s) - (and (looking-at (concat "\\(?:fn-?\\|macro\\|def\\|once\\|const\\|struct\\|data\\|union\\|enum\\)[ \t]+" + (and (looking-at (concat "\\(?:fn-?\\|macro\\|def\\|once\\|const\\|struct\\|data\\|union\\|enum\\|type\\)[ \t]+" flan-fln--name-re)) (match-string-no-properties 1)))))) diff --git a/emacs/test-flan-fln-live.el b/emacs/test-flan-fln-live.el index fdba902e..cccee446 100644 --- a/emacs/test-flan-fln-live.el +++ b/emacs/test-flan-fln-live.el @@ -88,6 +88,10 @@ fn dir(d: Dir) -> i64 struct Oops :parent Error code: i64 +type Count = i64 + +fn counted(n: Count) -> Count = n + 1 + fn oops-code() -> i64 handler-case error(Oops{.code 7}) @@ -235,6 +239,8 @@ comment(): ("fn rs" "(rs)" "3") ("fn dir" "(dir :north)" "7") ("struct Oops" "(oops-code)" "7") + ("type Count" "(counted 1)" "2") + ("fn counted" "(counted 1)" "2") ("fn oops-code" "(oops-code)" "7") ("macro dbl-of" "(use-mac 5)" "10") ("fn use-mac" "(use-mac 5)" "10") diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 9600fc4f..fcee3294 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -714,6 +714,8 @@ of its line with AT-END." (test-flan-fln--in "struct DiskFull :parent IoError free: i64 +type Row = Vec(i64) + macro repeat(i, n, & body) quote for ~i in range(~n) @@ -731,7 +733,14 @@ fn gcd(a: i32, b: i32) -> i32 (test-flan-fln--is "and :parent a keyword" (funcall face ":parent") 'font-lock-constant-face) (test-flan-fln--is "macro is a keyword" (funcall face "macro") 'font-lock-keyword-face) (test-flan-fln--is "and its name a function's" (funcall face "repeat") 'font-lock-function-name-face) - (test-flan-fln--is "loop is a keyword" (funcall face "loop") 'font-lock-keyword-face)) + (test-flan-fln--is "loop is a keyword" (funcall face "loop") 'font-lock-keyword-face) + (test-flan-fln--is "type is a keyword" (funcall face "type") 'font-lock-keyword-face) + (test-flan-fln--is "an alias's name is a type" (funcall face "Row") 'font-lock-type-face) + (test-flan-fln--is "and so is what it names" (funcall face "Vec(i64)") 'font-lock-type-face)) + (goto-char (point-min)) + (search-forward "Row") + (test-flan-fln--is "an alias installs as a defalias" + (flan-fln--declaration-head-at (line-beginning-position)) "defalias") (goto-char (point-min)) (search-forward "~@body") (test-flan-fln--is "a macro is one top-level form" diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index 0ee3a505..a253a00a 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -26,7 +26,7 @@ let reserved = [ "fn"; "fn-"; "def"; "once"; "const"; "struct"; "union"; "data"; "enum"; "import"; "if"; "elif"; "else"; "while"; "until"; "match"; "let"; "for"; "return"; "break"; "continue"; "defer"; "handler-case"; "handler-bind"; - "restart-case"; "quote"; "on"; "restart"; "macro"; "loop" ] + "restart-case"; "quote"; "on"; "restart"; "macro"; "loop"; "type" ] (* A symbol the reader gives back as itself when it is written bare. *) let name_ok s = @@ -1062,6 +1062,9 @@ and sugar n (f : Form.t) : string list option = (ind (n + 2) ^ if is_sym "dyn" t then fname else fname ^ ": " ^ ty t)) prs) | _ -> None) + | Form.List [ { v = Form.Sym "defalias"; _ }; { v = Form.Sym name; _ }; t ] + when def_name name && type_shaped t -> + Some [ i ^ "type " ^ name ^ " = " ^ ty t ] | Form.List [ { v = Form.Sym "defdata"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec cs; _ } ] when def_name name -> let case (c : Form.t) = diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 8cdafc16..104a303d 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1070,6 +1070,8 @@ let header_follow p s = | "macro" -> n.sp && plain_name n.tok && (let a = peek_at p 2 in a.tok = LP && not a.sp) + (* [type Row = Vec(i32)]: a name and its [=]. *) + | "type" -> n.sp && plain_name n.tok && (peek_at p 2).tok = NAME "=" (* [loop x = a, ...]: a name and its [=]. A name and a comma or the end of the line, or [loop] alone over a block, is a loop missing its first values, which [header] answers. *) @@ -1551,6 +1553,12 @@ and header (s : st) w : Form.t = (match parent with | None -> [ name; fv ] | Some (k, pt) -> name :: k :: pt :: (if fields = [] then [] else [ fv ])) + | "type" -> + let name = name_tok p ~what:"the alias's name" in + expect_name p "=" ~what:"= and the type it names"; + let t = ty p in + expect_eol p ~after:(text_of t); + named "defalias" [ name; t ] | "macro" -> let name = name_tok p ~what:"the macro's name" in let lp = glued_lp p ~what:"the parameters, in parentheses glued to the name" in diff --git a/spec-syntax.md b/spec-syntax.md index e1f749ee..8e190381 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -291,6 +291,7 @@ Each item: the proposal, then the reason in one line. `struct DiskFull :parent IoError` with its field lines, reading `(defstruct DiskFull :parent IoError [free i64])`; with no field lines it reads `(defstruct IoError :parent Error)`. **Built.** +- `type Row = Vec(i32)` reads `(defalias Row (Vec i32))`. **Built.** - `macro repeat(i, n, & body)` plus a block reads `(defmacro repeat [i n & body] …)`. A parameter is a bare name, a destructuring vector `[a b]`, or `& rest`, last. **Built.** @@ -300,7 +301,7 @@ Each item: the proposal, then the reason in one line. - `import rl "vendor:raylib"`. **Built.** - **Every other form uses the fallback** (next item) until someone asks for sugar: `defclass`, `defgeneric`, `defmulti`, `defmethod`, `declare`, - `declare-c`, `defalias`, `array-fill`. **Built.** + `declare-c`, `array-fill`. **Built.** The class forms keep the fallback for good (2026-09-26): `defmethod(area, point, [p]):` reads well enough. diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index f12aca6d..15aa8978 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -7314,6 +7314,14 @@ level "1" cli_case "check on a file that is not there" "check no-such-file.flan" ~code:1 ~says:[ "no-such-file.flan"; "No such file or directory" ]; + (* A file that checks prints nothing; --defs lists what it defined. *) + (match cli "check programs/recur.flan" with + | 0, "" -> () + | code, text -> + incr failures; + Printf.printf "FAIL a clean check prints nothing\n got: %S (exit %d)\n" text code); + cli_case "check --defs lists the definitions" "check programs/recur.flan --defs" ~code:0 + ~says:[ "defn gcd : (Fn [i32 i32] i32)" ]; (* And every other front end takes the same route, since the arm is on the one wrapper they all go through. *) cli_case "build on a file that is not there" diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 2b61405e..648cfbff 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -555,6 +555,9 @@ let () = reads "struct" "struct Cell\n row: i32\n tag" "(defstruct Cell [row i32 tag dyn])"; reads "struct with a parent" "struct DiskFull :parent IoError\n free: i64" "(defstruct DiskFull :parent IoError [free i64])"; + reads "type alias" "type Row = Vec(i32)" "(defalias Row (Vec i32))"; + reads "type alias of an array" "type V2 = [2 f32]" "(defalias V2 [2 f32])"; + reads "a local named type" "type = 3" "(set type 3)"; reads "a parent and no fields" "struct Io :parent Error" "(defstruct Io :parent Error)"; reads "macro" "macro repeat(i, n, & body)\n quote\n f(~i)\n ~@body" "(defmacro repeat [i n & body] (quasiquote (do (f (unquote i)) (unquote-splicing body))))"; @@ -824,6 +827,7 @@ let () = prints "a template's for keeps its unquotes" "(defmacro m [i n & body] `(dotimes [~i ~n] ~@body))" "for ~i in range(~n)"; prints "a macro" "(defmacro m [[a b] n & body] `(do ~@body))" "macro m([a b], n, & body)\n quote"; + prints "a type alias" "(defalias Row (Vec i32))" "type Row = Vec(i32)"; prints "a struct with a parent" "(defstruct D :parent Io [free i64])" "struct D :parent Io\n free: i64"; prints "a parent with no fields" "(defstruct D :parent Io)" "struct D :parent Io";