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
This commit is contained in:
parent
82b02b6584
commit
074b2da6f3
@ -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
|
||||
|
||||
26
lib/check.ml
26
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -159,6 +159,23 @@ 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)) ->
|
||||
(* [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 ()
|
||||
@ -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";
|
||||
(* 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
|
||||
|
||||
14
lib/load.ml
14
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. *)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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:"<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 ────────────────── *)
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user