Joseph Ferano
8a175ebec5
The wasi-sdk candidate had an LLVM version in it, which moves release to release — so the path advertised as the proper article would have matched only by coincidence, while the emscripten one beside it was derived. Both are derived now. calc-me on wasm32 covers what the other three cases cannot: flan_argv hands Flan an array of flan_slice built in C, so what it pins is the element stride of a ptr+len pair — 16 bytes native, 12 on wasm32 — rather than a field offset. It is also the claim in this file's own header, that the table runs on the second target, honoured for the first time. flan emit refuses --target rather than stripping it. The IR really is target-free, so ignoring it is correct and silence about it is not.
215 lines
8.9 KiB
OCaml
215 lines
8.9 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
|
|
| 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
|
|
|
|
(* 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"
|
|
|
|
let flags = [ no_checks_flag; dev_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 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 files = List.filter (fun a -> not (is_flag a)) args in
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
checked path |> Flan.Emit.program ~checks ~dev |> 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 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] [--target=wasm32-wasi]";
|
|
exit 2
|
|
in
|
|
with_errors path (fun () ->
|
|
let l = load path in
|
|
let p = Flan.Check.program l.decls in
|
|
ignore (Flan.Build.executable
|
|
~opts:{ Flan.Build.default with checks; dev; target }
|
|
~csrcs:l.csrcs ~lflags:l.lflags 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
|
|
ignore (Flan.Build.executable ~csrcs:l.csrcs ~lflags:l.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) <file.flan>...\n\
|
|
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
|
|
[--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
|