1921 lines
107 KiB
OCaml
1921 lines
107 KiB
OCaml
(* 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:"<ops>" 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:"<ops>.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:"<syntax>" 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
|
|
<syntax>. *)
|
|
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:"<p>" 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:"<m>" 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:"<b>" 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:"<p>" src in
|
|
let text = Indent_printer.program ~source:src forms in
|
|
match Indent_reader.read_all ~file:"<p>" 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:"<p>" src in
|
|
let back = Indent_reader.read_all ~file:"<p>" (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:"<p>"
|
|
"(defn f [a i32] i32\n (loop [x a y 0]\n (if (= x 0) y (recur (- x 1) (+ y 1)))))\n\n(defn g [] i32 (loop [i 0] i))"
|
|
with
|
|
| forms ->
|
|
(match Indent_printer.program forms with
|
|
| text -> fail "a loop printed: %s" text
|
|
| exception Loc.Error d ->
|
|
if d.Loc.kind <> "convert/no-loop" then fail "a loop refused as %s" d.Loc.kind;
|
|
List.iter
|
|
(fun n ->
|
|
if not (Test_support.contains d.Loc.dmsg n) then
|
|
fail "the loop refusal does not say %S: %s" n d.Loc.dmsg)
|
|
[ "on lines 2, 3 and 5. The indented syntax"; "(while (< i 10)" ];
|
|
if List.length d.Loc.notes <> 2 then
|
|
fail "the loop refusal points at %d more places, wanted 2" (List.length d.Loc.notes))
|
|
| exception e -> fail "a loop: %s" (diag_text e))
|
|
|
|
(* ── Spans, for pause marks and error overlays ──────────────────────── *)
|
|
|
|
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:"<buf>" "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:"<buf>" "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:"<buf>" " 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:"<buf>" "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:"<buf>" "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:"<buf>" "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:"<buf>" "(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" ()
|