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.
This commit is contained in:
parent
69e5e7fe4a
commit
1a97dfff77
12
TODO.org
12
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
|
||||
|
||||
@ -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-<up>` / `M-<down>` | same | move the statement past its neighbour |
|
||||
|
||||
@ -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))))))
|
||||
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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) -> ()
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ──────────────────────── *)
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user