From 7d75cc0a5d7564d9419cedd73fd5a9ea96750534 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 07:30:55 +0700 Subject: [PATCH] The CLI and the tests load, check and link a program through one module in the library --- TODO.org | 12 +++++---- bin/main.ml | 59 ++++++++++++++++++++------------------------ lib/front.ml | 40 ++++++++++++++++++++++++++++++ test/test_support.ml | 21 ++++++++-------- 4 files changed, 84 insertions(+), 48 deletions(-) create mode 100644 lib/front.ml diff --git a/TODO.org b/TODO.org index a936aa1d..c285c37d 100644 --- a/TODO.org +++ b/TODO.org @@ -2007,11 +2007,13 @@ Sixty mutations, nineteen of which left the whole suite green; all nineteen are closed, each re-planted and watched fail against the new test. What is open is that the pass has not been run again, so nineteen is the old number. -** TODO bin/main.ml spells the compile pipeline out by hand -Two places each do a load, a check and a link feeding the builder, where the tests -go through one helper. The CLI loads through its own path and checks with a -different entry point, so this is not a matter of calling the test module from the -binary — closing it means the pipeline moving into the library. +** DONE bin/main.ml spells the compile pipeline out by hand +CLOSED: [2026-09-25] +=lib/front.ml= holds the load, the check and the link. =flan build=, =run=, +=emit= (both backends), =check= and =shim= go through it with =~all:true= (every error, +=Loc.Errors=); =Test_support.checked= and =linked= go through it without (the +first error, =Loc.Error=). The =--no-gc= and =--warn-memory= passes stay in the +CLI as a hook that sees the program before =Reach= prunes it. ** DONE Build.executable returns only its output path CLOSED: [2026-09-25] diff --git a/bin/main.ml b/bin/main.ml index b3ef9b85..07c29920 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -108,17 +108,13 @@ let summarise (d : Flan.Ast.decl) = (match fn.ret with None -> "Unit" | Some _ -> "explicit") (List.length fn.fbody) -(* Every path past [parse] goes through [Load]: an import is resolved into the - declarations it stands for, and the package's C shim and linker arguments - come back with them. *) -(* Every driver here is the batch case, which is the one the workflow is: write - everything, compile at the end, work through the list. So every one of them +(* Every path past [parse] goes through [Front], and so through [Load]: an + import is resolved into the declarations it stands for, and the package's C + shim and linker arguments come back with them. Every driver here is the + batch case, which is the one the workflow is: write everything, compile at + the end, work through the list. So every one of them passes [~all:true] and asks for the whole list rather than the first thing wrong. *) -let load path : Flan.Load.t = - Flan.Load.program ~file:path - ~parse:Flan.Parse.program_all (Flan.Reader.read_file path) - -let checked path = Flan.Check.program_all (load path).decls +let checked path = snd (Flan.Front.checked ~all:true path) (* 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 @@ -658,8 +654,7 @@ let () = List.iter (fun path -> with_errors path (fun () -> - load path |> fun l -> - Flan.Check.program_all l.decls + checked path |> Flan.X86.program ~checks ~dev ~debug ~annotate |> print_string)) files @@ -675,9 +670,8 @@ let () = List.iter (fun path -> with_errors path (fun () -> - let l = load path in + let l, p = Flan.Front.checked ~all:true path in let pnames = if debug then param_names l else [] in - let p = Flan.Check.program_all l.decls in (* Between checking and emission, and it hands the very same program on: the flag is a question asked of what was checked, never a parameter of what is emitted. *) @@ -724,28 +718,30 @@ let () = exit 2 in with_errors path (fun () -> - let l = load path in - let p = Flan.Check.program_all l.decls in - (* Before reachability rather than after: a dyn in a function nothing - calls is still a dyn somebody wrote, and a refusal that depended on - what [main] happened to reach would come and go as the program was - edited elsewhere. *) - if List.mem no_gc_flag rest then Flan.Check.no_gc p; - (* Before reachability too, and for the same reason: a push in a function - nothing calls is still a push somebody wrote. *) - if List.mem warn_memory_flag rest then print_memory_warnings ~file:path p; (* 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 raylib and still be buildable for wasm32. *) - let p, csrcs, lflags = Flan.Reach.link ~dev l p in + let f = + Flan.Front.linked ~all:true ~dev path ~before_link:(fun p -> + (* Before reachability rather than after: a dyn in a function + nothing calls is still a dyn somebody wrote, and a refusal that + depended on what [main] happened to reach would come and go as + the program was edited elsewhere. *) + if List.mem no_gc_flag rest then Flan.Check.no_gc p; + (* Before reachability too, and for the same reason: a push in a + function nothing calls is still a push somebody wrote. *) + if List.mem warn_memory_flag rest then + print_memory_warnings ~file:path p) + in ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev; debug; sanitize; target; x86; opt = Option.value opt ~default:Flan.Build.default.Flan.Build.opt } - ~csrcs ~lflags ~pnames:(if debug then param_names l else []) - p ~out)) + ~csrcs:f.csrcs ~lflags:f.lflags + ~pnames:(if debug then param_names f.load else []) + f.program ~out)) (* The daemon an editor talks to: one session, the program it belongs to running beside it, and a socket. Unlike [flan reload] the session persists, so a defonce added by one evaluation is part of what the next one is checked @@ -916,16 +912,15 @@ let () = Filename.concat (Filename.get_temp_dir_name ()) (Printf.sprintf "flan-run-%d" (Unix.getpid ())) in - let l = load path in - let p = Flan.Check.program_all l.decls in - let p, csrcs, lflags = Flan.Reach.link l p in + let f = Flan.Front.linked ~all:true path in ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; debug; sanitize; x86; opt = Option.value opt ~default:Flan.Build.default.Flan.Build.opt } - ~csrcs ~lflags ~pnames:(if debug then param_names l else []) - p ~out:exe); + ~csrcs:f.csrcs ~lflags:f.lflags + ~pnames:(if debug then param_names f.load else []) + f.program ~out:exe); let code = Sys.command (String.concat " " (List.map Filename.quote (exe :: prog_args))) diff --git a/lib/front.ml b/lib/front.ml new file mode 100644 index 00000000..fee00c6f --- /dev/null +++ b/lib/front.ml @@ -0,0 +1,40 @@ +(** The front half of a compile: read a file, load it with its imports, check + it, and decide the link. What [flan build], [flan run], [flan emit] and + [flan check] do before a backend is reached, and what the test binaries do + before theirs, so that the two cannot drift apart. + + [all] chooses how a refusal is reported. With it, the parser and the + checker keep going and raise [Loc.Errors] with every declaration they + refused, which is what the command-line drivers want: write everything, + compile at the end, work through the list. Without it they stop at the + first and raise [Loc.Error], which is what a test asserting on one message + wants. For a program with no errors the two are the same. *) + +let load ?(all = false) path : Load.t = + Load.program ~file:path + ~parse:(if all then Parse.program_all else Parse.program) + (Reader.read_file path) + +let check ?(all = false) (l : Load.t) : Tast.program = + (if all then Check.program_all else Check.program) l.Load.decls + +let checked ?all path = + let l = load ?all path in + (l, check ?all l) + +type linked = { + load : Load.t; (* the declarations, as loaded *) + program : Tast.program; (* checked, and pruned to what is reached *) + csrcs : string list; (* the packages' C that the link needs *) + lflags : string list; (* ...and their linker arguments *) +} + +(* [before_link] sees the checked program before [Reach.link] prunes it. The + questions asked there — [Check.no_gc], the memory warnings — are about what + was written, and a function nothing calls is still something somebody + wrote. *) +let linked ?(dev = false) ?all ?(before_link = fun _ -> ()) path = + let l, p = checked ?all path in + before_link p; + let program, csrcs, lflags = Reach.link ~dev l p in + { load = l; program; csrcs; lflags } diff --git a/test/test_support.ml b/test/test_support.ml index 28feea6f..75109809 100644 --- a/test/test_support.ml +++ b/test/test_support.ml @@ -193,14 +193,14 @@ let listening ?(ms = 30000) ~pid path = (* ── The front half of a compile ──────────────────────────────────── *) -(* Read, load and check a program: the same two calls [flan build] makes - before it reaches the backend. Through [Load], so a program with an - (import ...) is buildable here — it brings back the package's declarations - as well as the file's own. *) -let checked path = - Check.program (Load.program ~file:path (Reader.read_file path)).Load.decls +(* Read, load and check a program, through [Front], which is the path + [flan build] takes too. Without [~all], so a refusal raises the first error + rather than the list. Through [Load], so a program with an (import ...) is + buildable here — it brings back the package's declarations as well as the + file's own. *) +let checked path = snd (Front.checked path) -(* And the third call, which is where the binaries below actually differ from +(* And the link, which is where the binaries below actually differ from one another: [Reach.link] decides the link from the checked program — a package nothing reachable calls into hands over no C and no linker argument, and its functions are not emitted — and returns the program @@ -210,7 +210,6 @@ let checked path = different [Build.opts] (a sanitized build, a -O0 one, an x86 one, a web one) and several want the exception rather than the executable, so the options record is the one part that is genuinely theirs. *) -let linked ?(dev = false) path = - let l = Load.program ~file:path (Reader.read_file path) in - let p = Check.program l.Load.decls in - Reach.link ~dev l p +let linked ?dev path = + let f = Front.linked ?dev path in + (f.Front.program, f.Front.csrcs, f.Front.lflags)