(** Driver: typed IR → an executable, via LLVM IR text and clang.

    The release path from plan.org, Compilation:

    {v flan → typed IR → .ll → clang --target={native,wasm32} v}

    Three targets now, and the third takes a different driver: the browser is
    built by emcc, which accepts the same .ll. See [is_web].

    Not the dev path — that one never invokes the clang driver, because the
    driver *is* the cost, and goes llc + ld -shared + dlopen instead. That is
    [shared], at the bottom of this file, measured at ~19ms. *)

let clang = try Sys.getenv "FLAN_CLANG" with Not_found -> "clang"

(* The browser target's compiler. emcc is a clang driver with a sysroot, a
   builtins archive, a JS runtime and an HTML shell already attached, so the
   whole of [wasm_sysroot], [wasm_builtins] and [wasm_resource_dir] below —
   everything the wasi target has to find by hand — is what emcc *is*. It also
   accepts a .ll on its command line, which is the one thing that had to be
   true for this target to exist at all: [Emit] writes IR text and nothing
   else. *)
let emcc = try Sys.getenv "FLAN_EMCC" with Not_found -> "emcc"

let write path contents =
  let ch = open_out path in
  output_string ch contents;
  close_out ch

let write_bin path contents =
  let ch = open_out_bin path in
  output_string ch contents;
  close_out ch

let read_file path =
  let ch = open_in_bin path in
  let n = in_channel_length ch in
  let s = really_input_string ch n in
  close_in ch;
  s

let read_file_opt path =
  try Some (read_file path) with Sys_error _ -> None

(* One temporary directory per build, so the .ll is findable by name when
   something is wrong with it. *)
let workdir () =
  let d =
    Filename.concat (Filename.get_temp_dir_name ())
      (Printf.sprintf "flan-%d" (Unix.getpid ()))
  in
  (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  d

(* The object cache, which unlike [workdir] is stable across builds. The C that
   goes into a build — the host shim and the packages' shims — is the same on
   every build and never the thing being edited, yet it was being recompiled
   each time: 40ms of a 140ms build for [flan_rt.c] alone. *)
let cachedir () =
  let d = Filename.concat (Filename.get_temp_dir_name ()) "flan-objcache" in
  (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  d

type opts = {
  (* None is the host. "wasm32-wasi" is the headless one, run by a WASI
     runtime; "web" is the browser one, built by emscripten. They share the
     word wasm and almost nothing else — see [is_wasi] and [is_web]. *)
  target : string option;
  opt    : string;
  keep   : bool;            (* leave the .ll behind *)
  checks : bool;            (* bounds-check [at] and [slice] *)
  (* A dev build is the one a REPL can attach to. Two things, and they belong
     together because either alone is useless: every cross-function call goes
     through a cell so a redefinition can be installed, and [-rdynamic] exports
     those cells (and the globals) so a dlopen'd module can reach them. *)
  dev : bool;
  (* DWARF in the .ll and -g on the C, so lldb can put a breakpoint on a Flan
     function by name and print its locals.

     Its own axis, and deliberately not implied by -O0. The acceptance table
     runs the same programs at -O0 and -O2 to compare the emitted IR against
     what mem2reg makes of it, and if -O0 pulled in debug info every one of
     those comparisons would be against a different module. It is not implied
     by [dev] either: a dev build is about reloading, this is about reading,
     and either is useful without the other. What it *does* imply, downwards,
     is -O0 -- see [executable], where it sets [opt] -- because the whole
     mechanism is a [llvm.dbg.declare] on an alloca and mem2reg deletes the
     alloca. *)
  debug : bool;
  (* AddressSanitizer and UndefinedBehaviorSanitizer over the whole program:
     the runtime's C, the generated shim, and — via [Emit]'s
     [sanitize_address] attribute — the Flan code itself.

     Its own axis and not a mode of [debug]. It deliberately does *not* force
     -O0: the UB worth finding (a shift past the width folding to nothing, a
     float cast that only traps once it is a real cvttss2si) is what the
     optimiser does with it, so the sweep is worth running at -O2 and at -O0
     and any divergence between the two is itself the finding. It does pull in
     -g, because a report without a line number costs more to read than the
     build costs to make.

     What reaches what, measured rather than assumed:
       - ASan instruments Flan functions only because [Emit] attributes them;
         globals get their redzone from the module pass either way.
       - UBSan instruments the C only. Its checks come out of clang's C
         frontend, and there is no attribute that asks a pass for them, so
         hand-written IR gets none. See [Emit]'s [sanitize] comment.
       - signed-integer-overflow is excluded because wrapping is what this
         language's arithmetic means; without the exclusion every program
         trips on its first [+]. Nothing else is excluded. *)
  sanitize : bool;
}

(* Checks are deliberately independent of [opt]: the acceptance table runs the
   same programs at -O0 and -O2 to compare the emitted IR against what mem2reg
   makes of it, and that comparison is only meaningful if both emit the same
   checks. Dropping them is a release decision, not an optimisation one. *)
let default =
  { target = None; opt = "-O2"; keep = false; checks = true; dev = false;
    debug = false; sanitize = false }

(* The flags that are neither [opt] nor the target, spelled once so that the
   compile command and the object-cache key cannot disagree. They did before:
   -g was written out at the command and again at the key, and a flag that
   appears in one and not the other is the silent failure — an unsanitized
   [flan_rt.o] served out of the cache to a sanitized build links fine and
   reports nothing. *)
let cflags opts =
  (if opts.debug then [ "-g" ] else [])
  @ (if opts.sanitize then
       (* -g here and not via [debug]: a sanitizer report with no file and no
          line is most of the work still to do. *)
       [ "-fsanitize=address,undefined";
         "-fno-sanitize=signed-integer-overflow";
         "-fno-omit-frame-pointer" ]
       @ (if opts.debug then [] else [ "-g" ])
     else [])

(* ── wasm32, which needs more than a triple ──────────────────────────
   The native target is whatever clang was built for, so [--target=] alone is
   the whole of it. wasm32-wasi is not: the headers come from a sysroot clang
   does not know about, and the builtins archive is not in clang's resource
   directory on Fedora at all. Both have to be found, and *both* have to reach
   the C compiles as well as the link — [flan_rt.c] includes <stdio.h>.

   Anything missing is refused by name, with the path that is missing and the
   package that would supply it. A build that reports success for a target it
   cannot actually produce is the one outcome worth avoiding here. *)

let getenv name = try Some (Sys.getenv name) with Not_found -> None

(* ── Two wasm targets, spelled apart ─────────────────────────────────
   [web] is emscripten's: a browser, a GL context, a JS runtime, and a clang
   whose sysroot and builtins come with it. [wasm32-wasi] is the headless one:
   a WASI runtime, no GL, no browser, and a sysroot this file has to find.
   "wasm32-unknown-emscripten" is accepted as a synonym for [web] because that
   is the triple, and someone will write it.

   What the two share is the machine — 32-bit pointers, no dlopen — which is
   exactly the set of things [is_wasm] guards: the three refusals below are
   about the machine and so they apply to both. *)
let is_web t =
  t = "web" || t = "emscripten"
  || String.starts_with ~prefix:"wasm32-unknown-emscripten" t
  || String.starts_with ~prefix:"wasm32-emscripten" t

let is_wasi t = String.starts_with ~prefix:"wasm32" t && not (is_web t)
let is_wasm t = is_web t || is_wasi t

let wasm_target opts =
  match opts.target with Some t when is_wasm t -> true | _ -> false

let web_target opts =
  match opts.target with Some t when is_web t -> true | _ -> false

let wasi_target opts =
  match opts.target with Some t when is_wasi t -> true | _ -> false

(* Which compiler a target is built by. This is not a flag difference: emcc is
   a different program with a different driver, and the object cache key below
   carries it for the same reason it carries clang's mtime. *)
let compiler opts = if web_target opts then emcc else clang

(* Where on PATH a program is, or None. *)
let on_path prog =
  let dirs = String.split_on_char ':' (try Sys.getenv "PATH" with Not_found -> "") in
  List.find_map
    (fun d ->
       let p = Filename.concat d prog in
       if Sys.file_exists p then Some p else None)
    dirs

let wasm_sysroot () =
  match getenv "FLAN_WASM_SYSROOT" with Some s -> s | None -> "/usr/wasm32-wasi"

(* The builtins archive — __muldi3, the float conversions, memcpy. Fedora's
   clang ships no wasm copy of it (dnf provides '*libclang_rt.builtins*wasm*'
   finds nothing) and the proper article comes from a wasi-sdk release.
   Failing that, emscripten builds the same compiler-rt for wasm32 and calls it
   libcompiler_rt.a; it is a different triple (wasm32-unknown-emscripten) built
   by a different clang, and it is *substituting* here, not the real thing. It
   links and runs, and the sand hash matches native byte for byte, but a
   session reading this should know the joint is glued. *)
let wasm_builtins_candidates () =
  (* wasi-sdk's own resource directory, whichever LLVM that release bundled —
     the version is in the path and moves release to release, so it is read
     rather than guessed. Same rule as [clang_resource_dir]. *)
  (let root = "/opt/wasi-sdk/lib/clang" in
   match Sys.readdir root with
   | vs ->
     Array.sort compare vs;
     Array.to_list vs
     |> List.map (fun v ->
          Filename.concat root
            (Filename.concat v "lib/wasm32-unknown-wasi/libclang_rt.builtins.a"))
   | exception Sys_error _ -> [])
  @ (match on_path "emcc" with
     | None -> []
     | Some e ->
       [ Filename.concat (Filename.dirname e)
           "cache/sysroot/lib/wasm32-emscripten/libcompiler_rt.a" ])

let wasm_builtins () =
  (* An explicit FLAN_WASM_BUILTINS that does not exist is an error and not a
     hint: falling back to a guess would build against something other than
     what was asked for and say nothing. *)
  match getenv "FLAN_WASM_BUILTINS" with
  | Some s when Sys.file_exists s -> s
  | Some s ->
    failwith (Printf.sprintf "wasm32: FLAN_WASM_BUILTINS is %s, which does not exist" s)
  | None ->
  let cands = wasm_builtins_candidates () in
  match List.find_opt Sys.file_exists cands with
  | Some p -> p
  | None ->
    failwith
      (Printf.sprintf
         "wasm32: no builtins archive. clang wants \
          <resource-dir>/lib/wasm32-unknown-wasi/libclang_rt.builtins.a, which \
          no Fedora package provides; it comes from a wasi-sdk release, or \
          emscripten's libcompiler_rt.a will substitute. Looked in: %s. Set \
          FLAN_WASM_BUILTINS to the archive."
         (String.concat ", " cands))

(* clang's own resource directory, asked for rather than guessed — the version
   number is in the path and a Fedora clang bump changes it. *)
let clang_resource_dir =
  lazy
    (let tmp =
       Filename.concat (Filename.get_temp_dir_name ())
         (Printf.sprintf "flan-rd-%d" (Unix.getpid ()))
     in
     let code =
       Sys.command
         (Printf.sprintf "%s -print-resource-dir > %s 2>/dev/null"
            (Filename.quote clang) (Filename.quote tmp))
     in
     let s = if code = 0 then read_file_opt tmp else None in
     (try Sys.remove tmp with Sys_error _ -> ());
     match s with
     | Some s -> String.trim s
     | None -> failwith "wasm32: clang -print-resource-dir failed")

(* A resource directory clang will accept for wasm32-wasi: its real include
   directory, and the builtins archive under the name and triple clang looks
   for. Built under the object cache and named by a digest of what went into
   it, so repointing FLAN_WASM_BUILTINS or upgrading clang makes a new one
   rather than reusing a stale one. *)
let wasm_resource_dir () =
  let real = Lazy.force clang_resource_dir in
  let builtins = wasm_builtins () in
  let st = Unix.stat builtins in
  let key =
    Digest.to_hex
      (Digest.string
         (String.concat "\000"
            [ real; builtins; string_of_int st.Unix.st_size;
              string_of_float st.Unix.st_mtime ]))
  in
  let dir = Filename.concat (cachedir ()) ("wasm-rd-" ^ key) in
  let lib = Filename.concat dir "lib" in
  let triple = Filename.concat lib "wasm32-unknown-wasi" in
  let archive = Filename.concat triple "libclang_rt.builtins.a" in
  if not (Sys.file_exists archive) then begin
    let mk d = try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> () in
    mk dir; mk lib; mk triple;
    let inc = Filename.concat dir "include" in
    if not (Sys.file_exists inc) then
      (try Unix.symlink (Filename.concat real "include") inc
       with Unix.Unix_error _ -> ());
    let tmp = Printf.sprintf "%s.%d.tmp" archive (Unix.getpid ()) in
    write_bin tmp (read_file builtins);
    (try Unix.rename tmp archive with Unix.Unix_error _ -> ())
  end;
  dir

(* The flags a target adds, used by the C compiles and by the link alike. *)
let target_flags opts =
  match opts.target with
  | None -> []
  (* The browser target adds no flags to a compile at all: emcc already is the
     triple, the sysroot and the builtins. What it does need is to exist, and
     an emcc that is not there must be refused here — where the reason can name
     it — and not at the first "command not found" from a subshell. *)
  | Some t when is_web t ->
    if on_path emcc = None && not (Sys.file_exists emcc) then
      failwith
        (Printf.sprintf
           "web: no %s on PATH. The browser target is built by emscripten: \
            install an emsdk and source its emsdk_env.sh, or set FLAN_EMCC to \
            the emcc to use."
           emcc);
    []
  | Some t when not (is_wasm t) -> [ "--target=" ^ t ]
  | Some t ->
    let sysroot = wasm_sysroot () in
    (* Fedora's wasi-libc puts the headers one level deeper than wasi-sdk's
       does — include/wasm32-wasi/stdio.h against include/stdio.h — so both
       shapes count as a sysroot. clang finds either on its own. *)
    if not (List.exists
              (fun p -> Sys.file_exists (Filename.concat sysroot p))
              [ "include/stdio.h"; "include/wasm32-wasi/stdio.h" ])
    then
      failwith
        (Printf.sprintf
           "wasm32: no sysroot at %s (wanted include/stdio.h). Install \
            wasi-libc-devel and wasi-libc-static, or set FLAN_WASM_SYSROOT."
           sysroot);
    [ "--target=" ^ t; "--sysroot=" ^ sysroot;
      "-resource-dir=" ^ wasm_resource_dir () ]

(* wasi-libc's start code calls __main_argc_argv, not main: clang *renames*
   C's argc/argv [main] to that when it compiles C for wasm32, and the .ll
   Emit writes says @main literally. Without this the link succeeds and the
   program traps at its first instruction on a signature-mismatched weak stub.
   The __asm__ label is load-bearing and must not be "simplified" away —
   spelling the callee [main] makes clang rename *that* too, and the shim
   becomes an infinite self-call that hangs rather than failing. *)
let wasm_main_source =
  "int flan_entry(int argc, char **argv) __asm__(\"main\");\n\
   int __main_argc_argv(int argc, char **argv) { return flan_entry(argc, argv); }\n"

(* ── The browser: the main loop, the shell, and the link ─────────────
   The mechanism, and why it is not the one the old note predicted.

   BUILT.md says a web build "drives the loop with [emscripten_set_main_loop]
   instead of a [while]. That is a different [main], not a different program."
   The first half is right about the browser and wrong about what it costs
   here: [emscripten_set_main_loop] wants the loop body as a callback, so every
   example that spells

       (until (rl/window-should-close?) ...)

   would have to be cut in half — an init and a tick — by hand, in every file,
   and the resulting program would no longer be the one that runs natively.

   [-sASYNCIFY] is the other half of the same browser fact and costs none of
   that. It rewrites the module so a call can suspend and resume across a
   return to the event loop, and raylib's web platform is built for it:
   [WindowShouldClose] on PLATFORM_WEB is an [emscripten_sleep(16)] that then
   returns false (raylib 5.5, platforms/rcore_web.c). So the Flan [until] loop
   yields to the browser once a frame, at the call it already makes, and not
   one example changes. Same program, same [main], same source on both targets.

   What it costs is real and worth writing down: asyncify instruments the whole
   module, which is roughly a doubling of code size and a measurable slowdown
   on the instrumented paths. It is applied to every web build rather than to
   the ones that block, because "does this program block" is not a question
   this file can answer and a flag set that varies per program is a cache key
   that varies per program. *)

let web_shell_default =
  {html|<!doctype html>
<!-- The smallest page that makes a Flan web build openable: a canvas for
     raylib's GL context, and stdout on the page rather than only in the
     console, because a headless check and a human reader want the same text.
     emcc substitutes the module's JS for {{{ SCRIPT }}}; nothing else here is
     emscripten's. Replace it with FLAN_WEB_SHELL. -->
<html lang="en">
  <head>
    <meta charset="utf-8">
    <title>flan</title>
    <style>
      html, body { margin: 0; background: #14161a; color: #d8dee9;
                   font: 13px/1.5 ui-monospace, monospace; }
      #canvas { display: block; margin: 0 auto; background: #000;
                outline: none; }
      #out { white-space: pre-wrap; padding: 8px 12px; }
    </style>
  </head>
  <body>
    <canvas id="canvas" tabindex="-1"
            oncontextmenu="event.preventDefault()"></canvas>
    <pre id="out"></pre>
    <script>
      var out = document.getElementById('out');
      var Module = {
        canvas: document.getElementById('canvas'),
        print: function (t) { out.textContent += t + '\n'; },
        printErr: function (t) { out.textContent += t + '\n'; },
      };
    </script>
    {{{ SCRIPT }}}
  </body>
</html>
|html}

(* The shell is a string here rather than a file in the tree for the same
   reason [Runtime_src] is: it has to be present wherever the compiler is, and
   a build that cannot find its own shell is a build that fails for a reason
   nobody spelled. FLAN_WEB_SHELL replaces it. *)
let web_shell_file () =
  match getenv "FLAN_WEB_SHELL" with
  | Some p when Sys.file_exists p -> p
  | Some p ->
    failwith (Printf.sprintf "web: FLAN_WEB_SHELL is %s, which does not exist" p)
  | None ->
    let p = Filename.concat (workdir ()) "flan-shell.html" in
    write p web_shell_default;
    p

(* The flags the browser target adds at the link, and only at the link.

   ALLOW_MEMORY_GROWTH because the default heap is 16MB and a texture is not
   small. EXPORT_ES6=0 and the default MODULARIZE are left alone so that the
   .js is a plain script both the shell and node can run — which is what makes
   the test headless.

   --shell-file only when the output is a page. Asking emcc for a .js and
   handing it an HTML shell is accepted and ignored, which is the kind of
   silence this file tries not to produce. *)
let web_link_flags ~out =
  [ "-sASYNCIFY"; "-sALLOW_MEMORY_GROWTH=1" ]
  @ (if Filename.extension out = ".html" then
       [ "--shell-file"; Filename.quote (web_shell_file ()) ]
     else [])

(* ── A [link] line may be addressed to one target ────────────────────
   `vendor/raylib/link` names Fedora's libraylib.so.550, which exists on the
   host and nowhere else; the browser wants a static archive built by
   emscripten and three -s flags besides. So a line may carry a tag:

       @native -l:libraylib.so.550
       @web    ${FLAN_RAYLIB_WEB}

   and an untagged line applies to every target, which is what every existing
   `link` file is.

   The selection happens *here* and not in [Load], which is where the file is
   read, because [Load] resolves imports before a target is chosen — the same
   program is built for both — and a package's linker arguments are carried to
   this function as a flat list of strings. [Load] passing the lines through
   untouched is the whole of its part in this.

   ${NAME} expands from the environment. An unset one is refused by name: the
   archive a web build needs is built once by vendor/raylib/build-web.sh and
   lives at a path only that machine knows, and the alternative to naming it
   here is a linker error about GLFW symbols. *)

let link_tags = [ "native"; "wasi"; "web" ]

let target_tag opts =
  if web_target opts then "web"
  else if wasi_target opts then "wasi"
  else "native"

(* ${NAME} → the environment's NAME. Nothing else is substituted: this is not a
   shell, and a linker argument containing a $ that is not a ${ is left alone
   rather than guessed at. *)
let expand_vars ~where s =
  let b = Buffer.create (String.length s) in
  let n = String.length s in
  let rec go i =
    if i >= n then ()
    else if i + 1 < n && s.[i] = '$' && s.[i + 1] = '{' then
      match String.index_from_opt s (i + 2) '}' with
      | None -> Buffer.add_char b s.[i]; go (i + 1)
      | Some j ->
        let name = String.sub s (i + 2) (j - i - 2) in
        (match getenv name with
         | Some v -> Buffer.add_string b v
         | None ->
           failwith
             (Printf.sprintf
                "%s: the linker argument %s wants %s, which is not set in the \
                 environment"
                where s name));
        go (j + 1)
    else (Buffer.add_char b s.[i]; go (i + 1))
  in
  go 0;
  Buffer.contents b

let select_lflags opts flags =
  let want = target_tag opts in
  List.filter_map
    (fun f ->
       if String.length f > 0 && f.[0] = '@' then begin
         let tag, rest =
           match String.index_opt f ' ' with
           | Some i ->
             (String.sub f 1 (i - 1),
              String.trim (String.sub f (i + 1) (String.length f - i - 1)))
           | None -> (String.sub f 1 (String.length f - 1), "")
         in
         if not (List.mem tag link_tags) then
           failwith
             (Printf.sprintf
                "link: @%s is not a target — the tags are %s, and an untagged \
                 line applies to all of them"
                tag
                (String.concat ", " (List.map (fun t -> "@" ^ t) link_tags)));
         if tag = want && rest <> "" then
           Some (expand_vars ~where:("link: @" ^ tag) rest)
         else None
       end
       else Some (expand_vars ~where:"link" f))
    flags

(* ── A package's C may be addressed to one target too ─────────────────
   [link] lines carry a @tag; a package's .c files had no such channel, and
   [Load] collects every one of them by listing the directory. There is nowhere
   in a directory listing to put a tag except the name, so the tag goes there,
   before the extension:

       flan_agent.c        compiled everywhere, unless displaced
       flan_agent.web.c    compiled for the browser, and displaces the above

   The rule is one sentence: **a tagged file is compiled only on its own
   target, and there it replaces the untagged file of the same base name.**
   Untagged is the default and every existing package is untagged, so nothing
   that does not opt in changes.

   Replacement rather than pure tagging, which is what Go's `_windows.go` and
   Odin's `file_js.odin` do, and the difference is deliberate: pure tagging
   would mean renaming the file that already works — [flan_agent.c] becoming
   [flan_agent.native.c] — to teach a package about a target it had never
   heard of. Making the browser's answer *additive* means a package gains a
   target by gaining a file, and the file that was right on three targets is
   not touched to say so.

   The selection is here and not in [Load] for the reason [select_lflags] is:
   [Load] resolves imports before a target is chosen, and the same program is
   built for both.

   The base name is what is matched, not the path: two packages each with a
   [flan_agent.c] would already collide at the link, so there is nothing new
   to disambiguate here. *)
let split_csrc_tag path =
  let base = Filename.basename path in
  let stem = Filename.remove_extension base in
  match Filename.extension stem with
  | "" -> (stem, None)
  | dot_tag ->
    let tag = String.sub dot_tag 1 (String.length dot_tag - 1) in
    if List.mem tag link_tags then (Filename.remove_extension stem, Some tag)
    else (stem, None)

let select_csrcs opts csrcs =
  let want = target_tag opts in
  (* The base names a tagged file speaks for on *this* target. Only these
     displace; a [foo.wasi.c] is invisible to a native build in both
     directions, so it neither compiles nor hides [foo.c]. *)
  let displaced =
    List.filter_map
      (fun c ->
         match split_csrc_tag c with
         | (base, Some tag) when String.equal tag want -> Some base
         | _ -> None)
      csrcs
  in
  List.filter
    (fun c ->
       match split_csrc_tag c with
       | (_, Some tag) -> String.equal tag want
       | (base, None) -> not (List.mem base displaced))
    csrcs

(* What the compiler itself is, cheaply: its path, size and mtime. A clang
   upgrade changes one of those, so the key changes with it — without paying a
   [clang --version] subprocess on every build, which would cost most of what
   the cache buys. Taken of whichever compiler the target uses, so an emcc
   object and a clang object of the same source cannot collide. *)
let stamp_of prog =
  let path =
    if Filename.is_relative prog then
      let dirs = String.split_on_char ':' (try Sys.getenv "PATH" with Not_found -> "") in
      (try List.find (fun d -> Sys.file_exists (Filename.concat d prog))
             dirs |> fun d -> Filename.concat d prog
       with Not_found -> prog)
    else prog
  in
  match Unix.stat path with
  | st -> Printf.sprintf "%s:%d:%f" path st.Unix.st_size st.Unix.st_mtime
  | exception Unix.Unix_error _ -> path

let clang_stamp = lazy (stamp_of clang)

(* Compile one C translation unit to an object file, reusing a cached one when
   the source text, the compiler and the flags are all unchanged. The key has
   to carry [opt] and [target]: the acceptance table builds the same programs
   at -O0 and -O2, and an -O2 object must not serve an -O0 build. *)
let compile_c ~opts ?tflags ~src ~name () =
  (* The whole flag list, not just the triple: on wasm32 the sysroot and the
     resource directory decide which headers and which builtins an object was
     built against, so repointing either must not serve a stale .o. *)
  let tflags = match tflags with Some f -> f | None -> target_flags opts in
  let cc = compiler opts in
  let key =
    Digest.to_hex
      (Digest.string
         (String.concat "\000"
            [ name; src; stamp_of cc; opts.opt;
              String.concat " " (cflags opts);
              String.concat " " tflags ]))
  in
  let obj = Filename.concat (cachedir ()) (key ^ ".o") in
  if not (Sys.file_exists obj) then begin
    let dir = workdir () in
    let c = Filename.concat dir name in
    write c src;
    (* A distinct temporary target, renamed into place, so two builds running
       at once cannot see a half-written object. *)
    let tmp = Printf.sprintf "%s.%d.tmp" obj (Unix.getpid ()) in
    let cmd =
      String.concat " "
        ([ Filename.quote cc; opts.opt ]
         @ cflags opts
         @ [ "-c" ] @ tflags
         @ [ Filename.quote c; "-o"; Filename.quote tmp ])
    in
    let code = Sys.command cmd in
    if code <> 0 then
      failwith (Printf.sprintf "%s failed (exit %d) on %s" cc code name);
    (try Unix.rename tmp obj with Unix.Unix_error _ -> ());
    (try Sys.remove c with Sys_error _ -> ())
  end;
  obj

(* [csrcs] and [lflags] come from the imported packages (see [Load]): the C
   shim a package binds through, and the arguments needed to link the library
   it binds to. *)
let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
      (p : Tast.program) ~out =
  (* A dev build is the REPL's, and the REPL reaches a running process through
     [-rdynamic] and [dlopen]. Neither exists on wasm32, so the combination is
     refused rather than quietly producing a module nothing can attach to. *)
  (* Named for the target that was asked for, since two of them answer to
     [wasm_target] now and "wasm32:" on a --target=web build reads as a
     compiler that did not hear the question. *)
  let tname = if web_target opts then "web" else "wasm32" in
  if wasm_target opts && opts.dev then
    failwith
      (tname
       ^ ": --dev is native only — the reload path is dlopen, which wasm has \
          no equivalent of");
  (* Refused rather than emitted-and-hoped-for. The member offsets in the DWARF
     are computed for the host's layout — [ptr] 8 bytes — and wasm32's pointer
     is 4, so a slice's [len] is at byte 8 there and at byte 16 here. Emitting
     the host numbers would give a debugger a confident wrong answer for every
     slice and every struct holding one, which is the failure this project
     keeps meeting at the FFI boundary. *)
  if wasm_target opts && opts.debug then
    failwith
      (tname
       ^ ": --debug is native only — the DWARF member offsets are computed \
          for the host's layout, and wasm32's 32-bit pointer moves every one \
          of them");
  (* There is no wasm32 sanitizer runtime to link against: clang accepts
     -fsanitize=address for the triple and the link fails on
     __asan_report_load4. Refused by name rather than met at the linker. *)
  (* emscripten does ship an ASan, so the web half of this refusal is weaker
     than the wasi half: it is untested here rather than known to be
     impossible. Refused all the same, because a sanitizer that has never been
     run is a sanitizer whose silence means nothing, and the sweep this project
     runs (@sanitize) is native. *)
  if wasm_target opts && opts.sanitize then
    failwith
      (if web_target opts then
         "web: --sanitize is native only — emscripten has its own ASan, and \
          nothing here has ever run it; the sanitizer sweep is the native one"
       else
         "wasm32: --sanitize is native only — there is no libclang_rt.asan for \
          wasm32-wasi to link against");
  (* -O0 is not a choice a debug build offers: [llvm.dbg.declare] describes an
     alloca, and at -O2 mem2reg deletes the alloca. [sanitize] deliberately
     does not do this: see [opts]. *)
  let opts = if opts.debug then { opts with opt = "-O0" } else opts in
  let tflags = target_flags opts in
  let dir = workdir () in
  let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
  write ll
    (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames
       ~sanitize:opts.sanitize p);
  (* [flan_dev.c] is compiled into every build, not only a dev one. Nothing in
     a release build calls into it — the compiler only emits a registry lookup
     for a name the host was not built with, which cannot arise without cells —
     but the agent package's C refers to it, and a package's C sources are
     collected whatever [main] does. Leaving it out made [flan build sand.flan]
     fail at the link with an undefined symbol, which reads as a compiler bug
     rather than as a missing flag. The table is BSS, so this costs address
     space and not binary size, and [-rdynamic] and the cells are still what
     [--dev] means. *)
  let cc src name = compile_c ~opts ~tflags ~src ~name () in
  (* The runtime's own C wants -g too, or a backtrace that passes through
     flan_error lands in a frame with no line. The flag is part of the object
     cache key via [compile_c]'s [opt]/[tflags] digest — see [cflags]. *)
  let objs =
    cc Runtime_src.source "flan_rt.c"
    :: [ cc Runtime_src.dev_source "flan_dev.c" ]
    (* wasi-libc's entry point, which is not [main]. See [wasm_main_source].
       Not the browser's: emscripten's start code calls [main] under that name,
       so the .ll's @main is already the entry point and the shim would be a
       second definition of it. *)
    @ (if wasi_target opts then [ cc wasm_main_source "flan_wasm_main.c" ] else [])
    (* The generated half of the FFI: one translation unit holding a typedef
       per struct that crosses and a wrapper per (declare-c ...), compiled
       exactly like a package's hand-written .c. It rides on the program
       rather than on a parameter so that every caller of [executable] carries
       it without having been changed to. See [Shim]. *)
    @ (match p.Tast.cshim with
       | [] -> []
       | parts ->
         [ cc (String.concat "" (List.map snd parts)) "flan_shim.c" ])
    (* Per-target selection, the same shape [select_lflags] applies to a
       package's linker arguments. See [select_csrcs]. *)
    @ List.map (fun c -> cc (read_file c) (Filename.basename c))
        (select_csrcs opts csrcs)
  in
  let cmd =
    String.concat " "
      ([ Filename.quote (compiler opts); opts.opt; "-Wno-override-module" ]
       (* -g at the link so clang does not strip, and keeps the object files'
          debug sections; the .ll carries its own. The sanitizer flags have to
          be here too — they are what pulls in libclang_rt.asan and the UBSan
          runtime, and they are also what makes clang run the ASan pass over
          the .ll, which is the only place the Flan half of the program gets
          instrumented at all. *)
       @ cflags opts
       @ (if opts.dev then [ "-rdynamic" ] else [])
       @ tflags
       @ (if web_target opts then web_link_flags ~out else [])
       @ [ Filename.quote ll ]
       @ List.map Filename.quote objs
       (* A package's linker arguments, with the lines addressed to another
          target dropped and ${VAR} expanded. See [select_lflags]. *)
       @ select_lflags opts lflags
       (* The prelude declares sqrtf, so every link needs libm. It goes here
          and not in the leading flags: the default --as-needed drops a
          library named before the object that wants it, so at -O2 this would
          appear to work — LLVM folds most sqrtf calls into the hardware
          instruction and the symbol never has to resolve — and the -O0 build,
          which emits the call, would fail at the link. Untested against
          --target=wasm32; wasi-libc ships libm.a as a stub because the
          symbols live in libc, so it should be inert there. *)
       @ [ "-lm" ]
       @ [ "-o"; Filename.quote out ])
  in
  let code = Sys.command cmd in
  if code <> 0 then
    failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll);
  if not opts.keep then (try Sys.remove ll with Sys_error _ -> ());
  out

(* ── The dev path: one function into a loadable object ──────────────── *)

(* Step 1 of the dev loop (NEXT.md): [Emit.redefinition] text → a [.so] the
   running process can [dlopen]. This never invokes the clang driver — the
   driver is most of what a build costs and none of what it does is needed
   here, since the input is already IR and the output has no libc to find.

   [ld -shared] rather than [clang -shared] for the same reason. A shared
   object is allowed undefined symbols, which is the whole mechanism: the
   redefined function's calls to other Flan functions, to the globals and to
   the runtime are all left for the loader to bind back to the host.

   PIC has to be asked for. [llc] defaults to the static relocation model on
   this target, and the failure is at link time, not at codegen: "relocation
   R_X86_64_32S against ... can not be used when making a shared object". *)

let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc"
let linker = try Sys.getenv "FLAN_LD" with Not_found -> "ld"

(* Times in milliseconds, per stage, because a single total does not say
   whether the number is worth chasing. *)
type timing = { llc_ms : float; link_ms : float }

let time f =
  let t0 = Unix.gettimeofday () in
  let x = f () in
  (x, (Unix.gettimeofday () -. t0) *. 1000.)

let run what cmd =
  let code = Sys.command cmd in
  if code <> 0 then failwith (Printf.sprintf "%s failed (exit %d)" what code)

let shared ?(opts = default) ~ir ~out () : timing =
  let opts = if opts.debug then { opts with opt = "-O0" } else opts in
  if wasm_target opts then
    failwith
      ((if web_target opts then "web" else "wasm32")
       ^ ": the reload path is native only — it is llc + ld -shared + dlopen, \
          and wasm has no dlopen");
  let dir = workdir () in
  let base = Filename.remove_extension (Filename.basename out) in
  let ll = Filename.concat dir (base ^ ".ll") in
  let obj = Filename.concat dir (base ^ ".o") in
  write ll ir;
  let (), llc_ms =
    time (fun () ->
      run llc
        (String.concat " "
           ([ Filename.quote llc; opts.opt; "-filetype=obj";
              "-relocation-model=pic" ]
            @ (match opts.target with None -> [] | Some t -> [ "-mtriple=" ^ t ])
            @ [ Filename.quote ll; "-o"; Filename.quote obj ])))
  in
  let (), link_ms =
    time (fun () ->
      run linker
        (String.concat " "
           [ Filename.quote linker; "-shared"; Filename.quote obj; "-o";
             Filename.quote out ]))
  in
  if not opts.keep then begin
    (try Sys.remove ll with Sys_error _ -> ());
    (try Sys.remove obj with Sys_error _ -> ())
  end;
  { llc_ms; link_ms }

(* ── The macro path: a whole program into a shared object ───────────── *)

(* A macro module is not a redefinition, and the difference is the whole
   design. [shared] above builds a module full of [declare]s and [external]s
   for a host that is already running Flan; here the host is the *compiler*,
   an OCaml executable with no Flan symbols in it at all. So this module is
   self-contained: the runtime is linked in, every function it calls is
   defined, and nothing is left for the loader to find. That is also what
   keeps [-rdynamic] off the compiler's own link.

   It goes through clang rather than through llc + ld, unlike [shared]: there
   are C objects to link and a libc to find, which is exactly the part of the
   driver the dev path skips because it does not need it. The cost is the
   driver's ~50ms, paid once per process for the whole macro set. *)
let macro_module ?(opts = default) ?(csrcs = []) ?(lflags = []) ~macros
      (p : Tast.program) ~out =
  if wasm_target opts then
    failwith
      "macros are native only — running one means dlopening it into the \
       compiler, and wasm has no dlopen";
  let dir = workdir () in
  let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
  write ll (Emit.program ~checks:opts.checks ~macros p);
  (* -fPIC on every object, the .ll included. Without it the link fails with a
     relocation against a symbol that cannot be used in a shared object — at
     link time, not at codegen, which is the same trap [shared] meets and
     answers with -relocation-model=pic. *)
  let tflags = target_flags opts @ [ "-fPIC" ] in
  let cc src name = compile_c ~opts ~tflags ~src ~name () in
  let objs =
    cc Runtime_src.source "flan_rt.c"
    :: [ cc Runtime_src.dev_source "flan_dev.c" ]
    @ (match p.Tast.cshim with
       | [] -> []
       | parts ->
         [ cc (String.concat "" (List.map snd parts)) "flan_shim.c" ])
    @ List.map (fun c -> cc (read_file c) (Filename.basename c))
        (select_csrcs opts csrcs)
  in
  let cmd =
    String.concat " "
      ([ Filename.quote (compiler opts); opts.opt; "-Wno-override-module";
         "-shared"; "-fPIC" ]
       @ tflags
       @ [ Filename.quote ll ]
       @ List.map Filename.quote objs
       @ select_lflags opts lflags
       @ [ "-lm"; "-o"; Filename.quote out ])
  in
  let code = Sys.command cmd in
  if code <> 0 then
    failwith
      (Printf.sprintf "building the macro module failed (exit %d); the IR is \
                       at %s" code ll);
  if not opts.keep then (try Sys.remove ll with Sys_error _ -> ());
  out