diff --git a/lib/check.ml b/lib/check.ml index e5c506ce..a47256b9 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -6200,6 +6200,13 @@ and check_fn ctx ~want ?gen loc (params : string list) body = | Some other when other <> Types.Never -> fail loc "expected %s, found an fn" (Types.to_string other) | _ -> + if fln_source loc then + fail loc + "nothing here says what this fn's parameters are — an fn takes \ + its types from the position it is written in. Pass it where a \ + Fn(T, ...) -> R is expected, or name the type where it is \ + bound: let f: Fn(T, ...) -> R = fn(...)" + else fail loc "nothing here says what this fn's parameters are — an fn takes \ its types from the position it is written in. Write it as an \ @@ -10701,8 +10708,10 @@ and named_call ?(qualified = false) ctx ~want loc name args = fail loc "a pattern cannot destructure %s — a slice's length is not known \ until the program runs, so nothing here can check it has %Ld \ - element%s. Use (at s i) and test (length s) yourself" + element%s. Use %s and test %s yourself" (Types.to_string target.Tast.ty) n (plural n) + (if fln_source loc then "s[i]" else "(at s i)") + (if fln_source loc then "length(s)" else "(length s)") | other -> fail loc "%s is not a fixed array, so [a b ...] cannot destructure it" diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index 439d2c52..e7d99832 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -398,6 +398,10 @@ and list _f h args = && (match t.v with | Form.Byte _ -> false | Form.Sym x -> name_ok x && not (String.contains x '.') && not (R.capitalised x) + (* A field of a field chains: [w.x.count]. *) + | Form.List [ { v = Form.Sym f; _ }; _ ] + when String.length f > 1 && f.[0] = '.' && tt <> "" && tt.[0] <> '.' -> + String.length tt > 0 && not (String.contains tt ' ') | _ -> let c = tt.[String.length tt - 1] in c = ')' || c = ']' || c = '}' || c = '"') @@ -760,8 +764,15 @@ and sugar n (f : Form.t) : string list option = | Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads) | _ -> true in + (* An else that is another if with an else chains on the line: + [if a then x else if b then y else z]. *) + let rec chain (x : Form.t) = + match x.v with + | Form.List [ { v = Form.Sym "if"; _ }; _; a; b ] -> simple a && chain b + | _ -> simple x + in let line = i ^ fst (expr f) in - if simple a && simple b && String.length line <= width && not (!inside f) + if simple a && chain b && String.length line <= width && not (!inside f) then Some [ line ] else Some diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 8248ef3d..cfd21f3c 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -812,7 +812,21 @@ and items p closer open_loc ~what = | EOF -> unclosed p opener open_loc | _ -> let n = peek p in - if starts_value n.tok && n.sp && not (negative_literal n.tok) then + let block_lambda = + match e.v with + | Form.List ({ v = Form.Sym "fn"; _ } :: ps) -> + List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) ps + && n.loc.Loc.line > e.loc.Loc.eline + | _ -> false + in + if block_lambda then + failk "lambda-block-in-brackets" n.loc + "a lambda's block cannot go inside brackets, where a line break \ + is only a space. Name it first, with the block under it:\n\n\ + \ let f = %s\n ...\n\n\ + and pass f, or write it on one line: %s = value" + (text_of e) (text_of e) + else if starts_value n.tok && n.sp && not (negative_literal n.tok) then failk "missing-comma" n.loc "%s follows %s with no comma between them. Separate %s with \ commas: f(a, b)" @@ -897,6 +911,29 @@ let rec ty p : Form.t = as a call does not. *) type st = { p : p; mutable lets : Form.t list } +(* Whether the code line before [t] is a one-line [if c then a] with no + else: an else under it reads as written for that if, and is not. *) +let one_line_if_above p (t : token) = + let layout = function NEWLINE | INDENT | DEDENT -> true | _ -> false in + let rec prev j = + if j < 0 then None + else + let u = p.toks.(j) in + if u.loc.Loc.line < t.loc.Loc.line && not (layout u.tok) then Some u.loc.Loc.line + else prev (j - 1) + in + match prev (p.i - 1) with + | None -> false + | Some l -> + let rec line j acc = + if j < 0 || p.toks.(j).loc.Loc.line < l then acc + else line (j - 1) (if layout p.toks.(j).tok || p.toks.(j).loc.Loc.line > l then acc + else p.toks.(j).tok :: acc) + in + (match line (p.i - 1) [] with + | NAME "if" :: rest -> List.mem (NAME "then") rest && not (List.mem (NAME "else") rest) + | _ -> false) + (* A block of several lines is a [do] spanning its lines, from the first statement to the end of the last — not from the header above it, which is another form's. *) @@ -1132,6 +1169,14 @@ and stmt (s : st) : Form.t = let t = peek p in match t.tok with | NAME w when header_follow p w -> header s w + | NAME (("else" | "elif") as w) when one_line_if_above p t -> + failk "orphan-else" t.loc + "the if above is a one-line if, which ends with its line, so this %s \ + has no if to belong to. Keep the one-line form on one line:\n\n\ + \ if c then a else b\n\n\ + or give each branch a block:\n\n\ + \ if c\n a\n else\n b" + w | NAME (("else" | "elif") as w) -> failk "orphan-else" t.loc "%s is not under an if at this column. It goes at the same column as \ diff --git a/test/syntax/handwritten/traffic.fln b/test/syntax/handwritten/traffic.fln new file mode 100644 index 00000000..e0b56b23 --- /dev/null +++ b/test/syntax/handwritten/traffic.fln @@ -0,0 +1,91 @@ +; A traffic light at a crossing, driven by a clock and a pedestrian button. +; Each state carries how long it has left; a fault drops the light to +; flashing, and a supervisor decides whether to reset it. + +data Light + Green(left: i32) + Yellow(left: i32, walk: bool) + Red(left: i32, walk: bool) + Flashing() + +struct Fault + tick: i32 + +const green-time = 4 +const yellow-time = 1 +const red-time = 3 + +fn next(l: Light, pressed: bool) -> Light + match l + Green(left) -> + if left > 1 and not pressed + Light.Green{.left left - 1} + else + Light.Yellow{.left yellow-time, .walk pressed} + Yellow(left, walk) -> + if left > 1 + Light.Yellow{.left left - 1, .walk walk} + else + Light.Red{.left red-time, .walk walk} + Red(left, walk) -> + if left > 1 then Light.Red{.left left - 1, .walk walk} else Light.Green{.left green-time} + Flashing -> Light.Flashing{} + +fn show(l: Light) -> string + match l + Green(_) -> "G" + Yellow(_, _) -> "Y" + Red(_, walk) -> if walk then "W" else "R" + Flashing -> "*" + +; Runs the light for ticks steps; a fault at fault-at is signalled, and +; whoever handles it may reset the light to red. +fn run(ticks: i32, presses: [const i32], fault-at: i32) -> () + let l = Light.Red{.left 1, .walk false} + let p = 0 + let t = 0 + until :clock t >= ticks + let pressed = p < length(presses) + and presses[p] == t + if pressed + ++(p) + if t == fault-at + l = restart-case + error(Fault{.tick t}) + l + restart reset() + :report + "Put the light back to red and carry on" + Light.Red{.left red-time, .walk false} + restart flash() + Light.Flashing{} + match l + Flashing -> + print(show(l)) + break :clock + _ -> print(show(l)) + l = next(l, pressed) + t += 1 + println("") + +fn main() -> i32 + let none = [-1] + let two = [1 9] + run(12, slice(none), -1) + run(12, slice(two), -1) + handler-bind + run(12, slice(none), 5) + on Fault(f) + invoke-restart('reset) + handler-bind + run(12, slice(none), 5) + on Fault(f) + invoke-restart('flash) + println: + handler-case + run(12, slice(none), 2) + "no fault" + on Fault(f) + println("") + "fault at tick" + 0 diff --git a/test/syntax/handwritten/traffic.out b/test/syntax/handwritten/traffic.out new file mode 100644 index 00000000..3453bec5 --- /dev/null +++ b/test/syntax/handwritten/traffic.out @@ -0,0 +1,6 @@ +RGGGGYRRRGGG +RGYWWWGGGGYW +RGGGGRRRGGGG +RGGGG* +RG +fault at tick diff --git a/test/syntax/handwritten/words.fln b/test/syntax/handwritten/words.fln new file mode 100644 index 00000000..65d3773f --- /dev/null +++ b/test/syntax/handwritten/words.fln @@ -0,0 +1,84 @@ +; Word statistics over a paragraph: a frequency table, the longest words, +; and a grade for how varied the vocabulary is. + +enum Grade + poor = 1 + fair = 2 + rich = 3 + +struct Count + word: [const u8] + n: i32 + +fn letter?(c: u8) -> bool + (c >= \a and c <= \z) + or (c >= \A and c <= \Z) + or c == \' + +; The words of text, lowercased, in order. +fn words(text: [const u8]) -> Vec([const u8]) + let out = vec-new([const u8]) + let lower = to-lower(text) + let i = 0 + let n = length(lower) + while :scan i < n + until i >= n or letter?(lower[i]) + i += 1 + if i >= n + break :scan + let start = i + while i < n and letter?(lower[i]) + i += 1 + push(out, slice(lower, start, i)) + out + +fn tally(ws: [[const u8]]) -> Vec(Count) + let seen = map-new(string, i32) + defer free(seen) + let counts = vec-new(Count) + for i in range(length(ws)) + match get(seen, string(ws[i])) + Some(k) -> counts[k].n += 1 + None -> + put(seen, string(ws[i]), i32(length(counts))) + push(counts, Count{.word ws[i], .n 1}) + counts + +fn grade(distinct: i32, total: i32) -> Grade + let ratio = distinct * 10 / max(total, 1) + if ratio >= 7 then :rich else if ratio >= 4 then :fair else :poor + +fn describe(g: Grade) -> string + match i32(g) + 1 -> "repetitive" + 2 -> "ordinary" + _ -> "varied" + +fn main() -> i32 + let text = "The cat saw the dog. The dog didn't see the cat, but the bird saw both!" + let ws = words(bytes-view(text)) + let counts = tally(slice(ws)) + let by-count: Fn(Count, Count) -> bool = fn(a, b) + if a.n != b.n + return a.n > b.n + bytes length(a) then b else a) + println("longest", string(longest)) + let short = 0 < length(longest) < 5 + match short + true -> println("short words only") + false -> println("some long words") + println("three distinct counts?", !=(counts[0].n, counts[1].n, counts[2].n)) + 0 diff --git a/test/syntax/handwritten/words.out b/test/syntax/handwritten/words.out new file mode 100644 index 00000000..db6829dc --- /dev/null +++ b/test/syntax/handwritten/words.out @@ -0,0 +1,8 @@ +the 5 +cat 2 +dog 2 +most frequent seen 5 times, then [2 2] +9 of 16 distinct: ordinary +longest didn't +some long words +three distinct counts? false diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 611a2161..16aee4a8 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -918,7 +918,7 @@ let () = (* ── Both directions of an import, on both backends ────────────────── *) -let run_both path want = +let run_both ?(backends = [ false; true ]) path want = List.iter (fun x86 -> let exe = @@ -939,7 +939,7 @@ let run_both path want = 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) - [ false; true ] + 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. *) @@ -972,6 +972,66 @@ let run_converted path = | ((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