A .fln lambda's body follows =>, and a lambda's block may sit inside a call's brackets as its last argument

This commit is contained in:
Joseph Ferano 2026-09-26 05:17:31 +07:00
parent 7d898beb91
commit 3c962197f4
7 changed files with 362 additions and 149 deletions

View File

@ -6483,7 +6483,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
"nothing here says what this fn's parameters are — an fn takes \ "nothing here says what this fn's parameters are — an fn takes \
its types from the position it is written in. Pass it where a \ its types from the position it is written in. Pass it where a \
Fn(T, ...) -> R is expected, or name the type where it is \ Fn(T, ...) -> R is expected, or name the type where it is \
bound: let f: Fn(T, ...) -> R = fn(...)" bound: let f: Fn(T, ...) -> R = fn(...) => ..."
else else
fail loc fail loc
"nothing here says what this fn's parameters are — an fn takes \ "nothing here says what this fn's parameters are — an fn takes \
@ -8636,7 +8636,7 @@ and array_build ctx loc ns elem ~pre ~element =
[n T] the literal is, since an array literal is never a slice. *) [n T] the literal is, since an array literal is never a slice. *)
and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) = and check_the ctx ~want loc (t : Ast.texpr) (v : Ast.expr) =
let ty = resolve ctx.env t in let ty = resolve ctx.env t in
(* A typed .fln lambda, [fn(c: C) -> bool = ...], reads as [(the (Fn [C] (* A typed .fln lambda, [fn(c: C) -> bool => ...], reads as [(the (Fn [C]
bool) (fn ...))]; where a CFn of the same signature is wanted, the bool) (fn ...))]; where a CFn of the same signature is wanted, the
literal is that CFn, as an untyped one would be. *) literal is that CFn, as an untyped one would be. *)
let ty = let ty =

View File

@ -420,10 +420,10 @@ and list f h args =
(s ^ fst (expr m), 9) (s ^ fst (expr m), 9)
| Form.Sym "the", _ when (match typed_lambda f with Some (_, [ _ ]) -> true | _ -> false) -> | Form.Sym "the", _ when (match typed_lambda f with Some (_, [ _ ]) -> true | _ -> false) ->
(match typed_lambda f with (match typed_lambda f with
| Some (head, [ body ]) -> (head ^ " = " ^ unit_text body, 0) | Some (head, [ body ]) -> (head ^ " => " ^ unit_text body, 0)
| _ -> assert false) | _ -> assert false)
| 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 ^ ") = " ^ unit_text body, 0) ("fn(" ^ commas ps ^ ") => " ^ unit_text body, 0)
| Form.Sym "if", [ c; a; b ] -> | Form.Sym "if", [ c; a; b ] ->
("if " ^ at 1 c ^ " then " ^ inline_text ~lvl:1 a ^ " else " ^ inline_text b, 0) ("if " ^ at 1 c ^ " then " ^ inline_text ~lvl:1 a ^ " else " ^ inline_text b, 0)
| _ -> call () | _ -> call ()
@ -703,6 +703,7 @@ and plain n (f : Form.t) : string list =
| _ -> head_text h ^ "(" ^ commas fixed ^ "):" | _ -> head_text h ^ "(" ^ commas fixed ^ "):"
in in
[ ind n ^ guard opener ] @ block ~seq (n + 2) rest [ ind n ^ guard opener ] @ block ~seq (n + 2) rest
| _ when call_lambda n "" f <> None -> Option.get (call_lambda n "" f)
| _ 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)
@ -761,6 +762,71 @@ and wrapped n prefix (f : Form.t) =
go (ind n ^ open_) [] ts go (ind n ^ open_) [] ts
| _ -> [ ind n ^ prefix ^ at 0 f ] | _ -> [ ind n ^ prefix ^ at 0 f ]
(* A lambda as its header, [fn(a, b)] or [fn(a: C) -> R], and its body. *)
and lambda_parts (f : Form.t) =
match typed_lambda f with
| Some _ as l -> l
| None ->
match f.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body))
when List.for_all sym_param ps ->
Some ("fn(" ^ commas ps ^ ")", body)
| _ -> None
(* A lambda body that reads better as a block under [=>] than on the line:
several statements, or one that is a statement. *)
and block_body (body : Form.t list) =
match body with
| [ { v = Form.List ({ v = Form.Sym h; _ } :: _); _ } ] ->
List.mem h sugar_heads && h <> "if" && h <> "update"
| [ _ ] -> false
| _ -> true
(* A call whose last argument is a lambda with a block, as the reader takes
one inside brackets: [prefix f(a, fn(x) =>], the block under it, and the
[)] at the end of its last line, which ends the block. Only the last
argument: a block ends where its brackets close. *)
and call_lambda n prefix (f : Form.t) =
match f.v with
| Form.List (h :: (_ :: _ as args))
when typed_lambda f = None
&& (match h.v with
| Form.Sym ("at" | "quote" | "unquote" | "unquote-splicing" | "quasiquote") -> false
| Form.Sym s -> not (R.is_op_word s) && not (String.length s > 1 && s.[0] = '.')
| _ -> false) ->
let k = List.length args - 1 in
let last = List.nth args k in
let fixed = List.filteri (fun i _ -> i < k) args in
let lead =
prefix ^ head_text h ^ "("
^ String.concat "" (List.map (fun t -> t ^ ", ") (comma_items fixed))
in
let close ls =
match List.rev ls with
| l :: rest -> List.rev ((l ^ ")") :: rest)
| [] -> ls
in
(match lambda_parts last with
| Some (head, body)
when block_body body || !inside last
|| n + String.length prefix + String.length (fst (expr f)) > width ->
Some ((ind n ^ lead ^ head ^ " =>") :: close (block (n + 2) body))
| Some _ -> None
(* [f(g(x, fn(a) =>] and the block: the one [)] after it closes
both calls. *)
| None -> Option.map close (call_lambda n lead last))
| _ -> None
(* [prefix = fn(a) =>] or [prefix = f(x, fn(a) =>] and a lambda's block,
when the value is a lambda that takes one or a call that ends in one. *)
and lambda_value n prefix (v : Form.t) =
match lambda_parts v with
| Some (head, body)
when block_body body || !inside v
|| n + String.length prefix + 3 + String.length (fst (expr v)) > width ->
Some ([ ind n ^ prefix ^ " = " ^ head ^ " =>" ] @ block (n + 2) body)
| _ -> call_lambda n (prefix ^ " = ") v
(* [prefix = v], or [prefix =] and the value as an indented block when it is (* [prefix = v], or [prefix =] and the value as an indented block when it is
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) =
@ -771,15 +837,13 @@ and value_lines n prefix (v : Form.t) =
| _ -> false | _ -> false
in in
if is_do then [ ind n ^ prefix ^ " =" ] @ block (n + 2) (stmts_of v) 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 lambda_value n prefix v with
| Some ls -> ls
| None ->
if n + String.length inline <= width then [ ind n ^ inline ]
else else
match v.v with match v.v with
| _ when typed_lambda v <> None ->
let head, body = Option.get (typed_lambda v) in
[ ind n ^ prefix ^ " = " ^ head ] @ block (n + 2) body
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ as body))
when List.for_all sym_param ps ->
[ ind n ^ prefix ^ " = fn(" ^ commas ps ^ ")" ] @ block (n + 2) body
| Form.List ({ v = Form.Sym h; _ } :: _) | Form.List ({ v = Form.Sym h; _ } :: _)
when not (List.mem h sugar_heads || h = "fn" || h = "if") -> when not (List.mem h sugar_heads || h = "fn" || h = "if") ->
wrapped n (prefix ^ " = ") v wrapped n (prefix ^ " = ") v
@ -805,7 +869,8 @@ and sugar n (f : Form.t) : string list option =
Some [ i ^ guard (inline_text f) ] Some [ i ^ guard (inline_text f) ]
| Form.List [ { v = Form.Sym "set"; _ }; t; v ] -> | Form.List [ { v = Form.Sym "set"; _ }; t; v ] ->
let line = i ^ guard (assign_text t v) in let line = i ^ guard (assign_text t v) in
if String.length line <= width then Some [ line ] if String.length line <= width && lambda_value n (guard (at 9 t)) v = None
then Some [ line ]
else Some (value_lines n (guard (at 9 t)) v) 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) =
@ -939,9 +1004,9 @@ and sugar n (f : Form.t) : string list option =
@ List.concat_map Option.get cs) @ List.concat_map Option.get cs)
| Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] -> | Form.List [ { v = Form.Sym "quasiquote"; _ }; x ] ->
Some ((i ^ "quote") :: slot (n + 2) x) Some ((i ^ "quote") :: slot (n + 2) x)
| Form.List ({ v = Form.Sym "fn"; _ } :: { v = Form.Vec ps; _ } :: (_ :: _ :: _ as body)) | _ when (match lambda_parts f with Some (_, body) -> block_body body | None -> false) ->
when List.for_all sym_param ps -> let head, body = Option.get (lambda_parts f) in
Some ((guard (i ^ "fn(" ^ commas ps ^ ")")) :: block (n + 2) body) Some ((i ^ head ^ " =>") :: block (n + 2) body)
| Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ } | Form.List ({ v = Form.Sym (("defn" | "defn-") as d); _ } :: { v = Form.Sym name; _ }
:: { v = Form.Vec ps; _ } :: ret :: body) :: { v = Form.Vec ps; _ } :: ret :: body)
when def_name name -> when def_name name ->
@ -971,7 +1036,8 @@ and sugar n (f : Form.t) : string list option =
| Form.List (({ v = Form.Sym h; _ } as hf) :: args) -> | Form.List (({ v = Form.Sym h; _ } as hf) :: args) ->
(* A call that takes a block is a statement, not a value. *) (* A call that takes a block is a statement, not a value. *)
not (List.mem h sugar_heads) && body_split hf args = None not (List.mem h sugar_heads) && body_split hf args = None
| _ -> true) && lambda_value (n + 2) "" x = None
| _ -> lambda_value (n + 2) "" x = None)
&& String.length head + 3 + String.length (at 0 x) <= width && String.length head + 3 + String.length (at 0 x) <= width
&& not (!inside f) -> && not (!inside f) ->
Some [ head ^ " = " ^ unit_text x ] Some [ head ^ " = " ^ unit_text x ]

View File

@ -261,35 +261,72 @@ let point (l : Loc.t) = { l with Loc.line = l.Loc.eline; col = l.Loc.ecol }
(* NEWLINE, INDENT and DEDENT, at bracket depth zero only: inside ( [ { a (* NEWLINE, INDENT and DEDENT, at bracket depth zero only: inside ( [ { a
line break is whitespace. A line continues the one before it when either line break is whitespace. A line continues the one before it when either
side of the break is a spaced binary operator (spec §2 "Continuation"). *) side of the break is a spaced binary operator (spec §2 "Continuation").
The one exception is a lambda's block. A [=>] that ends its line inside
brackets opens a block there: the lines under it are laid out as they
would be at depth zero, against a base of their own (the column the [=>]
line starts at), until the bracket around the lambda closes. That closer
ends the block, whether it ends the block's last line or has a line of
its own. The block is the last thing in its brackets: a comma after it,
or a line back at the header's column, is refused. *)
type frame = {
f_base : int;
f_stack : int list;
f_opens : token list; (* the brackets open around the lambda *)
f_arrow : token; (* the [=>] that opened the block *)
}
let lambda_not_last (fr : frame) (t : token) =
failk "lambda-block-last" t.loc
"a comma follows the block of the lambda on line %d. A lambda with a \
block is the last thing in its brackets, and its block ends where they \
close. Name the lambda with a let first and pass the name:\n\n\
\ let f = fn(a) =>\n ...\n g(f, x)"
fr.f_arrow.loc.Loc.line
let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token array = let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token array =
let arr = Array.of_list toks in let arr = Array.of_list toks in
let n = Array.length arr in let n = Array.length arr in
(* A snippet from the editor starts wherever it was written, and its first (* A snippet from the editor starts wherever it was written, and its first
line is its base: a later line may not go left of it. *) line is its base: a later line may not go left of it. *)
let base = if snippet && n > 0 then arr.(0).loc.Loc.col else base in let base = ref (if snippet && n > 0 then arr.(0).loc.Loc.col else base) in
let out = ref [] in let out = ref [] in
let add tok loc = out := { tok; loc; sp = true } :: !out in let add tok loc = out := { tok; loc; sp = true } :: !out in
let stack = ref [ base ] in let stack = ref [ !base ] in
(* [indent] is the column of the statement a snippet was cut out of, when (* [indent] is the column of the statement a snippet was cut out of, when
the snippet starts after that statement's first word (an elif's the snippet starts after that statement's first word (an elif's
condition, an arm's value). Its first joined line continues as it does condition, an arm's value). Its first joined line continues as it does
in the file: deeper than the statement, not than the cut. *) in the file: deeper than the statement, not than the cut. *)
let first_line = ref true in let first_line = ref true in
let depth = ref 0 in (* The brackets open in the current layout, innermost first. A lambda's
block starts with none, and [frames] holds what it interrupted. *)
let opens = ref [] in
let frames = ref [] in
let binop t = match t.tok with NAME s -> is_binop s | _ -> false in let binop t = match t.tok with NAME s -> is_binop s | _ -> false in
let closer t = match t.tok with RP | RB | RC -> true | _ -> false in
(* The column [i]'s line starts at. *)
let line_col i =
let rec go j =
if j > 0 && arr.(j - 1).loc.Loc.eline = arr.(i).loc.Loc.line then go (j - 1) else j
in
arr.(go i).loc.Loc.col
in
for i = 0 to n - 1 do for i = 0 to n - 1 do
let t = arr.(i) in let t = arr.(i) in
(if i = 0 then begin (if i = 0 then begin
if t.loc.Loc.col <> base then if t.loc.Loc.col <> !base then
failk "unexpected-indent" t.loc failk "unexpected-indent" t.loc
"the first line starts at column %d, and a file's top-level lines \ "the first line starts at column %d, and a file's top-level lines \
start at column %d. Remove the indentation" start at column %d. Remove the indentation"
t.loc.Loc.col base t.loc.Loc.col !base
end end
else else
let p = arr.(i - 1) in let p = arr.(i - 1) in
if !depth = 0 && t.loc.Loc.line > p.loc.Loc.eline then begin (* The closer that ends a lambda's block takes the block's end with
it, below: the line break before it is nothing. *)
let ends_block = !frames <> [] && !opens = [] && closer t in
if !opens = [] && t.loc.Loc.line > p.loc.Loc.eline && not ends_block then begin
let spaced_after = let spaced_after =
i + 1 < n && arr.(i + 1).loc.Loc.line = t.loc.Loc.line i + 1 < n && arr.(i + 1).loc.Loc.line = t.loc.Loc.line
&& arr.(i + 1).sp && arr.(i + 1).sp
@ -324,15 +361,28 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
if not continues then begin if not continues then begin
first_line := false; first_line := false;
let at = point p.loc in let at = point p.loc in
add NEWLINE at;
let col = t.loc.Loc.col in let col = t.loc.Loc.col in
(* Inside a lambda's brackets, a line at or left of the line its
header is on would be a statement beside the lambda. *)
(match !frames with
| fr :: _ when col <= !base ->
if t.tok = COMMA then lambda_not_last fr t
else
failk "lambda-block-left" t.loc
"this line starts at column %d and is still inside the \
brackets of the lambda on line %d, whose block is indented \
past column %d. Indent it into the block, or close the \
brackets at the end of the block's last line"
col fr.f_arrow.loc.Loc.line !base
| _ -> ());
add NEWLINE at;
let top = List.hd !stack in let top = List.hd !stack in
if col > top then begin if col > top then begin
stack := col :: !stack; stack := col :: !stack;
add INDENT at add INDENT at
end end
else if col < top then begin else if col < top then begin
if col < base then if col < !base then
failk "dedent" t.loc failk "dedent" t.loc
"%s" "%s"
(if snippet then (if snippet then
@ -342,11 +392,11 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
edge, and no later line can go left of it: send the \ edge, and no later line can go left of it: send the \
enclosing form, or line this up at column %d or right \ enclosing form, or line this up at column %d or right \
of it" of it"
col base base col !base !base
else else
Printf.sprintf Printf.sprintf
"this line starts at column %d, left of the top level at \ "this line starts at column %d, left of the top level at \
column %d" col base); column %d" col !base);
let closed = ref top in let closed = ref top in
let rec pop () = let rec pop () =
match !stack with match !stack with
@ -368,12 +418,41 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
end end
end end
end); end);
(match !frames with
(* A comma at the top of a lambda's block, on one of the block's lines. *)
| fr :: _ when !opens = [] && t.tok = COMMA -> lambda_not_last fr t
(* The closer of the brackets a lambda's block is in: the block ends. *)
| fr :: rest when !opens = [] && closer t ->
let at = point arr.(i - 1).loc in
add NEWLINE at;
List.iter (fun _ -> add DEDENT at) (List.tl !stack);
base := fr.f_base;
stack := fr.f_stack;
opens := fr.f_opens;
frames := rest
| _ -> ());
out := t :: !out; out := t :: !out;
(match t.tok with (match t.tok with
| LP | LB | LC -> incr depth | LP | LB | LC -> opens := t :: !opens
| RP | RB | RC -> if !depth > 0 then decr depth | RP | RB | RC -> (match !opens with _ :: r -> opens := r | [] -> ())
| NAME "=>" when !opens <> [] && i + 1 < n
&& arr.(i + 1).loc.Loc.line > t.loc.Loc.eline ->
frames := { f_base = !base; f_stack = !stack; f_opens = !opens; f_arrow = t }
:: !frames;
base := line_col i;
stack := [ !base ];
opens := []
| _ -> ()) | _ -> ())
done; done;
(match !frames with
| fr :: _ ->
let o = match fr.f_opens with o :: _ -> o | [] -> fr.f_arrow in
failk "unclosed" o.loc
~notes:[ Loc.note (point arr.(n - 1).loc) "the input ends here, still inside it" ]
"unclosed %s: the block of the lambda on line %d ends where this \
bracket closes"
(show o.tok) fr.f_arrow.loc.Loc.line
| [] -> ());
(if n > 0 then (if n > 0 then
let at = point arr.(n - 1).loc in let at = point arr.(n - 1).loc in
add NEWLINE at; add NEWLINE at;
@ -384,11 +463,17 @@ let layout ?(snippet = false) ?(base = 1) ?indent (toks : token list) : token ar
(* ── Parsing ───────────────────────────────────────────────────────── *) (* ── Parsing ───────────────────────────────────────────────────────── *)
type p = { toks : token array; mutable i : int } (* [closed] is where a lambda's block that ended its statement stopped:
the block took the line's end with it, so a check for that end passes
there. *)
type p = { toks : token array; mutable i : int; mutable closed : int }
(* Set below [params] and [ty], which the expression parser comes before. *) (* Set below [params] and [ty], which the expression parser comes before. *)
let typed_fn_expr : (p -> Form.t * int) ref = ref (fun _ -> assert false) let typed_fn_expr : (p -> Form.t * int) ref = ref (fun _ -> assert false)
(* A block's statements, for a lambda's; set once the statement parser is. *)
let block_of : (p -> Form.t list) ref = ref (fun _ -> assert false)
let peek p = p.toks.(p.i) let peek p = p.toks.(p.i)
let peek_at p k = p.toks.(min (p.i + k) (Array.length p.toks - 1)) let peek_at p k = p.toks.(min (p.i + k) (Array.length p.toks - 1))
let advance p = let advance p =
@ -487,6 +572,7 @@ let expect_name p s ~what =
(* The end of a line that is not followed by a block. *) (* The end of a line that is not followed by a block. *)
let expect_eol p ~after = let expect_eol p ~after =
if p.i = p.closed then () else
match (peek p).tok with match (peek p).tok with
| NEWLINE -> | NEWLINE ->
ignore (advance p); ignore (advance p);
@ -785,36 +871,73 @@ and inline_stmt p : Form.t =
mk p t.loc (compound eq.loc (List.assoc op assign_ops) e v (span p e.loc)) mk p t.loc (compound eq.loc (List.assoc op assign_ops) e v (span p e.loc))
| _ -> unit_slot p i0 t e | _ -> unit_slot p i0 t 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 =
if typed_lambda p then !typed_fn_expr p else if typed_lambda p then !typed_fn_expr p else
let t = advance p in let t = advance p in
let lp = advance p in let lp = advance p in
let args = items p RP lp.loc ~what:"parameters" in let args = items p RP lp.loc ~what:"parameters" in
match (peek p).tok with let rp = last p in
| NAME "=" -> let names = List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) args in
let header () = "fn(" ^ String.concat ", " (List.map text_of args) ^ ")" in
let n = peek p in
match n.tok with
| NAME "=>" ->
ignore (advance p); ignore (advance p);
let ps = lambda_params args in let ps = lambda_params args in
let i0 = p.i and t0 = peek p in let body = lambda_body p ~header:(header ()) in
let body, _ = expr p in
let body = unit_slot p i0 t0 body in
(mk p t.loc (mk p t.loc
(Form.List (Form.List
[ sym t.loc "fn"; Form.make (Form.Vec ps) (span_of_list lp.loc args); body ]), (sym t.loc "fn" :: Form.make (Form.Vec ps) (span_of_list lp.loc args) :: body)),
0) 0)
| NAME "=" when names -> lambda_equals p (header ())
| NEWLINE when names && (peek_at p 1).tok = INDENT ->
lambda_arrow (peek_at p 2).loc (header ())
(* Inside brackets a line break is no token: the next line's first token
is what follows. *)
| tk when names && n.loc.Loc.line > rp.loc.Loc.eline && starts_value tk ->
lambda_arrow n.loc (header ())
| _ -> (mk p t.loc (Form.List (sym t.loc "fn" :: args)), 9) | _ -> (mk p t.loc (Form.List (sym t.loc "fn" :: args)), 9)
(* A lambda with a block written inside a call's brackets, where no block can (* What follows a lambda's [=>]: a value on the line, or the indented block
open. The fix shown is the typed form, since a lambda bound by [let] has under it. [header] is the lambda's header as written, for a message. *)
no call to take its types from; [header] is [fn(a: T) -> R] or the and lambda_body p ~header =
header as written. *) match (peek p).tok, (peek_at p 1).tok with
and lambda_in_brackets : 'a. Loc.t -> string -> 'a = fun at header -> | NEWLINE, INDENT ->
failk "lambda-block-in-brackets" at ignore (advance p);
"a lambda's block cannot go inside brackets, where a line break is only \ let body = !block_of p in
a space. Name it first, with its types and the block under it:\n\n\ p.closed <- p.i;
\ let f = %s\n ...\n\n\ body
and pass f, or write it on one line: %s = value" | (NEWLINE | EOF | DEDENT), _ ->
failk "lambda-body" (where_ p)
"the line ends after %s =>, and the lambda's body is not under it. Put \
the body after the =>, or on the lines under it, indented:\n\n\
\ %s =>\n ..."
header header
| _ ->
let i0 = p.i and t0 = peek p in
let body, _ = expr p in
[ unit_slot p i0 t0 body ]
(* [fn(a) = x]: a lambda written with a named function's [=]. *)
and lambda_equals : 'a. p -> string -> 'a = fun p header ->
let eq = advance p in
let body =
match expr p with
| b, _ -> text_of b
| exception _ -> "..."
in
failk "lambda-equals" eq.loc
"a lambda's body follows =>, and this one has =, which is how a named \
function is written. Write:\n\n %s => %s"
header body
(* A lambda header with lines under it and no [=>]. *)
and lambda_arrow : 'a. Loc.t -> string -> 'a = fun at header ->
failk "lambda-arrow" at
"the lines under %s are a lambda's body only after =>. End the header \
with it:\n\n %s =>\n ..."
header header header header
(* Whether the [fn(] at point has a [:] among its parameters or a [->] (* Whether the [fn(] at point has a [:] among its parameters or a [->]
@ -871,22 +994,7 @@ and items p closer open_loc ~what =
| EOF -> unclosed p opener open_loc | EOF -> unclosed p opener open_loc
| _ -> | _ ->
let n = peek p in let n = peek p in
let block_lambda = if starts_value n.tok && n.sp && not (negative_literal n.tok)
match e.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: ps) ->
List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) ps
&& n.loc.Loc.line > e.loc.Loc.eline
| _ -> false
in
if block_lambda then
let names =
match e.v with
| Form.List (_ :: ps) -> List.map text_of ps
| _ -> []
in
lambda_in_brackets n.loc
("fn(" ^ String.concat ", " (List.map (fun x -> x ^ ": T") names) ^ ") -> R")
else if starts_value n.tok && n.sp && not (negative_literal n.tok)
&& n.loc.Loc.line > e.loc.Loc.eline then && n.loc.Loc.line > e.loc.Loc.eline then
(* Most often the bracket was never closed: the next statement (* Most often the bracket was never closed: the next statement
has been read as one more argument. *) has been read as one more argument. *)
@ -1042,12 +1150,6 @@ let blk (s : st) l (ss : Form.t list) =
| (first : Form.t) :: _ -> mk s.p first.loc (Form.List (sym first.loc "do" :: ss)) | (first : Form.t) :: _ -> mk s.p first.loc (Form.List (sym first.loc "do" :: ss))
| [] -> mk s.p l (Form.List [ sym l "do" ]) | [] -> mk s.p l (Form.List [ sym l "do" ])
let is_lambda_candidate (e : Form.t) =
match e.v with
| Form.List ({ v = Form.Sym "fn"; _ } :: args) ->
List.for_all (fun (a : Form.t) -> match a.v with Form.Sym _ -> true | _ -> false) args
| _ -> false
let header_follow p s = let header_follow p s =
let n = peek_at p 1 in let n = peek_at p 1 in
let plain_name = function let plain_name = function
@ -1122,11 +1224,10 @@ let params p (lp : token) =
in in
go [] go []
(* [fn(a: C, b) -> R = body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the (* [fn(a: C, b) -> R => body] is [(the (Fn [C dyn] R) (fn [a b] body))]: the
paren [fn] takes its parameters' types from where it is written, and [the] paren [fn] takes its parameters' types from where it is written, and [the]
is the form that says what a value is, as in [let x: T = v]. An untyped is the form that says what a value is, as in [let x: T = v]. An untyped
parameter is dyn, as in a definition, and the return type is required. A parameter is dyn, as in a definition, and the return type is required. *)
block body is added by [lambda_block]. *)
let () = typed_fn_expr := fun p -> let () = typed_fn_expr := fun p ->
let t = advance p in let t = advance p in
let lp = advance p in let lp = advance p in
@ -1136,18 +1237,22 @@ let () = typed_fn_expr := fun p ->
| _ -> ([], []) | _ -> ([], [])
in in
let names, tys = split ps in let names, tys = split ps in
let params_text () =
String.concat ", "
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys)
in
let r = let r =
match (peek p).tok with match (peek p).tok with
| NAME "->" -> ignore (advance p); ty p | NAME "->" -> ignore (advance p); ty p
| _ -> | _ ->
failk "lambda-return" (where_ p) failk "lambda-return" (where_ p)
"a lambda that states its parameters' types states its return type \ "a lambda that states its parameters' types states its return type \
too: fn(%s) -> R = value" too: fn(%s) -> R => value"
(String.concat ", " (params_text ())
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys))
in in
let header () = "fn(" ^ params_text () ^ ") -> " ^ text_of r in
let fty = mk p lp.loc (Form.List [ sym t.loc "Fn"; Form.make (Form.Vec tys) lp.loc; r ]) in let fty = mk p lp.loc (Form.List [ sym t.loc "Fn"; Form.make (Form.Vec tys) lp.loc; r ]) in
let vec = Form.make (Form.Vec names) lp.loc in let vec = Form.make (Form.Vec names) lp.loc in
let wrap body = let wrap body =
@ -1155,26 +1260,20 @@ let () = typed_fn_expr := fun p ->
mk p t.loc (Form.List (sym t.loc "fn" :: vec :: body)) ]) mk p t.loc (Form.List (sym t.loc "fn" :: vec :: body)) ])
in in
match (peek p).tok with match (peek p).tok with
| NAME "=" -> | NAME "=>" ->
ignore (advance p); ignore (advance p);
let i0 = p.i and t0 = peek p in let body = lambda_body p ~header:(header ()) in
let body, _ = expr p in (wrap body, 0)
(wrap [ unit_slot p i0 t0 body ], 0) | NAME "=" -> lambda_equals p (header ())
| NEWLINE when (peek_at p 1).tok = INDENT -> (wrap [], 0) | NEWLINE when (peek_at p 1).tok = INDENT -> lambda_arrow (peek_at p 2).loc (header ())
(* Inside brackets a line break is no token: the next line's first token (* Inside brackets a line break is no token: the next line's first token
is what follows. *) is what follows. *)
| tk when (peek p).loc.Loc.line > (last p).loc.Loc.eline && tk <> EOF -> | tk when (peek p).loc.Loc.line > (last p).loc.Loc.eline && tk <> EOF ->
let header = lambda_arrow (peek p).loc (header ())
"fn(" ^ String.concat ", "
(List.map2 (fun n (ty : Form.t) ->
if ty.v = Form.Sym "dyn" then text_of n else text_of n ^ ": " ^ text_of ty)
names tys)
^ ") -> " ^ text_of r
in
lambda_in_brackets (peek p).loc header
| _ -> | _ ->
failk "lambda-body" (where_ p) failk "lambda-body" (where_ p)
"a lambda's body follows = on its line, or is the block under it" "a lambda's body follows => on its line, or is the block under it: \
%s => value" (header ())
let rec stmts (s : st) : Form.t list = let rec stmts (s : st) : Form.t list =
let p = s.p in let p = s.p in
@ -1249,33 +1348,13 @@ and then_on_line p =
in in
go 1 0 go 1 0
(* The end of a statement's line, which a lambda's block may already have
taken. *)
and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after = and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after =
let p = s.p in let p = s.p in
match e.v with if block_ok && p.i <> p.closed && (peek p).tok = NEWLINE then ignore (advance p)
(* A typed lambda waiting for its block, from [typed_fn_expr]. *) else expect_eol p ~after;
| Form.List [ ({ v = Form.Sym "the"; _ } as th); fty; e
({ v = Form.List [ ({ v = Form.Sym "fn"; _ } as fh); ({ v = Form.Vec _; _ } as vec) ]; _ } as fn_) ]
when (peek p).tok = NEWLINE && (peek_at p 1).tok = INDENT ->
ignore (advance p);
let body = block s ~after in
mk p e.loc (Form.List [ th; fty; { fn_ with v = Form.List (fh :: vec :: body) } ])
| _ ->
if is_lambda_candidate e && (last p).tok = RP && (peek p).tok = NEWLINE
&& (peek_at p 1).tok = INDENT
then begin
ignore (advance p);
let body = block s ~after in
match e.v with
| Form.List (h :: args) ->
mk p e.loc
(Form.List (h :: Form.make (Form.Vec args) (span_of_list e.loc args) :: body))
| _ -> assert false
end
else begin
if block_ok && (peek p).tok = NEWLINE then ignore (advance p)
else expect_eol p ~after;
e
end
and let_stmt (s : st) : Form.t list = and let_stmt (s : st) : Form.t list =
let p = s.p in let p = s.p in
@ -1837,6 +1916,7 @@ and clause_end p 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 =
if p.i = p.closed then () else
match (peek p).tok with match (peek p).tok with
| NEWLINE -> ignore (advance p) | NEWLINE -> ignore (advance p)
| _ -> stray p ~after | _ -> stray p ~after
@ -1861,6 +1941,8 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list =
go [] go []
end end
let () = block_of := fun p -> block { p; lets = [] } ~after:"=>"
(** All top-level forms in a [.fln] source string. [col] is the column the (** All top-level forms in a [.fln] source string. [col] is the column the
text's top level starts at, 1 for a file. *) text's top level starts at, 1 for a file. *)
let read_all ?(line = 1) ?col ?indent ~file src = let read_all ?(line = 1) ?col ?indent ~file src =
@ -1874,7 +1956,7 @@ let read_all ?(line = 1) ?col ?indent ~file src =
(String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src))); (String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src)));
Fun.protect ~finally:(fun () -> source := saved) (fun () -> Fun.protect ~finally:(fun () -> source := saved) (fun () ->
let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in let toks = layout ~snippet ~base:col ?indent (lex ~line ~col ~file src) in
let s = { p = { toks; i = 0 }; lets = [] } in let s = { p = { toks; i = 0; closed = -1 }; lets = [] } in
let fs = stmts s in let fs = stmts s in
(match (peek s.p).tok with (match (peek s.p).tok with
| EOF -> () | EOF -> ()

View File

@ -51,7 +51,7 @@ fn main() -> i32
let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3), let items = [stock/item("bolts", 12, 400), stock/item("nuts", 5, 3),
stock/item("gears", 1250, 7), stock/item("belts", 899, 0)] stock/item("gears", 1250, 7), stock/item("belts", 899, 0)]
let rules = [Rule{.label "reorder", .applies low?}, let rules = [Rule{.label "reorder", .applies low?},
Rule{.label "valuable", .applies fn(it) = stock/value(it) > 5000}] Rule{.label "valuable", .applies fn(it) => stock/value(it) > 5000}]
let frame = arena-new(4096) let frame = arena-new(4096)
repeat(pass, 2): repeat(pass, 2):
runs += 1 runs += 1
@ -75,7 +75,7 @@ fn main() -> i32
println("sign bits", stock/sign-bit(-2.5), stock/sign-bit(2.5), println("sign bits", stock/sign-bit(-2.5), stock/sign-bit(2.5),
"masked", bit-and(-total, 0xFF)) "masked", bit-and(-total, 0xFF))
let big = 1000 let big = 1000
println("worth over", big, count-if(slice(items), fn(it) = stock/value(it) > big)) println("worth over", big, count-if(slice(items), fn(it) => stock/value(it) > big))
expect(total == 407, "407 on even rows") expect(total == 407, "407 on even rows")
expect(runs == 2, "two runs") expect(runs == 2, "two runs")
0 0

View File

@ -60,7 +60,7 @@ fn repeat-apply(f: CFn($t) -> $t, x: $t, n: i32) -> $t
v = f(v) v = f(v)
v v
fn halve-all(x: $t) -> $t where numeric?($t) = repeat-apply(fn(a: $t) -> $t = a / 2, x, 3) fn halve-all(x: $t) -> $t where numeric?($t) = repeat-apply(fn(a: $t) -> $t => a / 2, x, 3)
fn main() -> i32 fn main() -> i32
let r: Ring(5, i32) = zeroed() let r: Ring(5, i32) = zeroed()
@ -80,16 +80,16 @@ fn main() -> i32
let d = distinct(slice(samples)) let d = distinct(slice(samples))
println("distinct", slice(d)) println("distinct", slice(d))
free(d) free(d)
let big = filter(slice(samples), fn(x) = x >= 7) let big = filter(slice(samples), fn(x) => x >= 7)
println("seven and up", slice(big), "sum", reduce(slice(big), 0, fn(a, b) = a + b)) println("seven and up", slice(big), "sum", reduce(slice(big), 0, fn(a, b) => a + b))
free(big) free(big)
let rs = [Reading{.sensor 2, .value 40} Reading{.sensor 1, .value 15} let rs = [Reading{.sensor 2, .value 40} Reading{.sensor 1, .value 15}
Reading{.sensor 3, .value 22}] Reading{.sensor 3, .value 22}]
sort-by(slice(rs), fn(a, b) = a.value < b.value) sort-by(slice(rs), fn(a, b) => a.value < b.value)
for i in range(length(rs)) for i in range(length(rs))
println("sensor", rs[i].sensor, rs[i].value) println("sensor", rs[i].sensor, rs[i].value)
let raw: [4 u32] = [1 2 3 4] let raw: [4 u32] = [1 2 3 4]
let p = Ptr(u8)(addr(raw[0])) let p = Ptr(u8)(addr(raw[0]))
println("checksum", checksum(p, 16)) println("checksum", checksum(p, 16))
println("doubled", repeat-apply(fn(a: i32) -> i32 = a * 2, 1, 10), "halved", halve-all(800.0)) println("doubled", repeat-apply(fn(a: i32) -> i32 => a * 2, 1, 10), "halved", halve-all(800.0))
0 0

View File

@ -58,7 +58,7 @@ fn main() -> i32
let text = "The cat saw the dog. The dog didn't see the cat, but the bird saw both!" let text = "The cat saw the dog. The dog didn't see the cat, but the bird saw both!"
let ws = words(bytes-view(text)) let ws = words(bytes-view(text))
let counts = tally(slice(ws)) let counts = tally(slice(ws))
let by-count = fn(a: Count, b: Count) -> bool let by-count = fn(a: Count, b: Count) -> bool =>
if a.n != b.n if a.n != b.n
return a.n > b.n return a.n > b.n
bytes<?(a.word, b.word) bytes<?(a.word, b.word)
@ -73,7 +73,7 @@ fn main() -> i32
let distinct = i32(length(counts)) let distinct = i32(length(counts))
let g = grade(distinct, total) let g = grade(distinct, total)
println(distinct, "of", total, "distinct:", describe(g)) println(distinct, "of", total, "distinct:", describe(g))
let longest = reduce(slice(ws), slice(ws[0], 0, 0), fn(a, b) = let longest = reduce(slice(ws), slice(ws[0], 0, 0), fn(a, b) =>
if length(b) > length(a) then b else a) if length(b) > length(a) then b else a)
println("longest", string(longest)) println("longest", string(longest))
let short = 0 < length(longest) < 5 let short = 0 < length(longest) < 5

View File

@ -545,8 +545,8 @@ let () =
reads "quote block" reads "quote block"
"defmacro(m, [x & ys]):\n quote\n f(~x)\n ~@ys" "defmacro(m, [x & ys]):\n quote\n f(~x)\n ~@ys"
"(defmacro m [x & ys] (quasiquote (do (f (unquote x)) (unquote-splicing ys))))"; "(defmacro m [x & ys] (quasiquote (do (f (unquote x)) (unquote-splicing ys))))";
reads "lambda" "g = fn(i, j) = i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))"; reads "lambda" "g = fn(i, j) => i * 10 + j" "(set g (fn [i j] (+ (* i 10) j)))";
reads "lambda with a block" "g = fn(i)\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))"; reads "lambda with a block" "g = fn(i) =>\n a(i)\n b(i)" "(set g (fn [i] (a i) (b i)))";
reads "where" "fn s(xs: [$t]) -> () where ordered?($t) = f(xs)" reads "where" "fn s(xs: [$t]) -> () where ordered?($t) = f(xs)"
"(defn s [xs [$t]] () {:where (ordered? $t)} (f xs))"; "(defn s [xs [$t]] () {:where (ordered? $t)} (f xs))";
reads "data" "data Shape\n Circle(r: f32)\n Empty" reads "data" "data Shape\n Circle(r: f32)\n Empty"
@ -592,10 +592,41 @@ let () =
refuses "field with =" "p = P{x = 1}" "indent/brace-field" "{.x value}"; refuses "field with =" "p = P{x = 1}" "indent/brace-field" "{.x value}";
refuses "field with a colon" "p = P{x: 1}" "indent/brace-field" "no colon"; refuses "field with a colon" "p = P{x: 1}" "indent/brace-field" "no colon";
refuses "a dotted range" "for i in 0..10\n g(i)" "indent/dot-range" "range(0, 10)"; refuses "a dotted range" "for i in 0..10\n g(i)" "indent/dot-range" "range(0, 10)";
refuses "a block lambda inside a call" "sort-by(xs, fn(a, b)\n a < b)" (* A lambda's block inside brackets ends where they close. *)
"indent/lambda-block-in-brackets" "let f = fn(a: T, b: T) -> R"; reads "a block lambda inside a call" "sort-by(xs, fn(a, b) =>\n let c = a + 1\n c < b)"
refuses "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)" "(sort-by xs (fn [a b] (let [c (+ a 1)] (< c b))))";
"indent/lambda-block-in-brackets" "let f = fn(a: C, b: C) -> bool"; reads "its closer on a line of its own" "sort-by(xs, fn(a, b) =>\n a < b\n)\ng()"
"(sort-by xs (fn [a b] (< a b)))\n(g)";
reads "a typed block lambda inside a call" "sort-by(xs, fn(a: C, b: C) -> bool =>\n a < b)"
"(sort-by xs (the (Fn [C C] bool) (fn [a b] (< a b))))";
reads "nested block lambdas"
"map(xs, fn(x) =>\n let ys = map(x, fn(y) =>\n if y > 0\n y\n else\n 0)\n sum(ys))"
"(map xs (fn [x] (let [ys (map x (fn [y] (if (> y 0) y 0)))] (sum ys))))";
reads "a block lambda on a wrapped argument line" "f(a,\n fn(b) =>\n g(b)\n h(b))"
"(f a (fn [b] (g b) (h b)))";
reads "a block lambda in a vector" "x = [1, fn(b) =>\n b]" "(set x [1 (fn [b] b)])";
reads "a call after a block lambda's call" "let v = f(fn(a) =>\n a)\ng(v)"
"(let [v (f (fn [a] a))] (g v))";
refuses "a block lambda is the last argument" "sort-by(fn(a, b) =>\n a < b, xs)"
"indent/lambda-block-last" "let f = fn(a) =>";
refuses "one block lambda to a call" "f(fn(a) =>\n a\n, fn(b) =>\n b)"
"indent/lambda-block-last" "on line 1";
refuses "a line back at the header's column" "f(fn(a) =>\n a\nb)"
"indent/lambda-block-left" "still inside the brackets";
refuses "a block lambda's brackets left open" "f(fn(a) =>\n a\n"
"indent/unclosed" "ends where this bracket closes";
refuses "a lambda written with =" "x = fn(a, b) = a + b"
"indent/lambda-equals" "fn(a, b) => a + b";
refuses "a typed lambda written with =" "x = fn(a: C) -> bool = a.n > 1"
"indent/lambda-equals" "fn(a: C) -> bool => a.n > 1";
refuses "a block lambda with no =>" "let f = fn(a)\n a\nf"
"indent/lambda-arrow" "fn(a) =>";
refuses "a block lambda with no => inside a call" "sort-by(xs, fn(a, b)\n a < b)"
"indent/lambda-arrow" "fn(a, b) =>";
refuses "a typed block lambda with no => inside a call" "sort-by(xs, fn(a: C, b: C) -> bool\n a < b)"
"indent/lambda-arrow" "fn(a: C, b: C) -> bool =>";
refuses "a => with nothing under it" "let f = fn(a) =>\nf"
"indent/lambda-body" "fn(a) =>";
refuses "an else after else-if on one line" "if a then x\nelse if b then y\nelse z" refuses "an else after else-if on one line" "if a then x\nelse if b then y\nelse z"
"indent/orphan-else" "Write that line as elif"; "indent/orphan-else" "Write that line as elif";
refuses "else deeper than a one-line if" "if a then b\n else c" refuses "else deeper than a one-line if" "if a then b\n else c"
@ -610,17 +641,17 @@ let () =
"(cond a b c d e (do (f) (g)) :else (h))"; "(cond a b c d e (do (f) (g)) :else (h))";
refuses "else left of a one-line if" "while x\n if a then b\nelse c" refuses "else left of a one-line if" "while x\n if a then b\nelse c"
"indent/orphan-else" "goes at the if's column"; "indent/orphan-else" "goes at the if's column";
reads "a typed lambda" "f = fn(a: C, b) -> bool = a.n < b" reads "a typed lambda" "f = fn(a: C, b) -> bool => a.n < b"
"(set f (the (Fn [C dyn] bool) (fn [a b] (< (.n a) b))))"; "(set f (the (Fn [C dyn] bool) (fn [a b] (< (.n a) b))))";
reads "a typed lambda with a block" "let f = fn(x: i32) -> i32\n let y = x + 1\n y\ng(f)" reads "a typed lambda with a block" "let f = fn(x: i32) -> i32 =>\n let y = x + 1\n y\ng(f)"
"(let [f (the (Fn [i32] i32) (fn [x] (let [y (+ x 1)] y)))] (g f))"; "(let [f (the (Fn [i32] i32) (fn [x] (let [y (+ x 1)] y)))] (g f))";
refuses "a typed lambda states its return type" "f = fn(a: C) = a" refuses "a typed lambda states its return type" "f = fn(a: C) = a"
"indent/lambda-return" "fn(a: C) -> R = value"; "indent/lambda-return" "fn(a: C) -> R => value";
reads "a restart's report on its header" reads "a restart's report on its header"
"restart-case\n go()\nrestart retry(n: i32) \"Try again\"\n n" "restart-case\n go()\nrestart retry(n: i32) \"Try again\"\n n"
"(restart-case (go) (retry [n i32] :report \"Try again\" n))"; "(restart-case (go) (retry [n i32] :report \"Try again\" n))";
reads "a bare () in a body slot does nothing" reads "a bare () in a body slot does nothing"
"fn f() -> () = ()\nfn g(x) -> ()\n match x\n 1 -> h()\n _ -> ()\n k = fn() = ()" "fn f() -> () = ()\nfn g(x) -> ()\n match x\n 1 -> h()\n _ -> ()\n k = fn() => ()"
"(defn f [] () (do))\n(defn g [x dyn] () (match x 1 (h) _ (do)) (set k (fn [] (do))))"; "(defn f [] () (do))\n(defn g [x dyn] () (match x 1 (h) _ (do)) (set k (fn [] (do))))";
reads "a parenthesised () stays a value" "x = (())" "(set x ())"; reads "a parenthesised () stays a value" "x = (())" "(set x ())";
reads "a template's for takes an unquoted variable" reads "a template's for takes an unquoted variable"
@ -700,7 +731,7 @@ let () =
prints "comment is a body in order" "(comment (let [a 1] (g a)) (h))" "comment:\n let a = 1\n g(a)\n h()"; prints "comment is a body in order" "(comment (let [a 1] (g a)) (h))" "comment:\n let a = 1\n g(a)\n h()";
prints "a later lambda keeps the outer name" prints "a later lambda keeps the outer name"
"(defn f [] i32 (let [x 1] (let [x 5] (g x)) (app (fn [y] (+ x y)) 2)))" "(defn f [] i32 (let [x 1] (let [x 5] (g x)) (app (fn [y] (+ x y)) 2)))"
" let x = 1\n let x-2 = 5\n g(x-2)\n app(fn(y) = x + y, 2)"; " let x = 1\n let x-2 = 5\n g(x-2)\n app(fn(y) => x + y, 2)";
prints "a renamed name renamed again counts on" prints "a renamed name renamed again counts on"
"(defn f [] () (let [x 1] (let [x 2] (let [x 3] (g x)) (g x)) (g x)))" "(defn f [] () (let [x 1] (let [x 2] (let [x 3] (g x)) (g x)) (g x)))"
" let x = 1\n let x-2 = 2\n let x-3 = 3\n g(x-3)\n g(x-2)\n g(x)"; " let x = 1\n let x-2 = 2\n let x-3 = 3\n g(x-3)\n g(x-2)\n g(x)";
@ -790,7 +821,38 @@ let () =
"(defn f [a bool b bool c bool] bool (or (and a b) c))" "= (a and b) or c"; "(defn f [a bool b bool c bool] bool (or (and a b) c))" "= (a and b) or c";
prints "a typed lambda prints as one" prints "a typed lambda prints as one"
"(defn f [] () (let [g (the (Fn [C] bool) (fn [c] (> (.n c) 3)))] (h g)))" "(defn f [] () (let [g (the (Fn [C] bool) (fn [c] (> (.n c) 3)))] (h g)))"
"let g = fn(c: C) -> bool = c.n > 3"; "let g = fn(c: C) -> bool => c.n > 3";
(* A lambda with a block as a call's last argument prints inside the call,
and reads back as it was. *)
let round name src want =
prints name src want;
let forms = Reader.read_all ~file:"<p>" src in
let text = Indent_printer.program ~source:src forms in
match Indent_reader.read_all ~file:"<p>" text with
| back ->
if not (same_forms forms back) then
fail "%s: read back %s from %S" name (describe_diff forms back) text
| exception e -> fail "%s: its text is refused: %s\n%s" name (diag_text e) text
in
round "a one-line lambda" "(defn f [] () (h (fn [a] (+ a 1)) 2))" "= h(fn(a) => a + 1, 2)";
round "a block lambda as a call's last argument"
"(defn f [] () (sort-by xs (fn [a b] (g a) (< a b))))"
" sort-by(xs, fn(a, b) =>\n g(a)\n a < b)";
round "one closer for a call in a call"
"(defn f [] () (println (run (fn [] (g) 1))))" " println(run(fn() =>\n g()\n 1))";
round "a typed block lambda in a call"
"(defn f [] () (h (the (Fn [C] bool) (fn [c] (g c) (> (.n c) 3)))))"
" h(fn(c: C) -> bool =>\n g(c)\n c.n > 3)";
round "a let's call with a block lambda"
"(defn f [] () (let [v (m xs (fn [x] (g x) x))] (h v)))"
" let v = m(xs, fn(x) =>\n g(x)\n x)\n h(v)";
round "nested block lambdas"
"(defn f [] () (m xs (fn [x] (let [y (m x (fn [z] (g z) z))] (h y)))))"
" m(xs, fn(x) =>\n let y = m(x, fn(z) =>\n g(z)\n z)\n h(y))";
round "a block lambda not last keeps the fallback"
"(defn f [] () (r (fn [a b] (g a) b) 0))" "= r(fn([a b], g(a), b), 0)";
round "a lambda bound by let"
"(defn f [] () (let [k (fn [a] (g a) a)] (k 1)))" " let k = fn(a) =>\n g(a)\n a\n k(1)";
prints "a restart's report goes on its header" prints "a restart's report goes on its header"
"(defn f [] i32 (restart-case (go) (retry [] :report \"Try again\" 7)))" "(defn f [] i32 (restart-case (go) (retry [] :report \"Try again\" 7)))"
"restart retry() \"Try again\"\n 7"; "restart retry() \"Try again\"\n 7";
@ -1014,8 +1076,8 @@ let () =
[ "it has to be written: i32(x)" ]; [ "it has to be written: i32(x)" ];
refused "unknown-type.fln" "fn f(p: Keyword) -> i32 = 0\n\nfn main() -> i32 = 0\n" refused "unknown-type.fln" "fn f(p: Keyword) -> i32 = 0\n\nfn main() -> i32 = 0\n"
[ "unknown type Keyword" ]; [ "unknown type Keyword" ];
refused "untyped-lambda.fln" "fn main() -> i32\n let f = fn(a)\n a\n 0\n" refused "untyped-lambda.fln" "fn main() -> i32\n let f = fn(a) =>\n a\n 0\n"
[ "let f: Fn(T, ...) -> R = fn(...)" ]; [ "let f: Fn(T, ...) -> R = fn(...) =>" ];
refused "plusplus.fln" "fn main() -> i32\n let x = 1\n x++\n x\n" refused "plusplus.fln" "fn main() -> i32\n let x = 1\n x++\n x\n"
[ "write ++(x) or x += 1" ]; [ "write ++(x) or x += 1" ];
refused "plusplus-global.fln" "once g = 0\n\nfn main() -> i32\n g--\n 0\n" refused "plusplus-global.fln" "once g = 0\n\nfn main() -> i32\n g--\n 0\n"
@ -1045,25 +1107,28 @@ let () =
fail "map-key.fln: %d errors, wanted one" (List.length ds) fail "map-key.fln: %d errors, wanted one" (List.length ds)
| exception _ -> () | exception _ -> ()
| _ -> ()); | _ -> ());
(* The fix the lambda-in-brackets refusal shows compiles, with its (* The fix a block lambda with no => is shown compiles, inside the call. *)
placeholders filled in. *)
(match read "sort-by(xs, fn(a, b)\n a.n < b.n)" with (match read "sort-by(xs, fn(a, b)\n a.n < b.n)" with
| _ -> fail "lambda in brackets: read" | _ -> fail "lambda in brackets: read"
| exception Loc.Error d -> | exception Loc.Error d ->
let header = let header =
let m = d.Loc.dmsg in let m = d.Loc.dmsg in
let i = String.index m '=' + 2 in let i = String.index m '\n' + 6 in
String.sub m i (String.index_from m i '\n' - i) String.sub m i (String.index_from m i '\n' - i)
in in
let header =
String.concat "C" (String.split_on_char 'T' header)
|> String.split_on_char 'R' |> String.concat "bool"
in
checks "lambda-fix.fln" checks "lambda-fix.fln"
("struct C\n n: i32\n\nfn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n" ("struct C\n n: i32\n\nfn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n"
^ " let f = " ^ header ^ "\n a.n < b.n\n sort-by(slice(xs), f)\n xs[0].n\n")); ^ " sort-by(slice(xs), " ^ header ^ "\n a.n < b.n)\n xs[0].n\n"));
(* A typed block lambda inside a call, a closer on its own line, and one
nested in another's block. *)
checks "block-lambdas.fln"
("struct C\n n: i32\n\nfn app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)\n\n"
^ "fn main() -> i32\n let xs = [C{.n 2} C{.n 1}]\n"
^ " sort-by(slice(xs), fn(a: C, b: C) -> bool =>\n let d = a.n - b.n\n d < 0)\n"
^ " let k = app(2, fn(a) =>\n let b = app(a, fn(c) =>\n c * 10\n )\n b + 1)\n"
^ " i32(k) + xs[0].n\n");
refused "cfn-captures.fln" refused "cfn-captures.fln"
"fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) = k)\n" "fn app(f: CFn(Option(i32)) -> i32) -> i32 = f(None)\n\nfn main() -> i32\n let k = 1\n app(fn(o) => k)\n"
[ "so it is a Fn(Option(i32)) -> i32 and not a CFn(Option(i32)) -> i32" ]; [ "so it is a Fn(Option(i32)) -> i32 and not a CFn(Option(i32)) -> i32" ];
refused "defvar.fln" "defvar(x, 1)\n\nfn main() -> i32 = 0\n" refused "defvar.fln" "defvar(x, 1)\n\nfn main() -> i32 = 0\n"
[ "once x = 1 initialises once"; "def x = 1 re-initialises" ] [ "once x = 1 initialises once"; "def x = 1 re-initialises" ]