Joseph Ferano
ba2f5bc9bb
--debug is a third flag beside --dev and the optimisation level because it answers a third question. --dev is "can I redefine this while it runs"; --debug is "can I stop it and read it". Either is useful without the other, and a REPL session that is not being stepped should not pay for DWARF. Not implied by -O0 in particular, for a reason already written down in this file: the acceptance table runs the same programs at -O0 and -O2 to compare the emitted IR against what mem2reg makes of it. If -O0 pulled in debug info, every one of those comparisons would be against a different module. It does imply -O0 downwards, and sets it. The whole mechanism is an llvm.dbg.declare hanging off an alloca, and mem2reg deletes the alloca. Refused for wasm32 by name. The member offsets in the DWARF are computed for the host — ptr is 8 bytes — and wasm32's pointer is 4, so a slice's len sits at byte 8 there and byte 16 here. Emitting the host numbers would hand a debugger a confident wrong answer for every slice and every struct holding one, which is the exact failure this project keeps meeting at the FFI boundary. Silence would be worse than the refusal. -g reaches the C compiles too, and joins compile_c's digest key with it, or an object built without it would be served to a build that asked for it.
268 lines
12 KiB
OCaml
268 lines
12 KiB
OCaml
(* flan — milestone 2 driver. *)
|
|
|
|
let with_errors path f =
|
|
try f () with
|
|
| Flan.Loc.Error (loc, msg) ->
|
|
Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg;
|
|
ignore path;
|
|
exit 1
|
|
|
|
let summarise (d : Flan.Ast.decl) =
|
|
let open Flan.Ast in
|
|
match d.d with
|
|
| Package n -> Printf.sprintf "package %s" n
|
|
| Import (a, p) -> Printf.sprintf "import %s %S" a p
|
|
| Defalias (n, _) -> Printf.sprintf "defalias %s" n
|
|
| Defstruct (n, fs) -> Printf.sprintf "defstruct %s (%d fields)" n (List.length fs)
|
|
| Defunion (n, vs) -> Printf.sprintf "defunion %s (%d cases)" n (List.length vs)
|
|
| Defvar (n, _, _) -> Printf.sprintf "defvar %s" n
|
|
| Defconst (n, _, _) -> Printf.sprintf "defconst %s" n
|
|
| Declare (fn, csym) ->
|
|
Printf.sprintf "declare %s (%d params) = %s" fn.name (List.length fn.params)
|
|
csym
|
|
| DeclareC (fn, csym) ->
|
|
Printf.sprintf "declare-c %s (%d params) = %s" fn.name
|
|
(List.length fn.params) csym
|
|
| Defenum (n, ms) -> Printf.sprintf "defenum %s (%d members)" n (List.length ms)
|
|
| Defn fn ->
|
|
Printf.sprintf "defn %s (%d params, %s return, %d body forms)"
|
|
fn.name (List.length fn.params)
|
|
(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. *)
|
|
let load path : Flan.Load.t =
|
|
Flan.Load.program ~file:path (Flan.Parse.program (Flan.Reader.read_file path))
|
|
|
|
let checked path = Flan.Check.program (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
|
|
list and drops them — so the debug info would otherwise print [p0] for
|
|
every argument. Slots 0..n-1 are the parameters in order ([Tast.fn]), which
|
|
is what makes this recoverable here, from declarations that are already in
|
|
hand, rather than needing a change to the typed IR. It stops at the
|
|
parameters: a let-bound local's name is genuinely not available without one.
|
|
Only gathered for a debug build. *)
|
|
let param_names (l : Flan.Load.t) =
|
|
List.filter_map
|
|
(fun (d : Flan.Ast.decl) ->
|
|
match d.Flan.Ast.d with
|
|
| Flan.Ast.Defn fn ->
|
|
Some (fn.Flan.Ast.name,
|
|
List.map (fun (p : Flan.Ast.field) -> p.Flan.Ast.fname)
|
|
fn.Flan.Ast.params)
|
|
| _ -> None)
|
|
l.Flan.Load.decls
|
|
|
|
(* Bounds checks are on unless a build asks for them off — the release
|
|
decision, not the optimisation level (NEXT.md, Bounds checks). *)
|
|
let no_checks_flag = "--no-bounds-checks"
|
|
|
|
(* A dev build is the one a REPL can attach to: every call goes through a cell
|
|
so a redefinition can be installed, and the cells and globals are exported
|
|
so a loaded module can reach them (NEXT.md, the dev loop). *)
|
|
let dev_flag = "--dev"
|
|
|
|
(* Source-level debugging: DWARF in the IR, -g on the C, and -O0 forced.
|
|
Its own flag and not a mode of --dev, because the two answer different
|
|
questions — --dev is "can I redefine this while it runs", --debug is "can I
|
|
stop it and read it". See [Build.opts]. *)
|
|
let debug_flag = "--debug"
|
|
|
|
let flags = [ no_checks_flag; dev_flag; debug_flag ]
|
|
|
|
(* [--target=wasm32-wasi], the one cross target. Unlike the flags above it
|
|
carries a value, so it is matched by prefix and stripped from the residual
|
|
arguments by the same test — otherwise [-o out --target=X] falls into the
|
|
usage error. *)
|
|
let target_prefix = "--target="
|
|
|
|
let is_flag a =
|
|
List.mem a flags || String.starts_with ~prefix:target_prefix a
|
|
|
|
let target_of args =
|
|
List.find_map
|
|
(fun a ->
|
|
if String.starts_with ~prefix:target_prefix a then
|
|
Some (String.sub a (String.length target_prefix)
|
|
(String.length a - String.length target_prefix))
|
|
else None)
|
|
args
|
|
|
|
let () =
|
|
match Array.to_list Sys.argv with
|
|
| _ :: "read" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> List.iter (fun f -> print_endline (Flan.Form.to_string f))))
|
|
files
|
|
| _ :: "parse" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> List.iter (fun d -> print_endline (summarise d))))
|
|
files
|
|
| _ :: "check" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
let p = checked path in
|
|
List.iter
|
|
(fun (g : Flan.Tast.global) ->
|
|
Printf.printf "%s %s %s\n"
|
|
(if g.gconst then "defconst" else "defvar")
|
|
g.gname (Flan.Types.to_string g.gty))
|
|
p.globals;
|
|
List.iter
|
|
(fun (f : Flan.Tast.fn) ->
|
|
Printf.printf "defn %s : (Fn [%s] %s) %d slots\n" f.name
|
|
(String.concat " "
|
|
(List.map Flan.Types.to_string f.params))
|
|
(Flan.Types.to_string f.ret) (Array.length f.slots))
|
|
p.fns))
|
|
files
|
|
(* The generated C, for looking at. A wrong FFI binding is wrong in the
|
|
wrapper, and the wrapper is not on disk anywhere — [Build] hands the text
|
|
straight to clang — so without this the only way to read one is to catch
|
|
it in the object cache. *)
|
|
| _ :: "shim" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
match (checked path).Flan.Tast.cshim with
|
|
| [] -> Printf.printf "%s: no declare-c, so no generated C\n" path
|
|
| parts -> List.iter (fun (_, src) -> print_string src) parts))
|
|
files
|
|
(* The IR is target-independent — [Emit] writes no triple and no datalayout,
|
|
which is what lets one .ll serve both targets — so there is nothing for a
|
|
target to change here. Refused rather than accepted and ignored: silently
|
|
swallowing a flag is the shape the house rule exists to prevent. *)
|
|
| _ :: "emit" :: args when target_of args <> None ->
|
|
prerr_endline
|
|
"flan emit: --target is refused — the emitted IR carries no triple and \
|
|
no datalayout, and the target is chosen at build.";
|
|
exit 2
|
|
| _ :: "emit" :: args when List.exists (fun a -> not (is_flag a)) args ->
|
|
let checks = not (List.mem no_checks_flag args) in
|
|
let dev = List.mem dev_flag args in
|
|
let debug = List.mem debug_flag args in
|
|
let files = List.filter (fun a -> not (is_flag a)) args in
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
let l = load path in
|
|
let pnames = if debug then param_names l else [] in
|
|
Flan.Check.program l.decls
|
|
|> Flan.Emit.program ~checks ~dev ~debug ~pnames
|
|
|> print_string))
|
|
files
|
|
| _ :: "build" :: path :: rest ->
|
|
let checks = not (List.mem no_checks_flag rest) in
|
|
let dev = List.mem dev_flag rest in
|
|
let debug = List.mem debug_flag rest in
|
|
let target = target_of rest in
|
|
let out =
|
|
match List.filter (fun a -> not (is_flag a)) rest with
|
|
| [ "-o"; o ] -> o
|
|
| [] ->
|
|
let base = Filename.remove_extension (Filename.basename path) in
|
|
(* A wasm module is not an executable and must not be named like one:
|
|
the extension is what tells a runtime, and a reader, what it is. *)
|
|
(match target with
|
|
| Some t when String.starts_with ~prefix:"wasm32" t -> base ^ ".wasm"
|
|
| _ -> base)
|
|
| _ ->
|
|
prerr_endline
|
|
"usage: flan build <file.flan> [-o out] [--no-bounds-checks] \
|
|
[--dev] [--debug] [--target=wasm32-wasi]";
|
|
exit 2
|
|
in
|
|
with_errors path (fun () ->
|
|
let l = load path in
|
|
let p = Flan.Check.program 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
|
|
raylib and still be buildable for wasm32. *)
|
|
let p, csrcs, lflags = Flan.Reach.link ~dev l p in
|
|
ignore (Flan.Build.executable
|
|
~opts:{ Flan.Build.default with checks; dev; debug; target }
|
|
~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
|
|
running beside it, and a socket. Unlike [flan reload] the session persists,
|
|
so a defvar added by one evaluation is part of what the next one is checked
|
|
against — and it owns the build, which is what makes its layout rules
|
|
describe the process that is actually running. *)
|
|
| _ :: "dev" :: path :: rest ->
|
|
let sock =
|
|
match rest with
|
|
| [ "-s"; s ] -> s
|
|
| [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock"
|
|
| _ -> prerr_endline "usage: flan dev <program.flan> [-s socket]"; exit 2
|
|
in
|
|
with_errors path (fun () -> Flan.Dev.start ~file:path ~sock)
|
|
|
|
(* One redefinition, built the way an editor will ask for it: a session over
|
|
the program the process was built from, and a file of the forms that
|
|
changed. The session works out which names are new and whether the change
|
|
is one a running process can be told at all — neither of which a command
|
|
given only a list of function names could. *)
|
|
| _ :: "reload" :: prog :: forms :: rest ->
|
|
let out =
|
|
match rest with
|
|
| [ "-o"; o ] -> o
|
|
| [] -> Filename.remove_extension (Filename.basename forms) ^ ".so"
|
|
| _ ->
|
|
prerr_endline "usage: flan reload <program.flan> <forms.flan> [-o out.so]";
|
|
exit 2
|
|
in
|
|
with_errors forms (fun () ->
|
|
let t, _ = Flan.Session.create ~file:prog in
|
|
let src = In_channel.with_open_bin forms In_channel.input_all in
|
|
let c = Flan.Session.eval ~origin:forms t src in
|
|
let opts = { Flan.Build.default with dev = true } in
|
|
let timing = Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out () in
|
|
Printf.eprintf "%s %s llc %.1fms ld %.1fms\n" out
|
|
(String.concat " " c.Flan.Session.fns) timing.Flan.Build.llc_ms
|
|
timing.Flan.Build.link_ms)
|
|
(* [run] builds and execs. A .wasm is not executable, and picking a runtime
|
|
for it is a decision this command has no business making, so a cross
|
|
target is refused here by name rather than half-supported. *)
|
|
| _ :: "run" :: _ :: args when target_of args <> None ->
|
|
prerr_endline
|
|
"flan run: --target is refused — a cross-built module is not something \
|
|
this host can exec. Use flan build --target=... and a wasm runtime.";
|
|
exit 2
|
|
| _ :: "run" :: path :: args ->
|
|
with_errors path (fun () ->
|
|
let exe =
|
|
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 l.decls in
|
|
let p, csrcs, lflags = Flan.Reach.link l p in
|
|
ignore (Flan.Build.executable ~csrcs ~lflags p ~out:exe);
|
|
let code =
|
|
Sys.command (String.concat " " (List.map Filename.quote (exe :: args)))
|
|
in
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
exit code)
|
|
| _ ->
|
|
prerr_endline
|
|
"usage: flan (read|parse|check|emit|shim) <file.flan>...\n\
|
|
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
|
|
[--debug] [--target=wasm32-wasi]\n\
|
|
\ flan run <file.flan> [args...]\n\
|
|
\ flan reload <program.flan> <forms.flan> [-o out.so]\n\
|
|
\ flan dev <program.flan> [-s socket]";
|
|
exit 2
|