(* The reload primitive, measured (NEXT.md, dev loop step 1).

   One function is recompiled into its own object and loaded into a process
   that is already running. Everything after this — indirection cells, the
   agent in the game, the daemon — assumes this works and is fast; nothing in
   the codebase had ever done it, and plan.org's 16ms was measured with clang
   in isolation somewhere else.

   The parts, all of them new here:

     Emit.program ~dev   a cell per function; every call goes through one
     Emit.redefinition   one [define], everything else [declare]/[external],
                         plus [flan_reload_install] to publish it into its cell
     Build.shared        that IR text through llc + ld -shared, timed
     reload_host.c       dlopen, install, call — twice, in one process

   The host is C rather than OCaml because that is where it has to end up: the
   agent of step 3 lives in the game process, next to flan_rt.c, and there is
   no OCaml runtime there. *)

open Flan

let failures = ref 0
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt

let scratch = Filename.get_temp_dir_name ()
let tmp name = Filename.concat scratch ("flan-reload-" ^ name)

let checked path =
  Check.program
    (Load.program ~file:path (Parse.program (Reader.read_file path))).Load.decls

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

let () =
  match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
  | 0 ->
    let p1 = checked "programs/reload.flan" in
    let p2 = checked "programs/reload-v2.flan" in

    (* [dev] is the two halves of a reloadable build together: cells, so a
       call site can be made to follow a redefinition, and [-rdynamic], so the
       cells and globals are visible to a dlopen'd object at all. [-ldl] is the
       host's own, for its dlopen. *)
    let dev = { Build.default with Build.dev = true } in
    let host = tmp "host" in
    ignore
      (Build.executable ~opts:dev ~csrcs:[ "reload_host.c" ]
         ~lflags:[ "-ldl" ] p1 ~out:host);

    (* Two paths, not one rewritten in place: dlopen caches by path and would
       hand back the first handle, so the swap would silently not happen. *)
    let so1 = tmp "v1.so" and so2 = tmp "v2.so" in
    let ir1, emit_ms = ms (fun () -> Emit.redefinition ~dev:true p1 ~fn:"bump") in
    let t1 = Build.shared ~opts:dev ~ir:ir1 ~out:so1 () in
    let ir2, emit2_ms = ms (fun () -> Emit.redefinition ~dev:true p2 ~fn:"bump") in
    let t2 = Build.shared ~opts:dev ~ir:ir2 ~out:so2 () in

    (* A redefinition module must not define what the host already owns:
       defining [counter] would give the loaded object a private copy and the
       state would reset on every reload, and defining [helper] would freeze a
       stale copy of it into the module. *)
    let has hay needle =
      let n = String.length needle and h = String.length hay in
      let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
      go 0
    in
    if not (has ir2 "@\"flan.counter\" = external global i64") then
      fail "redefinition defines the global instead of declaring it";
    if not (has ir2 "declare i64 @\"flan.helper\"(i64)") then
      fail "redefinition defines a sibling function instead of declaring it";
    if has ir2 "define i64 @\"flan.helper\"" then
      fail "redefinition emitted a second body for a function it does not own";
    if has ir2 "define i32 @main" then fail "redefinition emitted an entry point";
    (* [hidden], or the module's own [@"flan.bump"] is interposed by the host's
       and the installer publishes the very function it is replacing. *)
    if not (has ir2 "define hidden i64 @\"flan.bump\"") then
      fail "redefinition's own body is interposable";
    if not (has ir2 "@\"flan.cell.helper\" = external global ptr") then
      fail "redefinition defines a cell instead of using the host's";
    (* A dev host's calls are indirect; a release host's are not. That is the
       only difference between the two, and the whole of C-c C-c rests on it. *)
    let host_ir = Emit.program ~dev:true p1 in
    if not (has host_ir "@\"flan.cell.bump\" = global ptr @\"flan.bump\"") then
      fail "dev build emitted no cell";
    if has (Emit.program p1) "flan.cell." then
      fail "release build emitted a cell";

    let out = tmp "out" in
    let cmd =
      (* stderr kept apart from stdout: the host times its own dlopen there,
         and stdout is what the expected transcript is compared against. *)
      Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote host)
        (Filename.quote so1) (Filename.quote so2) (Filename.quote out)
        (Filename.quote (tmp "err"))
    in
    let (code, dlopen_ms) = ms (fun () -> Sys.command cmd) in
    let text = In_channel.with_open_bin out In_channel.input_all in
    let timings =
      In_channel.with_open_bin (tmp "err") In_channel.input_all in

    (* host: counter 0 -> 1, helper 1 = 2.  v1: 1 -> 2, helper 2 = 4.
       v2: the changed body, +10 and +1000, over the counter v1 left behind —
       so 2 -> 12, helper 12 = 24, 1024. Two things are being read here. The
       last line is the state: it is the host's, and two reloads did not touch
       it. And 1024 rather than 1036 is the call: v2's own text for [helper]
       multiplies by three, so the host's copy is demonstrably the one that
       ran. The bare "v1"/"v2" lines come from inside each [bump] and are what
       exercise a redefinition module's string constants.

       Two things are load-bearing about the shape of this transcript. Every
       call is [outer], compiled once into the host and never rebuilt — so a
       changed answer can only mean its call site followed the redefinition.
       And v2's [bump] recurses until the counter passes 100, through the cell:
       2 -> 12 -> ... -> 102, ten "v2" lines, helper 102 = 204, 1204. An
       interposed self-call would reach the host's v1 body instead, print "v1"
       on the second line of that run, and land nowhere near 1204. *)
    let v2s = String.concat "" (List.init 10 (fun _ -> "v2\n")) in
    let want =
      "v1\nhost 2\nv1\nv1 4\n" ^ v2s ^ "v2 1204\ncounter 102\n"
    in
    if code <> 0 || text <> want then
      fail "reload\n        got: %S (exit %d)\n     wanted: %S" text code want;

    Printf.printf
      "reload: emit %.1fms  llc %.1fms  ld %.1fms  (v2: emit %.1fms  llc %.1fms  ld %.1fms)  host run %.1fms\n"
      emit_ms t1.Build.llc_ms t1.Build.link_ms emit2_ms t2.Build.llc_ms
      t2.Build.link_ms dlopen_ms;
    print_string timings;

    List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
      [ host; so1; so2; out; tmp "err" ];
    if !failures = 0 then print_endline "reload: all tests passed"
    else begin
      Printf.printf "\n%d failure(s)\n" !failures;
      exit 1
    end
  | _ -> print_endline "reload: skipped (no clang or llc on PATH)"