A .fln file writes classes and methods as class, generic, multi and method headers, and flan convert prints them so.
This commit is contained in:
parent
905a4c53be
commit
cde4f2ab1b
@ -103,7 +103,8 @@ 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" "type"))
|
||||
"restart" "quote" "macro" "loop" "type" "class" "generic" "multi"
|
||||
"method"))
|
||||
|
||||
;; 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,13 +113,15 @@ 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" "macro" "loop"))
|
||||
"restart-case" "on" "restart" "quote" "macro" "loop" "class" "multi"
|
||||
"method"))
|
||||
|
||||
(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")
|
||||
("macro" . "defmacro") ("type" . "defalias"))
|
||||
("macro" . "defmacro") ("type" . "defalias") ("class" . "defclass")
|
||||
("generic" . "defgeneric") ("multi" . "defmulti") ("method" . "defmethod"))
|
||||
"Each declaration header word, and the paren head it reads as.")
|
||||
|
||||
;;; Syntax
|
||||
@ -1151,10 +1154,10 @@ Before it at the same level, else out to the line that owns this block."
|
||||
(cond
|
||||
;; `else x' after an if's block is the whole else.
|
||||
((member w '("defer" "quote" "else")) alone)
|
||||
((member w '("fn" "fn-"))
|
||||
((member w '("fn" "fn-" "multi" "method"))
|
||||
(not (re-search-forward "[ \t]=[ \t]" end t)))
|
||||
;; `struct Pt(x: i32)' has its fields on the line.
|
||||
((member w '("struct" "union"))
|
||||
((member w '("struct" "union" "class"))
|
||||
(not (save-excursion
|
||||
(goto-char w-end)
|
||||
(looking-at "[ \t]+[^][ \t\n(){},;\":]+("))))
|
||||
@ -1592,10 +1595,14 @@ 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) flan-fln--word-end-re)
|
||||
1 font-lock-keyword-face)
|
||||
(,(concat "^\\(fn-?\\|macro\\)[ \t]+" flan-fln--name-re)
|
||||
(,(concat "^\\(fn-?\\|macro\\|generic\\|multi\\|method\\)[ \t]+" flan-fln--name-re)
|
||||
2 font-lock-function-name-face)
|
||||
(,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\)[ \t]+" flan-fln--name-re)
|
||||
(,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\|class\\)[ \t]+" flan-fln--name-re)
|
||||
1 font-lock-type-face)
|
||||
;; A method's class, `method area(p: point)', and a value after `when'.
|
||||
(,(concat "^method[ \t]+[^][ \t\n(){},;\":]+([^][ \t\n(){},;\":]+:[ \t]*" flan-fln--name-re)
|
||||
1 font-lock-type-face)
|
||||
("^method[ \t].*)[ \t]+\\(when\\)[ \t]" 1 font-lock-keyword-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)
|
||||
@ -1647,10 +1654,10 @@ lambda or a `Fn(...)' type, and not after a match arm's."
|
||||
"Font lock for `flan-fln-mode'.")
|
||||
|
||||
(defvar flan-fln-imenu-generic-expression
|
||||
`(("Functions" ,(concat "^fn-?[ \t]+" flan-fln--name-re) 1)
|
||||
`(("Functions" ,(concat "^\\(?:fn-?\\|generic\\|multi\\|method\\)[ \t]+" flan-fln--name-re) 1)
|
||||
("Functions" ,(flan-fln--fallback-re flan-fln--fallback-function-heads) 2)
|
||||
("Macros" ,(concat "^\\(?:macro[ \t]+\\|defmacro(\\)" flan-fln--name-re) 1)
|
||||
("Types" ,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\)[ \t]+" flan-fln--name-re) 1)
|
||||
("Types" ,(concat "^\\(?:struct\\|data\\|union\\|enum\\|type\\|class\\)[ \t]+" flan-fln--name-re) 1)
|
||||
("Types" ,(flan-fln--fallback-re flan-fln--fallback-type-heads) 2)
|
||||
("Variables" ,(concat "^\\(?:def\\|once\\|const\\)[ \t]+" flan-fln--name-re) 1)
|
||||
("Variables" ,(flan-fln--fallback-re flan-fln--fallback-variable-heads) 2))
|
||||
@ -1662,7 +1669,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\\|type\\)[ \t]+"
|
||||
(and (looking-at (concat "\\(?:fn-?\\|macro\\|generic\\|multi\\|method\\|class\\|def\\|once\\|const\\|struct\\|data\\|union\\|enum\\|type\\)[ \t]+"
|
||||
flan-fln--name-re))
|
||||
(match-string-no-properties 1))))))
|
||||
|
||||
|
||||
@ -94,6 +94,19 @@ struct Pair(a: i64, b: i64)
|
||||
|
||||
fn pair-sum(p: Pair) -> i64 = p.a + p.b
|
||||
|
||||
class shape(w, h)
|
||||
|
||||
generic area(s) -> dyn
|
||||
|
||||
method area(s: shape) = get(s, :w) * get(s, :h)
|
||||
|
||||
multi kind(v) -> dyn = type-of(v)
|
||||
|
||||
method kind(v) when :int = 1
|
||||
|
||||
method kind(v) when :else
|
||||
0
|
||||
|
||||
fn counted(n: Count) -> Count = n + 1
|
||||
|
||||
fn oops-code() -> i64
|
||||
@ -246,6 +259,11 @@ comment():
|
||||
("type Count" "(counted 1)" "2")
|
||||
("struct Pair" "(pair-sum (Pair {.a 1 .b 2}))" "3")
|
||||
("fn pair-sum" "(pair-sum (Pair {.a 1 .b 2}))" "3")
|
||||
("class shape" "(i64 (area (shape 2 3)))" "6")
|
||||
("generic area" "(i64 (area (shape 2 3)))" "6")
|
||||
("method area" "(i64 (area (shape 2 3)))" "6")
|
||||
("multi kind" "(i64 (kind 3))" "1")
|
||||
("method kind(v) when :else" "(i64 (kind :x))" "0")
|
||||
("fn counted" "(counted 1)" "2")
|
||||
("fn oops-code" "(oops-code)" "7")
|
||||
("macro dbl-of" "(use-mac 5)" "10")
|
||||
|
||||
@ -903,6 +903,37 @@ defconst(k, 3)
|
||||
(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 class with a slot per line opens a block"
|
||||
(test-flan-fln--tabs "class point\n|" 1) 2)
|
||||
(test-flan-fln--is "not one on one line"
|
||||
(test-flan-fln--tabs "class point(x, y)\n|" 1) 0)
|
||||
(test-flan-fln--is "a method opens its block"
|
||||
(test-flan-fln--tabs "method area(p: point)\n|" 1) 2)
|
||||
(test-flan-fln--is "but not one with its value on the line"
|
||||
(test-flan-fln--tabs "method kind(v) when :int = 1\n|" 1) 0)
|
||||
(test-flan-fln--is "a multi with a block opens it"
|
||||
(test-flan-fln--tabs "multi kind(v) -> dyn\n|" 1) 2)
|
||||
(test-flan-fln--is "a generic never does"
|
||||
(test-flan-fln--tabs "generic area(p) -> dyn\n|" 1) 0)
|
||||
(test-flan-fln--in "class point(x, y)\n\ngeneric area(p) -> dyn\n\nmethod area(p: point)\n 1\n\nmulti kind(v) -> dyn = type-of(v)\n\nmethod kind(v) when :int = 2\n"
|
||||
(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 "class is a keyword" (funcall face "class") 'font-lock-keyword-face)
|
||||
(test-flan-fln--is "and its name a type" (funcall face "point(") 'font-lock-type-face)
|
||||
(test-flan-fln--is "a generic's name is a function's" (funcall face "area(p)") 'font-lock-function-name-face)
|
||||
(test-flan-fln--is "a method's class is a type" (funcall face "point)") 'font-lock-type-face)
|
||||
(test-flan-fln--is "a method's when is a keyword" (funcall face "when") 'font-lock-keyword-face))
|
||||
(let ((index (imenu--generic-function flan-fln-imenu-generic-expression)))
|
||||
(test-flan--check "imenu lists the class, the generic and the multi"
|
||||
(and (assoc "point" (cdr (assoc "Types" index)))
|
||||
(assoc "area" (cdr (assoc "Functions" index)))
|
||||
(assoc "kind" (cdr (assoc "Functions" index))))))
|
||||
(goto-char (point-min))
|
||||
(search-forward "method area")
|
||||
(test-flan-fln--is "a method installs as a defmethod"
|
||||
(flan-fln--declaration-head-at (line-beginning-position)) "defmethod"))
|
||||
(test-flan-fln--is "but not a struct on one line"
|
||||
(test-flan-fln--tabs "struct Pt(x: i32, y: i32)\n|" 1) 0)
|
||||
(test-flan-fln--is "nor one with a parent"
|
||||
|
||||
@ -499,10 +499,15 @@ let rec ty (f : Form.t) =
|
||||
primitive, a capitalised or [$] name, or a bracket. [[x y]] with a
|
||||
lowercase [y] keeps the fallback, because what it means depends on
|
||||
whether [y] names a type. *)
|
||||
(* The file's own class names, which are types and lowercase. Set by
|
||||
[program]. *)
|
||||
let classes : string list ref = ref []
|
||||
|
||||
let type_shaped (f : Form.t) =
|
||||
match f.v with
|
||||
| Form.Sym t ->
|
||||
List.mem t Types.primitive_names || (t <> "" && t.[0] = '$') || R.capitalised t
|
||||
|| List.mem t !classes
|
||||
| Form.List [] | Form.List ({ v = Form.Sym _; _ } :: _) | Form.Vec _ -> true
|
||||
| _ -> false
|
||||
|
||||
@ -1084,6 +1089,55 @@ 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 "defclass"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec ss; _ } ]
|
||||
when def_name name ->
|
||||
(* A name, and the type after it when the next item is shaped like one:
|
||||
read back, the slots are the same items in the same order. *)
|
||||
let rec walk = function
|
||||
| [] -> Some []
|
||||
| ({ Form.v = Form.Sym x; _ } as xf) :: t :: rest when def_name x && type_shaped t ->
|
||||
Option.map (fun r -> (xf, Some t) :: r) (walk rest)
|
||||
| ({ Form.v = Form.Sym x; _ } as xf) :: rest when def_name x ->
|
||||
Option.map (fun r -> (xf, None) :: r) (walk rest)
|
||||
| _ -> None
|
||||
in
|
||||
let slots = walk ss in
|
||||
Option.map
|
||||
(fun sl ->
|
||||
let one (x, t) =
|
||||
fst (expr x) ^ match t with Some t -> ": " ^ ty t | None -> ""
|
||||
in
|
||||
let line = i ^ "class " ^ name ^ "(" ^ String.concat ", " (List.map one sl) ^ ")" in
|
||||
if sl = [] then [ i ^ "class " ^ name ]
|
||||
else if String.length line <= width && not (!inside f) then [ line ]
|
||||
else
|
||||
(i ^ "class " ^ name)
|
||||
:: List.map (fun ((x : Form.t), t) ->
|
||||
Source_text.tag x.loc.Loc.line (ind (n + 2) ^ one (x, t))) sl)
|
||||
slots
|
||||
| Form.List [ { v = Form.Sym "defgeneric"; _ }; { v = Form.Sym name; _ };
|
||||
{ v = Form.Vec ps; _ }; r ]
|
||||
when def_name name && List.for_all sym_param ps && not (is_sym "_" r) ->
|
||||
Some [ i ^ "generic " ^ name ^ "(" ^ commas ps ^ ") -> " ^ ty r ]
|
||||
| Form.List ({ v = Form.Sym "defmulti"; _ } :: { v = Form.Sym name; _ }
|
||||
:: { v = Form.Vec ps; _ } :: r :: (_ :: _ as body))
|
||||
when def_name name && List.for_all sym_param ps && not (is_sym "_" r) ->
|
||||
Some (fn_like n f (i ^ "multi " ^ name ^ "(" ^ commas ps ^ ") -> " ^ ty r) body)
|
||||
| Form.List ({ v = Form.Sym "defmethod"; _ } :: { v = Form.Sym name; _ } :: key
|
||||
:: { v = Form.Vec ps; _ } :: (_ :: _ as body))
|
||||
when def_name name && List.for_all sym_param ps ->
|
||||
(* A class written as the first parameter's type; any other value, and a
|
||||
class with no parameter to hang it on, after when. *)
|
||||
let head =
|
||||
match key.v, ps with
|
||||
| Form.Sym k, p0 :: rest when k <> "true" && k <> "false" && name_ok k ->
|
||||
Some ("(" ^ fst (expr p0) ^ ": " ^ ty key
|
||||
^ String.concat "" (List.map (fun p -> ", " ^ fst (expr p)) rest) ^ ")")
|
||||
| (Form.Kw _ | Form.Str _ | Form.Int _ | Form.Sym _), _ ->
|
||||
Some ("(" ^ commas ps ^ ") when " ^ at 9 key)
|
||||
| _ -> None
|
||||
in
|
||||
Option.map (fun h -> fn_like n f (i ^ "method " ^ name ^ h) body) head
|
||||
| Form.List [ { v = Form.Sym "defalias"; _ }; { v = Form.Sym name; _ }; t ]
|
||||
when def_name name && type_shaped t ->
|
||||
Some [ i ^ "type " ^ name ^ " = " ^ ty t ]
|
||||
@ -1127,6 +1181,19 @@ and sugar n (f : Form.t) : string list option =
|
||||
|
||||
and is_else (f : Form.t) = match f.v with Form.Kw "else" -> true | _ -> false
|
||||
|
||||
(* A header and its body: [head = value] when the body is one value that
|
||||
fits the line, else the block under it, as a [fn]'s. *)
|
||||
and fn_like n (f : Form.t) head body =
|
||||
match body with
|
||||
| [ x ] when (match x.v with
|
||||
| Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
|
||||
not (List.mem h sugar_heads) && body_split hf args = None
|
||||
| _ -> true)
|
||||
&& String.length head + 3 + String.length (at 0 x) <= width
|
||||
&& not (!inside f) ->
|
||||
[ head ^ " = " ^ unit_text x ]
|
||||
| _ -> head :: block (n + 2) body
|
||||
|
||||
and handler_clauses n cls =
|
||||
let clause (c : Form.t) =
|
||||
match c.v with
|
||||
@ -1163,6 +1230,13 @@ and let_lines n prs body =
|
||||
file's own macros are known and no imported package's. *)
|
||||
let program ?source ?macros:m (fs : Form.t list) : string =
|
||||
macros := (match m with Some m -> m | None -> Body_macros.table fs);
|
||||
classes :=
|
||||
List.filter_map
|
||||
(fun (f : Form.t) ->
|
||||
match f.v with
|
||||
| Form.List [ { v = Form.Sym "defclass"; _ }; { v = Form.Sym c; _ }; _ ] -> Some c
|
||||
| _ -> None)
|
||||
fs;
|
||||
spelling :=
|
||||
(match source with Some src -> Source_text.spelling src | None -> fun _ -> None);
|
||||
let cs = match source with Some src -> Source_text.comments src | None -> [] in
|
||||
|
||||
@ -1077,6 +1077,13 @@ 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)
|
||||
(* [class Lambda(...)] or [class Lambda] over its slot lines. *)
|
||||
| "class" -> n.sp && plain_name n.tok
|
||||
(* [generic describe(v)], [multi kind(v)], [method describe(f: C)]: the
|
||||
name and its glued parenthesis. *)
|
||||
| "generic" | "multi" | "method" ->
|
||||
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
|
||||
@ -1142,6 +1149,28 @@ let params p (lp : token) =
|
||||
in
|
||||
go []
|
||||
|
||||
(* [(a, b: T)] as each name and its type when one is written. *)
|
||||
let named_params p (lp : token) =
|
||||
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 n = name_tok p ~what:"a parameter's name" in
|
||||
let tyf =
|
||||
match (peek p).tok with
|
||||
| COLON -> ignore (advance p); Some (ty p)
|
||||
| _ -> None
|
||||
in
|
||||
(match (peek p).tok with
|
||||
| COMMA -> ignore (advance p)
|
||||
| RP -> ()
|
||||
| _ -> stray p ~after:(text_of (match tyf with Some t -> t | None -> n)));
|
||||
go ((n, tyf) :: acc)
|
||||
in
|
||||
go []
|
||||
|
||||
(* [fn(a: C, b) -> R = body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the
|
||||
paren [fn] takes its parameters' types from where it is written, and [the]
|
||||
is the form that says what a value is, as in [let x: T = v]. An untyped
|
||||
@ -1576,6 +1605,115 @@ and header (s : st) w : Form.t =
|
||||
(match parent with
|
||||
| None -> [ name; fv ]
|
||||
| Some (k, pt) -> name :: k :: pt :: (if fields = [] then [] else [ fv ]))
|
||||
| "class" ->
|
||||
let name = name_tok p ~what:"the class's name" in
|
||||
let ps =
|
||||
match (peek p).tok with
|
||||
| LP when not (peek p).sp ->
|
||||
let lp = advance p in
|
||||
let ps = named_params p lp in
|
||||
expect_eol p ~after:")";
|
||||
ps
|
||||
| _ ->
|
||||
expect_eol_block p ~after:("class " ^ text_of name);
|
||||
let acc = ref [] in
|
||||
ignore
|
||||
(lines s (fun () ->
|
||||
let f = name_tok p ~what:"a slot's name" in
|
||||
let t =
|
||||
match (peek p).tok with
|
||||
| COLON -> ignore (advance p); Some (ty p)
|
||||
| _ -> None
|
||||
in
|
||||
expect_eol p ~after:(match t with Some t -> text_of t | None -> text_of f);
|
||||
acc := (f, t) :: !acc;
|
||||
[]));
|
||||
List.rev !acc
|
||||
in
|
||||
(* Each slot's name, and its type after it when one is written: the
|
||||
paren form's [(defclass c [a b n i32])], whose untyped slots are dyn. *)
|
||||
let slots =
|
||||
List.concat_map (fun (n, t) -> match t with Some t -> [ n; t ] | None -> [ n ]) ps
|
||||
in
|
||||
named "defclass" [ name; Form.make (Form.Vec slots) (span p name.loc) ]
|
||||
| "generic" | "multi" | "method" ->
|
||||
let name = name_tok p ~what:(Printf.sprintf "the %s's name" w) in
|
||||
let lp = advance p in
|
||||
let ps = named_params p lp in
|
||||
(* A method's first parameter may name the class it answers for; every
|
||||
other parameter of these is dyn, so it takes no type. *)
|
||||
let names = String.concat ", " (List.map (fun ((n : Form.t), _) -> text_of n) ps) in
|
||||
let first = match ps with (n, _) :: _ -> text_of n | [] -> "v" in
|
||||
let first_class = ref None in
|
||||
List.iteri
|
||||
(fun k ((n : Form.t), t) ->
|
||||
match t with
|
||||
| Some (tf : Form.t) when k = 0 && w = "method" -> first_class := Some tf
|
||||
| Some tf ->
|
||||
failk "dyn-parameter" tf.loc
|
||||
"every parameter of a %s is dyn, so %s takes no type: write %s %s(%s)%s"
|
||||
w (text_of n) w (text_of name)
|
||||
(String.concat ", "
|
||||
(List.mapi
|
||||
(fun k ((n : Form.t), t) ->
|
||||
match t with
|
||||
| Some t when k = 0 && w = "method" -> text_of n ^ ": " ^ text_of t
|
||||
| _ -> text_of n)
|
||||
ps))
|
||||
(if w = "method" then "" else " -> dyn")
|
||||
| None -> ())
|
||||
ps;
|
||||
let pv = Form.make (Form.Vec (List.map fst ps)) (span p lp.loc) in
|
||||
let ret () =
|
||||
match (peek p).tok with
|
||||
| NAME "->" -> ignore (advance p); ty p
|
||||
| _ ->
|
||||
failk "generic-return" (where_ p)
|
||||
"a %s states the type every method returns: %s %s(%s) -> dyn"
|
||||
w w (text_of name) names
|
||||
in
|
||||
let body ~after ~prev =
|
||||
match (peek p).tok with
|
||||
| NAME "=" ->
|
||||
ignore (advance p);
|
||||
[ value_line s ~after:"=" ]
|
||||
| NEWLINE ->
|
||||
ignore (advance p);
|
||||
block s ~after
|
||||
| _ -> stray p ~after:prev
|
||||
in
|
||||
(match w with
|
||||
| "generic" ->
|
||||
let r = ret () in
|
||||
expect_eol p ~after:(text_of r);
|
||||
named "defgeneric" [ name; pv; r ]
|
||||
| "multi" ->
|
||||
let r = ret () in
|
||||
named "defmulti"
|
||||
(name :: pv :: r :: body ~after:("multi " ^ text_of name ^ "(...)") ~prev:(text_of r))
|
||||
| _ ->
|
||||
let key =
|
||||
match (peek p).tok, !first_class with
|
||||
| NAME "when", Some tf ->
|
||||
failk "method-key" (peek p).loc
|
||||
"this method already answers for %s, its first parameter's type. \
|
||||
Write the type or the when, not both"
|
||||
(text_of tf)
|
||||
| NAME "when", None ->
|
||||
ignore (advance p);
|
||||
fst (unary p)
|
||||
| _, Some tf -> tf
|
||||
| _, None ->
|
||||
failk "method-key" (where_ p)
|
||||
"a method says what it answers for: a class as its first \
|
||||
parameter's type, method %s(%s: point), or a value after when, \
|
||||
method %s(%s) when :int"
|
||||
(text_of name) first (text_of name) names
|
||||
in
|
||||
named "defmethod"
|
||||
(name :: key :: pv
|
||||
:: body ~after:("method " ^ text_of name ^ "(...)")
|
||||
~prev:(if !first_class = None then text_of key else ")")))
|
||||
| "type" ->
|
||||
let name = name_tok p ~what:"the alias's name" in
|
||||
expect_name p "=" ~what:"= and the type it names";
|
||||
|
||||
@ -301,12 +301,20 @@ Each item: the proposal, then the reason in one line.
|
||||
- `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.**
|
||||
- `class lambda(param, body, env)`, or `class lambda` with a slot per line,
|
||||
reads `(defclass lambda [param body env])`; a typed slot is `pause: bool`
|
||||
and its type follows its name in the vector. **Built.**
|
||||
- `generic describe(v) -> dyn` reads `(defgeneric describe [v] dyn)`;
|
||||
`multi kind(v) -> dyn = type-of(v)`, or plus a block, reads
|
||||
`(defmulti kind [v] dyn (type-of v))`. Their parameters are bare names.
|
||||
**Built.**
|
||||
- `method describe(f: lambda)` plus a block reads
|
||||
`(defmethod describe lambda [f] …)`: a class is the first parameter's type.
|
||||
Any other dispatch value follows `when`: `method kind(v) when :int`,
|
||||
`when :else` for the default. `= value` for a one-line body. **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`, `array-fill`. **Built.**
|
||||
The class forms keep the fallback for good (2026-09-26):
|
||||
`defmethod(area, point, [p]):` reads well enough.
|
||||
sugar: `declare`, `declare-c`, `array-fill`. **Built.**
|
||||
|
||||
### The fallback
|
||||
|
||||
|
||||
@ -2,22 +2,21 @@
|
||||
; first element is a keyword naming the operation, variables are keywords,
|
||||
; and environments are dyn maps chained through a :parent key.
|
||||
|
||||
defclass(lambda, [param body env])
|
||||
class lambda(param, body, env)
|
||||
|
||||
defgeneric(describe, [v], dyn)
|
||||
generic describe(v) -> dyn
|
||||
|
||||
defmethod(describe, lambda, [f]):
|
||||
method describe(f: lambda)
|
||||
"a function of one argument"
|
||||
|
||||
defmulti(kind, [v], dyn, type-of(v))
|
||||
multi kind(v) -> dyn = type-of(v)
|
||||
|
||||
defmethod(kind, :int, [v]):
|
||||
method kind(v) when :int
|
||||
"number"
|
||||
|
||||
defmethod(kind, :vec, [v]):
|
||||
"form"
|
||||
method kind(v) when :vec = "form"
|
||||
|
||||
defmethod(kind, :else, [v]):
|
||||
method kind(v) when :else
|
||||
"value"
|
||||
|
||||
once steps = 0
|
||||
|
||||
@ -563,6 +563,20 @@ let () =
|
||||
"handler-case\n g()\non E(c)\n h(c)\non = 2"
|
||||
"(handler-case (g) [(E [c] (h c))])\n(set on 2)";
|
||||
reads "an else assigned after an if" "if a\n b\nelse = 2" "(when a b)\n(set else 2)";
|
||||
reads "class" "class lambda(param, body, env)" "(defclass lambda [param body env])";
|
||||
reads "class with typed slots" "class state\n pause: bool\n tag"
|
||||
"(defclass state [pause bool tag])";
|
||||
reads "generic" "generic describe(v) -> dyn" "(defgeneric describe [v] dyn)";
|
||||
reads "multi" "multi kind(v) -> dyn = type-of(v)" "(defmulti kind [v] dyn (type-of v))";
|
||||
reads "method on a class" "method describe(f: lambda, x)\n g(f)"
|
||||
"(defmethod describe lambda [f x] (g f))";
|
||||
reads "method on a value" "method kind(v) when :else = 1" "(defmethod kind :else [v] 1)";
|
||||
refuses "a generic's typed parameter" "generic g(p: point) -> dyn" "indent/dyn-parameter"
|
||||
"write generic g(p) -> dyn";
|
||||
refuses "a method with no dispatch" "method g(p)\n 1" "indent/method-key"
|
||||
"method g(p: point)";
|
||||
refuses "a method with both" "method g(p: point) when :x\n 1" "indent/method-key"
|
||||
"not both";
|
||||
reads "a one-line struct" "struct Pt(x: i32, y)" "(defstruct Pt [x i32 y dyn])";
|
||||
reads "a one-line union" "union U(a: i32)" "(defunion U [a i32])";
|
||||
reads "a one-line struct with a parent" "struct D(free: i64) :parent Io"
|
||||
@ -840,6 +854,15 @@ let () =
|
||||
prints "a macro" "(defmacro m [[a b] n & body] `(do ~@body))" "macro m([a b], n, & body)\n quote";
|
||||
prints "a header word assigned keeps no parentheses"
|
||||
"(defn f [] () (set data 3) (set loop 4) (set on 5))" " data = 3\n loop = 4\n on = 5";
|
||||
prints "a class" "(defclass point [x y])" "class point(x, y)";
|
||||
prints "a class's typed slots, and one typed as a class of the file"
|
||||
"(defclass state [pause bool tag])\n(defclass node [owner state n])"
|
||||
"class state(pause: bool, tag)\n\nclass node(owner: state, n)";
|
||||
prints "a generic" "(defgeneric area [self] dyn)" "generic area(self) -> dyn";
|
||||
prints "a multi" "(defmulti kind [v] dyn (type-of v))" "multi kind(v) -> dyn = type-of(v)";
|
||||
prints "a method on a class" "(defmethod area point [p] (g p) (h p))"
|
||||
"method area(p: point)\n g(p)\n h(p)";
|
||||
prints "a method on a value" "(defmethod kind :int [v] \"n\")" "method kind(v) when :int = \"n\"";
|
||||
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(free: i64) :parent Io";
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user