JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The indented reader refuses a continuation line that is not deeper than its statement, takes one-line statements in arms, then/else and defer, typed lets and bare-name blocks, and names the shape it wanted where it used to say two values cannot sit side by side

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 15:30:52 +07:00
parent 82b02b6584
commit 074b2da6f3
7 changed files with 475 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
bin/main.ml
View File

@ -338,7 +338,8 @@ let () =
(String.concat "\n\n" (List.map (fun f -> Flan.Form.pretty f) forms) (String.concat "\n\n" (List.map (fun f -> Flan.Form.pretty f) forms)
^ "\n") ^ "\n")
else 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 | text -> print_string text
| exception Flan.Indent_printer.Unprintable (f, why) -> | exception Flan.Indent_printer.Unprintable (f, why) ->
Flan.Loc.failk "convert/unprintable" f.Flan.Form.loc Flan.Loc.failk "convert/unprintable" f.Flan.Form.loc

26
lib/check.ml
View File

@ -7144,6 +7144,32 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a =
(match no_such_rand name with (match no_such_rand name with
| Some msg -> Loc.failk "check/unknown-name" loc "%s" msg | Some msg -> Loc.failk "check/unknown-name" loc "%s" msg
| None -> ()); | 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 dot = String.index_opt name '.' in
let head, field = let head, field =
match dot with match dot with

154
lib/indent_printer.ml
View File

@ -50,6 +50,18 @@ let def_name s = name_ok s && s.[0] <> '.'
let paren s = "(" ^ s ^ ")" 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 let is_sym s (f : Form.t) = match f.v with Form.Sym x -> x = s | _ -> false
(* ── Expressions ───────────────────────────────────────────────────── *) (* ── Expressions ───────────────────────────────────────────────────── *)
@ -62,10 +74,12 @@ let rec expr (f : Form.t) : string * int =
| Form.Sym s -> sym f s | Form.Sym s -> sym f s
| Form.Kw k -> | Form.Kw k ->
if kw_ok k then (":" ^ k, 10) else unprintable f "a keyword with no spelling" 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.UInt (_, s) -> (s, 10)
| Form.Float x -> | 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 if not (Reader.is_digit s.[0] || (s.[0] = '-' && String.length s > 1
&& Reader.is_digit s.[1])) && Reader.is_digit s.[1]))
then unprintable f "a float with no literal"; 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 -> | Form.Sym "fn", [ { v = Form.Vec ps; _ }; body ] when List.for_all sym_param ps ->
("fn(" ^ commas ps ^ ") = " ^ at 0 body, 0) ("fn(" ^ commas ps ^ ") = " ^ at 0 body, 0)
| Form.Sym "if", [ c; a; b ] -> | 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 () | _ -> 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) = and sym_param (p : Form.t) =
match p.v with Form.Sym s -> name_ok s | _ -> false 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 | "unless" | "loop" -> Some 1
| "defmacro" -> Some 2 | "defmacro" -> Some 2
| "defmethod" -> Some 3 | "defmethod" -> Some 3
| _ when String.length base > 5 && String.sub base 0 5 = "with-" -> | _ ->
let rec leading n = function (* A with- macro, or any call whose last argument is a statement —
| ({ Form.v = Form.List _; _ }) :: _ -> n a let, a loop, an assignment — has a body: the trailing run of
| _ :: rest -> leading (n + 1) rest lists goes in the block. *)
| [] -> n 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 in
ignore lead; ignore lead;
Some (leading 0 args) if is_with || last_stmt then begin
| _ -> None) 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 | _ -> None
let sugar_heads = let sugar_heads =
@ -297,7 +350,14 @@ and plain n (f : Form.t) : string list =
| Some k when k < List.length args -> | Some k when k < List.length args ->
let fixed = List.filteri (fun i _ -> i < k) args in let fixed = List.filteri (fun i _ -> i < k) args in
let rest = 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 -> | _ when n + String.length text > width && fst (expr f) = text ->
wrapped n "" f wrapped n "" f
| _ -> one) | _ -> one)
@ -342,7 +402,13 @@ and wrapped n prefix (f : Form.t) =
too long for the line. *) too long for the line. *)
and value_lines n prefix (v : Form.t) = and value_lines n prefix (v : Form.t) =
let inline = prefix ^ " = " ^ at 0 v in 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 else
match v.v with match v.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body)) | 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 | None | Some [] -> None
| Some prs -> Some (let_lines n ~last prs body)) | Some prs -> Some (let_lines n ~last prs body))
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> | 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 ] -> | Form.List [ { v = Form.Sym "if"; _ }; c; a; b ] ->
let simple (x : Form.t) = let simple (x : Form.t) =
match x.v with 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) | Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads)
| _ -> true | _ -> true
in in
@ -422,7 +491,7 @@ and sugar n ~last (f : Form.t) : string list option =
when kw_ok k -> when kw_ok k ->
Some [ i ^ w ^ " :" ^ k ] Some [ i ^ w ^ " :" ^ k ]
| Form.List [ { v = Form.Sym "defer"; _ }; x ] -> | 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 ] if String.length line <= width then Some [ line ]
else Some ((i ^ "defer") :: block (n + 2) [ x ]) else Some ((i ^ "defer") :: block (n + 2) [ x ])
| Form.List ({ v = Form.Sym "defer"; _ } :: (_ :: _ :: _ as body)) -> | 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 :: List.concat_map
(fun (pat, body) -> (fun (pat, body) ->
let pt = at 8 pat in 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 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 -> | Form.List (_ :: _) when String.length line > width ->
(ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body (ind (n + 2) ^ pt ^ " ->") :: slot (n + 4) body
| _ -> [ line ]) | _ -> [ line ])
@ -576,22 +647,61 @@ and handler_clauses n cls =
One with siblings after it takes its body as an indented block under the 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. *) first binding, and the rest of the bindings go inside that block. *)
and let_lines n ~last prs body = 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 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 else
match prs with match prs with
| (t, v) :: rest -> | b :: rest ->
(ind n ^ target t ^ " = " ^ at 0 v) let p, v = bind b in
:: (List.concat_map (fun (t, v) -> value_lines (n + 2) (target t) v) rest (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 + 2) body)
| [] -> block n body | [] -> block n body
(** A whole file: top-level forms with a blank line between them. *) (** 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 let rec go = function
| [] -> [] | [] -> []
| [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ] | [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ]
| x :: rest -> String.concat "\n" (stmt 0 ~last:false x) :: go rest | x :: rest -> String.concat "\n" (stmt 0 ~last:false x) :: go rest
in 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

237
lib/indent_reader.ml
View File

@ -159,8 +159,25 @@ let lex ~file src : token list =
else emit UNQ (Loc.upto l0 (Reader.here st)) else emit UNQ (Loc.upto l0 (Reader.here st))
| c when Reader.is_digit c | c when Reader.is_digit c
|| ((c = '-' || c = '+') && Reader.is_digit (Reader.peek2 st)) -> || ((c = '-' || c = '+') && Reader.is_digit (Reader.peek2 st)) ->
let f = Reader.read_number st in (* [while x < 3:] — the colon is a mistake the parser explains, and not
emit (ATOM f.v) f.loc 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 () | _ -> name_run ()
in in
let rec go () = let rec go () =
@ -224,6 +241,27 @@ let layout ?(base = 1) (toks : token list) : token array =
&& arr.(i + 1).sp && arr.(i + 1).sp
in in
let continues = (binop p && p.sp) || (binop t && spaced_after) 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 if not continues then begin
let at = point p.loc in let at = point p.loc in
add NEWLINE at; add NEWLINE at;
@ -234,19 +272,21 @@ let layout ?(base = 1) (toks : token list) : token array =
add INDENT at add INDENT at
end end
else if col < top then begin else if col < top then begin
let closed = ref top in
let rec pop () = let rec pop () =
match !stack with match !stack with
| top :: (_ :: _ as rest) when col < top -> | top :: (_ :: _ as rest) when col < top ->
stack := rest; add DEDENT at; pop () closed := top; stack := rest; add DEDENT at; pop ()
| _ -> () | _ -> ()
in in
pop (); pop ();
if col <> List.hd !stack then if col <> List.hd !stack then
failk "dedent" t.loc failk "dedent" t.loc
"this line starts at column %d, which is not where any \ "this line starts at column %d, between the block at column \
enclosing block starts — those start at column%s %s. Line \ %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" it up with one of them"
col col (List.hd !stack) !closed
(if List.length !stack > 1 then "s" else "") (if List.length !stack > 1 then "s" else "")
(String.concat ", " (String.concat ", "
(List.rev_map string_of_int !stack)) (List.rev_map string_of_int !stack))
@ -338,6 +378,17 @@ let stray p ~after =
| NEWLINE | INDENT | DEDENT | EOF -> | NEWLINE | INDENT | DEDENT | EOF ->
failk "unexpected-end" (where_ p) "the line ends after %s, which is not \ failk "unexpected-end" (where_ p) "the line ends after %s, which is not \
finished here" after 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 failk "unexpected-token" t.loc
"%s follows %s, and two values cannot sit side by side here. Separate \ "%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" ] ~notes:[ Loc.note (where_ p) "the input ends here, still inside it" ]
"unclosed %C" c "unclosed %C" c
let refuse_ws loc e = let refuse_ws ?(brace = false) loc e =
failk "separate-elements" loc failk "separate-elements" loc
"%s has an operator in it and sits in a list separated by spaces, where \ "%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) (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, (* 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 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 (match (peek p).tok with
| RP -> ignore (advance p) | RP -> ignore (advance p)
| EOF -> unclosed p '(' l0 | 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)); | _ -> stray p ~after:(text_of e));
(e, 10) (e, 10)
| LB -> | LB ->
@ -572,14 +630,57 @@ and if_expr p =
after %s. Write the then, or start the if on its own line with its \ after %s. Write the then, or start the if on its own line with its \
branches indented under it" branches indented under it"
(text_of c)); (text_of c));
let a, _ = binary p 1 in let a = inline_stmt p in
match (peek p).tok with match (peek p).tok with
| NAME "else" -> | NAME "else" ->
ignore (advance p); 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) (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) | _ -> (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 (* [fn(a, b) = body] is a lambda; [fn(...)] followed by anything else is the
fallback call spelling of [(fn ...)]. *) fallback call spelling of [(fn ...)]. *)
and fn_expr p = 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. *) (* [[a b c]] or [[a, b + 1]]: whitespace separates only single terms. *)
and vec_items p open_loc = 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 rec go acc prev_ws =
let t = peek p in let t = peek p in
match t.tok with match t.tok with
@ -656,11 +765,16 @@ and vec_items p open_loc =
let e, lvl = expr p in let e, lvl = expr p in
if lvl < 8 && prev_ws then refuse_ws t.loc e; if lvl < 8 && prev_ws then refuse_ws t.loc e;
(match (peek p).tok with (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) | RB -> ignore (advance p); List.rev (e :: acc)
| EOF -> unclosed p '[' open_loc | EOF -> unclosed p '[' open_loc
| tk when starts_value tk && (peek p).sp -> | tk when starts_value tk && (peek p).sp ->
if lvl < 8 then refuse_ws t.loc e; if lvl < 8 then refuse_ws t.loc e;
if !commas then mixed (peek p).loc;
spaces := true;
go (e :: acc) true go (e :: acc) true
| _ -> stray p ~after:(text_of e)) | _ -> stray p ~after:(text_of e))
in in
@ -681,7 +795,7 @@ and map_items p open_loc =
| RC -> ignore (advance p); List.rev (e :: acc) | RC -> ignore (advance p); List.rev (e :: acc)
| EOF -> unclosed p '{' open_loc | EOF -> unclosed p '{' open_loc
| tk when starts_value tk && (peek p).sp -> | 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) go (e :: acc)
| _ -> stray p ~after:(text_of e)) | _ -> stray p ~after:(text_of e))
in in
@ -742,8 +856,10 @@ let header_follow p s =
n.tok = NEWLINE || (n.sp && (match n.tok with KW _ -> true | _ -> false)) n.tok = NEWLINE || (n.sp && (match n.tok with KW _ -> true | _ -> false))
| "defer" -> | "defer" ->
(n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok) (n.tok = NEWLINE && (peek_at p 2).tok = INDENT) || (n.sp && starts_value n.tok)
| "handler-case" | "handler-bind" | "restart-case" -> n.tok = NEWLINE | "handler-case" | "handler-bind" | "restart-case" ->
| "quote" -> n.tok = NEWLINE && (peek_at p 2).tok = INDENT 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 | _ -> false
let name_tok p ~what = let name_tok p ~what =
@ -769,7 +885,15 @@ let params p (lp : token) =
| RP -> ignore (advance p); List.rev acc | RP -> ignore (advance p); List.rev acc
| EOF -> unclosed p '(' lp.loc | 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 n = name_tok p ~what:"a parameter's name" in
let typed = (peek p).tok = COLON in
let tyf = let tyf =
match (peek p).tok with match (peek p).tok with
| COLON -> ignore (advance p); ty p | COLON -> ignore (advance p); ty p
@ -778,7 +902,7 @@ let params p (lp : token) =
(match (peek p).tok with (match (peek p).tok with
| COMMA -> ignore (advance p) | COMMA -> ignore (advance p)
| RP -> () | RP -> ()
| _ -> stray p ~after:(text_of tyf)); | _ -> stray p ~after:(text_of (if typed then tyf else n)));
go (tyf :: n :: acc) go (tyf :: n :: acc)
in in
go [] go []
@ -839,12 +963,25 @@ and let_stmt (s : st) : Form.t list =
let p = s.p in let p = s.p in
let t = advance p in let t = advance p in
let target, _ = unary 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 (match (peek p).tok with
| NAME "=" -> ignore (advance p) | NAME "=" -> ignore (advance p)
| _ -> | _ ->
failk "let-equals" (where_ p) failk "let-equals" (where_ p)
"a let is let name = value, and %s is not followed by =" (text_of target)); "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 = 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 make bindings body =
let f = let f =
mk p t.loc mk p t.loc
@ -901,20 +1038,23 @@ and expr_stmt (s : st) : Form.t =
| COLON -> | COLON ->
let before = (last p).tok in let before = (last p).tok in
let c = advance p 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 (match e.v, before with
| Form.List (_ :: _), RP -> () | Form.List (_ :: _), RP -> ()
| Form.Sym _, NAME _ -> ()
| _ -> | _ ->
failk "colon-block" c.loc failk "colon-block" c.loc
"a trailing colon gives a call an indented block, and %s is not a \ "a trailing colon gives a call an indented block, and %s is not a \
call. Write it as one, as in %s():" call. Write it as one, as in f(x): or comment:"
(text_of e) (text_of e)); (text_of e));
(match (peek p).tok with (match (peek p).tok with
| NEWLINE -> ignore (advance p) | NEWLINE -> ignore (advance p)
| _ -> stray p ~after:":"); | _ -> stray p ~after:":");
let body = block s ~after:(text_of e ^ ":") in let body = block s ~after:(text_of e ^ ":") in
(match e.v with (match e.v with
| Form.List items -> mk p t0.loc (Form.List (items @ body)) | 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". *) (* [()] alone on a line is the empty statement, spec §2 "Unit". *)
let e = let e =
@ -1085,13 +1225,18 @@ and header (s : st) w : Form.t =
(match (peek p).tok with (match (peek p).tok with
| NAME "then" -> | NAME "then" ->
ignore (advance p); ignore (advance p);
let a, _ = binary p 1 in let a = inline_stmt p in
let f = let f =
match (peek p).tok with match (peek p).tok with
| NAME "else" -> | NAME "else" ->
ignore (advance p); ignore (advance p);
let b, _ = expr p in let b = inline_stmt p in
form [ c; a; b ] 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 ] | _ -> named "when" [ c; a ]
in in
expect_eol p ~after:(text_of f); expect_eol p ~after:(text_of f);
@ -1104,6 +1249,12 @@ and header (s : st) w : Form.t =
| NAME "elif" -> | NAME "elif" ->
ignore (advance p); ignore (advance p);
let c, _ = binary p 1 in 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); expect_line_end p ~after:("elif " ^ text_of c);
let b = block s ~after:"elif" in let b = block s ~after:"elif" in
elifs ((c, b) :: acc) elifs ((c, b) :: acc)
@ -1187,7 +1338,7 @@ and header (s : st) w : Form.t =
ignore (advance p); ignore (advance p);
form (block s ~after:"defer") form (block s ~after:"defer")
| _ -> | _ ->
let e, _ = expr p in let e = inline_stmt p in
expect_eol p ~after:(text_of e); expect_eol p ~after:(text_of e);
form [ e ]) form [ e ])
| "match" -> | "match" ->
@ -1203,7 +1354,7 @@ and header (s : st) w : Form.t =
blk s nl.loc (block s ~after:"->") blk s nl.loc (block s ~after:"->")
end end
else begin else begin
let e, _ = expr p in let e = inline_stmt p in
expect_eol p ~after:(text_of e); expect_eol p ~after:(text_of e);
e e
end end
@ -1212,7 +1363,7 @@ and header (s : st) w : Form.t =
in in
form (scrut :: arms) form (scrut :: arms)
| "handler-case" | "handler-bind" -> | "handler-case" | "handler-bind" ->
expect_line_end p ~after:w; clause_header_end p w;
let body = block s ~after:w in let body = block s ~after:w in
let rec clauses acc = let rec clauses acc =
match (peek p).tok, (peek_at p 1) with 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 \ "a handler clause is on Type(name), naming the condition type \
and the name it is bound to, as in on FileError(c)" and the name it is bound to, as in on FileError(c)"
in 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 b = block s ~after:"on" in
let c = let c =
mk p ot.loc 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 ] if w = "handler-case" then form [ blk s l0 body; vec ]
else form (vec :: body) else form (vec :: body)
| "restart-case" -> | "restart-case" ->
expect_line_end p ~after:w; clause_header_end p w;
let body = block s ~after:w in let body = block s ~after:w in
let rec clauses acc = let rec clauses acc =
match (peek p).tok, (peek_at p 1) with 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 name = name_tok p ~what:"the restart's name" in
let lp = glued_lp p ~what:"the restart's parameters in parentheses" in let lp = glued_lp p ~what:"the restart's parameters in parentheses" in
let ps = params p lp 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 b = block s ~after:"restart" in
let c = let c =
mk p name.loc (Form.List (name :: Form.make (Form.Vec ps) lp.loc :: b)) 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 let cs = clauses [] in
form (blk s l0 body :: cs) form (blk s l0 body :: cs)
| "quote" -> | "quote" ->
expect_line_end p ~after:"quote"; (* One line, [quote ~x + 1], is the quasiquote of that expression. *)
let body = block s ~after:"quote" in (match (peek p).tok with
named "quasiquote" [ blk s l0 body ] | 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 | _ -> 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. *) (* The end of a header line whose block must follow. *)
and expect_line_end p ~after = and expect_line_end p ~after =
match (peek p).tok with match (peek p).tok with

14
lib/load.ml
View File

@ -1215,6 +1215,20 @@ let rec import ~seen ~open_ ~loc alias dir =
let one_file = is_package_file dir in let one_file = is_package_file dir in
let files = if one_file then [ dir ] else source_entries 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; 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 (* 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 the macros at the end — and reading a file twice is the kind of second
opinion this module spends its comments warning about. *) opinion this module spends its comments warning about. *)

8
spec-syntax.md
View File

@ -120,7 +120,8 @@ Each item: the proposal, then the reason in one line.
operator (`+`, `and`, `==`, …) continues the previous line; so does a 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, after one that ends in a spaced infix operator. (F# `LexFilter.fs` 360-380,
1850-1870, 2345-2360.) No `\` continuation. **Built** (`=` does not 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 - **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 corpus). `-` glued to a name is negation (`-x` becomes `(- x)`; no name starts
with `-` except two prelude sentinels, `lib/prelude.ml:2280,2285`, which 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)`). `for :outer i in range(n)`).
- **`return v`, `break`, `break :outer`, `continue`, `defer expr`** (or `defer` - **`return v`, `break`, `break :outer`, `continue`, `defer expr`** (or `defer`
plus a block). **Built**; `defer` plus a block reads `(defer a b …)`. 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`:** - **`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, `(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 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, 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 ### Types

91
test/test_syntax.ml
View File

@ -115,7 +115,8 @@ let () =
match Reader.read_file path with match Reader.read_file path with
| exception Loc.Error _ -> () (* not a program the paren reader takes *) | exception Loc.Error _ -> () (* not a program the paren reader takes *)
| forms -> | 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) -> | exception Indent_printer.Unprintable (f, why) ->
fail "round trip %s: %s at %d:%d" path why f.loc.Loc.line f.loc.Loc.col fail "round trip %s: %s at %d:%d" path why f.loc.Loc.line f.loc.Loc.col
| text -> | text ->
@ -205,10 +206,19 @@ let () =
reads "fallback with a block" "defmethod(describe, :square, [s]):\n s" reads "fallback with a block" "defmethod(describe, :square, [s]):\n s"
"(defmethod describe :square [s] s)"; "(defmethod describe :square [s] s)";
refuses "block without the colon" "f(x)\n y" "indent/stray-indent" "trailing colon"; 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. *) (* Indentation. *)
refuses "tab" "fn f() -> ()\n\tg()" "indent/tab" "spaces"; 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" reads "blank and comment lines" "if a\n\n ; note\n b\n\n; more\nc"
"(when a b)\nc"; "(when a b)\nc";
(* Continuation lines. *) (* Continuation lines. *)
@ -248,7 +258,80 @@ let () =
"(defdata Shape [(Circle [r f32]) Empty])"; "(defdata Shape [(Circle [r f32]) Empty])";
reads "enum" "enum K\n lo = -1\n mid" "(defenum K [lo -1 mid])"; 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" "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:"<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 "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 ────────────────── *) (* ── Both directions of an import, on both backends ────────────────── *)