diff --git a/bin/main.ml b/bin/main.ml index 39e523ef..306e2373 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -338,7 +338,8 @@ let () = (String.concat "\n\n" (List.map (fun f -> Flan.Form.pretty f) forms) ^ "\n") else - match Flan.Indent_printer.program forms with + let source = In_channel.with_open_bin path In_channel.input_all in + match Flan.Indent_printer.program ~source forms with | text -> print_string text | exception Flan.Indent_printer.Unprintable (f, why) -> Flan.Loc.failk "convert/unprintable" f.Flan.Form.loc diff --git a/lib/check.ml b/lib/check.ml index ee0c4daf..7a300980 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -7144,6 +7144,32 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = (match no_such_rand name with | Some msg -> Loc.failk "check/unknown-name" loc "%s" msg | None -> ()); + (* In the indented syntax a binary operator needs spaces, so [x-1], [i+1] + and [x/2] are one name each. When the parts either side of an operator + character are a value in scope and a number or another value, that is + almost certainly the arithmetic, and the sentence says how to spell it. *) + (if Filename.check_suffix loc.Loc.file ".fln" then begin + let known s = + s <> "" + && (String.for_all (fun c -> (c >= '0' && c <= '9') || c = '.') s + || lookup ctx s <> None + || Hashtbl.mem ctx.env.globals s) + in + let n = String.length name in + let rec scan i = + if i < n - 1 then + match name.[i] with + | ('-' | '+' | '*' | '/') as c + when i > 0 && known (String.sub name 0 i) + && known (String.sub name (i + 1) (n - i - 1)) -> + Loc.failk "check/unknown-name" loc + "unknown name %s — an operator needs a space on each side, so \ + this is one name and not arithmetic. Did you mean %s %c %s?" + name (String.sub name 0 i) c (String.sub name (i + 1) (n - i - 1)) + | _ -> scan (i + 1) + in + scan 0 + end); let dot = String.index_opt name '.' in let head, field = match dot with diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index 9132c1f3..c7444155 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -50,6 +50,18 @@ let def_name s = name_ok s && s.[0] <> '.' let paren s = "(" ^ s ^ ")" +(* A number's own spelling, when the caller has the text it was read from: + [Form.Int] keeps only the value, so without this 0xFFF00FFF would print + as 4293922815. Set by [program ~source]. *) +let spelling : (Form.t -> string option) ref = ref (fun _ -> None) + +(* The same form, locations aside. *) +let rec same (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 same x y + | x, y -> x = y + let is_sym s (f : Form.t) = match f.v with Form.Sym x -> x = s | _ -> false (* ── Expressions ───────────────────────────────────────────────────── *) @@ -62,10 +74,12 @@ let rec expr (f : Form.t) : string * int = | Form.Sym s -> sym f s | Form.Kw k -> if kw_ok k then (":" ^ k, 10) else unprintable f "a keyword with no spelling" - | Form.Int i -> (Int64.to_string i, if Int64.compare i 0L < 0 then 8 else 10) + | Form.Int i -> + let t = Option.value (!spelling f) ~default:(Int64.to_string i) in + (t, if t.[0] = '-' then 8 else 10) | Form.UInt (_, s) -> (s, 10) | Form.Float x -> - let s = Form.float_repr x in + let s = Option.value (!spelling f) ~default:(Form.float_repr x) in if not (Reader.is_digit s.[0] || (s.[0] = '-' && String.length s > 1 && Reader.is_digit s.[1])) then unprintable f "a float with no literal"; @@ -167,9 +181,30 @@ and list _f h args = | Form.Sym "fn", [ { v = Form.Vec ps; _ }; body ] when List.for_all sym_param ps -> ("fn(" ^ commas ps ^ ") = " ^ at 0 body, 0) | Form.Sym "if", [ c; a; b ] -> - ("if " ^ at 1 c ^ " then " ^ at 1 a ^ " else " ^ at 0 b, 0) + ("if " ^ at 1 c ^ " then " ^ inline_text ~lvl:1 a ^ " else " ^ inline_text b, 0) | _ -> call () +(* A one-line slot's text — an arm's value, a then or an else, what follows + defer: the statements that fit on a line are written as statements, + everything else as a value. [lvl] is what a value in the slot needs. *) +and inline_text ?(lvl = 0) (f : Form.t) = + match f.v with + | Form.List [ { v = Form.Sym (("break" | "continue" | "return") as w); _ } ] -> w + | Form.List [ { v = Form.Sym (("break" | "continue") as w); _ }; { v = Form.Kw k; _ } ] + when kw_ok k -> + w ^ " :" ^ k + | Form.List [ { v = Form.Sym "return"; _ }; v ] -> "return " ^ at (max lvl 1) v + | Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> assign_text ~lvl t v + | _ -> at lvl f + +(* [t = v], or [t += w] when [v] is [(+ t w)]. *) +and assign_text ?(lvl = 0) t v = + let tt = at 9 t in + match v.v with + | Form.List [ { v = Form.Sym (("+" | "-" | "*" | "/") as op); _ }; a; w ] when same a t -> + tt ^ " " ^ op ^ "= " ^ at (max lvl 1) w + | _ -> tt ^ " = " ^ at (max lvl 1) v + and sym_param (p : Form.t) = match p.v with Form.Sym s -> name_ok s | _ -> false @@ -253,15 +288,33 @@ let body_split (h : Form.t) args = | "unless" | "loop" -> Some 1 | "defmacro" -> Some 2 | "defmethod" -> Some 3 - | _ when String.length base > 5 && String.sub base 0 5 = "with-" -> - let rec leading n = function - | ({ Form.v = Form.List _; _ }) :: _ -> n - | _ :: rest -> leading (n + 1) rest - | [] -> n + | _ -> + (* A with- macro, or any call whose last argument is a statement — + a let, a loop, an assignment — has a body: the trailing run of + lists goes in the block. *) + let stmt_like (a : Form.t) = + match a.v with + | Form.List ({ v = Form.Sym h; _ } :: _) -> + List.mem h [ "let"; "set"; "when"; "unless"; "cond"; "while"; + "until"; "dotimes"; "match"; "handler-case"; + "handler-bind"; "restart-case"; "return"; "defer"; + "do"; "break"; "continue" ] + | _ -> false + in + let is_with = String.length base > 5 && String.sub base 0 5 = "with-" in + let last_stmt = + match List.rev args with a :: _ -> stmt_like a | [] -> false in ignore lead; - Some (leading 0 args) - | _ -> None) + if is_with || last_stmt then begin + let k = ref 0 in + List.iteri + (fun i (a : Form.t) -> + match a.v with Form.List (_ :: _) -> () | _ -> k := i + 1) + args; + Some !k + end + else None) | _ -> None let sugar_heads = @@ -297,7 +350,14 @@ and plain n (f : Form.t) : string list = | Some k when k < List.length args -> let fixed = List.filteri (fun i _ -> i < k) args in let rest = List.filteri (fun i _ -> i >= k) args in - [ ind n ^ guard (head_text h ^ "(" ^ commas fixed ^ "):") ] @ block (n + 2) rest + let opener = + match h.v, fixed with + (* No arguments before the block: [comment:] rather than + [comment():], the author's decision 85. *) + | Form.Sym s, [] when name_ok s && not (List.mem s reserved) -> s ^ ":" + | _ -> head_text h ^ "(" ^ commas fixed ^ "):" + in + [ ind n ^ guard opener ] @ block (n + 2) rest | _ when n + String.length text > width && fst (expr f) = text -> wrapped n "" f | _ -> one) @@ -342,7 +402,13 @@ and wrapped n prefix (f : Form.t) = too long for the line. *) and value_lines n prefix (v : Form.t) = let inline = prefix ^ " = " ^ at 0 v in - if n + String.length inline <= width then [ ind n ^ inline ] + let is_do = + match v.v with + | Form.List ({ v = Form.Sym "do"; _ } :: _ :: _ :: _) -> true + | _ -> false + in + if is_do then [ ind n ^ prefix ^ " =" ] @ block (n + 2) (stmts_of v) + else if n + String.length inline <= width then [ ind n ^ inline ] else match v.v with | Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body)) @@ -368,10 +434,13 @@ and sugar n ~last (f : Form.t) : string list option = | None | Some [] -> None | Some prs -> Some (let_lines n ~last prs body)) | Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> - Some (value_lines n (guard (at 9 t)) v) + let line = i ^ guard (assign_text t v) in + if String.length line <= width then Some [ line ] + else Some (value_lines n (guard (at 9 t)) v) | Form.List [ { v = Form.Sym "if"; _ }; c; a; b ] -> let simple (x : Form.t) = match x.v with + | Form.List ({ v = Form.Sym ("return" | "set" | "break" | "continue"); _ } :: _) -> true | Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads) | _ -> true in @@ -422,7 +491,7 @@ and sugar n ~last (f : Form.t) : string list option = when kw_ok k -> Some [ i ^ w ^ " :" ^ k ] | Form.List [ { v = Form.Sym "defer"; _ }; x ] -> - let line = i ^ "defer " ^ at 0 x in + let line = i ^ "defer " ^ inline_text x in if String.length line <= width then Some [ line ] else Some ((i ^ "defer") :: block (n + 2) [ x ]) | Form.List ({ v = Form.Sym "defer"; _ } :: (_ :: _ :: _ as body)) -> @@ -436,8 +505,10 @@ and sugar n ~last (f : Form.t) : string list option = :: List.concat_map (fun (pat, body) -> let pt = at 8 pat in - let line = ind (n + 2) ^ pt ^ " -> " ^ at 0 body in + let line = ind (n + 2) ^ pt ^ " -> " ^ inline_text body in match body.v with + | Form.List ({ v = Form.Sym "do"; _ } :: _ :: _ :: _) -> + (ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body | Form.List (_ :: _) when String.length line > width -> (ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body | _ -> [ line ]) @@ -576,22 +647,61 @@ and handler_clauses n cls = One with siblings after it takes its body as an indented block under the first binding, and the rest of the bindings go inside that block. *) and let_lines n ~last prs body = - let target (t : Form.t) = "let " ^ guard (at 8 t) in + (* [(let [x (the T v)])] is [let x: T = v]. *) + let bind ((t : Form.t), (v : Form.t)) = + match t.v, v.v with + | Form.Sym x, Form.List [ { v = Form.Sym "the"; _ }; ty_; w ] when def_name x -> + ("let " ^ x ^ ": " ^ ty ty_, w) + | _ -> ("let " ^ guard (at 8 t), v) + in if last then - List.concat_map (fun (t, v) -> value_lines n (target t) v) prs @ block n body + List.concat_map (fun b -> let p, v = bind b in value_lines n p v) prs @ block n body else match prs with - | (t, v) :: rest -> - (ind n ^ target t ^ " = " ^ at 0 v) - :: (List.concat_map (fun (t, v) -> value_lines (n + 2) (target t) v) rest + | b :: rest -> + let p, v = bind b in + (ind n ^ p ^ " = " ^ at 0 v) + :: (List.concat_map (fun b -> let p, v = bind b in value_lines (n + 2) p v) rest @ block (n + 2) body) | [] -> block n body (** A whole file: top-level forms with a blank line between them. *) -let program (fs : Form.t list) : string = +let program ?source (fs : Form.t list) : string = + (* With the text the forms were read from, a number keeps its spelling: + the text under its span, when that reads back to the same value. *) + let lines = + match source with + | Some src -> Array.of_list (String.split_on_char '\n' src) + | None -> [||] + in + spelling := + (fun (f : Form.t) -> + let l = f.loc in + if l.Loc.line < 1 || l.Loc.line > Array.length lines || l.Loc.eline <> l.Loc.line + then None + else + let text = lines.(l.Loc.line - 1) in + let a = l.Loc.col - 1 and b = l.Loc.ecol - 1 in + if a < 0 || b > String.length text || b <= a then None + else + let t = String.sub text a (b - a) in + match f.v with + | Form.Int i when Int64.of_string_opt t = Some i -> Some t + | Form.Float x + when String.exists (fun c -> c = '.' || c = 'e' || c = 'E') t + && (match float_of_string_opt t with + | Some y -> Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y) + | None -> false) -> + Some t + | _ -> None); let rec go = function | [] -> [] | [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ] | x :: rest -> String.concat "\n" (stmt 0 ~last:false x) :: go rest in - String.concat "\n\n" (go fs) ^ "\n" + let text = + try String.concat "\n\n" (go fs) ^ "\n" + with e -> spelling := (fun _ -> None); raise e + in + spelling := (fun _ -> None); + text diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 4c8b34da..ee419924 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -159,8 +159,25 @@ let lex ~file src : token list = else emit UNQ (Loc.upto l0 (Reader.here st)) | c when Reader.is_digit c || ((c = '-' || c = '+') && Reader.is_digit (Reader.peek2 st)) -> - let f = Reader.read_number st in - emit (ATOM f.v) f.loc + (* [while x < 3:] — the colon is a mistake the parser explains, and not + part of the number, so the number is read without it. *) + let rec run i = + if i < String.length src && not (Reader.is_delimiter src.[i]) then run (i + 1) + else i + in + let stop = run st.Reader.pos in + if stop - st.Reader.pos > 1 && src.[stop - 1] = ':' then begin + let text = String.sub src st.Reader.pos (stop - st.Reader.pos - 1) in + let f = Reader.read_number (Reader.of_string ~file text) in + let n = String.length text in + for _ = 1 to n do Reader.advance st done; + emit (ATOM f.v) (piece l0.Loc.line l0.Loc.col n); + Reader.advance st; + emit COLON (piece l0.Loc.line (l0.Loc.col + n) 1) + end + else + let f = Reader.read_number st in + emit (ATOM f.v) f.loc | _ -> name_run () in let rec go () = @@ -224,6 +241,27 @@ let layout ?(base = 1) (toks : token list) : token array = && arr.(i + 1).sp in let continues = (binop p && p.sp) || (binop t && spaced_after) in + (* A continuation line sits deeper than the statement it continues. + One at or left of that statement's column is not read as joining + it: that would pull a line into a block it was written outside + of, silently. *) + if continues && t.loc.Loc.col <= List.hd !stack then + failk "continuation" t.loc + "%s" + (if binop t then + Printf.sprintf + "this line starts with the operator %s, so it continues the \ + line above, but it is not indented past the start of that \ + line (column %d). Indent it further to continue the line, \ + or give %s a value on its left" + (show t.tok) (List.hd !stack) (show t.tok) + else + Printf.sprintf + "the line above ends with the operator %s, so this line \ + continues it, but it is not indented past the start of \ + that line (column %d). Indent it further, or finish the \ + line above" + (show p.tok) (List.hd !stack)); if not continues then begin let at = point p.loc in add NEWLINE at; @@ -234,19 +272,21 @@ let layout ?(base = 1) (toks : token list) : token array = add INDENT at end else if col < top then begin + let closed = ref top in let rec pop () = match !stack with | top :: (_ :: _ as rest) when col < top -> - stack := rest; add DEDENT at; pop () + closed := top; stack := rest; add DEDENT at; pop () | _ -> () in pop (); if col <> List.hd !stack then failk "dedent" t.loc - "this line starts at column %d, which is not where any \ - enclosing block starts — those start at column%s %s. Line \ + "this line starts at column %d, between the block at column \ + %d and the one at column %d it would close, so it belongs \ + to neither. The enclosing blocks start at column%s %s: line \ it up with one of them" - col + col (List.hd !stack) !closed (if List.length !stack > 1 then "s" else "") (String.concat ", " (List.rev_map string_of_int !stack)) @@ -338,6 +378,17 @@ let stray p ~after = | NEWLINE | INDENT | DEDENT | EOF -> failk "unexpected-end" (where_ p) "the line ends after %s, which is not \ finished here" after + | NAME "=" -> + failk "assign-in-test" t.loc + "= assigns, and here it follows %s where a value is being read. To \ + compare, write ==: %s == ..." + after after + | COLON -> + failk "header-colon" t.loc + "this line ends in a colon after %s. A header (if, elif, else, while, \ + until, for, fn, match, ...) opens its block with no colon; only a call \ + takes one, as in f(x):. Remove the colon" + after | _ -> failk "unexpected-token" t.loc "%s follows %s, and two values cannot sit side by side here. Separate \ @@ -390,11 +441,13 @@ let unclosed p c l0 = ~notes:[ Loc.note (where_ p) "the input ends here, still inside it" ] "unclosed %C" c -let refuse_ws loc e = +let refuse_ws ?(brace = false) loc e = failk "separate-elements" loc "%s has an operator in it and sits in a list separated by spaces, where \ - only single values are. Separate the elements with commas: [a - 1, b]" + only single values are. Separate the %s with commas: %s" (text_of e) + (if brace then "entries" else "elements") + (if brace then "{.x a + 1, .y 2}" else "[a - 1, b]") (* Expressions come back with their syntactic level: 10 an atom or a bracket, 9 a postfix chain, 8 a unary minus, 1-7 a binary operator's level, 3 a @@ -540,6 +593,11 @@ and primary p : Form.t * int = (match (peek p).tok with | RP -> ignore (advance p) | EOF -> unclosed p '(' l0 + | COMMA -> + failk "tuple" (peek p).loc + "parentheses group one value, and this comma starts a second. \ + Several values in a list are written in brackets, [a, b]; \ + arguments go glued to a name, f(a, b)" | _ -> stray p ~after:(text_of e)); (e, 10) | LB -> @@ -572,14 +630,57 @@ and if_expr p = after %s. Write the then, or start the if on its own line with its \ branches indented under it" (text_of c)); - let a, _ = binary p 1 in + let a = inline_stmt p in match (peek p).tok with | NAME "else" -> ignore (advance p); - let b, _ = expr p in + let b = inline_stmt p in (mk p t.loc (Form.List [ sym t.loc "if"; c; a; b ]), 0) + | NAME "elif" -> + failk "one-line-elif" (peek p).loc + "a one-line if has then and else and no elif. Chain another if after \ + the else — if a then x else if b then y else z — or write the if over \ + several lines, where elif goes" | _ -> (mk p t.loc (Form.List [ sym t.loc "when"; c; a ]), 0) +(* What a one-line slot takes — a match arm's value, a then or an else, the + thing after defer: a value, or one of the statements that fit on a line, + break, continue, return and an assignment. *) +and inline_stmt p : Form.t = + let t = peek p in + let glued = let n = peek_at p 1 in n.tok = LP && not n.sp in + match t.tok with + | NAME (("break" | "continue") as w) when not glued -> + ignore (advance p); + (match (peek p).tok with + | KW k -> + let kt = advance p in + mk p t.loc (Form.List [ sym t.loc w; Form.make (Form.Kw k) kt.loc ]) + | _ -> mk p t.loc (Form.List [ sym t.loc w ])) + | NAME "return" when not glued -> + ignore (advance p); + let n = peek p in + if starts_value n.tok && not (n.tok = NAME "else") then + let v, _ = expr p in + mk p t.loc (Form.List [ sym t.loc "return"; v ]) + else mk p t.loc (Form.List [ sym t.loc "return" ]) + | _ -> + let e, _ = expr p in + match (peek p).tok with + | NAME "=" -> + let eq = advance p in + let v, _ = expr p in + mk p t.loc (Form.List [ sym eq.loc "set"; e; v ]) + | NAME op when List.mem_assoc op assign_ops -> + let eq = advance p in + let v, _ = expr p in + mk p t.loc + (Form.List + [ sym eq.loc "set"; e; + Form.make (Form.List [ sym eq.loc (List.assoc op assign_ops); e; v ]) + (span p e.loc) ]) + | _ -> e + (* [fn(a, b) = body] is a lambda; [fn(...)] followed by anything else is the fallback call spelling of [(fn ...)]. *) and fn_expr p = @@ -647,6 +748,14 @@ and items p closer open_loc ~what = (* [[a b c]] or [[a, b + 1]]: whitespace separates only single terms. *) and vec_items p open_loc = + (* One separator per bracket: [1 2, 3] mixes them, and which elements the + comma was meant to part is a guess. *) + let commas = ref false and spaces = ref false in + let mixed at = + failk "mixed-separators" at + "this bracket separates some elements with commas and some with only \ + spaces. Use one: [1, 2, 3] or [1 2 3]" + in let rec go acc prev_ws = let t = peek p in match t.tok with @@ -656,11 +765,16 @@ and vec_items p open_loc = let e, lvl = expr p in if lvl < 8 && prev_ws then refuse_ws t.loc e; (match (peek p).tok with - | COMMA -> ignore (advance p); go (e :: acc) false + | COMMA -> + if !spaces then mixed (peek p).loc; + commas := true; + ignore (advance p); go (e :: acc) false | RB -> ignore (advance p); List.rev (e :: acc) | EOF -> unclosed p '[' open_loc | tk when starts_value tk && (peek p).sp -> if lvl < 8 then refuse_ws t.loc e; + if !commas then mixed (peek p).loc; + spaces := true; go (e :: acc) true | _ -> stray p ~after:(text_of e)) in @@ -681,7 +795,7 @@ and map_items p open_loc = | RC -> ignore (advance p); List.rev (e :: acc) | EOF -> unclosed p '{' open_loc | tk when starts_value tk && (peek p).sp -> - if lvl < 8 then refuse_ws t.loc e; + if lvl < 8 then refuse_ws ~brace:true t.loc e; go (e :: acc) | _ -> stray p ~after:(text_of e)) in @@ -742,8 +856,10 @@ let header_follow p s = n.tok = NEWLINE || (n.sp && (match n.tok with KW _ -> true | _ -> false)) | "defer" -> (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok) - | "handler-case" | "handler-bind" | "restart-case" -> n.tok = NEWLINE - | "quote" -> n.tok = NEWLINE && (peek_at p 2).tok = INDENT + | "handler-case" | "handler-bind" | "restart-case" -> + n.tok = NEWLINE || (n.sp && starts_value n.tok) + | "quote" -> + (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok) | _ -> false let name_tok p ~what = @@ -769,7 +885,15 @@ let params p (lp : token) = | RP -> ignore (advance p); List.rev acc | EOF -> unclosed p '(' lp.loc | _ -> + (match t.tok with + | NAME "&" -> + failk "rest-parameter" t.loc + "a function's parameters are a fixed list of names, each with an \ + optional : Type, and & (a rest parameter) is not one. Take the rest \ + as one parameter, xs: [T]" + | _ -> ()); let n = name_tok p ~what:"a parameter's name" in + let typed = (peek p).tok = COLON in let tyf = match (peek p).tok with | COLON -> ignore (advance p); ty p @@ -778,7 +902,7 @@ let params p (lp : token) = (match (peek p).tok with | COMMA -> ignore (advance p) | RP -> () - | _ -> stray p ~after:(text_of tyf)); + | _ -> stray p ~after:(text_of (if typed then tyf else n))); go (tyf :: n :: acc) in go [] @@ -839,12 +963,25 @@ and let_stmt (s : st) : Form.t list = let p = s.p in let t = advance p in let target, _ = unary p in + (* [let x: T = v] is [(let [x (the T v)])]: a let binding has no type slot + of its own, and [the] is the form that says what a value is. *) + let annot = + match (peek p).tok with + | COLON -> ignore (advance p); Some (ty p) + | _ -> None + in (match (peek p).tok with | NAME "=" -> ignore (advance p) | _ -> failk "let-equals" (where_ p) "a let is let name = value, and %s is not followed by =" (text_of target)); let v = value_line ~block_ok:true s ~after:("let " ^ text_of target) in + let v = + match annot with + | Some tyf -> + Form.make (Form.List [ sym tyf.loc "the"; tyf; v ]) (span p tyf.loc) + | None -> v + in let make bindings body = let f = mk p t.loc @@ -901,20 +1038,23 @@ and expr_stmt (s : st) : Form.t = | COLON -> let before = (last p).tok in let c = advance p in + (* [f(x):] and, with no arguments, [comment:] — a bare name — open a + block; anything else has no call to hang it on. *) (match e.v, before with | Form.List (_ :: _), RP -> () + | Form.Sym _, NAME _ -> () | _ -> failk "colon-block" c.loc "a trailing colon gives a call an indented block, and %s is not a \ - call. Write it as one, as in %s():" - (text_of e) (text_of e)); + call. Write it as one, as in f(x): or comment:" + (text_of e)); (match (peek p).tok with | NEWLINE -> ignore (advance p) | _ -> stray p ~after:":"); let body = block s ~after:(text_of e ^ ":") in (match e.v with | Form.List items -> mk p t0.loc (Form.List (items @ body)) - | _ -> assert false) + | _ -> mk p t0.loc (Form.List (e :: body))) | _ -> (* [()] alone on a line is the empty statement, spec §2 "Unit". *) let e = @@ -1085,13 +1225,18 @@ and header (s : st) w : Form.t = (match (peek p).tok with | NAME "then" -> ignore (advance p); - let a, _ = binary p 1 in + let a = inline_stmt p in let f = match (peek p).tok with | NAME "else" -> ignore (advance p); - let b, _ = expr p in + let b = inline_stmt p in form [ c; a; b ] + | NAME "elif" -> + failk "one-line-elif" (peek p).loc + "a one-line if has then and else and no elif. Chain another if \ + after the else — if a then x else if b then y else z — or write \ + the if over several lines, where elif goes" | _ -> named "when" [ c; a ] in expect_eol p ~after:(text_of f); @@ -1104,6 +1249,12 @@ and header (s : st) w : Form.t = | NAME "elif" -> ignore (advance p); let c, _ = binary p 1 in + (match (peek p).tok with + | NAME "then" -> + failk "elif-then" (peek p).loc + "elif takes its block on the indented lines under it, with no \ + then. Put the branch on the next line, indented" + | _ -> ()); expect_line_end p ~after:("elif " ^ text_of c); let b = block s ~after:"elif" in elifs ((c, b) :: acc) @@ -1187,7 +1338,7 @@ and header (s : st) w : Form.t = ignore (advance p); form (block s ~after:"defer") | _ -> - let e, _ = expr p in + let e = inline_stmt p in expect_eol p ~after:(text_of e); form [ e ]) | "match" -> @@ -1203,7 +1354,7 @@ and header (s : st) w : Form.t = blk s nl.loc (block s ~after:"->") end else begin - let e, _ = expr p in + let e = inline_stmt p in expect_eol p ~after:(text_of e); e end @@ -1212,7 +1363,7 @@ and header (s : st) w : Form.t = in form (scrut :: arms) | "handler-case" | "handler-bind" -> - expect_line_end p ~after:w; + clause_header_end p w; let body = block s ~after:w in let rec clauses acc = match (peek p).tok, (peek_at p 1) with @@ -1227,7 +1378,7 @@ and header (s : st) w : Form.t = "a handler clause is on Type(name), naming the condition type \ and the name it is bound to, as in on FileError(c)" in - expect_line_end p ~after:("on " ^ text_of head); + clause_end p ("on " ^ text_of ty ^ "(" ^ text_of var ^ ")"); let b = block s ~after:"on" in let c = mk p ot.loc @@ -1241,7 +1392,7 @@ and header (s : st) w : Form.t = if w = "handler-case" then form [ blk s l0 body; vec ] else form (vec :: body) | "restart-case" -> - expect_line_end p ~after:w; + clause_header_end p w; let body = block s ~after:w in let rec clauses acc = match (peek p).tok, (peek_at p 1) with @@ -1250,7 +1401,7 @@ and header (s : st) w : Form.t = let name = name_tok p ~what:"the restart's name" in let lp = glued_lp p ~what:"the restart's parameters in parentheses" in let ps = params p lp in - expect_line_end p ~after:("restart " ^ text_of name); + clause_end p ("restart " ^ text_of name ^ "(...)"); let b = block s ~after:"restart" in let c = mk p name.loc (Form.List (name :: Form.make (Form.Vec ps) lp.loc :: b)) @@ -1261,11 +1412,39 @@ and header (s : st) w : Form.t = let cs = clauses [] in form (blk s l0 body :: cs) | "quote" -> - expect_line_end p ~after:"quote"; - let body = block s ~after:"quote" in - named "quasiquote" [ blk s l0 body ] + (* One line, [quote ~x + 1], is the quasiquote of that expression. *) + (match (peek p).tok with + | NEWLINE -> + ignore (advance p); + let body = block s ~after:"quote" in + named "quasiquote" [ blk s l0 body ] + | _ -> + let e, _ = expr p in + expect_eol p ~after:(text_of e); + named "quasiquote" [ e ]) | _ -> assert false +(* handler-case, handler-bind and restart-case take nothing on their own line. *) +and clause_header_end p w = + match (peek p).tok with + | NEWLINE -> ignore (advance p) + | _ -> + failk "clause-header" (peek p).loc + "%s takes its body on the indented lines under it, and its %s clauses \ + at its own column after that, each with its block under it:\n\ + %s\n body\n%s" + w (if w = "restart-case" then "restart" else "on") w + (if w = "restart-case" then "restart name()\n value" else "on Type(c)\n value") + +and clause_end p head = + match (peek p).tok with + | NEWLINE -> ignore (advance p) + | _ -> + failk "clause-body" (peek p).loc + "the body of %s goes on the indented lines under it, not on its line. \ + Move it to the next line, indented" + head + (* The end of a header line whose block must follow. *) and expect_line_end p ~after = match (peek p).tok with diff --git a/lib/load.ml b/lib/load.ml index 3df71271..70bb75cb 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -1215,6 +1215,20 @@ let rec import ~seen ~open_ ~loc alias dir = let one_file = is_package_file dir in let files = if one_file then [ dir ] else source_entries dir in if files = [] then fail loc "the package at %s has no .flan or .fln file" dir; + (* geo.flan beside geo.fln is one file written twice — a conversion that + kept its original — and loading both would report every definition in + it as defined twice, pointing at neither file as the cause. *) + List.iter + (fun f -> + if Filename.check_suffix f Source.paren_ext then + let twin = Filename.remove_extension f ^ Source.indented_ext in + if List.mem twin files then + fail loc + "the package at %s has both %s and %s. They are one file in two \ + syntaxes, and a package reads every source file it has, so \ + keep one of them" + dir (Filename.basename f) (Filename.basename twin)) + files; (* Read once. The forms are wanted twice — for the imports below and for the macros at the end — and reading a file twice is the kind of second opinion this module spends its comments warning about. *) diff --git a/spec-syntax.md b/spec-syntax.md index e4d50942..2fb6c31d 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -120,7 +120,8 @@ Each item: the proposal, then the reason in one line. operator (`+`, `and`, `==`, …) continues the previous line; so does a line after one that ends in a spaced infix operator. (F# `LexFilter.fs` 360-380, 1850-1870, 2345-2360.) No `\` continuation. **Built** (`=` does not - continue: `let x =` plus a block is a block value). + continue: `let x =` plus a block is a block value). A continuation line must + sit deeper than the line it continues; one that does not is refused. - **Minus.** `-` glued to a digit is a negative literal (`-1`; 269 in the corpus). `-` glued to a name is negation (`-x` becomes `(- x)`; no name starts with `-` except two prelude sentinels, `lib/prelude.ml:2280,2285`, which @@ -190,6 +191,8 @@ Each item: the proposal, then the reason in one line. `for :outer i in range(n)`). - **`return v`, `break`, `break :outer`, `continue`, `defer expr`** (or `defer` plus a block). **Built**; `defer` plus a block reads `(defer a b …)`. + `break`, `continue`, `return v` and `x = v`/`x += v` also fit the one-line + slots: a match arm's value, `then`/`else`, and after `defer`. - **`match`:** ``` @@ -250,7 +253,8 @@ plus an indented block, reads as `(head arg … block…)`. Commas vanish into t `(defmethod describe :square [s] …)`. So every form is reachable on day one, the printer has something to fall back on, and the sugar above can land one piece at a time. **Built**; a header word glued to `(` is always this call, -`if(c, a)`, `let([x 1], x)`. +`if(c, a)`, `let([x 1], x)`. A bare name with a trailing colon takes a block too, +`comment:` (author's decision 85). ### Types diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 54fb145a..bc80d076 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -115,7 +115,8 @@ let () = match Reader.read_file path with | exception Loc.Error _ -> () (* not a program the paren reader takes *) | forms -> - match Indent_printer.program forms with + let source = In_channel.with_open_bin path In_channel.input_all in + match Indent_printer.program ~source 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 -> @@ -205,10 +206,19 @@ let () = 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" "x:\n y" "indent/colon-block" "x():"; + 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" "column 3"; + 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. *) @@ -248,7 +258,80 @@ let () = "(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 "read-only pointer" "def p: Ptr(const u8) = uninit" "(def p (Ptr const u8) uninit)" + reads "read-only pointer" "def 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" "x == ..."; + 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 "typed let" "let x: i32 = 5\nx" "(let [x (the i32 5)] x)"; + (* And back: the printer writes the idioms. *) + let prints name src want = + match Reader.read_all ~file:"

" src with + | forms -> + let got = Indent_printer.program ~source:src forms in + if not (Test_support.contains got want) then + fail "%s: printed %S, wanted it to contain %S" name got want + | exception e -> fail "%s: %s" name (diag_text e) + in + prints "compound assignment" "(defn f [] () (set x (+ x 1)))" " x += 1"; + prints "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"; + 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" + +(* ── 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) (* ── Both directions of an import, on both backends ────────────────── *)