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

A missing file is a sentence, and flan run's two argument lists are told apart

Browse Source 
with_errors had no Sys_error arm, so flan check nosuch.flan ended in OCaml's
default handler; the daemon has had that arm since before the CLI did. A
Not_found backstop joins it — nothing reaches it today, and the day something
does the failure should name the file rather than say nothing at all.

flan run handed every flag it did not understand to the compiled program:
flan run game.flan --debug built at -O2 and gave the game a --debug. Build
flags are now the build's, -- ends them, and an unknown dash argument before
-- is refused by name with -- named as the way to mean it for the program.

-O0 through -O3 get a spelling on build and run, which they did not have at
all: Build.default pinned -O2 and --debug was the only route to anything
else. Four levels and not five, because -Os is clang's and llc rejects it,
and the same string reaches both. --debug with a higher level is refused
rather than quietly overruled by Build's own -O0.
This commit is contained in:
Joseph Ferano 2026-09-17 21:44:55 +07:00
parent 223e282e44
commit 652361e169
2 changed files with 188 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
bin/main.ml
View File

@ -31,6 +31,31 @@ let with_errors path f =
prerr_endline ("flan: " ^ m);
ignore path;
exit 1
(* A file that is not there, or that cannot be read. The exception already
carries the path and the reason the operating system gave, which is the
whole of what anybody can act on, so it is passed through as it is —
[lib/dev.ml]'s [message_of_exn] does the same for the same reason, and
the daemon has had this arm since before the CLI did. Without it
[flan check nosuch.flan] ends in [Fatal error: exception Sys_error(...)],
which is the compiler telling the user it did not expect to be asked. *)
| Sys_error m ->
prerr_endline ("flan: " ^ m);
ignore path;
exit 1
(* The backstop. Nothing in this binary reaches it today: every [Hashtbl.find]
on a path a command can take is guarded by a [find_opt]. It is here so
that the day one is not, the failure is a sentence naming the file being
worked on rather than a bare [Fatal error: exception Not_found] — which
says nothing at all, not even which file. Its own exit status, because a
compiler bug is not a refusal of the program and a script should be able
to tell the two apart. *)
| Not_found ->
prerr_endline
("flan: internal error — a lookup failed with no name to report, while \
working on " ^ path
^ ". This is a bug in the compiler and not a fault in the program; \
please report the file that provoked it.");
exit 4
let summarise (d : Flan.Ast.decl) =
let open Flan.Ast in
@ -143,8 +168,43 @@ let flags =
usage error. *)
let target_prefix = "--target="
(* The optimisation level, which until now had no spelling at all: [Build.default]
pinned -O2 and [--debug] was the only route to anything else. Four levels and
not five — -Os is clang's and llc rejects it outright ("invalid optimization
level"), and the same string reaches both ([Build] at the clang compile and
again at the llc step of the live loop), so offering a level one of the two
tools does not know would be a flag that works for [flan build] and breaks
[C-c C-c].
Last one wins, which is what every compiler does with a repeated -O and the
only rule that does not need explaining. *)
let opt_levels = [ "-O0"; "-O1"; "-O2"; "-O3" ]
let opt_of args =
List.fold_left
(fun acc a -> if List.mem a opt_levels then Some a else acc)
None args
let is_flag a =
List.mem a flags || String.starts_with ~prefix:target_prefix a
List.mem a flags || List.mem a opt_levels
|| String.starts_with ~prefix:target_prefix a
(* [--debug] forces -O0 in [Build] and says why there: [llvm.dbg.declare]
describes an alloca and mem2reg deletes the alloca, so a debug build at -O2
has a line table over code whose locals are gone. That is a good rule, and
it makes [--debug -O2] a request that cannot be honoured — so it is refused
here by name instead of being quietly overruled two modules away. *)
let check_opt_against_debug ~debug ~opt =
match (debug, opt) with
| true, Some o when o <> "-O0" ->
prerr_endline
("flan: --debug and " ^ o
^ " ask for opposite things — a debug build is -O0 because \
llvm.dbg.declare describes an alloca and mem2reg at any higher level \
deletes it, leaving a line table over locals that are not there. \
Drop one of the two.");
exit 2
| _ -> ()
let target_of args =
List.find_map
@ -507,6 +567,8 @@ let () =
let debug = List.mem debug_flag rest in
let sanitize = List.mem sanitize_flag rest in
let x86 = List.mem x86_flag rest in
let opt = opt_of rest in
check_opt_against_debug ~debug ~opt;
let target = target_of rest in
let out =
match List.filter (fun a -> not (is_flag a)) rest with
@ -524,7 +586,8 @@ let () =
| _ -> base)
| _ ->
prerr_endline
"usage: flan build <file.flan> [-o out] [--no-bounds-checks] \
"usage: flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
[--no-bounds-checks] \
[--dev] [--debug] [--sanitize] [--target=wasm32-wasi|web]";
exit 2
in
@ -538,7 +601,9 @@ let () =
let p, csrcs, lflags = Flan.Reach.link ~dev l p in
ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; dev; debug; sanitize;
target; x86 }
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))
(* The daemon an editor talks to: one session, the program it belongs to
@ -626,6 +691,48 @@ let () =
this host can exec. Use flan build --target=... and a wasm runtime.";
exit 2
| _ :: "run" :: path :: args ->
(* One command, two argument lists, and until now no rule saying which was
which: [flan run game.flan --debug] built at -O2 and handed the game a
[--debug] it had never heard of. Nothing reported that, because neither
side thought it had been given anything wrong.
The rule, in one line: a build flag is the build's, [--] ends the build
flags, and everything after [--] is the program's whatever it looks
like. Before [--], an argument that starts with a dash and is not a
build flag this command offers is refused by name — not guessed at,
because guessing is the failure this exists to stop, and a program of
one's own that wants [-v] has [--] to ask for it. Plain arguments need
no ceremony: they were never ambiguous and they still go straight
through, so [flan run calc-me.flan "1+2"] is unchanged. *)
let run_flags = [ no_checks_flag; dev_flag; debug_flag; sanitize_flag;
x86_flag ] @ opt_levels in
let build_args, prog_args =
let rec split acc = function
| "--" :: rest -> (List.rev acc, rest)
| a :: rest when String.length a > 1 && a.[0] = '-' ->
if List.mem a run_flags then split (a :: acc) rest
else begin
prerr_endline
("flan run: " ^ a
^ " is not a flag this command offers, and it will not be \
guessed at — a build flag belongs to the build and \
anything else belongs to the program. Write it after -- to \
send it to the program: flan run "
^ Filename.basename path ^ " -- " ^ a);
exit 2
end
| a :: rest -> let l, r = split acc rest in (l, a :: r)
| [] -> (List.rev acc, [])
in
split [] args
in
let checks = not (List.mem no_checks_flag build_args) in
let dev = List.mem dev_flag build_args in
let debug = List.mem debug_flag build_args in
let sanitize = List.mem sanitize_flag build_args in
let x86 = List.mem x86_flag build_args in
let opt = opt_of build_args in
check_opt_against_debug ~debug ~opt;
with_errors path (fun () ->
let exe =
Filename.concat (Filename.get_temp_dir_name ())
@ -633,10 +740,17 @@ let () =
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
ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe);
let p, csrcs, lflags = Flan.Reach.link ~dev l p in
ignore (Flan.Build.executable
~opts:{ Flan.Build.default with checks; dev; 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);
let code =
Sys.command (String.concat " " (List.map Filename.quote (exe :: args)))
Sys.command
(String.concat " " (List.map Filename.quote (exe :: prog_args)))
in
(try Sys.remove exe with Sys_error _ -> ());
exit code)
@ -645,9 +759,10 @@ let () =
"usage: flan (read|parse|check|emit|shim) <file.flan>...\n flan emit <file.flan> [--x86] [--dev] [--debug] [--no-bounds-checks]\n\
\ flan import-c <header.h> [package.flan...] [clang flags...]\n\
\ flan generate-c <package-dir>\n\
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
\ flan build <file.flan> [-o out] [-O0|-O1|-O2|-O3] \
[--no-bounds-checks] [--dev] \
[--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\
\ flan run <file.flan> [args...]\n\
\ flan run <file.flan> [build flags...] [--] [program args...]\n\
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
\ flan dev <program.flan> [-s socket] [--x86]";
exit 2

65
test/test_acceptance.ml
View File

@ -3670,6 +3670,71 @@ ERR@7 unexpected token: not the kind the caller was reading
outputs ~opt:"-O0" "utf-8, splitting and ascii case, -O0"
"programs/utf8.flan" utf8_out;
(* ── The driver's own refusals ─────────────────────────────────────
Not about compiled code at all: about what the CLI does when it is
handed something it cannot do. Each of these was an escape before —
an OCaml exception printed by the default handler, or a build flag
silently forwarded to the program — and each is pinned here because
"it prints a sentence" is exactly the kind of claim that rots without
a test to hold it. *)
let cli args =
let out = Filename.concat scratch "flan-cli.out" in
let code =
Sys.command
(Printf.sprintf "../bin/main.exe %s > %s 2>&1" args (Filename.quote out))
in
let text = In_channel.with_open_bin out In_channel.input_all in
(try Sys.remove out with Sys_error _ -> ());
(code, text)
in
let cli_case name args ~code:want_code ~says =
let code, text = cli args in
let bad =
code <> want_code
|| List.exists (fun n -> not (contains text n)) says
(* The point of half of these: no arm here may end in OCaml's default
handler, whatever else it does. *)
|| contains text "Fatal error"
in
if bad then begin
incr failures;
Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted exit %d with %s\n"
name text code want_code (String.concat ", " says)
end
in
(* A path that is not there. This used to be
[Fatal error: exception Sys_error("...")] — the compiler reporting that
it had not expected to be asked. *)
cli_case "check on a file that is not there"
"check no-such-file.flan" ~code:1
~says:[ "no-such-file.flan"; "No such file or directory" ];
(* And every other front end takes the same route, since the arm is on the
one wrapper they all go through. *)
cli_case "build on a file that is not there"
"build no-such-file.flan -o /dev/null" ~code:1
~says:[ "no-such-file.flan" ];
(* [flan run] and its two argument lists. -O0 is the build's, so calc-me
never sees it and answers the expression that follows; before the split
it was handed "-O0" as the expression and said it could not parse it. *)
cli_case "run keeps a build flag out of the program's argv"
"run ../calc-me.flan -O0 '1+2'" ~code:0 ~says:[ "3" ];
(* -- hands the rest over whatever it looks like, which is what makes the
refusal below affordable. *)
cli_case "run passes everything after -- to the program"
"run ../calc-me.flan -O0 -- '3*4'" ~code:0 ~says:[ "12" ];
(* And an unknown dash argument is refused by name rather than guessed at
in either direction. *)
cli_case "run refuses a flag it does not offer"
"run ../calc-me.flan --lint" ~code:2
~says:[ "--lint"; "will not be guessed at"; "--" ];
(* The one pair of flags that cannot both be honoured: --debug is -O0 in
[Build] and says why, so asking for it alongside a higher level is a
request with two answers. *)
cli_case "--debug and an explicit -O are refused together"
"build ../calc-me.flan --debug -O2 -o /dev/null" ~code:2
~says:[ "--debug"; "-O2"; "Drop one of the two" ];
if !failures = 0 then print_endline "acceptance: all tests passed"
else begin
Printf.printf "\n%d failure(s)\n" !failures;