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

A dev eval prints the compiler's warnings for the forms it sent and not again for forms sent earlier.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 18:59:34 +07:00
parent 08ecba92f6
commit bbaca242e5
3 changed files with 76 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lib/check.ml
View File

@ -20806,6 +20806,30 @@ let prelude_alias = "prelude~"
the dev program re-creating the session its launcher built and warned for. *)
let print_warnings = ref true
(* Where a dev eval's own forms are, so its warnings are said for those and
not again, on every later eval, for everything the session holds. [None]
is a build or a check, which says everything. *)
let warn_within : Loc.t list option ref = ref None
let say_warnings (ds : Loc.diag list) =
let within (at : Loc.t) =
match !warn_within with
| None -> true
| Some spans ->
List.exists
(fun (s : Loc.t) ->
String.equal s.Loc.file at.Loc.file
&& s.Loc.line <= at.Loc.line && at.Loc.line <= max s.Loc.line s.Loc.eline)
spans
in
if !print_warnings then
List.iter
(fun (d : Loc.diag) ->
if within d.Loc.dloc then
prerr_endline
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
ds
(* A name the renaming above made, which nobody wrote: left out of every
listing a person reads, and shown as whose it is where a frame has to be. *)
let internal_name n = String.starts_with ~prefix:(prelude_alias ^ "/") n
@ -21060,12 +21084,7 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
reload, which is where a defn is most likely to be written. Printed in
the shape [Loc] gives an error, so a checker in an editor parses it the
same way. *)
if !print_warnings then
List.iter
(fun (d : Loc.diag) ->
prerr_endline
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
(shadowed_builtins decls @ prelude_warnings);
say_warnings (shadowed_builtins decls @ prelude_warnings);
(* Pass one, and it stops at the first thing it refuses. That is not
laziness: every name, type and signature in the file comes from here, so a
declaration this pass could not make sense of leaves a hole that pass two
@ -21079,22 +21098,12 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
if keep_going then env.deferred <- Some [];
grow_warnings := [];
let decls = collect env decls in
if !print_warnings then
List.iter
(fun (d : Loc.diag) ->
prerr_endline
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
(List.rev !pairing_warnings);
say_warnings (List.rev !pairing_warnings);
check_finite env;
check_union_members env;
infer_returns ~keep_going ?tolerate ?previous env decls;
recursion_warnings := unconditional_recursion env decls;
if !print_warnings then
List.iter
(fun (d : Loc.diag) ->
prerr_endline
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
!recursion_warnings;
say_warnings !recursion_warnings;
(let late = !consts_after_infer in
consts_after_infer := [];
settle_consts env late);
@ -21155,12 +21164,7 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
| _ -> None)
decls
in
if !print_warnings then
List.iter
(fun (d : Loc.diag) ->
prerr_endline
(Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
(List.rev !grow_warnings);
say_warnings (List.rev !grow_warnings);
Loc.finish s;
(* The placeholder a [_] body is read against is never a type anything
downstream may see; a signature carrying it would be emitted as a

10
lib/session.ml
View File

@ -1105,9 +1105,15 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
else None)
t.program.Tast.fns
in
(* The whole session is checked again, and only the forms sent are warned
about: a warning said at the eval that wrote it is not said again at
every eval after. *)
let was = !Check.warn_within in
Check.warn_within := Some (List.map (fun (f : Form.t) -> f.Form.loc) forms);
match
Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
decls
Fun.protect ~finally:(fun () -> Check.warn_within := was) (fun () ->
Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
decls)
with
| r -> r
| exception Loc.Errors [ d ] -> raise (Loc.Error d)

62
test/test_session.ml
View File

@ -2237,32 +2237,50 @@ let () =
(* A fn sent to the session that calls itself on every path is warned at
(decision 142) on the daemon's stderr, which is the daemon's buffer in
the editor. *)
the editor — once, at the eval that sent it. Every eval checks the whole
session again, and a warning about a form sent earlier is not said
again; nor is a builtin-shadow warning. *)
(let t, _ = Session.create ~file:"programs/reload.flan" () in
let path = Test_support.tmp "recursion-" "stderr.txt" in
let fd = Unix.openfile path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let saved = Unix.dup Unix.stderr in
flush stderr;
Unix.dup2 fd Unix.stderr;
let r =
Fun.protect
~finally:(fun () -> flush stderr; Unix.dup2 saved Unix.stderr; Unix.close saved; Unix.close fd)
(fun () ->
Source.with_code ~syntax:Source.Indented ~at:None (fun () ->
Session.eval ~origin:"handshakes.fln" t
"fn count-handshakes(people)\n for p in range(people)\n \
println(p)\n count-handshakes(5)\n"))
let stderr_of f =
let path = Test_support.tmp "recursion-" "stderr.txt" in
let fd = Unix.openfile path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let saved = Unix.dup Unix.stderr in
flush stderr;
Unix.dup2 fd Unix.stderr;
let r =
Fun.protect
~finally:(fun () ->
flush stderr; Unix.dup2 saved Unix.stderr; Unix.close saved; Unix.close fd)
(fun () -> Source.with_code ~syntax:Source.Indented ~at:None f)
in
let said = In_channel.with_open_bin path In_channel.input_all in
Sys.remove path;
(r, said)
in
let said = In_channel.with_open_bin path In_channel.input_all in
Sys.remove path;
(match r with
| c when not (List.mem "count-handshakes" c.Session.fns) ->
fail "a fn that calls itself on every path was not installed"
| _ -> ());
let warnings said =
List.length
(List.filter (fun l -> has l ": warning: ") (String.split_on_char '\n' said))
in
let r, said =
stderr_of (fun () ->
Session.eval ~origin:"handshakes.fln" t
"fn count-handshakes(people)\n for p in range(people)\n \
println(p)\n count-handshakes(5)\n\nfn get(p: i64) -> i64\n p\n")
in
if not (List.mem "count-handshakes" r.Session.fns) then
fail "a fn that calls itself on every path was not installed";
(match !Check.recursion_warnings with
| [ d ] when d.Loc.kind = "check/unconditional-recursion" && d.Loc.dloc.Loc.line = 4 -> ()
| ds -> fail "a dev eval of count-handshakes warned %d times" (List.length ds));
| ds -> fail "a dev eval of count-handshakes found %d recursions" (List.length ds));
if not (has said "warning: count-handshakes calls itself on line 4 on every path")
then fail "a dev eval printed no recursion warning: %S" said);
then fail "a dev eval printed no recursion warning: %S" said;
if warnings said <> 2 then
fail "the eval that sent them printed %d warnings, not 2: %S" (warnings said) said;
let _, again =
stderr_of (fun () ->
Session.eval ~origin:"other.fln" t "fn other-thing(x: i64) -> i64\n x + 1\n")
in
if warnings again <> 0 then
fail "an unrelated eval said an earlier form's warnings again: %S" again);
Test_support.report ~label:"session" ()