diff --git a/TODO.org b/TODO.org index 08a02ae2..6a35158f 100644 --- a/TODO.org +++ b/TODO.org @@ -675,6 +675,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 diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 6f044e41..6b74c2e2 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`, `= 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-` / `M-` | same | move the statement past its neighbour | diff --git a/emacs/flan-fln-mode.el b/emacs/flan-fln-mode.el index 96e0c01c..ba5f631e 100644 --- a/emacs/flan-fln-mode.el +++ b/emacs/flan-fln-mode.el @@ -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)))))) diff --git a/emacs/test-flan-fln-live.el b/emacs/test-flan-fln-live.el index 62f41a79..622cdffd 100644 --- a/emacs/test-flan-fln-live.el +++ b/emacs/test-flan-fln-live.el @@ -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" diff --git a/emacs/test-flan-fln.el b/emacs/test-flan-fln.el index 1a69fbd1..1a36cefe 100644 --- a/emacs/test-flan-fln.el +++ b/emacs/test-flan-fln.el @@ -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" diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index a86235e1..62325b7a 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -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 diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index b703d7f4..03b13c6f 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -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 = diff --git a/spec-syntax.md b/spec-syntax.md index bda24f0a..e7e4cfc6 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -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.** diff --git a/test/programs/fn-capture.flan b/test/programs/fn-capture.flan index 934e8b8e..6c34b144 100644 --- a/test/programs/fn-capture.flan +++ b/test/programs/fn-capture.flan @@ -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. diff --git a/test/programs/generic-struct.flan b/test/programs/generic-struct.flan index f295fbd8..f8efc122 100644 --- a/test/programs/generic-struct.flan +++ b/test/programs/generic-struct.flan @@ -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)]) diff --git a/test/programs/match-enum.flan b/test/programs/match-enum.flan index 988b092c..83f7c5fd 100644 --- a/test/programs/match-enum.flan +++ b/test/programs/match-enum.flan @@ -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 "") diff --git a/test/programs/match-literal.flan b/test/programs/match-literal.flan index 2b95ed13..811dadfb 100644 --- a/test/programs/match-literal.flan +++ b/test/programs/match-literal.flan @@ -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)) diff --git a/test/syntax/flat/shadows.flan b/test/syntax/flat/shadows.flan index 87dd7fa0..44353369 100644 --- a/test/syntax/flat/shadows.flan +++ b/test/syntax/flat/shadows.flan @@ -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)] diff --git a/test/syntax/handwritten/inventory.fln b/test/syntax/handwritten/inventory.fln index 79d7b494..bb1161cb 100644 --- a/test/syntax/handwritten/inventory.fln +++ b/test/syntax/handwritten/inventory.fln @@ -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)) diff --git a/test/test_syntax.ml b/test/test_syntax.ml index a623b0a4..fc970edb 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -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:"

" + "(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 ──────────────────────── *)