From 1a97dfff77f432856ecfd8cbaa3b75850cc6c3ee Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 05:08:21 +0700 Subject: [PATCH] A .fln file writes a condition's parent as struct DiskFull :parent IoError, a macro as macro repeat(i, n, & body) and a loop as loop x = a, y = b, and flan convert prints them so. --- TODO.org | 12 ---- emacs/MANUAL.md | 2 +- emacs/flan-fln-mode.el | 25 ++++--- emacs/test-flan-fln-live.el | 50 +++++++++++++- emacs/test-flan-fln.el | 54 +++++++++++++++ lib/indent_printer.ml | 66 ++++++++++++++++-- lib/indent_reader.ml | 98 ++++++++++++++++++++++++++- spec-syntax.md | 15 +++- test/syntax/handwritten/csv.fln | 2 +- test/syntax/handwritten/inventory.fln | 6 +- test/syntax/handwritten/ledger.fln | 4 +- test/test_syntax.ml | 29 +++++++- 12 files changed, 322 insertions(+), 41 deletions(-) diff --git a/TODO.org b/TODO.org index cc934a8c..02617bc5 100644 --- a/TODO.org +++ b/TODO.org @@ -650,10 +650,6 @@ 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 condition struct with a parent has no sugar -On the author's decision. =defstruct(DiskFull, :parent, IoError, [free i64])= is the fallback, with a -paren field vector. Proposal: =struct DiskFull :parent IoError= plus field lines. - ** 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. @@ -675,14 +671,6 @@ Decided 2026-09-26: in .fln ~let x = v~ at column 0 reads ~(def x v)~ and replac 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. -** NEXT defmacro has no sugar -On the author's decision. =defmacro(repeat, [i n & body]):= with a space-separated parameter vector. -Proposal: =macro repeat(i, n, & body)= plus a block. - -** NEXT loop/recur has no sugar -On the author's decision. =loop([x a y b]):=. Proposal: =loop x = a, y = b= plus a block; =recur(...)= -stays a call. - ** 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/emacs/MANUAL.md b/emacs/MANUAL.md index 36e24899..bae96297 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -1205,7 +1205,7 @@ Use `C-c C-g` if you need frames. | `M-a` / `M-e` | `(` / `)` | statement: start / end (`)`: start of the next) | | `C-M-u` | same | up to the enclosing bracket, or the line that owns the block | | `C-M-f` / `C-M-b` | same | brackets and terms, as everywhere | -| `TAB` | same | a line at a valid column stays; an empty or misplaced line goes deepest; each repeat steps out a level. One level deeper only after a line that opens a block: never after a `let`, unless its value goes on under it (`= match x`, `= if c`, a lambda header) | +| `TAB` | same | a line at a valid column stays; an empty or misplaced line goes deepest; each repeat steps out a level. One level deeper only after a line that opens a block: never after a `let`, unless its value goes on under it (`= match x`, `= if c`, `= loop i = 0`, a lambda header) | | `DEL` in indentation | same | drop one level | | `C-c <` / `C-c >` | `<` / `>` | shift the region's lines a level | | `M-` / `M-` | same | move the statement past its neighbour | diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index 34b3cdad..3afbb17e 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")) + "restart" "quote" "macro" "loop")) ;; 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 @@ -106,12 +106,13 @@ fine here. Brackets and strings are still paired." (defconst flan-fln--opener-words '("fn" "fn-" "struct" "union" "data" "enum" "if" "elif" "else" "while" "until" "for" "match" "defer" "handler-case" "handler-bind" - "restart-case" "on" "restart" "quote")) + "restart-case" "on" "restart" "quote" "macro" "loop")) (defconst flan-fln--declaration-words '(("fn" . "defn") ("fn-" . "defn-") ("def" . "def") ("once" . "defonce") ("const" . "defconst") ("struct" . "defstruct") ("data" . "defdata") - ("enum" . "defenum") ("union" . "defunion") ("import" . "import")) + ("enum" . "defenum") ("union" . "defunion") ("import" . "import") + ("macro" . "defmacro")) "Each declaration header word, and the paren head it reads as.") ;;; Syntax @@ -324,15 +325,16 @@ depth, outside strings and comments, or nil." (defun flan-fln--value-opens-p (l) "Non-nil if the value the joined line L binds or assigns goes on under it: -`= match x', `= if c' with no `then', `= handler-case', `= restart-case', or -a lambda header. These are the values lib/indent_reader.ml's `value_line' -reads a block for, besides a bare `=' and a call ending in `:'." +`= match x', `= if c' with no `then', `= handler-case', `= restart-case', +`= loop i = 0', or a lambda header. These are the values +lib/indent_reader.ml's `value_line' reads a block for, besides a bare `=' +and a call ending in `:'." (let ((v (flan-fln--value-start l)) (end (flan-fln--joined-end l))) (and v (< v end) (save-excursion (goto-char v) - (or (looking-at "\\(?:match\\|handler-case\\|handler-bind\\|restart-case\\)\\(?:[ \t]\\|$\\)") + (or (looking-at "\\(?:match\\|handler-case\\|handler-bind\\|restart-case\\|loop\\)\\(?:[ \t]\\|$\\)") (and (looking-at "if[ \t]") (not (flan-fln--then l))) (flan-fln--lambda-header-p v end)))))) @@ -1556,10 +1558,13 @@ lambda or a `Fn(...)' type, and not after a match arm's." ;; end of it: `if(c, a)' is the fallback call and is not a header. (,(concat "^[ \t]*" (regexp-opt flan-fln--header-words t) "\\(?:[ \t]\\|$\\)") 1 font-lock-keyword-face) - (,(concat "^\\(fn-?\\)[ \t]+" flan-fln--name-re) + (,(concat "^\\(fn-?\\|macro\\)[ \t]+" flan-fln--name-re) 2 font-lock-function-name-face) (,(concat "^\\(?:struct\\|data\\|union\\|enum\\)[ \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) + 1 font-lock-type-face) (,(concat "^\\(?:def\\|once\\|const\\)[ \t]+" flan-fln--name-re) 1 font-lock-variable-name-face) ;; A restart clause's name, `restart retry() "Try again"'. @@ -1594,7 +1599,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 "^defmacro(" 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) ("Variables" ,(concat "^\\(?:def\\|once\\|const\\)[ \t]+" flan-fln--name-re) 1)) "Imenu index for `flan-fln-mode'.") @@ -1605,7 +1610,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-?\\|def\\|once\\|const\\|struct\\|data\\|union\\|enum\\)[ \t]+" + (and (looking-at (concat "\\(?:fn-?\\|macro\\|def\\|once\\|const\\|struct\\|data\\|union\\|enum\\)[ \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 5c36ff93..fdba902e 100644 --- a/emacs/test-flan-fln-live.el +++ b/emacs/test-flan-fln-live.el @@ -85,6 +85,30 @@ fn dir(d: Dir) -> i64 Dir.north -> 7 _ -> 8 +struct Oops :parent Error + code: i64 + +fn oops-code() -> i64 + handler-case + error(Oops{.code 7}) + on Oops(c) + c.code + +macro dbl-of(x, & more) + quote + ~x + ~x + +fn use-mac(k: i64) -> i64 = dbl-of(k) + +fn gcd(a: i64, b: i64) -> i64 + loop x = a, y = b + if y == 0 then x else recur(y, x % y) + +fn sum-to(n: i64) -> i64 + let r = loop i = 0, acc = 0 + if i > n then acc else recur(i + 1, acc + i) + r + comment(): if 1 < 2 and 3 < 4 @@ -209,12 +233,30 @@ comment(): ("fn size" "(size 20)" "2") ("fn lam" "(lam 3)" "7") ("fn rs" "(rs)" "3") - ("fn dir" "(dir :north)" "7"))) + ("fn dir" "(dir :north)" "7") + ("struct Oops" "(oops-code)" "7") + ("fn oops-code" "(oops-code)" "7") + ("macro dbl-of" "(use-mac 5)" "10") + ("fn use-mac" "(use-mac 5)" "10") + ("fn gcd" "(gcd 1071 462)" "21") + ("fn sum-to" "(sum-to 4)" "10"))) (funcall goto needle) (flan-fln-eval-defun) (test-flan--check (funcall name (format "C-c C-c installs %s" needle)) (equal (funcall value call) want))) + ;; A macro changed in the buffer and installed again reaches the + ;; function installed after it. + (funcall goto "~x + ~x") + (delete-char 7) + (insert "~x * 3") + (funcall goto "macro dbl-of") + (flan-fln-eval-defun) + (funcall goto "fn use-mac") + (flan-fln-eval-defun) + (test-flan--check (funcall name "C-c C-c on a changed macro takes effect") + (equal (funcall value "(use-mac 5)") "15")) + ;; The pause mark. What is sent is a line and column, and the daemon ;; answers `:pause' only when a form the reader made starts exactly ;; there (`Ast.mark_pause'). Each kind of target once, and one position @@ -284,7 +326,11 @@ comment(): ("restart retry" "a restart with a report, at its block") ("Dir.north" "an enum member's arm, at its value") ("let b = 2" "a let the let above takes in, at its value") - ("let c: i64" "a typed one, at its value"))) + ("let c: i64" "a typed one, at its value") + ("loop x = a" "a loop, at its word") + ("if y == 0" "a loop's block") + ("let r = loop" "a let-bound loop, at its let") + ("if i > n" "a let-bound loop's block"))) (funcall goto (car c)) (let ((reply (flan-fln-eval-defun '(4)))) (test-flan--check (funcall name (format "C-u C-c C-c marks %s where the reader starts it" diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 10721aaf..9600fc4f 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -711,6 +711,54 @@ of its line with AT-END." (test-flan-fln--is "an enum member as a constant" (funcall face "Dir.north") 'font-lock-constant-face) (test-flan-fln--is "an arm's value is not a type" (funcall face "twice(1)") nil) (test-flan-fln--is "nor after a pattern with parentheses" (funcall face "r\n") nil))) +(test-flan-fln--in "struct DiskFull :parent IoError + free: i64 + +macro repeat(i, n, & body) + quote + for ~i in range(~n) + ~@body + +fn gcd(a: i32, b: i32) -> i32 + loop x = a, y = b + if y == 0 then x else recur(y, x % y) +" + (font-lock-ensure) + (let ((face (lambda (needle) + (save-excursion (goto-char (point-min)) (search-forward needle) + (get-text-property (match-beginning 0) 'face))))) + (test-flan-fln--is "a struct's parent is a type" (funcall face "IoError") 'font-lock-type-face) + (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)) + (goto-char (point-min)) + (search-forward "~@body") + (test-flan-fln--is "a macro is one top-level form" + (test-flan-fln--thing 'flan-fln-toplevel) + "macro repeat(i, n, & body) + quote + for ~i in range(~n) + ~@body") + (test-flan-fln--is "installed as a defmacro" + (flan-fln--declaration-head-at (car (flan-fln--toplevel-bounds (point)))) + "defmacro") + (search-forward "recur") + (test-flan-fln--is "a loop's statement is its header and block" + (progn (forward-line -1) + (test-flan-fln--thing 'flan-fln-statement)) + "loop x = a, y = b + if y == 0 then x else recur(y, x % y)") + (test-flan-fln--is "and its body the block" + (test-flan-fln--thing 'flan-fln-body) + "if y == 0 then x else recur(y, x % y)") + (goto-char (point-min)) + (test-flan-fln--is "the struct's head is defstruct" + (flan-fln--declaration-head-at (point)) "defstruct") + (let ((imenu-generic-expression flan-fln-imenu-generic-expression)) + (test-flan--check "imenu lists the macro" + (assoc "repeat" (cdr (assoc "Macros" (imenu--generic-function + imenu-generic-expression))))))) (test-flan-fln--in "fn far(a: i64,\n b: i64) -> Point\n match a\n Some(x) -> Other\n" (font-lock-ensure) (let ((face (lambda (needle) @@ -782,11 +830,17 @@ of its line with AT-END." ("let f = fn(a, b)" "a lambda header") ("let f = fn(a: i64, b) -> i64" "a typed lambda header") ("let f = fn(g: Fn(i64) -> i64) -> Option(i64)" "one with a function type in it") + ("let r = loop i = 0, acc = 1" "a let's loop") + ("loop i = 0, acc = 1" "a loop") ("fn(a: i64) -> i64" "a typed lambda as a statement"))) (test-flan-fln--is (format "unless its value goes on under it: %s" (cadr c)) (test-flan-fln--tabs (concat "fn f()\n " (car c) "\n|") 1) 4)) (test-flan-fln--is "but not a typed lambda with its body on the line" (test-flan-fln--tabs "fn f()\n let f = fn(a: i64) -> i64 = a\n|" 1) 2) +(test-flan-fln--is "a macro opens a block" + (test-flan-fln--tabs "macro repeat(i, n, & body)\n|" 1) 2) +(test-flan-fln--is "and a struct with a parent" + (test-flan-fln--tabs "struct DiskFull :parent IoError\n|" 1) 2) (test-flan-fln--is "a one-line fn whose value is a match opens it" (test-flan-fln--tabs "fn f(x) = match x\n|" 1) 2) (test-flan-fln--is "no deeper after a one-line else" diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index 0214b69a..0ee3a505 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" ] + "restart-case"; "quote"; "on"; "restart"; "macro"; "loop" ] (* A symbol the reader gives back as itself when it is written bare. *) let name_ok s = @@ -771,6 +771,9 @@ and value_lines n prefix (v : Form.t) = | _ -> false in if is_do then [ ind n ^ prefix ^ " =" ] @ block (n + 2) (stmts_of v) + else if loop_head v <> None then + let head, body = Option.get (loop_head v) in + [ ind n ^ prefix ^ " = " ^ head ] @ block (n + 2) body else if n + String.length inline <= width then [ ind n ^ inline ] else match v.v with @@ -789,6 +792,23 @@ and value_lines n prefix (v : Form.t) = and slot n (f : Form.t) = block n (stmts_of f) +(* [(loop [x a y b] body ...)] as the header [loop x = a, y = b] and its + body, when every binding is a plain name. A lambda or one-line if as a + value is parenthesised, so its else cannot run on into the next binding. *) +and loop_head (f : Form.t) = + match f.v with + | Form.List ({ v = Form.Sym "loop"; _ } :: { v = Form.Vec bs; _ } :: (_ :: _ as body)) -> + (match pairs bs with + | Some (_ :: _ as prs) + when List.for_all (fun ((x : Form.t), _) -> + match x.v with Form.Sym x -> def_name x | _ -> false) prs -> + Some + ("loop " + ^ String.concat ", " (List.map (fun (x, v) -> fst (expr x) ^ " = " ^ at 1 v) prs), + body) + | _ -> None) + | _ -> None + and label_of = function | ({ Form.v = Form.Kw k; _ }) :: rest when kw_ok k -> (":" ^ k ^ " ", rest) | rest -> ("", rest) @@ -989,14 +1009,52 @@ and sugar n (f : Form.t) : string list option = | _, [ t ] when type_shaped t -> Some [ pre ^ ": " ^ ty t ] | _, [ t; v ] -> Some (value_lines n (w ^ " " ^ name ^ ": " ^ ty t) v) | _ -> None) - | Form.List [ { v = Form.Sym (("defstruct" | "defunion") as d); _ }; - { v = Form.Sym name; _ }; { v = Form.Vec fs; _ } ] + | Form.List ({ v = Form.Sym "loop"; _ } :: _) when loop_head f <> None -> + let head, body = Option.get (loop_head f) in + Some ((i ^ head) :: block (n + 2) body) + | Form.List ({ v = Form.Sym "defmacro"; _ } :: { v = Form.Sym name; _ } + :: { v = Form.Vec ps; _ } :: (_ :: _ as body)) when def_name name -> + (* A parameter is a name, a destructuring vector, or & and the rest's + name, last. *) + let rec go = function + | [] -> Some [] + | [ { Form.v = Form.Sym "&"; _ }; { Form.v = Form.Sym r; _ } ] when def_name r -> + Some [ "& " ^ r ] + | { Form.v = Form.Sym x; _ } :: rest when def_name x && x <> "&" -> + Option.map (fun r -> x :: r) (go rest) + | ({ Form.v = Form.Vec _; _ } as v) :: rest -> + Option.map (fun r -> fst (expr v) :: r) (go rest) + | _ -> None + in + Option.map + (fun pt -> + (i ^ "macro " ^ name ^ "(" ^ String.concat ", " pt ^ ")") :: block (n + 2) body) + (go ps) + | Form.List ({ v = Form.Sym (("defstruct" | "defunion") as d); _ } + :: { v = Form.Sym name; _ } :: rest) + when def_name name + && (match d, rest with + | _, [ { v = Form.Vec _; _ } ] -> true + (* [(defstruct N :parent P [])] keeps the fallback: no field lines + reads as the form with no vector. *) + | "defstruct", [ { v = Form.Kw "parent"; _ }; { v = Form.Sym pn; _ } ] + | "defstruct", [ { v = Form.Kw "parent"; _ }; { v = Form.Sym pn; _ }; + { v = Form.Vec (_ :: _); _ } ] -> + def_name pn + | _ -> false) -> + let parent, fs = + match rest with + | [ { v = Form.Vec fs; _ } ] -> ("", fs) + | [ _; pf ] -> (" :parent " ^ ty pf, []) + | [ _; pf; { v = Form.Vec fs; _ } ] -> (" :parent " ^ ty pf, fs) + | _ -> assert false + in (match pairs fs with | Some prs when List.for_all (fun ((f : Form.t), _) -> match f.v with Form.Sym x -> def_name x | _ -> false) prs -> Some - ((i ^ (if d = "defstruct" then "struct " else "union ") ^ name) + ((i ^ (if d = "defstruct" then "struct " else "union ") ^ name ^ parent) :: List.map (fun ((f : Form.t), t) -> let fname = fst (expr f) in diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 4aaa75f0..8cdafc16 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1066,6 +1066,17 @@ let header_follow p s = let a = peek_at p 2 in a.tok = LP && not a.sp | _ -> true) + (* [macro name(...)]: the name and its glued parenthesis. *) + | "macro" -> + n.sp && plain_name n.tok + && (let a = peek_at p 2 in a.tok = LP && not a.sp) + (* [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. *) + | "loop" -> + (n.sp && plain_name n.tok + && (match (peek_at p 2).tok with NAME "=" | COMMA | NEWLINE -> true | _ -> false)) + || (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) | "return" -> n.tok = NEWLINE || (n.sp && starts_value n.tok) | "break" | "continue" -> n.tok = NEWLINE || (n.sp && (match n.tok with KW _ -> true | _ -> false)) @@ -1209,7 +1220,7 @@ and value_line ?(block_ok = false) (s : st) ~after : Form.t = match (peek p).tok with (* [let r = match a] with its arms under it, and [let r = if c] with its branches: a header read as the value, block and all. *) - | NAME (("match" | "handler-case" | "handler-bind" | "restart-case") as w) + | NAME (("match" | "handler-case" | "handler-bind" | "restart-case" | "loop") as w) when header_follow p w -> header s w | NAME "if" when header_follow p "if" && not (then_on_line p) -> header s "if" @@ -1510,7 +1521,18 @@ and header (s : st) w : Form.t = named head items | "struct" | "union" -> let name = name_tok p ~what:"the type's name" in - expect_eol_block p ~after:(w ^ " " ^ text_of name); + (* [struct DiskFull :parent IoError]: a condition's parent, before the + fields as in the paren form. *) + let parent = + match (peek p).tok with + | KW "parent" when w = "struct" -> + let kt = advance p in + let pt = ty p in + Some (Form.make (Form.Kw "parent") kt.loc, pt) + | _ -> None + in + expect_eol_block p + ~after:(match parent with Some (_, pt) -> text_of pt | None -> w ^ " " ^ text_of name); let fields = lines s (fun () -> let f = name_tok p ~what:"a field's name" in @@ -1522,8 +1544,78 @@ and header (s : st) w : Form.t = expect_eol p ~after:(text_of tf); [ f; tf ]) in + let fv = Form.make (Form.Vec fields) (span p name.loc) in + (* No field lines under a parent is the category form, which has no + field vector. *) named (if w = "struct" then "defstruct" else "defunion") - [ name; Form.make (Form.Vec fields) (span p name.loc) ] + (match parent with + | None -> [ name; fv ] + | Some (k, pt) -> name :: k :: pt :: (if fields = [] then [] else [ fv ])) + | "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 + let rec go acc = + let t = peek p in + match t.tok with + | RP -> ignore (advance p); List.rev acc + | EOF -> unclosed p '(' lp.loc + | _ -> + let one = + match t.tok with + | NAME "&" -> + ignore (advance p); + [ name_tok p ~what:"the rest parameter's name after &"; sym t.loc "&" ] + | LB -> [ fst (primary p) ] + | _ -> [ name_tok p ~what:"a parameter's name" ] + in + (match (peek p).tok with + | COMMA -> ignore (advance p) + | RP -> () + | _ -> stray p ~after:(text_of (List.hd one))); + go (one @ acc) + in + let ps = go [] in + let n = List.length ps in + List.iteri + (fun k (a : Form.t) -> + if a.v = Form.Sym "&" && k < n - 2 then begin + let r = List.nth ps (k + 1) in + let others = List.filteri (fun j _ -> j <> k && j <> k + 1) ps in + failk "macro-rest-last" a.loc + "& %s takes the arguments left over, so it comes last: macro %s(%s)" + (text_of r) (text_of name) + (String.concat ", " (List.map text_of others @ [ "& " ^ text_of r ])) + end) + ps; + let pv = Form.make (Form.Vec ps) (span p lp.loc) in + expect_line_end p ~after:")"; + let body = block s ~after:("macro " ^ text_of name ^ "(...)") in + named "defmacro" (name :: pv :: body) + | "loop" -> + let missing () = + failk "loop-bindings" l0 + "loop names each variable with its first value: loop i = 0, acc = 1. \ + A loop with no variables is written loop([]):" + in + if (peek p).tok = NEWLINE then missing (); + let rec binds acc = + let n = name_tok p ~what:"a loop variable's name" in + (match (peek p).tok with + | NAME "=" -> ignore (advance p) + | _ -> + failk "loop-bindings" n.loc + "%s needs its first value: loop %s = 0. Each variable of a loop \ + takes one, separated by commas: loop i = 0, acc = 1" + (text_of n) (text_of n)); + let v, _ = expr p in + match (peek p).tok with + | COMMA -> ignore (advance p); binds (v :: n :: acc) + | _ -> List.rev (v :: n :: acc) + in + let bs = binds [] in + expect_line_end p ~after:(text_of (List.nth bs (List.length bs - 1))); + let body = block s ~after:"loop" in + form (Form.make (Form.Vec bs) (span_of_list (List.hd bs).loc bs) :: body) | "data" -> let name = name_tok p ~what:"the type's name" in expect_eol_block p ~after:("data " ^ text_of name); diff --git a/spec-syntax.md b/spec-syntax.md index 0416c89a..e1f749ee 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -287,11 +287,20 @@ Each item: the proposal, then the reason in one line. case: `Circle(r: f32)`, `Empty`. `enum K` with `lo = -1`, `mid`. `union U` like `struct`. **Built** (an untyped field is `dyn`; `Empty()` is `(Empty [])`). A member is `:mid` or `K.mid`, in a value and in a match arm, in both - syntaxes (section 3, item 8). + syntaxes (section 3, item 8). A condition names its parent after the name, + `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.** +- `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.** +- `loop x = a, y = b` plus a block reads `(loop [x a y b] …)`, as a statement + or as a value, `let r = loop i = 0`. `recur(y, x % y)` is a call. A loop with + no variables is the fallback, `loop([]):`. **Built.** - `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`, `defmacro`, `loop`/`recur`, `array-fill`. **Built.** + `declare-c`, `defalias`, `array-fill`. **Built.** The class forms keep the fallback for good (2026-09-26): `defmethod(area, point, [p]):` reads well enough. @@ -317,7 +326,7 @@ value, `vec-new(Fn([i32], i32))` is the call spelling). ### Macro templates ``` -defmacro(with-mode-2d, [camera & body]): +macro with-mode-2d(camera, & body) quote begin-mode-2d(~camera) ~@body diff --git a/test/syntax/handwritten/csv.fln b/test/syntax/handwritten/csv.fln index bb1a54cb..7e503813 100644 --- a/test/syntax/handwritten/csv.fln +++ b/test/syntax/handwritten/csv.fln @@ -12,7 +12,7 @@ def fields-seen: i32 = 0 const separator = \, ; Frame the body's output with a title line and a closing rule. -defmacro(with-section, [title & body]): +macro with-section(title, & body) quote println("--", ~title, "--") ~@body diff --git a/test/syntax/handwritten/inventory.fln b/test/syntax/handwritten/inventory.fln index 6f23270d..a4262be2 100644 --- a/test/syntax/handwritten/inventory.fln +++ b/test/syntax/handwritten/inventory.fln @@ -13,19 +13,19 @@ once runs: i32 const reorder-below = 5 ; Run the body n times, counting passes in the name given. -defmacro(repeat, [i n & body]): +macro repeat(i, n, & body) quote for ~i in range(~n) ~@body ; Say what went wrong when a check does not hold. -defmacro(expect, [test message]): +macro expect(test, message) quote if not ~test println("expected:", ~message) fn gcd(a: i32, b: i32) -> i32 - loop([x a y b]): + loop x = a, y = b if y == 0 then x else recur(y, x % y) fn line(it: stock/Item) -> () diff --git a/test/syntax/handwritten/ledger.fln b/test/syntax/handwritten/ledger.fln index bea43893..e75b1e18 100644 --- a/test/syntax/handwritten/ledger.fln +++ b/test/syntax/handwritten/ledger.fln @@ -2,7 +2,9 @@ ; overdraw signals, and the caller picks a restart: skip it, cap it at what ; the account holds, or allow an overdraft up to a limit it supplies. -defstruct(Overdraft, :parent, Error, [account i32 short i64]) +struct Overdraft :parent Error + account: i32 + short: i64 struct Audit account: i32 diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 1b3843a1..2b61405e 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -553,6 +553,21 @@ let () = "(defdata Shape [(Circle [r f32]) Empty])"; reads "enum" "enum K\n lo = -1\n mid" "(defenum K [lo -1 mid])"; 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 "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))))"; + reads "macro with a pattern" "macro m([a b], c)\n a" "(defmacro m [[a b] c] a)"; + reads "macro with no parameters" "macro m()\n a" "(defmacro m [] a)"; + refuses "a rest parameter not last" "macro m(& a, b)\n a" "indent/macro-rest-last" + "comes last: macro m(b, & a)"; + reads "loop" "loop x = a, y = b + 1\n recur(y, x)" "(loop [x a y (+ b 1)] (recur y x))"; + reads "a let-bound loop" "let r = loop i = 0\n recur(i)\nr" "(let [r (loop [i 0] (recur i))] r)"; + reads "the loop call stays a call" "loop([x 1]):\n x" "(loop [x 1] x)"; + refuses "a loop with no values" "loop\n g()" "indent/loop-bindings" "loop([]):"; + refuses "a loop variable with no value" "loop x, y = 1\n g()" "indent/loop-bindings" + "loop x = 0"; reads "read-only pointer" "def p: Ptr(const u8) = uninit" "(def p (Ptr const u8) uninit)"; (* Statements that fit on a line, in one-line slots. *) reads "arm statements" "match s\n 1 -> break\n 2 -> continue :outer\n _ -> x += 1" @@ -807,7 +822,19 @@ let () = prints "a long vector wraps" ("(defn f [] () (let [v [" ^ String.concat " " (List.init 30 string_of_int) ^ "]] (g v)))") " let v = [0 1 2 3"; prints "a template's for keeps its unquotes" - "(defmacro m [i n & body] `(dotimes [~i ~n] ~@body))" "for ~i in range(~n)" + "(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 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"; + prints "an empty field vector under a parent keeps the fallback" + "(defstruct D :parent Io [])" "defstruct(D, :parent, Io, [])"; + prints "a loop" "(defn f [a i32] i32 (loop [x a y 0] (if (= x 0) y (recur (- x 1) (+ y 1)))))" + " loop x = a, y = 0\n if x == 0 then y"; + prints "a let-bound loop" "(defn f [] i32 (let [r (loop [i 0] (recur i))] r))" + " let r = loop i = 0\n recur(i)"; + prints "a lambda as a loop's value is parenthesised" + "(defn f [] () (loop [g (fn [x] x) n 0] (recur g n)))" "loop g = (fn(x) = x), n = 0" (* ── Spans, for pause marks and error overlays ──────────────────────── *)