JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
flan/bin/main.ml
Joseph Ferano 238f65db59 A listing says which form it came from, and what each slot is 
`flan emit --x86` printed a three-line header and then nothing but .byte
blobs. The information was all there and none of it was written down.

Each run of bytes is now headed by the Flan form that produced it, with the
position it was written at, indented by how deeply the form nests. The
headings are queued rather than written, so a form that emits nothing does
not leave its heading on the next form's bytes; atoms queue none at all,
because a literal operand would otherwise steal the heading standing above
the imul that consumes it.

Above each function is a frame map, which is the half no disassembly
recovers: every value in this backend lives in a frame temporary, so
-0x20(%rbp) is the whole vocabulary of the listing and nothing says what it
means. It is read out of what emit_fn already keeps, so it cannot drift.
Beside it, where the arguments arrived and whether there is a hidden sret.

And the bookkeeping is named where it appears -- the transfer guard, the
bounds triple, the arithmetic guards, rep movsb, the dev indirection cell --
with each explained once in a legend at the top rather than at every site.

Always on for `emit --x86`, which exists to be read, and never for a build,
whose .s is a temp file handed to clang. spike/x86/annot.sh is the check that
this costs no byte: emit both ways, assemble both, compare every section.
342 SAME / 0 DIFFER over the corpus in default, --dev and --debug. dump.sh
now shows the annotated listing beside objdump's disassembly -- why beside
what, which is the pairing that answers the mnemonics question.

survey.sh has not been run on this; see the handoff.
2026-09-14 11:54:36 +07:00

635 lines
28 KiB
OCaml
Raw Blame History

(* flan — milestone 2 driver. *)
(* Both error channels, in the one place that prints them. A single refusal
still exits 1 and still opens with [file:line:col: message]; a driver that
got to the end of the file hands over everything it found, sorted, with a
count after it. Nothing here parses the message — the squiggle comes from
the span and the classification from the kind. *)
let with_errors path f =
try f () with
| Flan.Loc.Error d ->
prerr_endline (Flan.Loc.report d);
ignore path;
exit 1
| Flan.Loc.Errors ds ->
prerr_endline (Flan.Loc.report_all ds);
ignore path;
exit 1
(* The dev backend's own refusal, which is not a program error: the program
is fine and this backend does not lower it. Its own exit status, so that
a sweep comparing the two backends can count "refused by name" apart from
"did not compile". *)
| Flan.X86.Unsupported m ->
prerr_endline ("x86: " ^ m);
ignore path;
exit 3
(* A refusal with no location: a combination of flags this command does not
offer, or a build step that failed. Every [failwith] this binary can reach
is one of those, and a sentence is what a user can act on where an
uncaught OCaml exception and its backtrace are not. *)
| Failure m ->
prerr_endline ("flan: " ^ m);
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. *)
(* 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
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
(* 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"
(* ASan and UBSan over the whole program, the runtime's C and the Flan alike.
Its own flag for the same reason --debug is: it answers "is this program
touching memory it does not own", which is neither of the other two
questions. It does not imply -O0 — see [Build.opts], which also records
what each of the two sanitizers actually reaches. *)
let sanitize_flag = "--sanitize"
(* [flan dev] builds one binary that is the program and holds the compiler,
and serves the editor from a thread inside it. This asks for the old shape
instead — a compiler process that launches the program and talks to it over
a socket. It is the escape hatch for a machine that cannot build the
compiler object (no ocamlfind, no flan.cmxa beside this binary), not a
preference, and it goes away with the transport it drives. *)
let two_process_flag = "--two-process"
(* The hand-written x86-64 backend (lib/x86.ml) instead of LLVM. The dev
backend from docs/DISCUSS.md item 15, off by default and named explicitly:
LLVM stays the release path and the default one. It covers a subset of the
IR and refuses the rest by name, so a build that succeeds is one it really
compiled. *)
let x86_flag = "--x86"
(* [flan emit --x86] annotates, because it exists to be read. This turns that
off, and the only caller who wants it is the test that assembles the listing
both ways and compares the object's sections byte for byte -- a claim that
comments and the splitting of a [.byte] directive are invisible to the
assembler is worth measuring rather than asserting. *)
let no_annotate_flag = "--no-annotate"
let flags =
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
x86_flag; no_annotate_flag ]
(* [--target=wasm32-wasi] and [--target=web], the two cross targets. Unlike
the flags above, a target
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_all
|> 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
(* A header, read. The importer is a pure function of the header and the
package beside it, so it can be looked at without building anything —
which is what makes the diff against a hand-written binding possible, and
what makes "generate once and commit the result" a usable option rather
than a description of one. Prints the declarations it would produce, then
what it refused and why, then how the package's defstructs compare with
the header's records. *)
| _ :: "import-c" :: header :: rest ->
with_errors header (fun () ->
let pkg = List.filter (fun a -> Filename.check_suffix a ".flan") rest in
let flags =
List.filter (fun a -> not (Filename.check_suffix a ".flan")) rest
in
let ds =
List.concat_map
(fun f -> Flan.Parse.program (Flan.Reader.read_file f)) pkg
in
let structs =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.Defstruct (n, fs) -> Some (n, fs)
| _ -> None)
ds
in
let known_enums =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.Defenum (n, _) -> Some n
| _ -> None)
ds
in
let taken = Hashtbl.create 64 in
List.iter
(fun d ->
match Flan.Ast.declared_name d with
| Some n -> Hashtbl.replace taken n ()
| None -> ())
ds;
let bound_syms =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.Declare (_, s) | Flan.Ast.DeclareC (_, s) -> Some s
| _ -> None)
ds
in
let imported, dump, env =
Flan.Cimport.header ~loc:(Flan.Loc.make header 0 0) ~header ~flags
~known_structs:(List.map fst structs) ~known_enums ~taken ~bound_syms
~config:
(match pkg with
| f :: _ -> Flan.Load.binding_config (Filename.dirname f)
| [] -> Flan.Cimport.no_config)
in
List.iter
(fun d -> print_endline (Flan.Cimport.decl_source d))
imported.Flan.Cimport.decls;
Printf.printf "\n;; %d imported, %d refused, of %d functions in %s\n"
(List.length imported.Flan.Cimport.decls)
(List.length imported.Flan.Cimport.hidden)
(List.length dump.Flan.Cimport.fns) header;
List.iter
(fun (n, why) -> Printf.printf ";; refused %s: %s\n" n why)
imported.Flan.Cimport.hidden;
(match Flan.Cimport.check_structs ~env ~structs dump with
| [] ->
if structs <> [] then
Printf.printf ";; every defstruct agrees with the header\n"
| bad ->
List.iter
(fun (n, why) -> Printf.printf ";; DISAGREES %s: %s\n" n why)
bad);
(* And the bindings the package already wrote by hand, against the
header's own signatures. Nothing else in the build can do this: a
wrong declare-c is wrong in the generated prototype too, so the two
agree with each other and only the library disagrees. *)
let bound =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.DeclareC (fn, sym) -> Some (fn, sym)
| _ -> None)
ds
in
if bound <> [] then
(match Flan.Cimport.diff_bound ~env ~bound dump with
| [] ->
Printf.printf
";; all %d hand-written declare-c agree with the header\n"
(List.length bound)
| diffs ->
Printf.printf ";; %d of %d hand-written declare-c disagree\n"
(List.length diffs) (List.length bound);
List.iter
(fun (x : Flan.Cimport.sig_diff) ->
Printf.printf ";; DIFFERS %s (%s): %s\n"
x.Flan.Cimport.dflan x.Flan.Cimport.dsym x.Flan.Cimport.dwhy)
diffs);
(* And the constants, which until now nothing read at all: a wrong flag
bit or a wrong enum member is the one kind of error here that is
completely silent. *)
let enums =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.Defenum (n, ms) -> Some (n, ms)
| _ -> None)
ds
and pconsts =
List.filter_map
(fun (d : Flan.Ast.decl) ->
match d.Flan.Ast.d with
| Flan.Ast.Defconst (n, _, e) -> Some (n, e)
| _ -> None)
ds
in
let config =
match pkg with
| f :: _ -> Flan.Load.binding_config (Filename.dirname f)
| [] -> Flan.Cimport.no_config
in
(match Flan.Cimport.check_constants ~config ~enums ~consts:pconsts dump with
| [] ->
if enums <> [] then
Printf.printf ";; every defenum member agrees with the header\n"
| bad ->
List.iter
(fun (x : Flan.Cimport.const_diff) ->
Printf.printf ";; %s %s: %s\n"
(if x.Flan.Cimport.cmapping then "UNMAPPED" else "DISAGREES")
x.Flan.Cimport.cname x.Flan.Cimport.cwhy)
bad))
(* Regeneration. [import-c] prints what it would produce; this writes it, and
the difference between the two is that this one cannot skip the check.
It reads the header out of the package's own `headers`, not off the
command line, because the version that may be read is a property of the
package — `headers` is where it says which one, and `link` is where it
says which library that has to match. And it reads every .flan in the
directory *except* the file it writes, so the hand-written declarations
still win and the generated ones are not mistaken for them on the next
run.
Non-zero and nothing written when the package and the header disagree.
That is the whole point: the committed file is the one thing here with no
second opinion, so the moment of writing it is the only moment left at
which the library can contradict it. *)
| _ :: "generate-c" :: dir :: _ ->
with_errors dir (fun () ->
let loc = Flan.Loc.make dir 0 0 in
let out = Filename.concat dir "generated.flan" in
let ds =
List.concat_map
(fun f -> Flan.Parse.program (Flan.Reader.read_file f))
(List.filter
(fun f -> not (String.equal f out))
(Flan.Load.entries dir ".flan"))
in
let config = Flan.Load.binding_config dir in
match Flan.Load.header_specs ~loc dir with
| [] ->
Printf.eprintf
"flan generate-c: %s/headers names no header that is there. \
Regeneration reads the library's own header, at the version \
%s/link names — export it and run this again.\n" dir dir;
exit 2
| _ :: _ :: _ ->
Printf.eprintf
"flan generate-c: %s/headers names more than one header, and one \
generated file cannot come from several — the declarations would \
depend on which was read last.\n" dir;
exit 2
| [ (h, flags) ] ->
let r = Flan.Cimport.regenerate ~loc ~header:h ~flags ~ds ~config ~out in
List.iter
(fun (n, why) -> Printf.printf ";; refused %s: %s\n" n why)
r.Flan.Cimport.ghidden;
List.iter
(fun (n, why) -> Printf.eprintf "DISAGREES %s: %s\n" n why)
r.Flan.Cimport.gstructs;
List.iter
(fun (x : Flan.Cimport.sig_diff) ->
Printf.eprintf "DIFFERS %s (%s): %s\n"
x.Flan.Cimport.dflan x.Flan.Cimport.dsym x.Flan.Cimport.dwhy)
r.Flan.Cimport.gsigs;
List.iter
(fun (x : Flan.Cimport.const_diff) ->
Printf.eprintf "%s %s: %s\n"
(if x.Flan.Cimport.cmapping then "UNMAPPED" else "DISAGREES")
x.Flan.Cimport.cname x.Flan.Cimport.cwhy)
r.Flan.Cimport.gconsts;
if r.Flan.Cimport.gwrote then
Printf.printf
"wrote %s: %d declarations, %d refused, of %d functions in %s.\n\
Every defstruct, every hand-written declare-c and every mapped\n\
constant agrees with it.\n"
out r.Flan.Cimport.gdecls
(List.length r.Flan.Cimport.ghidden) r.Flan.Cimport.gfns h
else begin
Printf.eprintf
"flan generate-c: %s does not agree with %s — %d struct layouts, \
%d hand-written signatures and %d constants, of which %d are a \
mapping the package has not declared. Nothing was written: a \
generated file made against a header the library does not match \
is the silent failure this check exists to prevent, and a \
constant nothing is mapped to is one nothing checks.\n"
dir h
(List.length r.Flan.Cimport.gstructs)
(List.length r.Flan.Cimport.gsigs)
(List.length r.Flan.Cimport.gconsts)
(List.length
(List.filter
(fun (x : Flan.Cimport.const_diff) -> x.Flan.Cimport.cmapping)
r.Flan.Cimport.gconsts));
exit 1
end)
(* 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
(* --x86 prints the hand-written backend's assembly where the default prints
LLVM IR. The two are the same act — here is what this program compiles to,
before an assembler or an optimiser has touched it — and reading one
against the other is the only way to check a lowering by eye. --sanitize
is refused rather than ignored: ASan is an LLVM pass and this backend has
no arm for it, so honouring the flag is impossible and dropping it
silently would print something that is not what --sanitize builds. *)
| _ :: "emit" :: args
when List.mem x86_flag args && List.exists (fun a -> not (is_flag a)) args ->
if List.mem sanitize_flag args then begin
prerr_endline
"flan emit --x86: --sanitize is an LLVM pass and this backend has no \
arm for it — emit without --x86 to see what a sanitized build compiles.";
exit 2
end;
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
(* The listing is annotated because a listing is what this command is for:
a person asked to see what their program compiles to, and a wall of
[.byte] with nothing saying which form produced which run answers the
letter of that and not the question. --no-annotate is here for the one
consumer that wants the bare spelling, which is the check that says
annotation changed no byte of the object. *)
let annotate = not (List.mem no_annotate_flag args) in
let files = List.filter (fun a -> not (is_flag a)) args in
List.iter
(fun path ->
with_errors path (fun () ->
load path |> fun l ->
Flan.Check.program_all l.decls
|> Flan.X86.program ~checks ~dev ~debug ~annotate
|> print_string))
files
| _ :: "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
(* --sanitize changes the IR — every [define] names the attribute group
ASan's pass selects on — so [emit] has to honour it or what this prints
is not what a sanitized build compiles. *)
let sanitize = List.mem sanitize_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_all l.decls
|> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize
|> 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 sanitize = List.mem sanitize_flag rest in
let x86 = List.mem x86_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. *)
(* A web build is three files — the page, its JS and the module — and
the page is the one named here: emcc derives the other two from it,
and it is the one a browser opens. *)
(match target with
| Some t when Flan.Build.is_web t -> base ^ ".html"
| 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] [--sanitize] [--target=wasm32-wasi|web]";
exit 2
in
with_errors path (fun () ->
let l = load path 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
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; sanitize;
target; x86 }
~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 ->
(* --debug builds the host *and* every module this daemon sends with DWARF,
which is one flag because it is one decision: a line breakpoint in a
.flan buffer needs a line table on the host to fire at all, and one in
each redefinition module to still be firing after C-c C-c. It implies
-O0 on both, so it is asked for rather than assumed. *)
let debug = List.mem debug_flag rest in
(* One flag for both halves of the session, which is what makes it safe at
all: the host and every module this daemon sends are compiled by the
same backend, because there is one place that says which. The two
conventions agree on every scalar and disagree on every aggregate, so a
crossed pair is correct until the first redefined function takes or
returns a struct — and [flan.abi.x86] refuses that pair at [dlopen] if
this is ever got wrong. Off by default: LLVM stays the default path
here exactly as it is for [flan build]. *)
let x86 = List.mem x86_flag rest in
let merged = not (List.mem two_process_flag rest) in
let rest = List.filter (fun a -> not (is_flag a)) rest in
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] [--debug] [--x86] \
[--two-process]";
exit 2
in
with_errors path (fun () ->
Flan.Dev.start ~debug ~merged ~x86 ~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 debug = List.mem debug_flag rest in
(* The same flag, for the same reason, and it had to arrive with [flan
dev]'s: a command that could build a module for a host the other backend
compiled is how the crossed pair was reachable from the CLI at all.
Building an --x86 host with [flan build --x86 --dev] and then reloading
into it now has a spelling that produces a module it can load. *)
let x86 = List.mem x86_flag rest in
let rest = List.filter (fun a -> not (is_flag a)) rest in
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] \
[--debug] [--x86]";
exit 2
in
with_errors forms (fun () ->
let t, _ = Flan.Session.create ~debug ~x86 ~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; debug; x86 } in
let timing =
if c.Flan.Session.x86 then
Flan.Build.shared_x86 ~opts ~asm:c.Flan.Session.ir ~out ()
else Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out ()
in
(* [as] where the other path has [llc], which is the number the whole
backend exists to move. Named for what ran. *)
Printf.eprintf "%s %s %s %.1fms ld %.1fms\n" out
(String.concat " " c.Flan.Session.fns)
(if x86 then "as " else "llc") 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_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 =
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 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] \
[--debug] [--sanitize] [--x86] [--target=wasm32-wasi|web]\n\
\ flan run <file.flan> [args...]\n\
\ flan reload <program.flan> <forms.flan> [-o out.so] [--x86]\n\
\ flan dev <program.flan> [-s socket] [--x86]";
exit 2
Reference in New Issue View Git Blame Copy Permalink