(* The indented syntax (spec-syntax.md): its reader, its printer, and the switch between the two readers by file extension. Four parts. Two programs hand-converted from paren to indented must read to the same forms. Every corpus file must survive paren -> printed indented -> read indented unchanged, up to the normalisation the spec allows. A table pins the lexical edge cases and the refusals, with their kinds. And a program in each syntax importing a package in the other builds and runs the same on both backends. *) open Flan let () = Watchdog.arm ~seconds:300 "test_syntax" let fail fmt = Test_support.fail fmt let scratch = Test_support.scratch (* ── Forms, compared without locations ─────────────────────────────── *) let rec eq (a : Form.t) (b : Form.t) = match a.v, b.v with | Form.List x, Form.List y | Form.Vec x, Form.Vec y | Form.Map x, Form.Map y -> List.length x = List.length y && List.for_all2 eq x y | Form.Float x, Form.Float y -> Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y) | x, y -> x = y (* The innermost pair that differs, for the failure line. *) let rec first_diff (a : Form.t) (b : Form.t) = match a.v, b.v with | (Form.List x, Form.List y | Form.Vec x, Form.Vec y | Form.Map x, Form.Map y) when List.length x = List.length y -> (match List.find_opt (fun (p, q) -> not (eq p q)) (List.combine x y) with | Some (p, q) -> first_diff p q | None -> (a, b)) | _ -> (a, b) let same_forms a b = List.length a = List.length b && List.for_all2 eq a b let describe_diff a b = if List.length a <> List.length b then Printf.sprintf "%d forms against %d" (List.length a) (List.length b) else match List.find_opt (fun (x, y) -> not (eq x y)) (List.combine a b) with | Some (x, y) -> let u, w = first_diff x y in Printf.sprintf "wanted %s, read %s (at %d:%d)" (Form.to_string u) (Form.to_string w) w.loc.Loc.line w.loc.Loc.col | None -> "equal" (* Spec §4 step 3's normalisation. Each rule keeps the meaning. First every name a [let] binds is renamed, through its scope, to one numbered in the order the binders come: so two forms that differ only in what their [let]s call things compare equal, and one where a name was captured does not. Then, where statements are a body run in order, a [let] takes in the statements after it (the printer's flat [let]; with every [let] name unique by now, nothing after it can mean one of them). A [(do x)] whose [x] is a [let] is [x], a [let] whose whole body is another [let] is the merged [let], [(fn [a] (do x y))] is [(fn [a] x y)], and [(and x)] and [(or x)] are [x]. The flat [let] and the one-argument [and] stop at a quote or quasiquote: data, or a template whose unquotes could name anything. *) (* A binding target with every struct pattern written as [name .field] pairs: [{.x}] and [{:keys [x]}] are [{x .x}] (Parse.dmap). *) let rec pairs_pat (t : Form.t) : Form.t = let dotted s = String.length s > 1 && s.[0] = '.' in let rec items = function | ({ Form.v = Form.Sym s; _ } as f) :: rest when dotted s -> { f with v = Form.Sym (String.sub s 1 (String.length s - 1)) } :: f :: items rest | { Form.v = Form.Kw "keys"; _ } :: { Form.v = Form.Vec ns; _ } :: rest -> List.concat_map (fun (n : Form.t) -> match n.v with | Form.Sym x -> [ n; { n with v = Form.Sym ("." ^ x) } ] | _ -> [ n ]) ns @ items rest | pat :: f :: rest -> pairs_pat pat :: f :: items rest | rest -> rest in match t.v with | Form.Vec l -> { t with v = Form.Vec (List.map pairs_pat l) } | Form.Map l -> { t with v = Form.Map (items l) } | _ -> t (* The names a target so written binds, in order. *) let rec binders (t : Form.t) = match t.v with | Form.Sym "&" -> [] | Form.Sym s -> [ s ] | Form.Vec l -> List.concat_map binders l | Form.Map l -> List.concat (List.filteri (fun i _ -> i mod 2 = 0) (List.map binders l)) | _ -> [] let canon (f : Form.t) : Form.t = let k = ref 0 in let look env s = match List.assoc_opt s env with | Some c -> c | None -> (* [x.y], a field path on a bound [x]. *) match String.index_opt s '.' with | Some i when i > 0 -> (match List.assoc_opt (String.sub s 0 i) env with | Some c -> c ^ String.sub s i (String.length s - i) | None -> s) | _ -> s in let rec go env (f : Form.t) = let v = match f.v with (* The Lisp side may write the bit operators' .fln spellings, which read back as their words: the same builtin by two names. *) | Form.Sym ("&&" | "||" | "^^" as s) -> Form.Sym (match s with "&&" -> "bit-and" | "||" -> "bit-or" | _ -> "bit-xor") | Form.Sym s -> Form.Sym (look env s) (* Quoted data keeps its names: renaming them would hide a printer that renamed them too. *) | Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> f.v | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec bs; _ } as bv) :: body) -> let rec binds env acc = function | t :: v :: rest -> let v' = go env v in let t = pairs_pat t in let env' = List.fold_left (fun e n -> incr k; (n, "%" ^ string_of_int !k) :: e) env (binders t) in binds env' (v' :: go env' t :: acc) rest | rest -> (env, List.rev_append acc (List.map (go env) rest)) in let env', bs' = binds env [] bs in Form.List (h :: { bv with v = Form.Vec bs' } :: List.map (go env') body) | Form.List l -> Form.List (List.map (go env) l) | Form.Vec l -> Form.Vec (List.map (go env) l) | Form.Map l -> Form.Map (List.map (go env) l) | v -> v in { f with v } in go [] f (* The macros of the file being compared ([Body_macros.table]). *) let macros : Body_macros.t ref = ref (Body_macros.create ()) (* Where the statements of a body start, for a head whose trailing arguments are a body run in order. *) let body_start (l : Form.t list) = let label k = match List.nth_opt l 1 with | Some { Form.v = Form.Kw _; _ } -> k + 1 | _ -> k in match l with | { Form.v = Form.Sym h; _ } :: _ -> (match h with | "do" | "defer" -> Some 1 | "let" | "when" | "fn" | "loop" -> Some 2 | "while" | "until" | "dotimes" -> Some (label 2) | "defmacro" -> Some 3 | "defmethod" -> Some 4 | "defn" | "defn-" -> Some (match List.nth_opt l 4 with | Some { Form.v = Form.Map _; _ } -> 5 | _ -> 4) | h -> (match List.assoc_opt h Body_macros.core with | Some k -> Some (k + 1) | None -> Option.map (fun k -> k + 1) (Hashtbl.find_opt !macros.bodies h))) | _ -> None let is_let (f : Form.t) = match f.v with Form.List ({ v = Form.Sym "let"; _ } :: _) -> true | _ -> false let rec shape ?(q = false) (f : Form.t) : Form.t = let q = q || (match f.v with | Form.List ({ v = Form.Sym ("quote" | "quasiquote"); _ } :: _) -> true | _ -> false) in let sh = shape ~q in (* A body's statements, each [let] taking in the ones after it. *) let rec stmts = function | [] -> [] | x :: (_ :: _ as rest) when not q -> (match (sh x).v with | Form.List (({ v = Form.Sym "let"; _ } as h) :: ({ v = Form.Vec (_ :: _); _ } as bv) :: (_ :: _ as body)) -> [ sh { x with v = Form.List (h :: bv :: (body @ rest)) } ] | _ -> sh x :: stmts rest) | x :: rest -> sh x :: stmts rest in let seq_list l = match body_start l with | Some k when List.length l > k -> List.map sh (List.filteri (fun i _ -> i < k) l) @ stmts (List.filteri (fun i _ -> i >= k) l) | _ -> List.map sh l in (* Handler and restart clauses: [(name [v] body ...)]. *) let clause (c : Form.t) = match c.v with | Form.List (n :: p :: body) -> { c with v = Form.List (sh n :: sh p :: stmts body) } | _ -> sh c in match f.v with | Form.List [ { v = Form.Sym ("and" | "or"); _ }; x ] when not q -> sh x | _ -> let v = match f.v with | Form.List (({ v = Form.Sym "let"; _ } as h) :: { v = Form.Vec bs; loc } :: body) -> (match stmts body with | [ { v = Form.List ({ v = Form.Sym "let"; _ } :: { v = Form.Vec bs2; _ } :: body2); _ } ] -> Form.List (h :: Form.make (Form.Vec (List.map sh bs @ bs2)) loc :: body2) | body -> Form.List (h :: Form.make (Form.Vec (List.map sh bs)) loc :: body)) (* A lambda whose body is one [do] is the lambda of its statements: the printer writes them straight under [=>]. *) | Form.List [ ({ v = Form.Sym "fn"; _ } as h); ({ v = Form.Vec _; _ } as ps); { v = Form.List ({ v = Form.Sym "do"; _ } :: (_ :: _ :: _ as ss)); _ } ] when not q -> (sh { f with v = Form.List (h :: ps :: ss) }).v | Form.List (({ v = Form.Sym "handler-case"; _ } as h) :: body :: ({ v = Form.Vec cls; _ } as cv) :: more) -> Form.List (h :: sh body :: { cv with v = Form.Vec (List.map clause cls) } :: List.map sh more) | Form.List (({ v = Form.Sym "handler-bind"; _ } as h) :: ({ v = Form.Vec cls; _ } as cv) :: body) -> Form.List (h :: { cv with v = Form.Vec (List.map clause cls) } :: stmts body) | Form.List (({ v = Form.Sym "restart-case"; _ } as h) :: body :: cls) -> Form.List (h :: sh body :: List.map clause cls) | Form.List l -> (match seq_list l with | [ { v = Form.Sym "do"; _ }; x ] when is_let x -> x.v | l -> Form.List l) | Form.Vec l -> Form.Vec (List.map sh l) | Form.Map l -> Form.Map (List.map sh l) | v -> v in { f with v } let norm f = shape (canon f) let diag_text = function | Loc.Error d -> Printf.sprintf "%s %d:%d %s" d.Loc.kind d.dloc.Loc.line d.dloc.Loc.col d.dmsg | e -> Printexc.to_string e (* ── The hand-converted pairs ──────────────────────────────────────── *) let pair flan fln = match Reader.read_file flan, Source.read_file fln with | a, b -> macros := Body_macros.table ~file:flan a; (* Normalised: a hand conversion writes a let flat where its scope does not matter, as the printer does. *) let a = List.map norm a and b = List.map norm b in if not (same_forms a b) then fail "%s and %s read differently: %s" flan fln (describe_diff a b) | exception e -> fail "%s / %s: %s" flan fln (diag_text e) let () = pair "syntax/algorithms.flan" "syntax/algorithms.fln"; pair "../sand.flan" "syntax/sand.fln"; pair "syntax/infer/main.flan" "syntax/infer/main.fln"; (* Checked, never run: sand opens a window. *) List.iter (fun f -> match Front.checked f with | _ -> () | exception e -> fail "%s does not check: %s" f (diag_text e)) [ "syntax/sand.fln"; "syntax/algorithms.fln" ] (* ── The round trip over the corpus ────────────────────────────────── *) (* The comments of a text, as a sorted list: where each lands may move — a comment inside an expression printed on one line goes above it — but none may be lost or made. *) let comment_texts src = List.sort compare (List.map (fun (c : Source_text.comment) -> String.trim c.text) (Source_text.comments src)) (* What each comment is attached to. An own-line comment belongs to the form after it; a trailing one to the last form that starts on its line. After a conversion, the form after an own-line comment must be that form or one holding it (a comment inside an expression printed on one line goes above the line), and a trailing comment's line — or, when it had to move onto a line of its own, the line above — must hold its form. So a comment that drifted to another statement is caught, not only a lost one. *) let starts_of (fs : Form.t list) = let out = ref [] in let rec walk (f : Form.t) = (* Outermost first among forms starting at one place: [x = v] and its [x] start together, and the statement is what a comment is about. *) let t = Form.to_string f in out := ((f.loc.Loc.line, f.loc.Loc.col, - String.length t), t) :: !out; match f.v with | Form.List l | Form.Vec l | Form.Map l -> List.iter walk l | _ -> () in (* The normalised forms: a [let] a flat line extended is, on both sides, the one that holds what now follows it. *) List.iter walk (List.map norm fs); List.map (fun ((l, c, _), t) -> (l, c, t)) (List.sort compare !out) let attachments src forms = let st = starts_of forms in List.map (fun (c : Source_text.comment) -> let owner = if c.own_line then List.find_opt (fun (l, _, _) -> l > c.line) st else (* The last place a form starts on the line, and the outermost form starting there. *) List.fold_left (fun acc ((l, col, _) as x) -> match acc with | Some (_, col', _) when l = c.line && col = col' -> acc | _ -> if l = c.line then Some x else acc) None st in (c, Option.map (fun (_, _, t) -> t) owner)) (Source_text.comments src) let attached_ok ~what path (src, forms) (out, back) = let want = attachments src forms and got = attachments out back in let st = starts_of back in let on_line l = List.filter_map (fun (l', _, t) -> if l' = l then Some t else None) st in (* Paired by text, in order: the n-th copy of a text with the n-th. *) let rec pair = function | [] -> () | ((c : Source_text.comment), o) :: rest -> let t = String.trim c.text in let same (d : Source_text.comment) = String.trim d.text = t in let rec take = function | [] -> None | ((d, _) as x) :: xs -> if same d && not (List.memq x !used) then (used := x :: !used; Some x) else take xs in (match take got, o with | None, _ -> fail "%s %s: the comment %s went missing" what path t | Some _, None -> () | Some ((d : Source_text.comment), g), Some o -> let holds x = Test_support.contains x o in (* The code line a moved trailing comment sits under: up past the comment lines between. *) let rec code_above l = if l < 1 then [] else match on_line l with [] -> code_above (l - 1) | fs -> fs in let fine = if c.own_line then (match g with (* Above the form, above the statement holding it, or above the first statement of the block it was: all of those read as being about it. *) | Some g -> holds g || (String.length g > 4 && Test_support.contains o g) | None -> false) else List.exists holds (on_line d.line) || (d.own_line && List.exists holds (code_above (d.line - 1))) in if not fine then fail "%s %s: the comment %s (line %d) was about %s and is now beside %s" what path t c.line o (Option.value g ~default:"nothing")); pair rest and used = ref [] in pair want (* 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" && not (List.mem name lisp_only) then path :: acc else acc) acc (Sys.readdir dir) in List.sort String.compare (walk ".." []) let () = let ok = ref 0 in List.iter (fun path -> match Reader.read_file path with | exception Loc.Error _ -> () (* not a program the paren reader takes *) | forms -> let source = In_channel.with_open_bin path In_channel.input_all in macros := Body_macros.table ~file:path forms; match Indent_printer.program ~source ~macros:!macros forms with | exception Indent_printer.Unprintable (f, why) -> fail "round trip %s: %s at %d:%d" path why f.loc.Loc.line f.loc.Loc.col | text -> match Indent_reader.read_all ~file:(path ^ ".fln") text with | exception e -> fail "round trip %s: %s" path (diag_text e) | back -> let a = List.map norm forms and b = List.map norm back in if not (same_forms a b) then fail "round trip %s: %s" path (describe_diff a b) else if comment_texts text <> comment_texts source then fail "round trip %s: the comments did not all come through" path else begin attached_ok ~what:"round trip" path (source, forms) (text, back); (* And back to parens, from the indented text: the forms and the comments survive the second printer too. *) let paren = Paren_printer.program ~source:text back in match Reader.read_all ~file:path paren with | exception e -> fail "back to parens %s: %s" path (diag_text e) | again -> if not (same_forms (List.map norm again) b) then fail "back to parens %s: %s" path (describe_diff b (List.map norm again)) else if comment_texts paren <> comment_texts source then fail "back to parens %s: the comments did not all come through" path else begin attached_ok ~what:"back to parens" path (text, back) (paren, again); incr ok end end) (corpus ()); Printf.printf "round trip: %d files\n" !ok; (* The deps decide what is walked, and a stanza that lost them would pass over nothing. *) if !ok < 390 then fail "round trip covered only %d files" !ok (* Names that are operator words are written in parentheses, and a group reads them back. *) let () = let src = "(defn f [] () (let [a 1 not 2 and 3 or 4 + 5 - 6 < 7 = 8 mod 9 % 10 b 11] \ (g a not and or + - < = mod % b)))" in let forms = Reader.read_all ~file:"" src in let text = Indent_printer.program ~source:src forms in if not (Test_support.contains text " (not) = 2\n (and) = 3") then fail "operator-word bindings printed %S" text; match Indent_reader.read_all ~file:".fln" text with | back -> if not (same_forms (List.map norm forms) (List.map norm back)) then fail "operator-word bindings: %s" (describe_diff (List.map norm forms) (List.map norm back)) | exception e -> fail "operator-word bindings read back: %s\n%s" (diag_text e) text (* ── Lexical edge cases ────────────────────────────────────────────── *) (* [~global:false] reads as an expression the editor sends, where a [let] is local; a file's top-level [let] is a global. *) let read ?(global = true) src = Indent_reader.read_all ~global_let:global ~file:"" src let reads ?global name src want = match read ?global src with | forms -> let got = String.concat "\n" (List.map Form.to_string forms) in if got <> want then fail "%s: read %s, wanted %s" name got want | exception e -> fail "%s: refused: %s" name (diag_text e) let refuses ?global name src kind needle = match read ?global src with | forms -> fail "%s: read %s, wanted the refusal %s" name (String.concat " " (List.map Form.to_string forms)) kind | exception Loc.Error d -> if d.Loc.kind <> kind then fail "%s: refused as %s, wanted %s (%s)" name d.Loc.kind kind d.dmsg else if not (Test_support.contains d.dmsg needle) then fail "%s: %s does not say %S: %s" name kind needle d.dmsg | exception e -> fail "%s: %s" name (Printexc.to_string e) let () = (* Minus. *) reads "subtraction" "x = a - 1" "(set x (- a 1))"; reads "negative literal" "x = -1" "(set x -1)"; reads "negation" "x = -y" "(set x (- y))"; reads "negation binds after postfix" "x = -p.x" "(set x (- (.x p)))"; reads "lisp name" "x = a-b" "(set x a-b)"; reads "decrement is a name" "--(j)" "(-- j)"; reads "minus as a call" "x = -(a + b)" "(set x (- (+ a b)))"; refuses "glued minus" "x = a -1" "indent/glued-minus" "a - 1"; refuses "glued minus in a call" "f(a -1)" "indent/glued-minus" "space the minus"; (* The arrow. *) reads "return arrow" "fn f(x: i32) -> i32 = x" "(defn f [x i32] i32 x)"; reads "arrow inside a name" "fn dyn->f64(v: f64) -> f64 = v" "(defn dyn->f64 [v f64] f64 v)"; reads "function type" "fn g(h: Fn(i32, i32) -> bool) -> () = h(1, 2)" "(defn g [h (Fn [i32 i32] bool)] () (h 1 2))"; reads "untyped parameter is dyn" "fn id(x) -> dyn = x" "(defn id [x dyn] dyn x)"; reads "no arrow infers the return" "fn f(x)\n x" "(defn f [x dyn] _ x)"; reads "no arrow, one expression" "fn f(x: i32) = x + 1" "(defn f [x i32] _ (+ x 1))"; reads "no arrow, with where" "fn f(x: $t) where is-ordered($t) = x" "(defn f [x $t] _ {:where (is-ordered $t)} x)"; (* The fix is .fln's commas whatever the file is called: [read] names it . *) refuses "where predicates joined with and" "fn f(x: $t, y: $u) -> i32 where is-ordered($t) and is-equal($u)\n 0" "indent/where-and" "commas, not and — write where is-ordered($t), is-equal($u)"; (* Characters, lexed before brackets and separators. *) reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])"; reads "character arguments" "f(\\,, \\))" "(f \\, \\))"; reads "character spellings" "x = [\\u0041 \\u0007 \\backspace \\formfeed \\日]" "(set x [\\A \\u0007 \\backspace \\formfeed \\日])"; (* Keywords and annotations. *) reads "keyword" "let k = :else" "(def k dyn :else)"; reads "annotation" "once grid: [4 [8 u32]]" "(defonce grid [4 [8 u32]])"; reads "keyword argument" "rl/is-key-pressed(:key-r)" "(rl/is-key-pressed :key-r)"; refuses "colon inside a name" "fn f(x:i32) -> () = x" "indent/colon-in-name" "x: i32"; (* Adjacency. *) reads "call" "f(a, b)" "(f a b)"; reads "index" "x[i, j]" "(at x i j)"; reads "call of a call" "f(a)(b)" "((f a) b)"; reads "field chain" "camera.target.x" "(.x (.target camera))"; reads "qualified case" "Shape.Rect" "Shape.Rect"; reads "field of a call" "f(x).y" "(.y (f x))"; reads "struct literal" "Vector2{.x 1, .y 2}" "(Vector2 {.x 1 .y 2})"; reads "operator call" "+(a, b, c)" "(+ a b c)"; reads "operator value" "reduce(+, 0, xs)" "(reduce + 0 xs)"; refuses "spaced call" "f (a)" "indent/spaced-call" "f(...)"; refuses "spaced index" "x [i]" "indent/spaced-index" "x[i]"; refuses "missing comma" "f(a b)" "indent/missing-comma" "commas"; refuses "unspaced operator" "x = f(a)+ b" "indent/unspaced-operator" "a + b"; (* Collections. *) reads "whitespace vector" "x = [i n]" "(set x [i n])"; reads "comma vector" "x = [a - 1, b]" "(set x [(- a 1) b])"; refuses "operator between spaces" "x = [a - 1 b]" "indent/separate-elements" "commas"; reads "quoted list" "x = '(a b c)" "(set x (quote (a b c)))"; (* Trailing colon blocks. *) reads "trailing block" "rl/with-drawing():\n clear()\n draw()" "(rl/with-drawing (clear) (draw))"; reads "fallback with a block" "defmethod(describe, :square, [s]):\n s" "(defmethod describe :square [s] s)"; refuses "block without the colon" "f(x)\n y" "indent/stray-indent" "trailing colon"; refuses "colon on a non-call" "a + b:\n y" "indent/colon-block" "comment:"; reads "bare name takes a block" "comment:\n f()\n g()" "(comment (f) (g))"; reads "qualified name takes a block" "rl/with-drawing:\n f()" "(rl/with-drawing (f))"; (* Indentation. *) refuses "tab" "fn f() -> ()\n\tg()" "indent/tab" "spaces"; refuses "dedent to no block" "if a\n b\n c" "indent/dedent" "between the block at column 1 and the one at column 5"; (* A continuation sits deeper than the line it continues. *) refuses "leading operator left of its block" "if a\n b\n+ 1" "indent/continuation" "column 3"; refuses "leading operator at the statement's column" "let x = 1\n+ 2\nx" "indent/continuation" "Indent it further"; refuses "trailing operator, shallower next line" "if a\n x = b +\nc" "indent/continuation" "finish the line above"; reads "blank and comment lines" "if a\n\n ; note\n b\n\n; more\nc" "(when a b)\nc"; (* Continuation lines. *) reads "trailing operator" "x = a +\n b" "(set x (+ a b))"; reads "leading operator" "x = a\n + b" "(set x (+ a b))"; reads "continued condition" "if a\n and b\n c" "(when (and a b) c)"; (* Runs of one operator. *) reads "flattened" "x = a + b + c" "(set x (+ a b c))"; reads "chain" "x = a < b < c" "(set x (< a b c))"; reads "left to right" "x = a - b + c" "(set x (+ (- a b) c))"; reads "precedence" "x = a or b and not c == d" "(set x (or a (and b (not (= c d)))))"; (* not is a prefix word, between and and the comparisons. *) reads "not over a comparison" "x = not a == b" "(set x (not (= a b)))"; reads "not under and" "x = not a and b" "(set x (and (not a) b))"; reads "not twice" "x = not not a" "(set x (not (not a)))"; reads "not of a group" "x = not (a or b)" "(set x (not (or a b)))"; reads "not glued is a call" "x = not(a) or b" "(set x (or (not a) b))"; reads "not as a statement" "if not done\n go()" "(when (not done) (go))"; refuses "not after a comparison" "x = a == not b" "indent/not-operand" "parentheses with what it negates:\n\n x = a == (not b)"; refuses "not after arithmetic" "if 1 + not b and c\n g()" "indent/not-operand" "if 1 + (not b) and c"; refuses "not in a spaced vector" "x = [not a b]" "indent/separate-elements" "commas"; (* The bit operators: tighter than a comparison, looser than a shift, and among themselves && then ^^ then ||. *) reads "bit and under a comparison" "x = a && mask == 0" "(set x (= (bit-and a mask) 0))"; reads "bit operator order" "x = a || b ^^ c && d << 2 + 1" "(set x (bit-or a (bit-xor b (bit-and c (<< d (+ 2 1))))))"; reads "bit operators left to right" "x = a && b && c || d" "(set x (bit-or (bit-and a b c) d))"; reads "bit-not" "x = ~~a && ~~f(b)" "(set x (bit-and (bit-not a) (bit-not (f b))))"; reads "bit-not of a negation" "x = ~~-a" "(set x (bit-not (- a)))"; reads "bit operator values" "x = reduce(^^, 0, xs)" "(set x (reduce bit-xor 0 xs))"; reads "bit-not in a spaced vector" "x = [~~a b]" "(set x [(bit-not a) b])"; reads "a nested unquote" "quote\n f(~(~x))" "(quasiquote (f (unquote (unquote x))))"; reads "bit-not in a template" "quote\n f(~~x, ~(~~y))" "(quasiquote (f (bit-not x) (unquote (bit-not y))))"; refuses "not-equal chain" "x = a != b != c" "indent/chained-not-equal" "!=(a, b, c)"; reads "not-equal call" "x = !=(a, b, c)" "(set x (!= a b c))"; (* One direction mixes; each operand that is a call is bound once, in order, before any test. *) reads "mixed chain" "x = 0 <= r < rows" "(set x (and (<= 0 r) (< r rows)))"; reads "mixed chain of four" "x = a < b <= c < d" "(set x (and (< a b) (<= b c) (< c d)))"; reads "mixed chain downward" "x = x >= y > 0" "(set x (and (>= x y) (> y 0)))"; (* A name is bound too once any operand is, so it is read in its turn. *) reads "mixed chain over a call" "x = a < f(b) <= c" "(set x (let [~cmp1 a ~cmp2 (f b) ~cmp3 c] (and (< ~cmp1 ~cmp2) (<= ~cmp2 ~cmp3))))"; reads "mixed chain over two calls" "x = 0 < f() <= g() < h()" "(set x (let [~cmp1 (f) ~cmp2 (g) ~cmp3 (h)] (and (< 0 ~cmp1) (<= ~cmp1 ~cmp2) (< ~cmp2 ~cmp3))))"; refuses "chain that turns around" "x = a < b > c" "indent/mixed-comparison" "a < b and b > c"; refuses "== in a chain" "x = a == b < c" "indent/mixed-comparison" "a == b and b < c"; refuses "== after a chain" "x = x < 1 <= 2 == true" "indent/mixed-comparison" "x < 1 and 1 <= 2 and 2 == true"; refuses "a refused chain's middle call is named once" "x = a < f(b) <= g(c) > d" "indent/mixed-comparison" "let mid = f(b)\n let mid2 = g(c)\n a < mid and mid <= mid2 and mid2 > d"; (* Statements. *) reads "lets merge" "fn f() -> i32\n let a = 1\n let b = 2\n a + b" "(defn f [] i32 (let [a 1 b 2] (+ a b)))"; refuses ~global:false "let with a block" "let a = 1\n a\nb" "indent/let-block" "goes at the let's column"; reads ~global:false "flat let" "let a = 1\na\nb" "(let [a 1] a b)"; reads "elif" "if a\n 1\nelif b\n 2\nelse\n 3" "(cond a 1 b 2 :else 3)"; reads "one-line if" "x = if a then 1 else 2" "(set x (if a 1 2))"; reads "assignment ops" "a[i] += 1" "(set (at a i) (+ (at a i) 1))"; (* A place with a call in it is evaluated once: it reads as update. *) reads "assignment op over a call's place" "a[next()] += 1" "(update (at a (next)) + 1)"; reads "for" "for :outer i in range(1, n)\n f(i)" "(dotimes :outer [i 1 n] (f i))"; reads "unit statement" "restart-case\n f()\nrestart continue()\n ()" "(restart-case (f) (continue [] (do)))"; reads "match" "match s\n Circle(r) -> r\n _ ->\n a()\n b()" "(match s (Circle r) r _ (do (a) (b)))"; reads "match over literals" "match n\n 5 -> a\n -2.5 -> b\n \"go\" -> c\n \\a -> d\n _ -> e" "(match n 5 a -2.5 b \"go\" c \\a d _ e)"; reads "match over a bool" "match b\n true -> a\n false -> b" "(match b true a false b)"; reads "keyword arms over a dyn" "match d\n :north -> a\n 1 -> b\n _ -> c" "(match d :north a 1 b _ c)"; reads "handler-bind moves the clauses" "handler-bind\n f()\non E(c)\n g(c)" "(handler-bind [(E [c] (g c))] (f))"; reads "quote block" "defmacro(m, [x & ys]):\n quote\n f(~x)\n ~@ys" "(defmacro m [x & ys] (quasiquote (do (f (unquote x)) (unquote-splicing ys))))"; reads "lambda" "g = fn(i, j) => i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))"; reads "lambda with a block" "g = fn(i) =>\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))"; reads "where" "fn s(xs: [$t]) -> () where is-ordered($t) = f(xs)" "(defn s [xs [$t]] () {:where (is-ordered $t)} (f xs))"; reads "data" "data Shape\n Circle(r: f32)\n Empty" "(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 "type alias" "type Row = Vec(i32)" "(defalias Row (Vec i32))"; reads "type alias of an array" "type V2 = [2 f32]" "(defalias V2 [2 f32])"; reads "a local named type" "type = 3" "(set type 3)"; reads "a header word assigned" "data += 3" "(set data (+ data 3))"; reads "a clause word assigned after its header" "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 top-level let is a global" "let g = 1\nlet h: i32 = 2\nlet s: [4 u8]\nf(g)" "(def g dyn 1)\n(def h i32 2)\n(def s [4 u8])\n(f g)"; refuses "def" "def g: i32 = 1" "indent/def-is-let" "let g: i32 = 1"; refuses "a bare def" "def g" "indent/def-is-let" "let g: i32 = 0"; (match read "generic f(a)\n\nfn g() = 1" with | exception Loc.Error d when d.Loc.dloc.Loc.line = 1 && d.Loc.dloc.Loc.col = 13 -> () | exception Loc.Error d -> fail "a generic with no arrow is refused at %d:%d, not at its line's end" d.Loc.dloc.Loc.line d.Loc.dloc.Loc.col | _ -> fail "a generic with no arrow was read"); reads "a let in a comment block stays local" "comment:\n let x = 1\n f(x)" "(comment (let [x 1] (f x)))"; reads "and in a fn" "fn f() -> i32\n let x = 1\n x" "(defn f [] i32 (let [x 1] x))"; 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" "(defstruct D :parent Io [free i64])"; refuses "a one-line struct takes no block" "struct Pt(x: i32)\n y: i32" "indent/stray-indent" "takes no block"; 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)"; (* 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" "(match s 1 (break) 2 (continue :outer) _ (set x (+ x 1)))"; reads "then break" "if c then break" "(when c (break))"; reads "then return else assign" "if c then return 5 else x = 2" "(if c (return 5) (set x 2))"; reads "return in an expression if" "y = if c then return else 1" "(set y (if c (return) 1))"; reads "defer an assignment" "defer x = 0" "(defer (set x 0))"; (* Messages with a shape of their own. *) refuses "parenthesised pair" "x = (a, b)" "indent/tuple" "[a, b]"; refuses "rest parameter" "fn f(& rest) -> () = 0" "indent/rest-parameter" "xs: [T]"; refuses "assignment as a test" "if x = 1\n y" "indent/assign-in-test" "write == instead"; (* A message quotes the text as written, never the paren form. *) refuses "two assignments" "if a then b = c = d" "indent/assign-in-test" "if a then b = c,"; refuses "a let-bound if with no block" "let r = if a > 1\nr" "indent/expected-block" "if a > 1 takes"; refuses "two bindings on a line" "let v: i32 = a, w = b" "indent/one-binding" "a is followed by a comma"; refuses "two bindings on a let's line" "fn f()\n let v = a, w = b\n v" "indent/one-binding" "under its name:\n\n let v = a\n w = b"; reads ~global:false "a let-bound match" "let r = match a\n 1 -> 2\n _ -> 3\nr" "(let [r (match a 1 2 _ 3)] r)"; reads ~global:false "a let-bound if" "let q = if a\n 1\nelse\n 2\nq" "(let [q (if a 1 2)] q)"; reads ~global:false "a let-bound call with a block" "let v = foo(a):\n x\nv" "(let [v (foo a x)] v)"; refuses "colon after if" "if c:\n y" "indent/header-colon" "no colon"; refuses "colon after a return type" "fn f() -> i32:\n 0" "indent/header-colon" "no colon"; refuses "colon after a number" "while x < 3:\n y" "indent/header-colon" "no colon"; refuses "one-line handler-case" "handler-case g()" "indent/clause-header" "on Type(c)"; refuses "one-line on clause" "handler-case\n g()\non A(c) -> 1" "indent/clause-body" "on A(c)"; refuses "one-line elif" "x = if a then 1 elif b then 2 else 3" "indent/one-line-elif" "else if b"; refuses "elif with then" "if a\n 1\nelif b then 2" "indent/elif-then" "no then"; refuses "brace hint" "x = {.x a + 1 .y 2}" "indent/separate-elements" "{.x a + 1, .y 2}"; refuses "mixed separators" "x = [1 2, 3]" "indent/mixed-separators" "[1, 2, 3]"; reads "one-line quote" "defmacro(m, [x]):\n quote ~x + 1" "(defmacro m [x] (quasiquote (+ (unquote x) 1)))"; reads ~global:false "typed let" "let x: i32 = 5\nx" "(let [x (the i32 5)] x)"; refuses "a let takes no block" "fn f() -> ()\n let x = 1\n g(x)\n h(x)" "indent/let-block" "goes at the let's column"; (* Mistakes carried over from other languages, answered in this one. *) refuses "a block without the colon names the call" "with-allocator(a, b)\n g()" "indent/stray-indent" "as in with-allocator(a, b):"; refuses "field with =" "p = P{x = 1}" "indent/brace-field" "{.x value}"; refuses "field with a colon" "p = P{x: 1}" "indent/brace-field" "no colon"; refuses "a dotted range" "for i in 0..10\n g(i)" "indent/dot-range" "range(0, 10)"; (* A lambda's block inside brackets ends where they close. *) reads "a block lambda inside a call" "sort-by(xs, fn(a, b) =>\n let c = a + 1\n c < b)" "(sort-by xs (fn [a b] (let [c (+ a 1)] (< c b))))"; reads "its closer on a line of its own" "sort-by(xs, fn(a, b) =>\n a < b\n)\ng()" "(sort-by xs (fn [a b] (< a b)))\n(g)"; reads "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool =>\n a < b)" "(sort-by xs (the (Fn [C C] bool) (fn [a b] (< a b))))"; reads "nested block lambdas" "map(xs, fn(x) =>\n let ys = map(x, fn(y) =>\n if y > 0\n y\n else\n 0)\n sum(ys))" "(map xs (fn [x] (let [ys (map x (fn [y] (if (> y 0) y 0)))] (sum ys))))"; reads "a block lambda on a wrapped argument line" "f(a,\n fn(b) =>\n g(b)\n h(b))" "(f a (fn [b] (g b) (h b)))"; reads "a block lambda in a vector" "x = [1, fn(b) =>\n b]" "(set x [1 (fn [b] b)])"; reads ~global:false "a call after a block lambda's call" "let v = f(fn(a) =>\n a)\ng(v)" "(let [v (f (fn [a] a))] (g v))"; refuses "a block lambda is the last argument" "sort-by(fn(a, b) =>\n a < b, xs)" "indent/lambda-block-last" "let f = fn(a) =>"; refuses "one block lambda to a call" "f(fn(a) =>\n a\n, fn(b) =>\n b)" "indent/lambda-block-last" "on line 1"; refuses "a line back at the header's column" "f(fn(a) =>\n a\nb)" "indent/lambda-block-last" "b follows the block of the lambda on line 1"; refuses "an element after a block lambda, left of its block" "m = {:a fn(x) =>\n x\n :b 2}" "indent/lambda-block-last" ":b follows the block"; refuses "a block's first line not indented" "f(fn(a) =>\na)" "indent/lambda-block-left" "Indent it into the block"; refuses "a block lambda's brackets left open" "f(fn(a) =>\n a\n" "indent/unclosed" "ends where this bracket closes"; (* A let's bindings on the lines under it. *) reads ~global:false "a let's bindings on indented lines" "let a = 1\n b = a + 1\n c: i32 = b\ng(c)" "(let [a 1 b (+ a 1) c (the i32 b)] (g c))"; reads ~global:false "patterns among them" "let p = q()\n {x .x} = p\n [h & t] = xs\ng(x, h)" "(let [p (q) {x .x} p [h & t] xs] (g x h))"; reads ~global:false "a block value last in a group" "let a = 1\n c = match a\n 1 -> 2\n _ -> 3\ng(c)" "(let [a 1 c (match a 1 2 _ 3)] (g c))"; reads ~global:false "a let after a block value" "let a = 1\n b =\n f()\n a\nlet c = 2\ng(c)" "(let [a 1 b (do (f) a) c 2] (g c))"; reads ~global:false "a let after a group merges into it" "let a = 1\n b = 2\nlet c = 3\ng(c)" "(let [a 1 b 2 c 3] (g c))"; reads ~global:false "a group in a body" "fn f()\n let a = 1\n b = 2\n a + b" "(defn f [] _ (let [a 1 b 2] (+ a b)))"; refuses ~global:false "a statement under a let" "let a = 1\n g(a)\nh()" "indent/let-block" "b = a + 1"; refuses ~global:false "an assignment to a field under a let" "let a = p()\n a.x = 1\nh()" "indent/let-block" "only lines that go there are more bindings"; refuses ~global:false "a compound assignment under a let" "let a = 1\n a += 1\nh()" "indent/let-block" "let's column"; reads "a top-level group is several globals" "let a = 1\n b: i32 = 2\nfn f() = a" "(def a dyn 1)\n(def b i32 2)\n(defn f [] _ a)"; refuses "a global group binds names" "let a = 1\n {x .x} = p" "indent/global-pattern" "a global binds one name"; refuses "a statement under a global" "let a = 1\n f(a)" "indent/let-block" "more bindings of the let"; reads "typed globals with no value in a group" "let a: i32\n b: i32\n c = 2" "(def a i32)\n(def b i32)\n(def c dyn 2)"; reads "a group under a typed global with no value" "let a: i32 = 1\n b: i64" "(def a i32 1)\n(def b i64)"; refuses ~global:false "a local binding with no value" "let a = 1\n b: i32\ng()" "indent/let-block" "more bindings of the let"; (* A binding lines up with the let's first name. *) refuses ~global:false "a binding right of the first name" "let x = 1\n y = 2\ng()" "indent/let-align" "starts at column 7, under the let on line 1, whose bindings line up with its first name, x, at column 5. Move it to column 5:\n\n let x = 1\n y = 2"; refuses ~global:false "a binding left of the first name" "fn f()\n let x = 1\n y = 2\n z = 3\n g()" "indent/let-align" "Move it to column 7"; refuses ~global:false "a binding deeper than the one above" "fn f()\n let x = 1\n y = 2\n z = 3\n g()" "indent/let-align" "Move it to column 7"; refuses "a global binding out of line" "let x = 1\n y = 2" "indent/let-align" "Move it to column 5"; (* A let whose value is a block takes no more bindings under it. *) refuses "a binding after a lambda block" "fn f()\n let g = fn(x) =>\n x + 1\n y = 2\n g(y)" "indent/let-after-block" "one more binding of the let on line 2, after g, whose value is the block above it"; refuses "a binding after a match's arms" "fn f(a)\n let g = match a\n 1 -> 2\n _ -> 3\n y = 2\n g" "indent/let-after-block" "let of its own, at that let's column:\n\n let y = 2"; refuses "a binding after a deeper block" "fn f()\n let g =\n h()\n y = 2\n g" "indent/let-after-block" "after g"; refuses "a binding after a later binding's block" "fn f()\n let a = 0\n g = fn(x) =>\n x\n h = 2\n h" "indent/let-after-block" "one more binding of the let on line 2, after g, whose value is the block above it. A binding whose value is a block ends its let's bindings, so this one needs a let of its own, at that let's column:\n\n let h = 2"; (* A block lambda whose brackets close ends no group: its block is shut when its value ends. *) reads ~global:false "a binding after a later binding's bracketed lambda" "let a = 1\n g = map(xs, fn(x) =>\n x + 1)\n h = 2\nh" "(let [a 1 g (map xs (fn [x] (+ x 1))) h 2] h)"; reads ~global:false "a binding after a first binding's bracketed lambda" "let g = map(xs, fn(x) =>\n x + 1)\n h = 2\nh" "(let [g (map xs (fn [x] (+ x 1))) h 2] h)"; refuses "a binding after a later binding's match" "fn f()\n let a = 1\n b = match a\n 1 -> 2\n _ -> 3\n c = 4\n c" "indent/let-after-block" "the let on line 2, after b"; refuses "a global after a global's block" "let a = 0\n g =\n h()\n b = 2" "indent/let-after-block" "after g"; (* Only a line shaped as a binding gets the alignment advice. *) refuses "a statement between a let and its lambda's block" "fn f()\n let g = fn(x) =>\n x + 1\n print(g)" "indent/dedent" "belongs to neither"; refuses "an else between a let and its if's block" "fn f(c)\n let g = if c\n 1\n else\n 2\n g" "indent/dedent" "belongs to neither"; refuses ~global:false "a statement deeper than a binding" "let x = 1\n y = 2\n g()\nh()" "indent/let-block" "more bindings of the let"; (* A tab between let and its first name. *) refuses "a tab after a local let" "fn f()\n let\ta = 1\n a" "indent/tab" "put a space there: let a"; refuses "a tab after a global let" "let \ta = 1" "indent/tab" "a tab between let and a"; (* Indices separate as a vector's elements do. *) reads "indices separated by spaces" "x = grid[row col].color-idx" "(set x (.color-idx (at grid row col)))"; reads "grouped indices separated by spaces" "x = grid[(r + 1) (c - 1)]" "(set x (at grid (+ r 1) (- c 1)))"; reads "indices separated by commas" "x = grid[r + 1, c]" "(set x (at grid (+ r 1) c))"; reads "calls and fields as spaced indices" "x = grid[f(r) p.y]" "(set x (at grid (f r) (.y p)))"; reads "a negative literal first" "x = grid[-1 c]" "(set x (at grid -1 c))"; reads "a spaced index assigned" "grid[r c] = 1" "(set (at grid r c) 1)"; refuses "an operator among spaced indices" "x = grid[r + 1 c]" "indent/separate-elements" "Separate the indices with commas: grid[r + 1, c]"; refuses "an operator last among spaced indices" "x = grid[r c - 1]" "indent/separate-elements" "grid[r, c - 1]"; refuses "mixed index separators" "x = grid[r c, d]" "indent/mixed-separators" "Use one: grid[r, c, d] or grid[r c d]"; refuses "a glued minus among indices" "x = grid[i -1]" "indent/glued-minus" "grid[i - 1]"; refuses "a glued negation among indices" "x = grid[i -j]" "indent/glued-minus" "grid[i, -j]"; refuses "arguments with no comma" "x = f(a b)" "indent/missing-comma" "Separate arguments with commas: f(a, b)"; refuses "a body glued to =>" "x = fn(a) =>a" "indent/lambda-arrow-space" "fn(a) => a"; refuses "a lambda written with =" "x = fn(a, b) = a + b" "indent/lambda-equals" "fn(a, b) => a + b"; refuses "a typed lambda written with =" "x = fn(a: C) -> bool = a.n > 1" "indent/lambda-equals" "fn(a: C) -> bool => a.n > 1"; refuses "a block lambda with no =>" "let f = fn(a)\n a\nf" "indent/lambda-arrow" "fn(a) =>"; refuses "a block lambda with no => inside a call" "sort-by(xs, fn(a, b)\n a < b)" "indent/lambda-arrow" "fn(a, b) =>"; refuses "a typed block lambda with no => inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)" "indent/lambda-arrow" "fn(a: C, b: C) -> bool =>"; refuses "a => with nothing under it" "let f = fn(a) =>\nf" "indent/lambda-body" "fn(a) =>"; refuses "an else after else-if on one line" "if a then x\nelse if b then y\nelse z" "indent/orphan-else" "Write that line as elif"; refuses "else deeper than a one-line if" "if a then b\n else c" "indent/else-column" "Put it at the if's column"; reads "a one-line else after an if with a block" "if a\n b()\n c()\nelse d()" "(if a (do (b) (c)) (d))"; refuses "an unclosed call swallows the next line" "fn f() -> ()\n push(v, 1\n g()" "indent/missing-comma" "If the ( on line 2 was meant to close"; reads "else on the line after a one-line if" "if a then b\nelse c" "(if a b c)"; reads "elif and else continuing a one-line if" "if a then b\nelif c then d\nelif e\n f()\n g()\nelse\n h()" "(cond a b c d e (do (f) (g)) :else (h))"; refuses "else left of a one-line if" "while x\n if a then b\nelse c" "indent/orphan-else" "goes at the if's column"; reads "a typed lambda" "f = fn(a: C, b) -> bool => a.n < b" "(set f (the (Fn [C dyn] bool) (fn [a b] (< (.n a) b))))"; reads ~global:false "a typed lambda with a block" "let f = fn(x: i32) -> i32 =>\n let y = x + 1\n y\ng(f)" "(let [f (the (Fn [i32] i32) (fn [x] (let [y (+ x 1)] y)))] (g f))"; refuses "a typed lambda states its return type" "f = fn(a: C) = a" "indent/lambda-return" "fn(a: C) -> R => value"; reads "a restart's report on its header" "restart-case\n go()\nrestart retry(n: i32) \"Try again\"\n n" "(restart-case (go) (retry [n i32] :report \"Try again\" n))"; reads "a bare () in a body slot does nothing" "fn f() -> () = ()\nfn g(x) -> ()\n match x\n 1 -> h()\n _ -> ()\n k = fn() => ()" "(defn f [] () (do))\n(defn g [x dyn] () (match x 1 (h) _ (do)) (set k (fn [] (do))))"; reads "a parenthesised () stays a value" "x = (())" "(set x ())"; reads "a template's for takes an unquoted variable" "quote\n for ~i in range(~n)\n g(~i)" "(quasiquote (dotimes [(unquote i) (unquote n)] (g (unquote i))))"; (* And back: the printer writes the idioms. *) let prints name src want = match Reader.read_all ~file:"

" src with | forms -> let got = Indent_printer.program ~source:src forms in if not (Test_support.contains got want) then fail "%s: printed %S, wanted it to contain %S" name got want | exception e -> fail "%s: %s" name (diag_text e) in prints "compound assignment" "(defn f [] () (set x (+ x 1)))" " x += 1"; prints "not as a word" "(defn f [] () (g (not (= a b)) (and (not x) y)))" "g(not a == b, not x and y)"; prints "not of a lower operator in parentheses" "(defn f [] () (g (not (or a b))))" "g(not (a or b))"; prints "not under a comparison in parentheses" "(defn f [] () (g (= (not a) b)))" "g((not a) == b)"; prints "compound update" "(defn f [] () (update (at a (next)) + 1))" " a[next()] += 1"; prints "arm statements" "(defn f [] () (match s 1 (break) _ (return 2)))" "1 -> break\n _ -> return 2"; prints "then and else statements" "(defn f [] () (if c (return 1) (set x 2)))" "if c then return 1 else x = 2"; prints "a statement argument makes a block" "(foo 1 (set x 2))" "foo(1):\n x = 2"; prints "no arguments before the block" "(comment (f))" "comment:\n f()"; prints "typed let" "(defn f [] i32 (let [x (the i32 5)] x))" "let x: i32 = 5"; (* A let is always flat: it takes in the rest of its block. *) prints "flat let" "(defn f [] () (let [j 1] (g j)) (h))" " let j = 1\n g(j)\n h()"; prints "a chain of lets, all flat" "(defn f [] () (let [a 1] (let [b 2] (g b)) (k a)) (h))" " let a = 1\n b = 2\n g(b)\n k(a)\n h()"; (* A later statement that means an outer name of the same spelling: the let's own is renamed. *) prints "a later outer name of the same spelling renames the let's" "(defn f [x i32] () (let [x 1] (g x)) (h x))" " let x-2 = 1\n g(x-2)\n h(x)"; prints "the inner let of a chain renamed" "(defn f [] () (let [a 1] (let [b 2] (g b)) (h b)))" " let a = 1\n b-2 = 2\n g(b-2)\n h(b)"; prints "the binding's own value keeps the outer name" "(defn f [x i32] () (let [x (+ x 1)] (g x)) (h x))" " let x-2 = x + 1\n g(x-2)\n h(x)"; prints "a later binding's value takes the new name" "(defn f [x i32] () (let [x 1 y (+ x 1)] (g y)) (h x))" " let x-2 = 1\n y = x-2 + 1\n g(y)\n h(x)"; prints "the new name is one the function does not use" "(defn f [x i32] () (let [x 1] (g x x-2)) (h x))" " let x-3 = 1\n g(x-3, x-2)\n h(x)"; prints "a later let of the same name is no mention" "(defn f [] () (let [a 1] (g a)) (let [a 2] (k a)))" " let a = 1\n g(a)\n let a = 2\n k(a)"; prints "unless its value uses the name" "(defn f [a i32] () (let [a 1] (g a)) (let [a (+ a 1)] (k a)))" " let a-2 = 1\n g(a-2)\n let a = a + 1\n k(a)"; prints "a destructured name renamed alone" "(defn f [] () (let [[p q] v] (g p q)) (h q))" " let [p q-2] = v\n g(p, q-2)\n h(q)"; prints "a qualified name counts" "(defn f [] () (let [p (pt)] (g p)) (h p/x))" " let p-2 = pt()\n g(p-2)\n h(p/x)"; prints "a quoted name later counts" "(defn f [] () (let [a 1] (g a)) (h 'a))" " let a-2 = 1\n g(a-2)\n h('a)"; (* Where a rename cannot be trusted, a do: block holds the let. *) prints "a quoted name inside is not renamed" "(defn f [] () (let [a 1] (g 'a)) (h a))" " do:\n let a = 1\n g('a)\n h(a)"; prints "a call of the name inside is not renamed" "(defn f [] () (let [len 1] (len v)) (h len))" " do:\n let len = 1\n len(v)\n h(len)"; (* A struct pattern renames as pairs, so the field keeps its name. *) prints "a struct pattern renamed" "(defn f [x i32] () (let [{.x .y} p] (g x y)) (h x))" " let {x-2 .x y .y} = p\n g(x-2, y)\n h(x)"; prints "a :keys pattern renamed" "(defn f [x i32] () (let [{:keys [x y]} p] (g x y)) (h x))" " let {x-2 .x y .y} = p\n g(x-2, y)\n h(x)"; prints "a struct pattern that binds none of them stays" "(defn f [x i32] () (let [{.y .z} p] (g y)) (h x))" " let {.y .z} = p\n g(y)\n h(x)"; prints "a later struct pattern rebinding the name is no mention" "(defn f [] () (let [x 1] (g x)) (let [{.x} p] (k x)))" " let x = 1\n g(x)\n let {.x} = p\n k(x)"; prints "a struct literal inside is renamed" "(defn f [x i32] () (let [x 1] (g (P {.x x}))) (h x))" " let x-2 = 1\n g(P{.x x-2})\n h(x)"; (* A macro whose body its definition splices into a do is a body run in order; one that splices it anywhere else is not. *) prints "a macro's in-order body" "(defmacro twice [n & body] `(do ~@body ~@body))\n(defn f [] () (twice 2 (let [a 1] (g a)) (h)))" " twice(2):\n let a = 1\n g(a)\n h()"; prints "a macro's list of arguments" "(defmacro listed [& xs] `(list ~@xs))\n(defn f [] () (listed (let [a 1] (g a)) (set x 2)))" " listed:\n do:\n let a = 1\n g(a)\n x = 2"; prints "comment is a body in order" "(comment (let [a 1] (g a)) (h))" "comment:\n let a = 1\n g(a)\n h()"; prints "a later lambda keeps the outer name" "(defn f [] i32 (let [x 1] (let [x 5] (g x)) (app (fn [y] (+ x y)) 2)))" " let x = 1\n x-2 = 5\n g(x-2)\n app(fn(y) => x + y, 2)"; prints "a renamed name renamed again counts on" "(defn f [] () (let [x 1] (let [x 2] (let [x 3] (g x)) (g x)) (g x)))" " let x = 1\n x-2 = 2\n x-3 = 3\n g(x-3)\n g(x-2)\n g(x)"; prints "a macro that names the let's name keeps its scope" "(defmacro show-it [] `(println it))\n(defn f [] () (let [it 1] (let [it 2] (show-it)) (show-it)))" " let it = 1\n do:\n let it = 2\n show-it()\n show-it()"; (* Which macros take a body run in order, read off their definitions. *) let body name src want = let t = Body_macros.table (Reader.read_all ~file:"" src) in let got = Hashtbl.find_opt t.Body_macros.bodies name in if got <> want then fail "%s: body at %s, wanted %s" name (match got with Some k -> string_of_int k | None -> "none") (match want with Some k -> string_of_int k | None -> "none") in body "twice" "(defmacro twice [n & b] `(do ~@b ~@b))" (Some 1); body "tail" "(defmacro tail [& a] `(let [x ~(at a 0)] ~@(form-rest a 1)))" (Some 1); body "nested" "(defmacro inner [& b] `(do ~@b))\n(defmacro nested [& b] `(inner ~@b))" (Some 0); body "listed" "(defmacro listed [& b] `(list ~@b))" None; body "vtwice" "(defmacro vtwice [& b] `(do ~@b (println (length [~@b]))))" None; body "counted" "(defmacro counted [& b] (let [n (length b)] `(do ~n ~@b)))" None; body "counts" "(defmacro counts [& b] (if (= (length b) 2) `(do) `(do ~@b)))" None; body "guarded" "(defmacro guarded [& b] (if (< (length b) 1) `(do) `(do ~@b)))" (Some 0); body "labelled" "(defmacro labelled [& b] `(while :l ~@b))" None; body "labelled-test" "(defmacro labelled-test [& b] `(while :l true ~@b))" (Some 0); body "reads-body" "(defmacro reads-body [& b] `(do ~(at b 0) ~@b))" None; body "unless" "" (Some 1); body "comment" "" (Some 0); body "with-drawing" "(defmacro with-drawing [& args]\n (if (or (< (length args) 1) (and (= (length args) 1) (is-form-empty-list (at args 0))))\n `(takes-a-body)\n `(do (begin) ~@args (end))))" (Some 0); prints "in a quasiquote" "(defmacro m [x] (quasiquote (do (let [a 1] (g a)) (h ~x))))" " do:\n let a = 1\n g(a)\n h(~x)"; prints "among a call's arguments" "(foo 1 (let [a 1] (g a)) (set x 2))" "foo(1):\n do:\n let a = 1\n g(a)\n x = 2"; prints "at the top level" "(let [a 1] (g a))\n(h)" "do:\n let a = 1\n g(a)\n\nh()"; prints "one-argument and" "(defn f [] () (while (and (< i n)) (g)))" " while i < n\n"; prints "one-argument or" "(defn f [] () (when (or c) (g)))" " if c\n"; prints "one-argument and in a quasiquote" "(defmacro m [x] (quasiquote (and ~x)))" "and(~x)"; prints "do in an arm is a block" "(defn f [] () (match s _ (do (a) (b))))" "_ ->\n a()"; prints "hex spelling" "(def c dyn 0xFFF00FFF)" "0xFFF00FFF"; prints "own-line comment above its form" "(defn f [] ()\n ;; why\n (g))" " ;; why\n g()"; prints "trailing comment at its line's end" "(defn f [] ()\n (g) ; note\n (h))" " g() ; note\n"; (* The other direction keeps them too. *) let back name src want = match Indent_reader.read_all ~file:"" src with | forms -> let got = Paren_printer.program ~source:src forms in if not (Test_support.contains got want) then fail "%s: printed %S, wanted it to contain %S" name got want | exception e -> fail "%s: %s" name (diag_text e) in back "spellings to parens" "fn main() -> i32\n println(0x1F, 1e3, 1_000, 3.0, 2.50, 0b101)\n 0" "(println 0x1F 1e3 1_000 3.0 2.50 0b101)"; back "each binding keeps its comment" "fn main() -> i32\n let a = 1 ; first\n let b = 2 ; second\n a + b" "(let [a 1 ; first\n b 2] ; second"; prints "each binding keeps its comment, indented" "(defn f [] i32\n (let [a 1 ; first\n b 2] ; second\n (+ a b)))" " let a = 1 ; first\n b = 2 ; second"; prints "a comment line between grouped bindings" "(defn f [] i32\n (let [a 1\n ;; why b\n b 2]\n (+ a b)))" " let a = 1\n ;; why b\n b = 2\n"; prints "a long value starts a let of its own" "(defn f [] i32 (let [a 1 b (some-function-with-a-long-name alpha beta gamma) c 2] (+ a b c)))" " let a = 1\n let b = some-function-with-a-long-name(alpha, beta, gamma)\n let c = 2\n"; prints "a block value ends the group" "(defn f [] i32 (let [a 1 b 2 c (do (g) a) d 4 e 5] (+ a b c d e)))" " let a = 1\n b = 2\n let c =\n g()\n a\n let d = 4\n e = 5\n"; prints "a block value starts and ends a let of its own" "(defn f [] i32 (let [a 0 b 1 g (fn [x] (p x) x) h 2 k 3] (+ a h k)))" " let a = 0\n b = 1\n let g = fn(x) =>\n p(x)\n x\n let h = 2\n k = 3\n"; prints "typed and pattern bindings in a group" "(defn f [p dyn] i32 (let [a (the i32 1) {x .x} p [h & t] xs] (+ a x h)))" " let a: i32 = 1\n {x .x} = p\n [h & t] = xs\n"; back "comments to parens" "; head\n\nfn main() -> i32\n ; why\n g() ; note\n 0" "; head\n\n(defn main [] i32\n ; why\n (g) ; note\n 0)"; (* Written the way the corpus writes them. *) back "quasiquote as its reader sugar" "defmacro(m, [x & body]):\n quote\n g(~x)\n ~@body" "`(do (g ~x) ~@body)"; back "arms a pair to a line" ("fn f(s) -> dyn\n match s\n 1 -> \"one, a long string to break the line\"\n" ^ " _ -> \"another long string to push it over\"") " (match s\n 1 \"one, a long string to break the line\"\n _ \"another"; back "a let's bindings hang after their names" ("fn f() -> dyn\n let a = compute-something-long(1, 2, 3, 4, 5)\n" ^ " let b = compute-something-long(5, 6, 7, 8, 9)\n a") "(let [a (compute-something-long 1 2 3 4 5)\n b (compute-something-long 5 6 7 8 9)]"; back "a label stays with its test" "fn f() -> ()\n while :outer is-some-long-condition(1, 2, 3) and is-another-long-one(4, 5, 6)\n g()" "(while :outer"; back "a call's arguments fill the line" "fn f() -> ()\n println(\"alpha\", \"beta\", \"gamma\", \"delta\", \"epsilon\", \"zeta\", \"eta\", \"theta\", \"iota\", g(1))" "\"eta\" \"theta\" \"iota\"\n (g 1))"; back "a comment between a cond's test and its branch stays there" "fn f(x) -> dyn\n if x\n ; why\n 1\n elif y\n 2\n else\n 3" "; why"; prints "an if with no else keeps its test in the parentheses" "(defn f [] () (if (> a 1) (let [k 2] (g k))))" " if(a > 1):\n let k = 2"; prints "and inside or keeps its parentheses" "(defn f [a bool b bool c bool] bool (or (and a b) c))" "= (a and b) or c"; prints "a typed lambda prints as one" "(defn f [] () (let [g (the (Fn [C] bool) (fn [c] (> (.n c) 3)))] (h g)))" "let g = fn(c: C) -> bool => c.n > 3"; (* A lambda with a block as a call's last argument prints inside the call, and reads back as it was. *) let round name src want = prints name src want; let forms = Reader.read_all ~file:"

" src in let text = Indent_printer.program ~source:src forms in match Indent_reader.read_all ~file:"

" text with | back -> if not (same_forms forms back) then fail "%s: read back %s from %S" name (describe_diff forms back) text | exception e -> fail "%s: its text is refused: %s\n%s" name (diag_text e) text in round "a mixed chain" "(defn f [r i32 n i32] bool (and (<= 0 r) (< r n)))" "= 0 <= r < n"; round "an and of one operator stays an and" "(defn f [r i32 n i32] bool (and (< 0 r) (< r n)))" "= 0 < r and r < n"; round "an and whose middles differ stays an and" "(defn f [r i32 n i32] bool (and (<= 0 r) (< n 9)))" "= 0 <= r and n < 9"; round "a let the reader would not make stays a let" "(defn f [a i32] bool (let [m (g)] (and (<= a m) (< m (h)))))" " let m = g()"; back "a chain's middle call gets a name paren text can spell" "fn f(a, b) -> bool = a < g() <= b" "(let [mid a mid2 (g) mid3 b] (and (< mid mid2) (<= mid2 mid3)))"; (* And the paren text prints as the chain again, up to the names. *) let src = "(defn f [a i32 b i32] bool (let [mid a mid2 (g) mid3 b] (and (< mid mid2) (<= mid2 mid3))))" in prints "a mixed chain over a call comes back a chain" src " a < g() <= b"; (let forms = Reader.read_all ~file:"

" src in let back = Indent_reader.read_all ~file:"

" (Indent_printer.program ~source:src forms) in if not (same_forms (List.map norm forms) (List.map norm back)) then fail "a mixed chain over a call: read back %s" (describe_diff forms back)); round "bit operators print infix" "(defn f [a i32 m i32] bool (= (bit-and a (bit-not m)) (bit-or (bit-xor a 1) (<< m 2))))" "a && ~~m == a ^^ 1 || m << 2"; round "bit operators parenthesise against precedence" "(defn f [a i32 b i32 c i32] i32 (bit-and (bit-or a b) (+ c 1) (bit-not (bit-xor a b))))" "= (a || b) && c + 1 && ~~(a ^^ b)"; round "a nested unquote prints with parentheses" "(defmacro m [x] `(defmacro n [] `(g ~~x ~(bit-not x))))" "~(~x)"; prints "the Lisp spellings print as the operators" "(defn f [a i32 b i32] i32 (^^ (&& a b) (|| a b)))" "a && b ^^ (a || b)"; round "a one-line lambda""(defn f [] () (h (fn [a] (+ a 1)) 2))" "= h(fn(a) => a + 1, 2)"; round "a block lambda as a call's last argument" "(defn f [] () (sort-by xs (fn [a b] (g a) (< a b))))" " sort-by(xs, fn(a, b) =>\n g(a)\n a < b)"; round "one closer for a call in a call" "(defn f [] () (println (run (fn [] (g) 1))))" " println(run(fn() =>\n g()\n 1))"; (* if let and when, read both ways and printed back. *) round "if let with a block and an else" "(defn f [o (Option i32)] i32 (if-let [(Some g) o] (do (println g) g) 0))" " if let Some(g) = o\n println(g)\n g\n else\n 0"; round "if let on one line" "(defn f [o (Option i32)] i32 (if-let [(Some g) o] g 0))" " if let Some(g) = o then g else 0"; round "if let with elif" "(defn f [o (Option i32) k i32] i32 (if-let [(Some g) o] (+ g 1) (cond (> k 5) 100 :else 0)))" " elif k > 5\n 100\n else\n 0"; round "if let with no else" "(defn f [o (Option i32)] () (if-let [(Some g) o] (do (println g) (println g))))" " if let Some(g) = o\n println(g)"; round "elif let" "(defn f [a (Option i32) b (Option i32) k i32] i32 \ (if-let [(Some x) a] x (if-let [(Some y) b] (* y 10) (if (> k 5) 100 0))))" " elif let Some(y) = b\n y * 10\n elif k > 5\n 100\n else\n 0"; round "elif let after a plain if" "(defn f [a bool b (Option i32)] () \ (if a (println 1) (if-let [(Some y) b] (println y) (when (> 1 0) (println 2)))))" " elif let Some(y) = b\n println(y)\n elif 1 > 0\n println(2)"; reads "elif let reads as a nested if-let" "if let Some(x) = a\n f(x)\nelif let None = b\n g()\nelse\n h()" "(if-let [(Some x) a] (f x) (if-let [None b] (g) (h)))"; round "a kept if let chain with no else" "(defn f [a (Option i32) k i32] (Option i32) (if-let [(Some x) a] (do (g) x) (cond (> k 0) k)))" " if let Some(x) = a\n g()\n x\n elif k > 0\n k"; round "a kept when" "(defn f [] () (let [w (when (> a 1) 2)] (g w)))" " let w = when a > 1 then 2"; reads "when with a block" "when a\n b()\n c()" "(when a (b) (c))"; reads "when on one line" "when a then b()" "(when a (b))"; reads "if let with elif and no else" "if let None = o\n a()\nelif c\n b()" "(if-let [None o] (a) (cond c (b)))"; refuses "when has no else" "when a then b() else c()" "indent/when-else" "a when has no else"; refuses "nor an else block" "when a\n b()\nelse\n c()" "indent/when-else" "a when has no else"; round "a typed block lambda in a call" "(defn f [] () (h (the (Fn [C] bool) (fn [c] (g c) (> (.n c) 3)))))" " h(fn(c: C) -> bool =>\n g(c)\n c.n > 3)"; round "a let's call with a block lambda" "(defn f [] () (let [v (m xs (fn [x] (g x) x))] (h v)))" " let v = m(xs, fn(x) =>\n g(x)\n x)\n h(v)"; round "nested block lambdas" "(defn f [] () (m xs (fn [x] (let [y (m x (fn [z] (g z) z))] (h y)))))" " m(xs, fn(x) =>\n let y = m(x, fn(z) =>\n g(z)\n z)\n h(y))"; round "a block lambda inside an expression, the line going on after it" "(defn f [] i64 (+ (ap 1 (fn [x] (g x) x)) 1))" " ap(1, fn(x) =>\n g(x)\n x) + 1"; round "one in a lambda that fits on its line" "(defn f [] i64 (ap 1 (fn [x] (ap x (fn [y] (g y) y)))))" " ap(1, fn(x) =>\n ap(x, fn(y) =>\n g(y)\n y))"; round "a struct literal's last field" "(defn f [] i64 (let [o (Ops {.k 1 .run (fn [x] (g x) x)})] (.k o)))" " let o = Ops{.k 1, .run fn(x) =>\n g(x)\n x}"; round "a returned call" "(defn f [] i64 (return (ap 2 (fn [x] (g x) x))))" " return ap(2, fn(x) =>\n g(x)\n x)"; round "a let in a lambda inside a call's argument" "(defn f [] i64 (println (call0 (fn [] (let [n 0] (set n 1) n)))) 0)" " println(call0(fn() =>\n let n = 0\n n = 1\n n))"; prints "a body that is one do goes straight under =>" "(defn f [] i64 (call0 (fn [] (do (g 1) 2))))" " call0(fn() =>\n g(1)\n 2)"; round "a block lambda not last keeps the fallback" "(defn f [] () (r (fn [a b] (g a) b) 0))" "= r(fn([a b], g(a), b), 0)"; round "a lambda bound by let" "(defn f [] () (let [k (fn [a] (g a) a)] (k 1)))" " let k = fn(a) =>\n g(a)\n a\n k(1)"; prints "a restart's report goes on its header" "(defn f [] i32 (restart-case (go) (retry [] :report \"Try again\" 7)))" "restart retry() \"Try again\"\n 7"; prints "adjacent one-line globals stay adjacent" "(defonce a i32)\n(def b i32 2)\n\n(defconst c 3)\n" "once a: i32\nlet b: i32 = 2\n\nconst c = 3"; back "adjacent one-line globals stay adjacent in parens" "once a: i32\nlet b: i32 = 2\n\nconst c = 3\n" "(defonce a i32)\n(def b i32 2)\n\n(defconst c 3)"; prints "a field of a field chains" "(defn f [] () (g (.count (.x w))))" "g(w.x.count)"; prints "an else-if chain on one line" "(defn f [r] dyn (if (> r 7) :rich (if (> r 4) :fair :poor)))" "if r > 7 then :rich else if r > 4 then :fair else :poor"; 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)"; 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 global is a top-level let" "(def g dyn 1)\n(def h i32 2)" "let g = 1\nlet h: i32 = 2"; prints "a def inside a form keeps the fallback" "(comment (def g i32 1))" "comment:\n def(g, i32, 1)"; prints "a local let at the top level goes in a do block" "(let [x 1] (f x))" "do:\n let x = 1\n f(x)"; 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"; prints "a struct on one line" "(defstruct Pt [x i32 y dyn])" "struct Pt(x: i32, y)\n"; prints "a union too" "(defunion U [a i32 b f32])" "union U(a: i32, b: f32)"; prints "a struct too long for a line takes a line per field" ("(defstruct W [" ^ String.concat " " (List.init 8 (Printf.sprintf "field-number-%d i32")) ^ "])") "struct W\n field-number-0: i32\n"; prints "and so does one with a comment among its fields" "(defstruct C [a i32 ; first\n b i32])" "struct C\n a: i32 ; first\n b: i32"; 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, [])"; (* 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 ──────────────────────── *) let span_is name (f : Form.t) (l, c, el, ec) = let g = f.loc in if (g.Loc.line, g.Loc.col, g.Loc.eline, g.Loc.ecol) <> (l, c, el, ec) then fail "%s spans %d:%d-%d:%d, wanted %d:%d-%d:%d" name g.Loc.line g.Loc.col g.Loc.eline g.Loc.ecol l c el ec let () = (* A rewritten statement spans its text from the first token to the last, so a mark or an overlay drawn from it covers what was written. *) match read "x = a.b.c + b + c" with | [ ({ v = Form.List [ _; _; ({ v = Form.List [ _; abc; _; _ ]; _ } as sum) ]; _ } as set) ] -> span_is "x = ..." set (1, 1, 1, 18); span_is "a.b.c + b + c" sum (1, 5, 1, 18); span_is "a.b.c" abc (1, 5, 1, 10) | _ -> fail "x = a.b.c + b + c read as another shape" let () = (* Editor code, placed where it was written: line 40, column 5, and the indent stack seeded with that column, so the next line at column 5 is a sibling rather than a dedent. *) Source.with_code ~syntax:Source.Indented ~at:(Some (40, 5)) (fun () -> match Source.read_code ~expr:true ~file:"" "f(1)\n g(2)" with | [ ({ v = Form.List [ { v = Form.Sym "do"; _ }; a; b ]; _ } as d) ] -> span_is "the snippet" d (40, 5, 41, 9); span_is "its first line" a (40, 5, 40, 9); span_is "its second line" b (41, 5, 41, 9) | fs -> fail "a two-line snippet read as %s" (String.concat " " (List.map Form.to_string fs))); (* A snippet's first line is its left edge: a later line left of it is refused as that, and a snippet sent with leading spaces starts where its first token does. *) Source.with_code ~syntax:Source.Indented ~at:(Some (40, 5)) (fun () -> (match Source.read_code ~file:"" "f(1)\n g(2)" with | _ -> fail "a line left of the snippet's first was read" | exception Loc.Error d -> if not (Test_support.contains d.Loc.dmsg "left of column 5 where the code sent starts") then fail "a line left of a snippet: %s" d.Loc.dmsg); match Source.read_code ~file:"" " f(1)\n g(2)" with | [ _; _ ] -> () | _ -> fail "a snippet with leading spaces" | exception e -> fail "a snippet with leading spaces: %s" (diag_text e)); (* A condition cut out from after [elif ] at column 3: its wrapped line at column 8 is deeper than the elif, which is what the file says, though not deeper than the cut. [:indent] says where the statement starts; every location stays the buffer's own. *) Source.with_code ~indent:3 ~syntax:Source.Indented ~at:(Some (10, 8)) (fun () -> (match Source.read_code ~expr:true ~file:"" "x == 0 or\n x == 1" with | [ f ] -> span_is "a wrapped condition, cut mid-line" f (10, 8, 11, 14) | _ -> fail "a wrapped condition read as more than one form" | exception e -> fail "a wrapped condition: %s" (diag_text e)); match Source.read_code ~expr:true ~file:"" "x == 0 or\n x == 1" with | _ -> fail "a continuation left of its statement was read" | exception Loc.Error _ -> ()); Source.with_code ~syntax:Source.Indented ~at:(Some (10, 8)) (fun () -> match Source.read_code ~expr:true ~file:"" "x == 0 or\n x == 1" with | _ -> fail "without :indent, a wrapped line is measured from the cut" | exception Loc.Error _ -> ()); Source.with_code ~syntax:Source.Paren ~at:(Some (7, 3)) (fun () -> match Source.read_code ~file:"" "(f 1)" with | [ f ] -> span_is "a paren snippet" f (7, 3, 7, 8) | _ -> fail "a paren snippet") (* ── Loading ───────────────────────────────────────────────────────── *) let write path text = Out_channel.with_open_bin path (fun oc -> output_string oc text) let () = (* A spaced-out operator is one name; the checker says which arithmetic. *) let f = Filename.concat scratch "syntax-hint.fln" in write f "fn main() -> i32\n let x = 3\n x-1\n"; (match Front.checked f with | _ -> fail "x-1 checked" | exception Loc.Error d -> if not (Test_support.contains d.Loc.dmsg "Did you mean x - 1?") then fail "x-1: %s" d.Loc.dmsg | exception e -> fail "x-1: %s" (Printexc.to_string e)); (* One package, one file in two syntaxes: refused naming both. *) let dir = Filename.concat scratch "syntax-twin" in let pkg = Filename.concat dir "geo" in (try Unix.mkdir dir 0o755 with Unix.Unix_error _ -> ()); (try Unix.mkdir pkg 0o755 with Unix.Unix_error _ -> ()); write (Filename.concat pkg "geo.flan") "(defn one [] i32 1)\n"; write (Filename.concat pkg "geo.fln") "fn one() -> i32 = 1\n"; let main = Filename.concat dir "main.flan" in write main "(import geo \"geo\")\n(defn main [] i32 (geo/one))\n"; match Front.checked main with | _ -> fail "a package with geo.flan and geo.fln loaded" | exception Loc.Error d -> if not (Test_support.contains d.Loc.dmsg "geo.flan" && Test_support.contains d.Loc.dmsg "geo.fln") then fail "twin files: %s" d.Loc.dmsg | exception e -> fail "twin files: %s" (Printexc.to_string e) (* ── A refusal's fix is spelled in the file's own syntax, and compiles ── *) let refused name text needles = let f = Filename.concat scratch name in write f text; match Front.checked f with | _ -> fail "%s checked" name | exception (Loc.Error d | Loc.Errors [ d ]) -> List.iter (fun n -> if not (Test_support.contains d.Loc.dmsg n) then fail "%s: wanted %S in: %s" name n d.Loc.dmsg) needles | exception e -> fail "%s: %s" name (diag_text e) let checks name text = let f = Filename.concat scratch name in write f text; match Front.checked f with | _ -> () | exception e -> fail "%s does not check: %s" name (diag_text e) (* Names carry no ? or !; the forms that read them instead. *) let () = refuses "a ? ends no name" "fn empty-cell?(c: i32) -> bool = c == 0" "indent/question-name" "starts with is- or has- instead: is-empty-cell"; refuses "a ? in a call's name" "rl/key-pressed?(k)" "indent/question-name" "rl/is-key-pressed"; refuses "a renamed prelude question" "starts-with?(a, b)" "indent/question-name" "has-prefix"; refuses "a ? in a binding" "let ok? = 1" "indent/question-name" "is-ok"; refuses "a ! in a name" "set!(x)" "indent/mark-in-name" "Leave it out: set"; refuses "a ? inside a name" "a?b" "indent/mark-in-name" "cannot contain ?"; refuses "a glued ??" "x??y" "indent/unspaced-operator" "x ?? y"; refuses "a glued !=" "x!=y" "indent/unspaced-operator" "x != y"; reads "T? is Option(T)" "fn f(a: i32?, b: [i32?], c: Vec(Shape?), d: rl/Vector2?) -> $t? = a" "(defn f [a (Option i32) b [(Option i32)] c (Vec (Option Shape)) d (Option rl/Vector2)] (Option $t) a)"; reads "?? is variadic and above the comparisons" "x = a ?? b ?? c == d + 1" "(set x (= (?? a b c) (+ d 1)))"; reads "! unwraps, and a chain goes on after it" "x = a!.b + c!" "(set x (+ (.b (!! a)) (!! c)))"; reads "?. reads the rest over a fresh name" "x = a?.b.c(1)?.d" "(set x (?. [~o1 a] (?. [~o2 ((.c (.b ~o1)) 1)] (.d ~o2))))"; reads "?[ indexes" "x = f(a)?[2]" "(set x (?. [~o1 (f a)] (at ~o1 2)))"; (* Decision 133: x? tests, narrows a local, and e? as g names what it found; if let over a plain name is refused toward those. *) refuses "if let over a plain name" "if let g = x\n g" "indent/if-let-name" "write if x?, and in the block it is what it holds; to name what it holds, \ write if x as g"; reads "x? is a test" "y = f(x)? and not z.w?" "(set y (and (? (f x)) (not (? (.w z)))))"; reads "e? as g" "if f(x)? as g\n g\nelif y? as h\n h\nelse\n 0" "(cond (as g (f x)) g (as h y) h :else 0)"; reads "one-line e? as g" "v = if y? as h then h else 0" "(set v (if (as h y) h 0))"; reads "while e? as g" "while pop(s)? as x\n f(x)" "(while true (if (as x (pop s)) (do (f x)) (break)))"; (* Decision 136: e as g without the ?, and inside an and chain. *) reads "e as g" "if f(x) as g\n g" "(when (as g (f x)) g)"; reads "as in an and chain" "if a and f(x) as g and g > 1 and b\n g" "(when (and a (as g (f x)) (> g 1) b) g)"; reads "two as in one chain" "v = if a as x and b? as y and x < y then x else y" "(set v (if (and (as x a) (as y b) (< x y)) x y))"; reads "a kept when with as" "left = when get(grid, r + 1, c - 1) as g and is-empty-cell(g) then g" "(set left (when (and (as g (get grid (+ r 1) (- c 1))) (is-empty-cell g)) g))"; reads "while as and" "while pop(s) as x and x > 0\n f(x)" "(while true (if (and (as x (pop s)) (> x 0)) (do (f x)) (break)))"; reads "elif as and" "if a\n 1\nelif f(x) as g and g > 1\n g" "(cond a 1 (and (as g (f x)) (> g 1)) g)"; refuses "as under or" "if a or f(x) as g\n g" "indent/as-or" "Bind with as in an if of its own"; refuses "or after as" "if f(x) as g or b\n g" "indent/as-or" "nothing to name"; refuses "or later in the chain" "if f(x) as g and a or b\n g" "indent/as-or" "nothing to name"; refuses "as under not" "if not f(x) as g\n g" "indent/as-not" "not turns the test around"; refuses "as in parentheses under not" "if not (a as g)\n g" "indent/as-paren" "not inside parentheses"; refuses "as in a bracketed chain" "if (a as g and g > 1) and b\n g" "indent/as-paren" "if a as g and"; refuses "as after until" "until f(x) as g\n g" "indent/as-until" "Write while"; refused "as-not-optional.fln" "fn main()\n let n = 5\n if n as g and g > 1\n println(g)\n" [ "n is i32, which always holds a value, so as has nothing to test"; "It is not a conversion" ]; refused "as-not-in-else.fln" "fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n else\n g\n\nfn main()\n println(f(None))\n" [ "unknown name g" ]; refused "as-not-in-elif.fln" "fn f(o: i32?) -> i32\n if o as g and g > 1\n g\n elif g > 0\n 1\n else\n 0\n\nfn main()\n println(f(None))\n" [ "unknown name g" ]; refused "as-not-after.fln" "fn f(o: i32?) -> i32\n if o as g and g > 1\n println(g)\n g\n\nfn main()\n println(f(None))\n" [ "unknown name g" ]; (* Decision 137: x |> f(a) is f(x, a), below or. *) reads "|> into a call" "y = x |> f(1, 2)" "(set y (f x 1 2))"; reads "|> into an empty call" "y = x |> f()" "(set y (f x))"; reads "|> into a name" "y = x |> f" "(set y (f x))"; reads "|> into a case" "y = x |> Some" "(set y (Some x))"; reads "|> chains left to right" "y = get(grid, r, c) |> or-else(empty) |> is-empty-cell()" "(set y (is-empty-cell (or-else (get grid r c) empty)))"; reads "|> into a qualified name" "y = x |> m/f(a) |> m/g" "(set y (m/g (m/f x a)))"; reads "|> is below arithmetic" "y = a + 1 |> f()" "(set y (f (+ a 1)))"; reads "|> is below ??" "y = a ?? b |> f()" "(set y (f (?? a b)))"; reads "|> is below comparisons" "y = a == b |> f()" "(set y (f (= a b)))"; reads "|> is below not" "y = not x |> f()" "(set y (f (not x)))"; reads "|> is below or" "y = a or b and c |> f()" "(set y (f (or a (and b c))))"; reads "|> in an argument" "g(x |> f, 2)" "(g (f x) 2)"; reads "|> in a condition" "if x |> is-empty() then 1 else 2" "(if (is-empty x) 1 2)"; reads "|> starting lines" "let y = get(g, r)\n |> or-else(0)\n |> f()\ny" "(def y dyn (f (or-else (get g r) 0)))\ny"; reads "|> ending a line" "let y = get(g, r) |>\n or-else(0)\ny" "(def y dyn (or-else (get g r) 0))\ny"; reads "|> under a statement" "x\n |> f(1)\n |> g" "(g (f x 1))"; reads "|> into a call with a block" "xs |> each(1):\n print(2)" "(each xs 1 (print 2))"; reads "|>( is a call" "y = |>(a, b)" "(set y (|> a b))"; refuses "|> into a number" "y = x |> 3" "indent/pipe-target" "3 is neither"; refuses "|> into arithmetic" "y = x |> a + b" "indent/pipe-target" "\n (x |> a) + b"; refuses "|> into a field" "y = x |> a.b" "indent/pipe-target" "(x |> a).b"; refuses "|> into a field of a call" "y = x |> f(a).x" "indent/pipe-target" "f(a).x"; refuses "|> into a call's result" "y = x |> f(a)(b)" "indent/pipe-target" "f(a)(b)"; refuses "|> into an index" "y = x |> a[1]" "indent/pipe-target" "a[1]"; refuses "|> into a lambda" "y = x |> fn(a) => g(a)" "indent/pipe-keyword" "fn is a word"; refuses "|> into if" "y = 1 |> if" "indent/pipe-keyword" "if is a word"; refuses "|> into let" "y = 1 |> let" "indent/pipe-keyword" "let is a word"; refuses "|> into fn" "y = 1 |> fn" "indent/pipe-keyword" "fn is a word"; reads "|> into not" "y = x |> not" "(set y (not x))"; refuses "|> before ??" "y = a |> f ?? d" "indent/pipe-target" "\n (a |> f) ?? d"; refuses "|> before or" "y = a |> f or c" "indent/pipe-target" "\n (a |> f) or c"; refuses "|> before a test" "y = a |> f?" "indent/pipe-target" "\n (a |> f)?"; refuses "|> chained before ==" "y = a |> b |> f(1) == 2" "indent/pipe-target" "\n (a |> b |> f(1)) == 2"; reads "as names what a pipe answers" "if a |> f(1) as v and v > 0\n v" "(when (and (as v (f a 1)) (> v 0)) v)"; refuses "as before a pattern" "if a |> f as Some(v)\n v" "indent/as-name" "if let Some(v) = a |> f"; reads "|> into a macro passes the place" "y = x |> set(5)" "(set y (set x 5))"; refuses "|> into parentheses" "y = x |> (f)" "indent/pipe-target" "(f) is neither"; refuses "|> unspaced on the right" "y = x |>[f]" "indent/unspaced-operator" "x |> f(a)"; refuses "|> at a statement's column" "f(x)\n|> g()" "indent/continuation" "starts with the operator |>"; refuses "|> in a list separated by spaces" "y = [x |> f() 2]" "indent/separate-elements" "commas"; (match read "y = |>(a, b)" with | forms -> let got = Indent_printer.program ~source:"y = |>(a, b)" forms in if not (Test_support.contains got "|>(a, b)") then fail "a call to |> prints as a call: %S" got | exception e -> fail "a call to |> prints as a call: %s" (diag_text e)); refused "present-i32.fln" "fn main()\n let x = 5\n println(x?)\n" [ "x is i32, which always holds a value, so x? has nothing to test"; "a yes-or-no name starts with is- or has-, as in is-x" ]; refused "narrowed-set.fln" "fn main()\n let x: i32? = Some(1)\n if x?\n x = None\n println(x ?? 0)\n" [ "x is tested with x? above, so in this block it is i32"; "while x as item" ]; refused "not-narrowed-in-else.fln" "fn main()\n let x: i32? = None\n if x?\n println(x + 1)\n else\n println(x + 1)\n" [ "Option(i32)" ]; refused "not-narrowed-through-or.fln" "fn main()\n let x: i32? = None\n if x? or true\n println(x + 1)\n" [ "Option(i32)" ]; refused "coalesce-i32.fln" "fn main()\n let x = 5\n println(x ?? 1)\n" [ "the left side of ?? is i32, which always holds a value" ]; (* After review: ?? continues a line, a chain is no place, nested marks and a ? on a value say what to write, and a lowercase type takes ?. *) reads "a line ending in ?? continues" "x = a ??\n 5" "(set x (?? a 5))"; reads "a line starting with ?? continues" "x = a\n ?? 5" "(set x (?? a 5))"; refuses "a chain is not a place" "q?.x = 5" "indent/chain-assign" "cannot be assigned to"; refuses "nor under +=" "q?.x += 5" "indent/chain-assign" "cannot be assigned to"; refuses "an unwrap is not a place" "x! = 5" "indent/chain-assign" "a value cannot be assigned to"; refuses "T?? is not read" "fn f(a: i32??) = a" "indent/nested-option" "Option(i32?)"; refuses "x!! is not read" "y = x!!" "indent/double-unwrap" "(x!)!"; refuses "!= with its space missing names what follows" "y = x!= z" "indent/unspaced-operator" "x != z"; refuses "? on a parameter's name" "fn f(ok?: bool) = ok" "indent/question-name" "is-ok"; reads "a lowercase type takes ?" "fn f(a: grain?, b: [grain?]) -> grain? = a" "(defn f [a (Option grain) b [(Option grain)]] (Option grain) a)"; refused "option-value.fln" "fn main()\n let y = i32?\n" [ "i32? is an Option type, and a value is wanted here" ]; refused "where-fln.fln" "fn big(a: $t, b: $t) -> bool = a < b\n\nfn main()\n println(big(1, 2))\n" [ "nothing declares $t ordered (is-ordered)"; "Write where is-ordered($t)" ]; (* The second review: assignability holds in a narrowed block, a trailing ? tests a whole chain, and the messages name what to write. *) reads "a trailing ? tests the whole chain" "y = o?.i?" "(set y (? (?. [~o1 o] (.i ~o1))))"; reads "and ? then as binds the chain's result" "if d?.k? as k\n k" "(when (as k (?. [~o1 d] (.k ~o1))) k)"; refused "narrowed-param.fln" "fn f(x: i32?)\n if x?\n x += 100\n\nfn main()\n f(Some(1))\n" [ "x is a parameter, and a parameter is not assignable" ]; refused "narrowed-field.fln" "fn main()\n let x: i32? = Some(1)\n if x?\n x.n = 1\n" [ "so here it is what the Option holds, i32, and i32 has no fields" ]; refuses "a chain is no place, and the fix is a test" "q?.x = 5" "indent/chain-assign" "Test it first: if q?, and in the block q is what it holds, or if q as g"; refused "lowercase-type-arg.fln" "struct grain\n w: i32\n\nfn main()\n let v = vec-new(grain?)\n" [ "grain? here is the test that a value is present, and grain is a type"; "vec-new(Option(grain))" ]; refused "addr-taken.fln" "fn clear(p: Ptr(i32?))\n deref(p) = None\n\nfn main()\n let x: i32? = Some(1)\n\ \ let p = addr(x)\n if x?\n clear(p)\n println(x + 1)\n" [ "+ takes numbers, found Option(i32)" ]; refused "capital-local.fln" "fn main()\n let X: i32? = Some(1)\n println(X?)\n" [ "To test the local X, give it a lowercase name, as in x?" ]; checks "addr-taken-test.fln" "fn main()\n let x: i32? = Some(1)\n let p = addr(x)\n if x?\n println(x ?? 0)\n\ \ while x?\n x = None\n"; refused "chain-i32.fln" "struct P\n x: i32\n\nfn main()\n let p = P{.x 1}\n println(p?.x)\n" [ "?. has nothing to test. Write . instead" ] (* A kept if-let chain whose arm gives no value is a statement, refused as a plain if's is; one whose arm returns stays Never, in both syntaxes. *) let () = refused "if-let-unit.flan" "(defn main [] () (let [a (Some 1) r (if-let [(Some x) a] (println x) \ (when true (println 2)))] (println r)))\n" [ "r would be bound to (), which is not a value" ]; refused "if-let-unit.fln" "fn main()\n let a = Some(1)\n let r = if let Some(x) = a then println(x) \ else when true then println(2)\n println(r)\n" [ "r would be bound to (), which is not a value" ]; checks "if-let-never.flan" "(defn f [a (Option i32)] (Option i32) (if-let [(Some x) a] (return None) \ (when true 3)))\n(defn main [] () (println (f None)))\n"; checks "if-let-never.fln" "fn f(a: Option(i32)) -> Option(i32)\n if let Some(x) = a\n return None\n \ elif true\n 3\n\nfn main()\n println(f(None))\n" let () = let poke_fln = "fn poke(coll) -> dyn\n coll[0] = 99\n coll\n\n" in let poke_flan = "(defn poke [coll] dyn (set (at coll 0) 99) coll)\n" in (* A container of pointers has no dyn view, and the refusal's subject and fix follow what the container is: a local, a temporary, a parameter. *) refused "view-local.fln" (poke_fln ^ "fn main() -> ()\n let a = vec-new(Ptr(i64))\n poke(a)\n") [ "a is a Vec(Ptr(i64)), and a dyn value is wanted here"; "a Ptr(i64) is none of these"; "as in let a: dyn = [...]" ]; refused "view-local.flan" (poke_flan ^ "(defn main [] () (let [a (vec-new (Ptr i64))] (poke a)))\n") [ "a is a (Vec (Ptr i64))"; "as in (let [a (the dyn [...])] ...)" ]; refused "view-temp.flan" (poke_flan ^ "(defn main [] () (poke (vec-new (Ptr i64))))\n") [ "This is a (Vec (Ptr i64))"; "as in (the dyn [...])" ]; (* Any storage and any number crosses: a local [4 i32] is a view. *) checks "view-elem.fln" (poke_fln ^ "fn main() -> ()\n let d = [6 2 4 9]\n poke(d)\n"); (* A parameter is made by the caller, so its fix is its declaration. *) refused "view-param.fln" "fn take(d) -> i32 = 1\n\nfn give(n: i32, v: [Ptr(i64)]) -> i32\n take(v)\n\n\ fn main() -> i32 = 0\n" [ "v is a [Ptr(i64)] parameter"; "Declare v as dyn in give's parameters: v: dyn" ]; refused "view-param.flan" "(defn take [d dyn] i32 1)\n(defn give [n i32 v (Vec (Ptr i64))] i32 (take v))\n\ (defn main [] i32 0)\n" [ "v is a (Vec (Ptr i64)) parameter"; "Declare v as dyn in give's parameters: v dyn" ]; checks "view-param-fix.fln" "fn take(d) -> i32 = 1\n\nfn give(n: i32, v: dyn) -> i32\n take(v)\n\n\ fn main() -> i32 = 0\n"; (* A global's fix redefines it, in the form it was defined with. *) let show_flan = "(defn show [d dyn] i32 1)\n" in refused "view-global.flan" ("(defonce gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n") [ "gs is a (Vec (Ptr i32))"; "as in (defonce gs dyn [...])" ]; refused "view-global-def.flan" ("(def gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n") [ "as in (def gs dyn [...])" ]; refused "view-global.fln" "once gs: Vec(Ptr(i32)) = vec-new(Ptr(i32))\n\nfn show(d) -> i32 = 1\n\n\ fn main() -> i32 = show(gs)\n" [ "gs is a Vec(Ptr(i32))"; "as in once gs: dyn = [...]" ]; checks "view-global-typed.flan" ("(defonce gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n"); (* A dyn global's initialiser cannot view what it builds itself. *) refused "view-global-init.fln" "once xs = array-fill([3], i64(1))\n\nfn main() -> i32 = 0\n" [ "xs is a dyn global"; "as in once xs: [3 i64] = ..." ]; checks "view-global-fix.flan" ("(defonce gs dyn [1 2])\n(def hs dyn [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs) (show hs))\n"); checks "view-global-fix.fln" "once gs: dyn = [1 2]\n\nfn show(d) -> i32 = 1\n\nfn main() -> i32 = show(gs)\n"; (* The fix is spelled in the syntax the code was sent in, not the one the file's name implies: an editor request from an indented buffer. *) Source.with_code ~syntax:Source.Indented ~at:None (fun () -> refused "unit-tail-request.flan" "(defn f [coll] dyn (let [i 1] (while (< i 3) (++ i))))\n(defn main [] () (f 1))\n" [ "fn f(...) -> ()" ]); (* The fix both of them name. *) checks "view-fix.fln" (poke_fln ^ "fn main() -> ()\n let d: dyn = [6 2 4 9]\n poke(d)\n poke(the(dyn, [1 2]))\n"); checks "view-fix.flan" (poke_flan ^ "(defn main [] () (let [a (the dyn [6 2 4 9])] (poke a)) (poke (the dyn [1 2])))\n"); (* A dyn function whose body ends in a while gives no value. *) let loop_fln ret tail = "fn f(coll) -> " ^ ret ^ "\n let i = 1\n while i < 3\n ++(i)\n" ^ tail ^ "\nfn main() -> ()\n f(1)\n" in refused "unit-tail.fln" (loop_fln "dyn" "") [ "f is declared to return dyn, but the last form of its body gives no value"; "fn f(...) -> ()" ]; refused "unit-tail.flan" "(defn f [coll] dyn (let [i 1] (while (< i 3) (++ i))))\n(defn main [] () (f 1))\n" [ "f is declared to return dyn"; "(defn f [...] () ...)" ]; checks "unit-tail-nil.fln" (loop_fln "dyn" " nil\n"); checks "unit-tail-unit.fln" (loop_fln "()" ""); (* A unit argument deeper in the last form is about that argument. *) refused "unit-arg.flan" "(defn g [x dyn] dyn x)\n(defn f [coll] dyn (g (println 1)))\n(defn main [] () (f 1))\n" [ "() does not box into dyn" ]; (* Checker messages about a .fln file are in its spelling. *) refused "enum-none.fln" "fn main() -> i32\n let n = None\n 0\n" [ "the(Option(i32), None)" ]; checks "enum-annotated.fln" "enum Dir\n north\n south\n\nfn main() -> i32\n let d: Dir = :north\n i32(d)\n"; refused "annotation-dyn.fln" "fn main() -> i32\n let d = the(dyn, 3)\n let x: i32 = d\n x\n" [ "a type annotation checks a value as i32"; "write i32(d)" ]; refused "narrowing.fln" "fn f() -> i64 = 1\n\nfn main() -> i32\n let x: i32 = 0\n x = f()\n x\n" [ "it has to be written: i32(x)" ]; refused "unknown-type.fln" "fn f(p: Keyword) -> i32 = 0\n\nfn main() -> i32 = 0\n" [ "unknown type Keyword" ]; refused "untyped-lambda.fln" "fn main() -> i32\n let f = fn(a) =>\n a\n 0\n" [ "let f: Fn(T, ...) -> R = fn(...) =>" ]; refused "plusplus.fln" "fn main() -> i32\n let x = 1\n x++\n x\n" [ "write ++(x) or x += 1" ]; refused "plusplus-global.fln" "once g = 0\n\nfn main() -> i32\n g--\n 0\n" [ "write --(g) or g -= 1" ]; (* Types in a message are in the syntax of the code it is about. *) refused "types.fln" "fn g(x: Option(i32)) -> i32 = 0\n\nfn main() -> i32\n let v = vec-new(i32)\n g(v)\n" [ "expected Option(i32), found Vec(i32)" ]; refused "types.flan" "(defn g [x (Option i32)] i32 0)\n(defn main [] i32 (let [v (vec-new i32)] (g v)))\n" [ "expected (Option i32), found (Vec i32)" ]; refused "fn-field.fln" "struct R\n f: Fn(i32) -> bool\n\nfn main() -> i32 = 0\n" [ "cannot be Fn(i32) -> bool"; "store a CFn(i32) -> bool" ]; refused "generic-struct.fln" "struct Small\n items: [$n $t]\n\nfn main() -> i32\n let s: Small(4, i32) = zeroed()\n let q: i32 = s\n 0\n" [ "found Small(4, i32)" ]; (* Dir.north is the member :north. *) checks "enum-qualified.fln" ("enum Dir\n north\n south\n\nfn name(d: Dir) -> i32\n match d\n Dir.north -> 1\n :south -> 2\n\n" ^ "fn main() -> i32\n let d = Dir.north\n let e: Dir = Dir.south\n name(d) + name(e)\n"); refused "enum-qualified-miss.fln" "enum Dir\n north\n\nfn f(d: Dir) -> i32\n match d\n Dir.west -> 1\n _ -> 0\n\nfn main() -> i32 = 0\n" [ "Dir has no member west — it has Dir.north" ]; (* A bad key type is one error, not three. *) refused "map-key.fln" "fn main() -> i32\n let m = map-new([const u8], i32)\n 0\n" [ "[const u8] is not a map key" ]; (match Front.checked (Filename.concat scratch "map-key.fln") with | exception Loc.Errors (_ :: _ :: _ as ds) -> fail "map-key.fln: %d errors, wanted one" (List.length ds) | exception _ -> () | _ -> ()); (* The fix a block lambda with no => is shown compiles, inside the call. *) (match read "sort-by(xs, fn(a, b)\n a.n < b.n)" with | _ -> fail "lambda in brackets: read" | exception Loc.Error d -> let header = let m = d.Loc.dmsg in let i = String.index m '\n' + 6 in String.sub m i (String.index_from m i '\n' - i) in checks "lambda-fix.fln" ("struct C\n n: i32\n\nfn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n" ^ " sort-by(slice(xs), " ^ header ^ "\n a.n < b.n)\n xs[0].n\n")); (* A typed block lambda inside a call, a closer on its own line, and one nested in another's block. *) checks "block-lambdas.fln" ("struct C\n n: i32\n\nfn app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)\n\n" ^ "fn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n" ^ " sort-by(slice(xs), fn(a: C, b: C) -> bool =>\n let d = a.n - b.n\n d < 0)\n" ^ " let k = app(2, fn(a) =>\n let b = app(a, fn(c) =>\n c * 10\n )\n b + 1)\n" ^ " i32(k) + xs[0].n\n"); refused "cfn-captures.fln" "fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) => k)\n" [ "so it is a Fn(Option(i32)) -> i32 and not a CFn(Option(i32)) -> i32" ]; refused "defvar.fln" "defvar(x, 1)\n\nfn main() -> i32 = 0\n" [ "once x = 1 initialises once"; "def x = 1 re-initialises" ] (* ── Both directions of an import, on both backends ────────────────── *) let run_both ?(backends = [ false; true ]) path want = List.iter (fun x86 -> let exe = Filename.concat scratch (Printf.sprintf "flan-syntax-%s-%d%s" (Filename.basename path) (Unix.getpid ()) (if x86 then "-x86" else "")) in match let p, csrcs, lflags = Test_support.linked path in ignore (Build.executable ~opts:{ Build.default with x86 } ~csrcs ~lflags p ~out:exe) with | exception e -> fail "%s%s does not build: %s" path (if x86 then " --x86" else "") (diag_text e) | () -> let out = exe ^ ".out" in let code = Sys.command (Filename.quote exe ^ " > " ^ Filename.quote out ^ " 2>&1") in let text = In_channel.with_open_bin out In_channel.input_all in (try Sys.remove out; Sys.remove exe with Sys_error _ -> ()); if code <> 0 || text <> want then fail "%s%s printed %S and exited %d, wanted %S" path (if x86 then " --x86" else "") text code want) backends (* A program and its conversion print the same: the flat lets, the renames and the macro bodies they rest on keep what each name means. *) let run_converted path = let run p = let exe = Filename.concat scratch (Printf.sprintf "flan-flat-%s-%d" (Filename.basename p) (Unix.getpid ())) in let prog, csrcs, lflags = Test_support.linked p in ignore (Build.executable ~opts:Build.default ~csrcs ~lflags prog ~out:exe); let out = exe ^ ".out" in let code = Sys.command (Filename.quote exe ^ " > " ^ Filename.quote out ^ " 2>&1") in let text = In_channel.with_open_bin out In_channel.input_all in (try Sys.remove out; Sys.remove exe with Sys_error _ -> ()); (code, text) in match let forms = Reader.read_file path in let source = In_channel.with_open_bin path In_channel.input_all in let macros = Body_macros.table ~file:path forms in let fln = Filename.concat scratch (Printf.sprintf "%d-%s.fln" (Unix.getpid ()) (Filename.remove_extension (Filename.basename path))) in Out_channel.with_open_bin fln (fun oc -> output_string oc (Indent_printer.program ~source ~macros forms)); let a = run path and b = run fln in (try Sys.remove fln with Sys_error _ -> ()); (a, b) with | exception e -> fail "%s converted: %s" path (diag_text e) | ((0, a), (0, b)) when a = b -> () | ((c, a), (d, b)) -> fail "%s printed %S (exit %d), and converted %S (exit %d)" path a c b d (* ── Programs written by hand in the indented syntax ─────────────────── *) (* Each [syntax/handwritten/x.fln] prints [x.out] on both backends; its conversion to parens reads back to the same forms, with every comment, and converts back to indented text that reads to them again; and the converted .flan builds and prints the same. *) let handwritten () = let dir = "syntax/handwritten" in Sys.readdir dir |> Array.to_list |> List.filter (fun f -> Filename.check_suffix f ".fln") |> List.sort compare |> List.map (Filename.concat dir) let converts_back path = let src = In_channel.with_open_bin path In_channel.input_all in let forms = Source.read_file path in let norm_all fs = macros := Body_macros.table ~file:path fs; List.map norm fs in let want = norm_all forms in let paren = Paren_printer.program ~source:src forms in match Reader.read_all ~file:path paren with | exception e -> fail "%s to parens: %s" path (diag_text e) | again -> if not (same_forms want (norm_all again)) then fail "%s to parens: %s" path (describe_diff want (norm_all again)) else if comment_texts paren <> comment_texts src then fail "%s to parens: the comments did not all come through" path else begin let fln = Indent_printer.program ~source:paren ~macros:!macros again in (match Indent_reader.read_all ~file:path fln with | exception e -> fail "%s back to indented: %s" path (diag_text e) | back -> if not (same_forms want (norm_all back)) then fail "%s back to indented: %s" path (describe_diff want (norm_all back))); (* Beside the original, so its imports resolve the same way. *) let flan = Filename.concat (Filename.dirname path) (Printf.sprintf ".conv-%d-%s.flan" (Unix.getpid ()) (Filename.remove_extension (Filename.basename path))) in Out_channel.with_open_bin flan (fun oc -> output_string oc paren); Fun.protect ~finally:(fun () -> try Sys.remove flan with Sys_error _ -> ()) (fun () -> run_both ~backends:[ false ] flan (In_channel.with_open_bin (Filename.remove_extension path ^ ".out") In_channel.input_all)) end let () = List.iter (fun p -> try converts_back p with e -> fail "%s: %s" p (diag_text e)) (List.filter (fun _ -> Test_support.have "clang") (handwritten ())); if List.length (handwritten ()) < 8 then fail "only %d hand-written programs" (List.length (handwritten ())); if Test_support.have "clang" then List.iter (fun p -> run_both p (In_channel.with_open_bin (Filename.remove_extension p ^ ".out") In_channel.input_all)) (handwritten ()) let () = if Test_support.have "clang" then begin List.iter run_converted [ "syntax/flat/shadows.flan"; "syntax/flat/macros.flan"; "syntax/flat/capture.flan" ]; run_both "syntax/mixed/main.flan" "12\n12\n0\n55\n"; run_both "syntax/mixed/main.fln" "25\n7\nfar\n3\n"; (* A chain in a template: its names made where the macro expands in the paren text, and the chain printed back as one. *) let src = In_channel.with_open_bin "syntax/chain/macro.fln" In_channel.input_all in let want = "false\ntrue\nfalse\n" in run_both "syntax/chain/macro.fln" want; let forms = Indent_reader.read_all ~file:"syntax/chain/macro.fln" src in let paren = Paren_printer.program ~source:src forms in if not (Test_support.contains paren "~(Form.Sym {.s \"~cmp1\"}) ~lo") then fail "a template's chain in parens: %s" paren; let flan = Filename.concat scratch (Printf.sprintf "chain-macro-%d.flan" (Unix.getpid ())) in Out_channel.with_open_bin flan (fun oc -> output_string oc paren); run_both flan want; let back = Indent_printer.program ~source:paren (Reader.read_all ~file:flan paren) in (try Sys.remove flan with Sys_error _ -> ()); if not (Test_support.contains back "~lo <= ~x < ~hi") then fail "a template's chain back from parens: %s" back; (* Return types read off the body, in both spellings of [_]. *) List.iter (fun p -> run_both p "3\n2.5\n1.5\n2.5\nyes 0\n4\n0 5\n2\n1\n") [ "syntax/infer/main.flan"; "syntax/infer/main.fln" ] end else print_endline "syntax: no clang, the import programs are not built" let () = (* A local named like an enum shadows it. *) List.iter (fun (name, text) -> let f = Filename.concat scratch name in write f text; match Test_support.linked f with | exception e -> fail "%s: %s" name (diag_text e) | _ -> run_both f "5 true\n") (if Test_support.have "clang" then [ ("shadow-enum.fln", "enum Dir\n north\n south\n\nstruct P\n north: i32\n\nfn main() -> i32\n" ^ " let a = Dir.north\n let Dir = P{.north 5}\n println(Dir.north, a == :north)\n 0\n"); ("shadow-enum.flan", "(defenum Dir [north south])\n(defstruct P [north i32])\n(defn main [] i32 " ^ "(let [a Dir.north Dir (P {.north 5})] (println Dir.north (= a :north)) 0))\n") ] else []) (* A local whose address is taken is not narrowed by if x?: a pointer could clear it inside the block. The refusal of a payload use says so. *) let () = let f = Filename.concat scratch "addr-taken-note.fln" in write f "fn main()\n let x: i32? = Some(1)\n let p = addr(x)\n if x?\n println(x + 1)\n"; match Front.checked f with | _ -> fail "addr-taken-note.fln checked" | exception (Loc.Error d | Loc.Errors (d :: _)) -> if not (List.exists (fun (n : Loc.note) -> Test_support.contains n.Loc.nmsg "Write if x as g") d.Loc.notes) then fail "addr-taken-note.fln: no note naming if x as g on: %s" d.Loc.dmsg | exception e -> fail "addr-taken-note.fln: %s" (diag_text e) let () = Test_support.report ~label:"syntax" ()