diff --git a/bin/main.ml b/bin/main.ml index 6612f1a..f7933e6 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -47,9 +47,9 @@ let summarise (d : Flan.Ast.decl) = asks for the whole list rather than the first thing wrong. *) let load path : Flan.Load.t = Flan.Load.program ~file:path - (Flan.Parse.program ~keep_going:true (Flan.Reader.read_file path)) + (Flan.Parse.program_all (Flan.Reader.read_file path)) -let checked path = Flan.Check.program ~keep_going:true (load path).decls +let checked path = Flan.Check.program_all (load path).decls (* What the source called each parameter, per function. The typed IR refers to locals by slot index and records no names — [Check] has them in its scope @@ -136,7 +136,7 @@ let () = (fun path -> with_errors path (fun () -> Flan.Reader.read_file path - |> Flan.Parse.program ~keep_going:true + |> Flan.Parse.program_all |> List.iter (fun d -> print_endline (summarise d)))) files | _ :: "check" :: files when files <> [] -> @@ -290,7 +290,7 @@ let () = with_errors path (fun () -> let l = load path in let pnames = if debug then param_names l else [] in - Flan.Check.program ~keep_going:true l.decls + Flan.Check.program_all l.decls |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize |> print_string)) files @@ -322,7 +322,7 @@ let () = in with_errors path (fun () -> let l = load path in - let p = Flan.Check.program ~keep_going:true l.decls in + let p = Flan.Check.program_all l.decls in (* The link follows the program, not the import list: a package nothing reachable calls into contributes no C and no linker argument, and its functions are not emitted either. That is what lets one file import @@ -399,7 +399,7 @@ let () = (Printf.sprintf "flan-run-%d" (Unix.getpid ())) in let l = load path in - let p = Flan.Check.program ~keep_going:true l.decls in + let p = Flan.Check.program_all l.decls in let p, csrcs, lflags = Flan.Reach.link l p in ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe); let code = diff --git a/lib/check.ml b/lib/check.ml index d6cf6a0..0500aec 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4205,8 +4205,11 @@ let check_main env = expression typed at a REPL against the program the process is running — and it has to be this one rather than anything rebuilt from declarations, because [program] prepends the prelude and no accumulated AST contains it. *) -let program_with_env ?(keep_going = false) (decls : Ast.decl list) - : Tast.program * env = +(* Separate entry points below rather than a flag on the one the session calls, + for the reason [Parse] gives at the same fork: [Loc.Errors] is a second + exception that the session and the daemon do not catch, so the guarantee + that they never see one should be structural and not a default argument. *) +let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in let decls = Parse.program (Prelude.forms ()) @ decls in (* Before anything is collected: every (declare-c ...) becomes an ordinary @@ -4265,8 +4268,19 @@ let program_with_env ?(keep_going = false) (decls : Ast.decl list) globals; externs; fns; cshim }, env) -let program ?keep_going (decls : Ast.decl list) : Tast.program = - fst (program_with_env ?keep_going decls) +(** The program and the environment, stopping at the first refusal. What a + session needs, and it raises [Loc.Error] and never [Loc.Errors]. *) +let program_with_env (decls : Ast.decl list) : Tast.program * env = + build_program ~keep_going:false decls + +let program (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:false decls) + +(** The same, reporting every declaration whose body it refuses rather than the + first. Raises [Loc.Errors], so only a caller prepared for a list should be + calling it. *) +let program_all (decls : Ast.decl list) : Tast.program = + fst (build_program ~keep_going:true decls) (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing diff --git a/lib/loc.ml b/lib/loc.ml index 6815848..750c8ee 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -314,7 +314,21 @@ let report (d : diag) = prints when it finished the file rather than stopping at the first thing it found. *) let report_all (ds : diag list) = - let ds = List.stable_sort (fun a b -> before a.dloc b.dloc) ds in + (* Source order, with the placeless ones last. A diagnostic the checker + raised against [unknown] — a wrong [main] signature is the one that + happens — has line 0, and sorting on the number alone would put it at the + top of the list, above every error that can actually be clicked. It is a + real error and it is not anywhere, so it goes after the ones that are. *) + let placed (d : diag) = d.dloc.line > 0 in + let ds = + List.stable_sort + (fun a b -> + match (placed a, placed b) with + | true, false -> -1 + | false, true -> 1 + | _ -> before a.dloc b.dloc) + ds + in let n = List.length ds in String.concat "\n" (List.map report ds) ^ Printf.sprintf "\n%d error%s" n (if n = 1 then "" else "s") diff --git a/lib/parse.ml b/lib/parse.ml index 21dbacd..651136a 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -866,15 +866,20 @@ and variant (f : Form.t) : Ast.variant = unknown name, which is wrong but not silent. *) let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) -(* [keep_going] asks for every bad declaration in the file rather than the +(* Two entry points and not one function with a flag, and the reason is the + daemon. [Loc.Errors] is a second exception, and the handlers in the session + and in the daemon name only [Loc.Error] — so a list reaching them would be + an unhandled exception and a dead session, which is the one thing the whole + dev loop exists to prevent. A flag on the function the session already calls + would put that one label away from happening. A separate name cannot: the + session's call site has to be edited by someone for its behaviour to change. + + [keep_going] asks for every bad declaration in the file rather than the first. The resync point is a top-level form, and it is the only honest one here: the reader already found where each declaration ends, so skipping a bad one costs nothing and cannot lose its place. Inside a declaration there - is no such landmark, so one bad [defn] is one error. - - Off by default, because the daemon parses one form at a time and wants one - exception. *) -let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list = + is no such landmark, so one bad [defn] is one error. *) +let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list = (* Quasiquote first and always, because it is pure and needs nothing loaded: it is what turns a macro body into ordinary code, and the prelude's own macros have to parse in a process that has not built a macro module yet. @@ -886,6 +891,17 @@ let program ?(keep_going = false) (forms : Form.t list) : Ast.decl list = Loc.finish s; decls +(** One file, stopping at the first declaration it cannot parse. Raises + [Loc.Error], never [Loc.Errors]. *) +let program (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:false forms + +(** One file, reporting every declaration it cannot parse. Raises [Loc.Errors] + when there was more than nothing wrong, so only a caller prepared for a + list should be calling it. *) +let program_all (forms : Form.t list) : Ast.decl list = + parse_forms ~keep_going:true forms + (* Single-declaration entry point, for tests and the REPL. *) let decl (f : Form.t) : Ast.decl = temps := 0; diff --git a/test/test_flan.ml b/test/test_flan.ml index 4a5effc..59e1f51 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1685,8 +1685,8 @@ let () = the first and a checker that reported thirty pieces of wreckage would both fail this row. *) (match - Check.program ~keep_going:true - (Parse.program ~keep_going:true + Check.program_all + (Parse.program_all (read "(defn a [] i32 nope1)\n\ (defn b [] i32 nope2)\n\ (defn c [] i32 nope3)\n")) @@ -1699,18 +1699,19 @@ let () = (* The parser resynchronises on a top-level form, so two bad declarations are two errors rather than one. *) - (match Parse.program ~keep_going:true (read "(defn a)\n(defn b)\n") with + (match Parse.program_all (read "(defn a)\n(defn b)\n") with | _ -> check "two bad declarations are refused" false | exception Loc.Errors ds -> check "two bad declarations give two errors" (List.length ds = 2)); - (* One form at a time still raises one, which is what the daemon depends on: - it catches [Loc.Error] and would not see a list. *) + (* [Check.program] is a different function from [Check.program_all], and + that is the guarantee: the session calls this one, it raises one + diagnostic, and nobody can turn it into a list by passing a label. *) (match Check.program (Parse.program (read "(defn a [] i32 nope1)\n\ (defn b [] i32 nope2)\n")) with - | _ -> check "without keep_going it still refuses" false + | _ -> check "Check.program still refuses" false | exception Loc.Errors _ -> - check "without keep_going there is no list" false + check "Check.program never answers with a list" false | exception Loc.Error _ -> ()); (* The first line of a report is exactly the GNU format compilation-mode