Merge master
This commit is contained in:
commit
a546bde112
4
TODO.org
4
TODO.org
@ -683,6 +683,10 @@ Decided 2026-09-26: lines indented under a ~let~ that are ~name = v~ or ~name: T
|
||||
more bindings of the same let; anything else there stays refused. flan convert writes
|
||||
consecutive lets this way.
|
||||
|
||||
** DONE .fln has no loop or recur (decision 122)
|
||||
Rules out ~loop~/~recur~ anywhere the .fln reader reads, ~quote~ included; loops are
|
||||
~while~/~until~/~dotimes~/~for~. The Lisp syntax and its macros' expansions keep them.
|
||||
|
||||
** 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`, `= loop i = 0`, a lambda header). After a line ending in `=>`, one level in from that line, inside brackets too; a line of that block keeps to the block's columns |
|
||||
| `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). After a line ending in `=>`, one level in from that line, inside brackets too; a line of that block keeps to the block's columns |
|
||||
| `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 |
|
||||
|
||||
@ -104,8 +104,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" "type" "class" "generic" "multi"
|
||||
"method"))
|
||||
"restart" "quote" "macro" "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
|
||||
@ -114,8 +113,7 @@ 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" "class" "multi"
|
||||
"method"))
|
||||
"restart-case" "on" "restart" "quote" "macro" "class" "multi" "method"))
|
||||
|
||||
(defconst flan-fln--declaration-words
|
||||
'(("fn" . "defn") ("fn-" . "defn-") ("def" . "def") ("once" . "defonce")
|
||||
@ -402,7 +400,7 @@ or, when the line ends in `=>', at the end of the lambda's block under it."
|
||||
(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',
|
||||
`= loop i = 0', or a lambda header. These are the values
|
||||
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))
|
||||
@ -410,7 +408,7 @@ and a call ending in `:'."
|
||||
(and v (< v end)
|
||||
(save-excursion
|
||||
(goto-char v)
|
||||
(or (looking-at "\\(?:match\\|handler-case\\|handler-bind\\|restart-case\\|loop\\)\\(?:[ \t]\\|$\\)")
|
||||
(or (looking-at "\\(?:match\\|handler-case\\|handler-bind\\|restart-case\\)\\(?:[ \t]\\|$\\)")
|
||||
(and (looking-at "if[ \t]") (not (flan-fln--then l)))
|
||||
(flan-fln--lambda-header-p v end))))))
|
||||
|
||||
|
||||
@ -137,13 +137,21 @@ macro dbl-of(x, & more)
|
||||
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)
|
||||
let x = a
|
||||
let y = b
|
||||
while y != 0
|
||||
let r = x % y
|
||||
x = y
|
||||
y = r
|
||||
x
|
||||
|
||||
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
|
||||
let i = 0
|
||||
let acc = 0
|
||||
until i > n
|
||||
acc += i
|
||||
i += 1
|
||||
acc
|
||||
|
||||
comment():
|
||||
if 1 < 2 and
|
||||
@ -400,10 +408,10 @@ comment():
|
||||
("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")
|
||||
("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")))
|
||||
("while y != 0" "a while, at its word")
|
||||
("let r = x % y" "a while's block")
|
||||
("until i > n" "an until, at its word")
|
||||
("acc += i" "an until'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"
|
||||
|
||||
@ -722,8 +722,13 @@ macro repeat(i, n, & body)
|
||||
~@body
|
||||
|
||||
fn gcd(a: i32, b: i32) -> i32
|
||||
loop x = a, y = b
|
||||
if y == 0 then x else recur(y, x % y)
|
||||
let x = a
|
||||
let y = b
|
||||
while y != 0
|
||||
let r = x % y
|
||||
x = y
|
||||
y = r
|
||||
x
|
||||
"
|
||||
(font-lock-ensure)
|
||||
(let ((face (lambda (needle)
|
||||
@ -733,7 +738,6 @@ 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 "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))
|
||||
@ -752,15 +756,13 @@ fn gcd(a: i32, b: i32) -> i32
|
||||
(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)")
|
||||
(search-forward "while y")
|
||||
(test-flan-fln--is "a while's statement is its header and block"
|
||||
(test-flan-fln--thing 'flan-fln-statement)
|
||||
"while y != 0
|
||||
let r = x % y
|
||||
x = y
|
||||
y = r")
|
||||
(goto-char (point-min))
|
||||
(test-flan-fln--is "the struct's head is defstruct"
|
||||
(flan-fln--declaration-head-at (point)) "defstruct")
|
||||
@ -879,13 +881,13 @@ defconst(k, 3)
|
||||
("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 "loop is no header in .fln, and opens nothing"
|
||||
(test-flan-fln--tabs "fn f()\n let r = loop i = 0\n|" 1) 2)
|
||||
(test-flan-fln--is "a header word being assigned opens nothing"
|
||||
(test-flan-fln--tabs "fn f()\n for = 1\n|" 1) 2)
|
||||
(test-flan-fln--in "fn f()\n handler-case\n g()\n on E(c)\n h(c)\n on = 2\n data += 1\n"
|
||||
|
||||
@ -585,12 +585,12 @@ let body_guess (h : Form.t) args =
|
||||
match a.v with Form.List _ -> false | _ -> true) args) in
|
||||
(match base with
|
||||
| "comment" | "do" -> Some 0
|
||||
| "unless" | "loop" -> Some 1
|
||||
| "unless" -> Some 1
|
||||
| "defmacro" -> Some 2
|
||||
| "defmethod" -> Some 3
|
||||
| _ ->
|
||||
(* A with- macro, or any call whose last argument is a statement —
|
||||
a let, a loop, an assignment — has a body: the trailing run of
|
||||
a let, a while, an assignment — has a body: the trailing run of
|
||||
lists goes in the block. *)
|
||||
let stmt_like (a : Form.t) =
|
||||
match a.v with
|
||||
@ -920,9 +920,6 @@ 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
|
||||
match lambda_value n prefix v with
|
||||
| Some ls -> ls
|
||||
@ -939,23 +936,6 @@ 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)
|
||||
@ -1164,9 +1144,6 @@ 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 "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 ->
|
||||
@ -1365,10 +1342,37 @@ and let_lines n prs body =
|
||||
let lines n b = let p, v = bind b in tagged b (value_lines n p v) in
|
||||
List.concat_map (lines n) prs @ block n body
|
||||
|
||||
(* A .flan file that uses [loop] or [recur] has no indented spelling: the
|
||||
indented syntax loops with [while], [until], [dotimes] and [for]. The
|
||||
refusal names every line, so the file is rewritten in one pass. *)
|
||||
let refuse_loops (fs : Form.t list) =
|
||||
match R.loop_forms fs with
|
||||
| [] -> ()
|
||||
| (first : Form.t) :: rest as uses ->
|
||||
let word (f : Form.t) =
|
||||
match f.v with Form.List ({ v = Form.Sym w; _ } :: _) -> w | _ -> "loop"
|
||||
in
|
||||
let lines = List.sort_uniq compare (List.map (fun (f : Form.t) -> f.loc.Loc.line) uses) in
|
||||
let notes = List.map (fun (f : Form.t) -> Loc.note f.loc (word f ^ " is here")) rest in
|
||||
Loc.failk ~notes "convert/no-loop" first.loc
|
||||
"this file uses loop or recur on line%s %s. The indented syntax \
|
||||
has neither. Rewrite each one in the .flan file as a while or until \
|
||||
over let variables it changes, then convert again:\n\n\
|
||||
\ (let [i 0 total 0]\n\
|
||||
\ (while (< i 10)\n\
|
||||
\ (set total (+ total i))\n\
|
||||
\ (set i (+ i 1))))"
|
||||
(if List.length lines = 1 then "" else "s")
|
||||
(match List.rev_map string_of_int lines with
|
||||
| last :: (_ :: _ as before) ->
|
||||
String.concat ", " (List.rev before) ^ " and " ^ last
|
||||
| ls -> String.concat "" ls)
|
||||
|
||||
(** A whole file: top-level forms with a blank line between them. [macros]
|
||||
is [Body_macros.table] of the file; without it, the prelude's and the
|
||||
file's own macros are known and no imported package's. *)
|
||||
let program ?source ?macros:m (fs : Form.t list) : string =
|
||||
refuse_loops fs;
|
||||
macros := (match m with Some m -> m | None -> Body_macros.table fs);
|
||||
classes :=
|
||||
List.filter_map
|
||||
|
||||
@ -659,6 +659,17 @@ let refuse_ws ?(brace = false) loc e =
|
||||
[not], 0 a one-line [if] or a lambda. Anything under 8 is "compound": it
|
||||
has an operator at its top, so it cannot sit in a list separated only by
|
||||
whitespace. *)
|
||||
(* [loop] and [recur] are Lisp-syntax forms. A .fln loop is a [while],
|
||||
[until], [dotimes] or [for]; [read_all] refuses any that gets past the
|
||||
parser, in a [quote] or a quoted datum too. *)
|
||||
let no_loop loc word =
|
||||
failk "no-loop" loc
|
||||
"%s is not part of the indented syntax. A loop here is a while, until, \
|
||||
dotimes or for, with let variables it changes:\n\n\
|
||||
\ let i = 0\n let total = 0\n while i < 10\n total += i\n i += 1\n\n\
|
||||
break leaves the loop early, and continue goes on to the next round."
|
||||
word
|
||||
|
||||
let rec expr p : Form.t * int = binary p 1
|
||||
|
||||
and binary p lvl : Form.t * int =
|
||||
@ -765,6 +776,21 @@ and primary p : Form.t * int =
|
||||
let glued_lp = nxt.tok = LP && not nxt.sp in
|
||||
if s = "if" && nxt.sp && starts_value nxt.tok then if_expr p
|
||||
else if s = "fn" && glued_lp then fn_expr p
|
||||
(* Only the Lisp loop's spellings are refused here, for a message at the
|
||||
word: [loop x = a, ...], [loop([...]):], a bare [loop] over a block
|
||||
where a statement or a let's value starts, and [recur(...)]. Anywhere
|
||||
else [loop] and [recur] are names; [refuse_loops] catches the rest. *)
|
||||
else if glued_lp && (s = "loop" || s = "recur") then no_loop l0 s
|
||||
else if s = "loop"
|
||||
&& ((nxt.sp
|
||||
&& (match nxt.tok with NAME x -> not (is_op_word x) | _ -> false)
|
||||
&& (match (peek_at p 2).tok with NAME "=" | COMMA -> true | _ -> false))
|
||||
|| (nxt.tok = NEWLINE && (peek_at p 2).tok = INDENT
|
||||
&& (p.i = 0
|
||||
|| (match (last p).tok with
|
||||
| NEWLINE | INDENT | DEDENT | NAME "=" -> true
|
||||
| _ -> false)))) then
|
||||
no_loop l0 s
|
||||
else if is_op_word s then begin
|
||||
if glued_lp || ends_value nxt.tok then begin
|
||||
ignore (advance p);
|
||||
@ -1222,13 +1248,6 @@ let header_follow p s =
|
||||
&& (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. *)
|
||||
| "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))
|
||||
@ -1392,7 +1411,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" | "loop") as w)
|
||||
| NAME (("match" | "handler-case" | "handler-bind" | "restart-case") 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"
|
||||
@ -1892,31 +1911,6 @@ and header (s : st) w : Form.t =
|
||||
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);
|
||||
@ -2257,6 +2251,29 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list =
|
||||
|
||||
let () = block_of := fun p -> block { p; lets = [] } ~after:"=>"
|
||||
|
||||
(* Every [(loop ...)] and [(recur ...)] in [fs], at any depth and inside
|
||||
quoted code too, in source order. The indented syntax has neither: its
|
||||
loops are [while], [until], [dotimes] and [for]. The printer asks the same
|
||||
question before it converts a .flan file. *)
|
||||
let loop_forms (fs : Form.t list) =
|
||||
let out = ref [] in
|
||||
let rec walk (f : Form.t) =
|
||||
match f.v with
|
||||
| Form.List ({ v = Form.Sym ("loop" | "recur"); _ } :: _) ->
|
||||
out := f :: !out;
|
||||
(match f.v with Form.List l -> List.iter walk l | _ -> ())
|
||||
| Form.List l | Form.Vec l | Form.Map l -> List.iter walk l
|
||||
| _ -> ()
|
||||
in
|
||||
List.iter walk fs;
|
||||
List.rev !out
|
||||
|
||||
let refuse_loops fs =
|
||||
match loop_forms fs with
|
||||
| [] -> ()
|
||||
| (f : Form.t) :: _ ->
|
||||
no_loop f.loc (match f.v with Form.List ({ v = Form.Sym w; _ } :: _) -> w | _ -> "loop")
|
||||
|
||||
(** All top-level forms in a [.fln] source string. [col] is the column the
|
||||
text's top level starts at, 1 for a file. *)
|
||||
let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
|
||||
@ -2287,6 +2304,7 @@ let read_all ?(line = 1) ?col ?indent ?(global_let = true) ~file src =
|
||||
(match (peek s.p).tok with
|
||||
| EOF -> ()
|
||||
| tk -> failk "unexpected-token" (where_ s.p) "unexpected %s" (show tk));
|
||||
refuse_loops fs;
|
||||
fs)
|
||||
|
||||
let read_file path =
|
||||
|
||||
@ -192,7 +192,7 @@ Each item: the proposal, then the reason in one line.
|
||||
rebinds, the `let`'s is renamed (`x` to `x-2`, a name the top-level form
|
||||
does not use; a struct pattern is written as `{x-2 .x}` pairs). A macro's
|
||||
body counts as statements run in order when its definition splices its
|
||||
rest parameter only into a `do`, a `let`/`fn`/`when`/`while`/`loop` body or
|
||||
rest parameter only into a `do`, a `let`/`fn`/`when`/`while` body or
|
||||
another such macro's body; `comment` counts too. Where a rename cannot be
|
||||
trusted (the name quoted, qualified as `x/y`, or called as `x(...)`), and
|
||||
at the top level, among a call's other arguments and in a quasiquote, the
|
||||
@ -323,9 +323,12 @@ Each item: the proposal, then the reason in one line.
|
||||
- `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.**
|
||||
- There is no `loop` or `recur`. A loop is `while`, `until`, `dotimes` or
|
||||
`for`, over `let` variables it changes, with `break` and `continue`. The
|
||||
reader refuses `loop` and `recur` in any spelling, inside `quote` too
|
||||
(`indent/no-loop`), and `flan convert` refuses a .flan file that uses them,
|
||||
naming each line (`convert/no-loop`). A macro defined in a .flan file may
|
||||
still expand to them. **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.**
|
||||
|
||||
@ -91,15 +91,15 @@
|
||||
(set total (+ total (call0 (fn [] i)))))
|
||||
(println total))
|
||||
|
||||
;; And the same again where the loop variable is rebound by a recur rather
|
||||
;; than stepped by a dotimes, which is a store into the slot the copy is
|
||||
;; taken from: 100 + 101 + 102.
|
||||
;; And the same again where the loop variable is stepped by a set in a
|
||||
;; while rather than by a dotimes, which is a store into the slot the copy
|
||||
;; is taken from: 100 + 101 + 102.
|
||||
(println
|
||||
(let [base 100]
|
||||
(loop [i 0 acc 0]
|
||||
(if (< i 3)
|
||||
(recur (+ i 1) (+ acc (call0 (fn [] (+ base i)))))
|
||||
acc))))
|
||||
(let [base 100 i 0 acc 0]
|
||||
(while (< i 3)
|
||||
(set acc (+ acc (call0 (fn [] (+ base i)))))
|
||||
(set i (+ i 1)))
|
||||
acc))
|
||||
|
||||
;; Called twice, so the environment is read more than once and a body that
|
||||
;; consumed it would show.
|
||||
|
||||
@ -49,11 +49,13 @@
|
||||
(defstruct Node [v $t next (Option (Ptr (Node $t)))])
|
||||
|
||||
(defn sum-list [n (Ptr (Node i64))] i64
|
||||
(loop [at n acc (the i64 0)]
|
||||
(let [acc (+ acc (.v at))]
|
||||
(let [at n acc (the i64 0)]
|
||||
(while true
|
||||
(set acc (+ acc (.v at)))
|
||||
(match (.next at)
|
||||
(Some p) (recur p acc)
|
||||
None acc))))
|
||||
(Some p) (set at p)
|
||||
None (break)))
|
||||
acc))
|
||||
|
||||
;; A template naming another at its own parameters.
|
||||
(defstruct Twice [x (Small $m $u) y (Small $m $u)])
|
||||
|
||||
@ -25,12 +25,14 @@
|
||||
(calls)
|
||||
:west)
|
||||
|
||||
;; recur from inside an arm: the arm is the loop's tail.
|
||||
;; break from inside an arm leaves the while around the match.
|
||||
(defn steps-to-west [from Dir] i32
|
||||
(loop [d from n 0]
|
||||
(match d
|
||||
:west n
|
||||
_ (recur (turn d) (+ n 1)))))
|
||||
(let [d from n 0]
|
||||
(while true
|
||||
(match d
|
||||
:west (break)
|
||||
_ (do (set d (turn d)) (set n (+ n 1)))))
|
||||
n))
|
||||
|
||||
(defn main [] i32
|
||||
(print (steps-to-west :north)) (println "")
|
||||
|
||||
@ -44,12 +44,14 @@
|
||||
(print "(called) ")
|
||||
7)
|
||||
|
||||
;; recur from inside an arm: the arm is the loop's tail.
|
||||
;; break from inside an arm leaves the while around the match.
|
||||
(defn count-down [from i32] i32
|
||||
(loop [n from steps 0]
|
||||
(match n
|
||||
0 steps
|
||||
_ (recur (- n 1) (+ steps 1)))))
|
||||
(let [n from steps 0]
|
||||
(while true
|
||||
(match n
|
||||
0 (break)
|
||||
_ (do (set n (- n 1)) (set steps (+ steps 1)))))
|
||||
steps))
|
||||
|
||||
(defn main [] i32
|
||||
(println (small 5))
|
||||
|
||||
@ -29,10 +29,14 @@
|
||||
(println i))))
|
||||
|
||||
(defn loopr [] i32
|
||||
(loop [n 0 acc 0]
|
||||
(let [n (* n 2)]
|
||||
(println n))
|
||||
(if (< n 4) (recur (+ n 1) (+ acc n)) acc)))
|
||||
(let [n 0 acc 0]
|
||||
(while true
|
||||
(let [n (* n 2)]
|
||||
(println n))
|
||||
(if (< n 4)
|
||||
(do (set acc (+ acc n)) (set n (+ n 1)))
|
||||
(break)))
|
||||
acc))
|
||||
|
||||
(defn ret [a i32] i32
|
||||
(let [a (+ a 1)]
|
||||
|
||||
@ -25,8 +25,13 @@ macro expect(test, message)
|
||||
println("expected:", ~message)
|
||||
|
||||
fn gcd(a: i32, b: i32) -> i32
|
||||
loop x = a, y = b
|
||||
if y == 0 then x else recur(y, x % y)
|
||||
let x = a
|
||||
let y = b
|
||||
while y != 0
|
||||
let r = x % y
|
||||
x = y
|
||||
y = r
|
||||
x
|
||||
|
||||
fn line(it: stock/Item) -> ()
|
||||
let price = stock/money(stock/value(it))
|
||||
|
||||
@ -359,13 +359,17 @@ let attached_ok ~what path (src, forms) (out, back) =
|
||||
(* Every .flan the build tree holds. [..] is the workspace root from here;
|
||||
the deps in test/dune decide what is in it. *)
|
||||
let corpus () =
|
||||
(* recur.flan is about the Lisp loop form, which the indented syntax does
|
||||
not have. *)
|
||||
let lisp_only = [ "recur.flan" ] in
|
||||
let rec walk dir acc =
|
||||
Array.fold_left
|
||||
(fun acc name ->
|
||||
let path = Filename.concat dir name in
|
||||
if name <> "" && (name.[0] = '.' || name.[0] = '_') then acc
|
||||
else if Sys.is_directory path then walk path acc
|
||||
else if Filename.check_suffix name ".flan" then path :: acc
|
||||
else if Filename.check_suffix name ".flan" && not (List.mem name lisp_only) then
|
||||
path :: acc
|
||||
else acc)
|
||||
acc (Sys.readdir dir)
|
||||
in
|
||||
@ -612,12 +616,26 @@ let () =
|
||||
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 ~global:false "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";
|
||||
(* No loop and no recur: a .fln loop is a while, until, dotimes or for. *)
|
||||
refuses "a loop header" "loop x = a, y = b + 1\n recur(y, x)" "indent/no-loop"
|
||||
"while i < 10";
|
||||
refuses ~global:false "a let-bound loop" "let r = loop i = 0\n i\nr" "indent/no-loop"
|
||||
"loop is not part of the indented syntax";
|
||||
refuses "a loop call" "loop([x 1]):\n x" "indent/no-loop" "while, until, dotimes or for";
|
||||
refuses "a loop over a block" "loop\n g()" "indent/no-loop" "loop is not";
|
||||
refuses "a recur call" "f(recur(1))" "indent/no-loop" "recur is not part of the indented syntax";
|
||||
refuses "a loop in a macro's quote" "macro m(a)\n quote\n loop([i ~a]):\n i"
|
||||
"indent/no-loop" "loop is not";
|
||||
refuses "a quoted loop" "f('(loop [i 0] (recur i)))" "indent/no-loop" "loop is not";
|
||||
reads "loop as a name" "loop = 4" "(set loop 4)";
|
||||
reads "if over loop" "if loop\n 1" "(when loop 1)";
|
||||
reads "while over loop" "while loop\n g()" "(while loop (g))";
|
||||
reads "until over loop" "until loop\n g()" "(until loop (g))";
|
||||
reads "elif over loop" "if recur\n 1\nelif loop\n 2" "(cond recur 1 loop 2)";
|
||||
reads "a one-line if over loop" "if loop then 1 else 2" "(if loop 1 2)";
|
||||
reads "a one-line if over recur" "if recur > 0 then recur else 0" "(if (> recur 0) recur 0)";
|
||||
reads ~global:false "a typed let of loop" "let loop: i32 = 1\nloop" "(let [loop (the i32 1)] loop)";
|
||||
reads "a match over loop, and an arm of it" "match loop\n loop -> loop" "(match loop loop loop)";
|
||||
reads "read-only pointer" "let 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"
|
||||
@ -989,12 +1007,24 @@ let () =
|
||||
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"
|
||||
(* A .flan file with loop or recur is refused, every line named. *)
|
||||
(match
|
||||
Reader.read_all ~file:"<p>"
|
||||
"(defn f [a i32] i32\n (loop [x a y 0]\n (if (= x 0) y (recur (- x 1) (+ y 1)))))\n\n(defn g [] i32 (loop [i 0] i))"
|
||||
with
|
||||
| forms ->
|
||||
(match Indent_printer.program forms with
|
||||
| text -> fail "a loop printed: %s" text
|
||||
| exception Loc.Error d ->
|
||||
if d.Loc.kind <> "convert/no-loop" then fail "a loop refused as %s" d.Loc.kind;
|
||||
List.iter
|
||||
(fun n ->
|
||||
if not (Test_support.contains d.Loc.dmsg n) then
|
||||
fail "the loop refusal does not say %S: %s" n d.Loc.dmsg)
|
||||
[ "on lines 2, 3 and 5. The indented syntax"; "(while (< i 10)" ];
|
||||
if List.length d.Loc.notes <> 2 then
|
||||
fail "the loop refusal points at %d more places, wanted 2" (List.length d.Loc.notes))
|
||||
| exception e -> fail "a loop: %s" (diag_text e))
|
||||
|
||||
(* ── Spans, for pause marks and error overlays ──────────────────────── *)
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user