(** [flan dev]: one long-lived session, the program it belongs to running
    beside it, and a socket an editor talks to.

    This is the piece between an editor and everything else. What it adds over
    [flan reload] is that the session *persists*: a [defvar] added by one
    evaluation is part of the program the next one is checked against, and the
    set of names the running process was built with is the one from the build
    this daemon actually made. A CLI that rebuilds its session from source each
    time cannot have either.

    It owns the build, which is what makes its layout rules mean anything: a
    session's struct layouts and global types describe the memory of a process
    only if it is the session that compiled it. So the daemon launches the
    program rather than attaching to one. *)

(* Where a function's body was last built. The daemon owns the build, so it is
   the only thing that can answer "which module defines this name now" — but
   see [basis] below for what that answer honestly is. *)
type origin = {
  ogen : int;                    (* reload generation; 0 is the host's *)
  oso  : string;                 (* the object the body was linked into *)
  oll  : string;                 (* the IR it was built from *)
  oloc : string;                 (* where the source it came from was written *)
}

type t = {
  session : Session.t;
  (* The running program. [Some pid] is the two-process daemon, which launched
     it; [None] is the merged build, where the program is *this* process and
     the compiler is a thread inside it. That is the whole of the difference at
     this layer — see [merged_setup] for why there is no third case. *)
  child   : int option;
  agent   : string;              (* where it listens for modules *)
  dir     : string;              (* modules are built here, one per eval *)
  stdout  : Unix.file_descr;     (* the program's output, on its way to here *)
  out     : Buffer.t;            (* ...buffered until an editor asks for it *)
  mutable n : int;               (* dlopen caches by path: never reuse one *)
  (* Bookkeeping for disassembly, and the reason it can exist at all: the
     daemon compiled every module it sent, so the .ll and the .so are on its
     own disk. What it does not have is a way back into the process's cells. *)
  mutable gen : int;             (* accepted deliveries, in order *)
  owners  : (string, origin) Hashtbl.t;  (* fn name -> the last module sent *)
  host_ll : string;              (* the IR the running program was built from *)
  host_exe : string;             (* ...and the binary it was linked into *)
  (* Set when the program's stdout reads EOF. In the two-process daemon that
     happens because the child died and [waitpid] is the authority anyway; in
     the merged build it is the signal itself — the program's exit closes fd 1
     and parks, and this is how the compiler finds out. *)
  mutable finished : bool;
}

(* The program's stdout is a pipe into this process, so that an editor can see
   it. That makes draining it a *liveness* requirement and not a nicety: a pipe
   nobody reads fills at 64K and the next write blocks the program forever. So
   it is read from the accept loop's select, not only when someone asks. *)
let capacity = 256 * 1024

let drain t =
  let b = Bytes.create 8192 in
  let rec go () =
    match Unix.select [ t.stdout ] [] [] 0. with
    | [], _, _ -> ()
    | _ ->
      (match Unix.read t.stdout b 0 8192 with
       (* EOF on a pipe: every writer is gone, so the program has finished. *)
       | 0 -> t.finished <- true
       | n ->
         Buffer.add_subbytes t.out b 0 n;
         (* Bounded: a program that prints every frame must not grow this
            process without limit. The newest text is the useful end. *)
         if Buffer.length t.out > capacity then begin
           let keep = Buffer.sub t.out (Buffer.length t.out - capacity) capacity in
           Buffer.clear t.out;
           Buffer.add_string t.out keep
         end;
         go ()
       | exception Unix.Unix_error (Unix.EAGAIN, _, _) -> ()
       | exception Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> ()
       | exception Unix.Unix_error _ -> ())
  in
  go ()

let take t =
  drain t;
  let s = Buffer.contents t.out in
  Buffer.clear t.out;
  s

let await ?(ms = 5000) f =
  let rec go ms =
    if f () then true
    else if ms <= 0 then false
    else begin ignore (Unix.select [] [] [] 0.005); go (ms - 5) end
  in
  go ms

(* ── Delivery ──────────────────────────────────────────────────────── *)

(* The agent answers "ok" when it has queued a module, and anything else is a
   refusal with a reason. Reporting that back rather than swallowing it is what
   keeps a failed delivery from looking like a successful evaluation — the
   whole class of bug this socket makes possible. *)
let deliver t path =
  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  Fun.protect
    ~finally:(fun () -> try Unix.close s with Unix.Unix_error _ -> ())
    (fun () ->
       Unix.connect s (Unix.ADDR_UNIX t.agent);
       let msg = path ^ "\n" in
       ignore (Unix.write_substring s msg 0 (String.length msg));
       let b = Bytes.create 1024 in
       let buf = Buffer.create 64 in
       let rec drain () =
         match Unix.read s b 0 1024 with
         | 0 -> ()
         | n -> Buffer.add_subbytes buf b 0 n; drain ()
         | exception Unix.Unix_error _ -> ()
       in
       drain ();
       String.trim (Buffer.contents buf))

(* Read back the value of the last expression evaluated, with the counter that
   says whether it is a new one. The thunk runs on the game thread whenever the
   program next reaches a frame boundary, which is not a moment the daemon gets
   to know about, so this waits for the counter to move rather than assuming it
   has. *)
let result t =
  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  Fun.protect
    ~finally:(fun () -> try Unix.close s with Unix.Unix_error _ -> ())
    (fun () ->
       Unix.connect s (Unix.ADDR_UNIX t.agent);
       ignore (Unix.write_substring s "result\n" 0 7);
       let b = Bytes.create 4096 in
       let buf = Buffer.create 256 in
       let rec drain () =
         match Unix.read s b 0 4096 with
         | 0 -> ()
         | n -> Buffer.add_subbytes buf b 0 n; drain ()
         | exception Unix.Unix_error _ -> ()
       in
       drain ();
       let text = Buffer.contents buf in
       match String.index_opt text '\n' with
       | None -> None
       | Some i ->
         let header = String.sub text 0 i in
         let body = String.sub text (i + 1) (String.length text - i - 1) in
         (match String.split_on_char ' ' header with
          | [ g; _ ] ->
            (match Int64.of_string_opt g with
             | Some g -> Some (g, body)
             | None -> None)
          | _ -> None))

(* ── The break state ───────────────────────────────────────────────── *)

(* Everything above is about changing a *running* program. This is the other
   half: an unhandled [error] does not kill a dev build, it stops the game
   thread on the frame that erred and waits. The agent's socket is where that
   shows, and the daemon is the only thing holding that socket — so an editor
   asks here or not at all.

   One line out, one line back, exactly like [result]: the agent is not a
   protocol and must not become one. *)
let ask t verb =
  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  Fun.protect
    ~finally:(fun () -> try Unix.close s with Unix.Unix_error _ -> ())
    (fun () ->
       Unix.connect s (Unix.ADDR_UNIX t.agent);
       let msg = verb ^ "\n" in
       ignore (Unix.write_substring s msg 0 (String.length msg));
       let b = Bytes.create 4096 in
       let buf = Buffer.create 128 in
       let rec drain () =
         match Unix.read s b 0 4096 with
         | 0 -> ()
         | n -> Buffer.add_subbytes buf b 0 n; drain ()
         | exception Unix.Unix_error _ -> ()
       in
       drain ();
       Buffer.contents buf)

type state =
  | Running
  | Stopped of string            (* the condition's class name *)
  | Unreachable of string        (* no answer: exited, or never listened *)

(* [status] is answered whether or not the program is stopped — "running" is an
   answer, not a refusal. Everything else the break loop offers is refused
   while running, and rightly: there is no restart stack to walk. But the
   question an editor asks *without already knowing* is this one, so it had to
   have an answer in both states or there would be nothing to poll. *)
let state t =
  match ask t "status" with
  | "" -> Unreachable "the program is not answering on its socket"
  | text ->
    let line = String.trim (List.hd (String.split_on_char '\n' text)) in
    if line = "running" then Running
    else if String.length line > 8 && String.sub line 0 8 = "stopped " then
      Stopped (String.sub line 8 (String.length line - 8))
    else Unreachable ("the program answered " ^ line)
  | exception Unix.Unix_error (e, _, _) -> Unreachable (Unix.error_message e)

(* Innermost first, terminated by a line that is a single dot — the agent's
   framing, not this one's. A refusal comes back as a line starting "err ", and
   is passed on rather than turned into an empty list: no restarts and cannot
   say are different answers.

   Each line is [I ± NAME]: the index it is taken by, whether it can be taken,
   and the name. The index is the identity — two frames may offer [retry] and
   a name cannot say which — and it is the program's number, not this end's
   position in a list, so it is carried rather than recomputed. *)
let restarts t =
  match ask t "restarts" with
  | text ->
    let lines = String.split_on_char '\n' text in
    if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
    then Error (String.trim text)
    else begin
      let parse line =
        match String.index_opt line ' ' with
        | None -> None
        | Some i ->
          (match int_of_string_opt (String.sub line 0 i) with
           | None -> None
           | Some idx ->
             let rest = String.sub line (i + 1) (String.length line - i - 1) in
             if String.length rest < 2 then None
             else
               Some
                 ( idx,
                   rest.[0] = '+',
                   String.sub rest 2 (String.length rest - 2) ))
      in
      Ok
        (List.filter_map parse
           (List.filter
              (fun l -> l <> "" && l <> ".")
              (List.map String.trim lines)))
    end
  | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)

(* Where a stopped program is, one frame per line, innermost first — the same
   framing [restarts] uses, terminated by a lone dot, because it comes back
   over the same one-line-out socket.

   Each line is [I ± NSLOTS SIG RSIG LOC NAME]. [SIG] is the slot fingerprint
   of the body this frame was compiled from — [Emit.slot_fingerprint] over the
   name and the type of every slot — and it is how [locals] tells a frame whose
   body has been redefined underneath it from one that still matches. [RSIG] is
   [Reach.ref_fingerprint] over the globals that body names, which is the same
   question asked about a different part of the body: the slots can be
   identical while the globals are not, and then it is the globals section that
   must not trust the frame while [locals] still can. Both stay off the wire: a
   hash is not something a client can act on, and the refusals they produce say
   the fact in words instead. They sit before [LOC] because [NAME] is the only
   field that can contain a space and so has to be last.

   The flag says whether the frame belongs
   to the program or to the C-x C-e thunk the break happens to be inside: a
   break inside an evaluation has that evaluation's frames on top, and
   answering "where is my program" with [eval/7] would be true and useless.
   [LOC] is the frame's own — it travels in the module that defined the body,
   so a redefined function reports where the *installed* body is written and
   not where the one this daemon first built was. A frame with none says [?].

   A truncated backtrace ends [... N] before the dot; deep recursion is the
   case, and the innermost frames are the ones the question is about. *)
let backtrace t =
  match ask t "backtrace" with
  | text ->
    let lines =
      List.map String.trim (String.split_on_char '\n' text)
    in
    if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
    then Error (String.trim text)
    else begin
      let more = ref 0 in
      let parse line =
        if String.length line > 4 && String.sub line 0 4 = "... " then begin
          (match int_of_string_opt (String.sub line 4 (String.length line - 4)) with
           | Some n -> more := n
           | None -> ());
          None
        end
        else
          match String.split_on_char ' ' line with
          | idx :: flag :: nslots :: sig_ :: rsig :: loc :: rest when rest <> [] ->
            (match
               int_of_string_opt idx, int_of_string_opt nslots,
               int_of_string_opt sig_, int_of_string_opt rsig
             with
             | Some _, Some k, Some g, Some r ->
               Some (String.concat " " rest, (if loc = "?" then "" else loc),
                     flag = "+", k, g, r)
             | _ -> None)
          | _ -> None
      in
      let frames =
        List.filter_map parse
          (List.filter (fun l -> l <> "" && l <> ".") lines)
      in
      Ok (frames, !more)
    end
  | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)

(* Which of a frame's slots have been reached. One line per slot, [I ±], the
   same framing as everything else the agent answers.

   Asked before a thunk is built rather than after: an unbound slot is a null
   address, and a thunk that rendered one would take a fault on the game
   thread of a program that is already stopped — which is the one place a
   crash costs the most, because it is where someone is standing over the
   wreck deciding what to do about it. *)
let bound_slots t ~frame =
  match ask t (Printf.sprintf "locals %d" frame) with
  | text ->
    let lines = List.map String.trim (String.split_on_char '\n' text) in
    if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
    then Error (String.trim text)
    else
      Ok
        (List.filter_map
           (fun l ->
              match String.split_on_char ' ' l with
              | [ i; "+" ] -> int_of_string_opt i
              | _ -> None)
           (List.filter (fun l -> l <> "" && l <> ".") lines))
  | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)

(* In the merged build the program is this process, so the question answers
   itself: if this code is running, so is the program. The two-process daemon
   has to ask the kernel. *)
let alive t =
  match t.child with
  | None -> not t.finished
  | Some child ->
    (match Unix.waitpid [ Unix.WNOHANG ] child with
     | 0, _ -> true
     | _ -> false
     | exception Unix.Unix_error _ -> false)

(* ── What a body was built from ─────────────────────────────────────── *)

let write_file path text =
  let oc = open_out_bin path in
  Fun.protect ~finally:(fun () -> close_out oc) (fun () -> output_string oc text)

let read_file path =
  let ic = open_in_bin path in
  Fun.protect
    ~finally:(fun () -> close_in ic)
    (fun () -> really_input_string ic (in_channel_length ic))

let find_fn t name =
  List.find_opt
    (fun (f : Tast.fn) ->
       String.equal f.Tast.name name && f.Tast.fparent = None)
    t.session.Session.program.Tast.fns

let fn_loc t name =
  match find_fn t name with
  | Some f -> Loc.to_string f.Tast.floc
  | None -> ""

(* Where the *running process* has this function written, which is not where
   the session has it. [Session.eval] replaces the checked program as soon as a
   form checks — before the build, before delivery — so a body that checked and
   then failed to build leaves the session holding a location in a buffer whose
   code never landed. [host] is the program the process was launched from and
   nothing mutates it, so it is the only honest answer for a name no module has
   been accepted for. *)
let host_loc t name =
  match
    List.find_opt
      (fun (f : Tast.fn) ->
         String.equal f.Tast.name name && f.Tast.fparent = None)
      t.session.Session.host.Tast.fns
  with
  | Some f -> Loc.to_string f.Tast.floc
  | None -> ""

(* ── Ops ───────────────────────────────────────────────────────────── *)

(* Every reply is a plist with a :status, so an editor can dispatch on one key
   and never has to guess whether a missing field means failure. *)
let ok fields =
  "(:status \"ok\"" ^ String.concat "" (List.map (fun f -> " " ^ f) fields) ^ ")"

(* Anything the program printed since the last reply rides along with this one.
   An editor that had to ask separately would miss the output an evaluation
   itself caused, which is the output anyone actually wants to see. *)
let with_output t reply =
  match take t with
  | "" -> reply
  | text ->
    let i = String.length reply - 1 in
    String.sub reply 0 i ^ " :output " ^ Wire.quote text ^ ")"

(* The break state rides along with every reply, exactly as the program's own
   output does, and for the same reason: a program can stop at any moment and
   nothing in a request/response protocol will mention it unless every response
   does. An editor that had to *ask* would find out about a stop only when it
   happened to wonder — and the most common moment for a program to stop is the
   instant after an evaluation, which is a reply it is already reading.

   It is the annotation, not the ops, that decides these two fields, so that
   there is one place in the daemon that says whether the program is stopped
   and the break ops cannot disagree with the poll. *)
let with_break t reply =
  let fields =
    match state t with
    | Stopped c -> " :stopped t :condition " ^ Wire.quote c
    | Running -> " :stopped nil"
    (* Unreachable is not "running": the honest shape of "it exited" is
       [:alive nil] from [describe], and claiming a state we could not read
       would be the [ok]-means-probably failure in miniature. *)
    | Unreachable _ -> " :stopped nil"
  in
  String.sub reply 0 (String.length reply - 1) ^ fields ^ ")"

let error ?loc msg =
  "(:status \"error\" :message " ^ Wire.quote msg
  ^ (match loc with None -> "" | Some l -> " :loc " ^ Wire.quote l)
  ^ ")"

let eval t ~code ~origin =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match Session.eval ~origin t.session code with
    | c when not c.Session.installs ->
      (* Accepted into the session and nothing to send: a declaration the
         program already has, with no body and no new storage. Saying "ok" and
         shipping an empty module would report success for a change that cannot
         have taken effect. *)
      ok
        [ ":names " ^ Wire.strings c.Session.names; ":fns ()";
          ":note " ^ Wire.quote "nothing to install" ]
    | c ->
      t.n <- t.n + 1;
      let out = Filename.concat t.dir (Printf.sprintf "m%d.so" t.n) in
      (* [Build.shared] deletes its own .ll unless asked to keep it, and what it
         keeps is in a working directory named after this process rather than
         after the module. Writing our own copy beside the .so is what makes
         [disassemble] able to show the IR of a body installed ten reloads ago:
         nothing else on this machine still has that text. *)
      let ll = Filename.concat t.dir (Printf.sprintf "m%d.ll" t.n) in
      write_file ll c.Session.ir;
      (match Build.shared
               ~opts:{ Build.default with Build.dev = true;
                                         Build.debug = t.session.Session.debug }
               ~ir:c.Session.ir ~out () with
       | timing ->
         (match deliver t out with
          | "ok" ->
            t.gen <- t.gen + 1;
            List.iter
              (fun n ->
                 Hashtbl.replace t.owners n
                   { ogen = t.gen; oso = out; oll = ll; oloc = fn_loc t n })
              c.Session.fns;
            ok
              [ ":names " ^ Wire.strings c.Session.names;
                ":fns " ^ Wire.strings c.Session.fns;
                Printf.sprintf ":ms %.1f"
                  (timing.Build.llc_ms +. timing.Build.link_ms) ]
          | reply -> error ("the program refused the module: " ^ reply)
          | exception Unix.Unix_error (e, _, _) ->
            error
              ("cannot reach the program on " ^ t.agent ^ ": "
               ^ Unix.error_message e))
       | exception Failure m -> error m)
    | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg

(* Redefining a name installs a body; evaluating an expression has no name to
   install into, so the module carries a thunk the agent runs once. The value
   comes back through the runtime rather than through this reply, because the
   frame boundary it runs at is the program's to choose. *)
let eval_expr t ~code ~origin =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match Session.eval_expr ~origin t.session code with
    | c ->
      let before = match result t with Some (g, _) -> g | None -> 0L in
      t.n <- t.n + 1;
      let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in
      (match Build.shared
               ~opts:{ Build.default with Build.dev = true;
                                         Build.debug = t.session.Session.debug }
               ~ir:c.Session.ir ~out () with
       | _ ->
         (match deliver t out with
          | "ok" ->
            let rec wait ms =
              match result t with
              | Some (g, v) when Int64.compare g before > 0 -> Some v
              | _ when ms <= 0 -> None
              | _ ->
                ignore (Unix.select [] [] [] 0.005);
                if alive t then wait (ms - 5) else None
            in
            (match wait 5000 with
             | Some v -> ok [ ":value " ^ Wire.quote v ]
             | None ->
               error
                 "the program did not reach a frame boundary; is it calling \
                  (agent/poll)?")
          | reply -> error ("the program refused the module: " ^ reply)
          | exception Unix.Unix_error (e, _, _) ->
            error ("cannot reach the program: " ^ Unix.error_message e))
       | exception Failure m -> error m)
    | exception Loc.Error (l, msg) -> error ~loc:(Loc.to_string l) msg

let describe t =
  ok
    [ ":fns "
      ^ Wire.strings
          (List.map (fun (f : Tast.fn) -> f.Tast.name)
             t.session.Session.program.Tast.fns);
      ":globals "
      ^ Wire.strings
          (List.map (fun (g : Tast.global) -> g.Tast.gname)
             t.session.Session.program.Tast.globals);
      ":alive " ^ (if alive t then "t" else "nil") ]

(* [describe] answers what exists; this answers what each one *is*. Its own op
   rather than more fields on [describe], because [describe] is polled — an
   editor uses it to drain the program's output — and this is asked once on
   connect and again after each install. Putting signatures on the poll would
   pay for them every time anyone looked at the output buffer.

   One entry per name: (name kind signature loc). Four strings, so the editor
   reads it with [read] and nothing here needs a new wire type. [loc] is empty
   where there is none to give — only [Tast.fn] carries one — and an editor
   that finds it empty must say so rather than guess a file.

   Parameter *names* are not in the Tast, so a signature shows types only. *)
let signature_of_fn (f : Tast.fn) =
  Printf.sprintf "%s [%s] %s" f.Tast.name
    (String.concat " " (List.map Types.to_string f.Tast.params))
    (Types.to_string f.Tast.ret)

let entry ~name ~kind ~sign ~loc =
  Wire.list [ Wire.quote name; Wire.quote kind; Wire.quote sign; Wire.quote loc ]

let defs t =
  let p = t.session.Session.program in
  let fns =
    List.filter_map
      (fun (f : Tast.fn) ->
         match f.Tast.fparent with
         (* A handler-bind clause the checker lifted out. Nobody wrote this
            name, so completing it is noise and jumping to it is meaningless. *)
         | Some _ -> None
         | None ->
           Some
             (entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f)
                ~loc:(Loc.to_string f.Tast.floc)))
      p.Tast.fns
  in
  let globals =
    List.map
      (fun (g : Tast.global) ->
         entry ~name:g.Tast.gname
           ~kind:(if g.Tast.gconst then "const" else "var")
           ~sign:
             (Printf.sprintf "%s %s" g.Tast.gname (Types.to_string g.Tast.gty))
           ~loc:"")
      p.Tast.globals
  in
  let externs =
    List.map
      (fun (e : Tast.extern) ->
         entry ~name:e.Tast.ename ~kind:"extern"
           ~sign:
             (Printf.sprintf "%s [%s] %s" e.Tast.ename
                (String.concat " " (List.map Types.to_string e.Tast.eparams))
                (Types.to_string e.Tast.eret))
           ~loc:"")
      p.Tast.externs
  in
  ok [ ":defs " ^ Wire.list (fns @ globals @ externs) ]

(* [(:op "layout" :type T)] — a struct's fields and their types.

   The daemon can answer this with no running program at all: [Tast.structs] is
   what it built the process from, and a layout is a fact about the build. That
   is why it is the one thing the conditions buffer can fill in while the
   condition's *values* stay refused.

   **The type is a name, and the name is the qualified one.** [Load] qualifies
   every declaration as it imports it — [Defstruct (qualify alias n, ...)] — so
   the names in [Tast.structs] are a flat namespace in which two packages each
   declaring [Missing] are [a/Missing] and [b/Missing] and no collision is
   possible. That makes the name a type identity rather than a class name, with
   no id table to keep in step, and it is the same string on both ends of the
   wire already: [Emit.struct_name_of] puts [Types.Named n] into [flan_error],
   the agent holds it in [condition_name], and [break] answers it as
   [:condition]. Handing that string straight back as [:type] therefore
   resolves, by construction.

   A bare name is **refused, not resolved**, even when only one struct's last
   segment matches: resolving it is exactly the ambiguity that made this op
   need a rule, and a rule with an exception cannot be relied on by a client.
   The refusal lists the qualified names it could have meant, so a person who
   typed [Missing] is one copy-paste from the answer and a client can offer
   them as completions.

   Field types are spelled by [Types.to_string], which is what [defs] spells a
   signature with — so [(Option T)], [[T]], [[n T]] and [(Ptr T)] read here
   exactly as they read in a signature and in the source. A field that is
   itself a struct shows its qualified name, which is a [:type] this op
   accepts: nesting is another request rather than a second walk, and nothing
   here can recurse forever. [Render] is the other walk over a type and is not
   reused, because it walks a *value* and emits code that prints it; this emits
   text about the type and never touches the program. *)
let layout t ~ty =
  let structs = t.session.Session.program.Tast.structs in
  match
    List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname ty)
      structs
  with
  | Some s ->
    ok
      [ ":type " ^ Wire.quote s.Tast.sname;
        ":fields "
        ^ Wire.list
            (List.map
               (fun (f : Tast.field) ->
                  Wire.list
                    [ Wire.quote f.Tast.fname;
                      Wire.quote (Types.to_string f.Tast.fty) ])
               s.Tast.fields) ]
  | None ->
    (* Two types the checker knows and this op cannot describe. An enum's
       members are erased to i32 before [Tast.program] exists, which is the
       same fact that makes a defenum unreloadable; a union is declared and
       has no values yet. Either way, saying which kind it is beats "no such
       type" for a name that plainly exists. *)
    if Hashtbl.mem t.session.Session.env.Check.enums ty then
      error (ty ^ " is an enum, not a struct; its members are erased to i32")
    else if
      List.exists (fun (u : Tast.union) -> String.equal u.Tast.uname ty)
        t.session.Session.program.Tast.unions
    then
      (* Unions have landed, so "milestone 6" was stale — but what replaces it
         is not a layout. This op's reply is a flat [:fields] list, and a union
         is a tag and one payload per case: there is no one field list to
         answer with, and flattening the cases into one would describe storage
         no value ever has. So it says which kind of type this is, and where
         the question it was probably asked for *is* answered — the renderer
         walks a union now, so a union value prints in a frame's locals and at
         `C-x C-e' with its case and that case's fields. *)
      error
        (ty
         ^ " is a union, not a struct; a union is a tag and one payload per case, so it has no single field list for this op to answer with. Its value renders with its case and fields in a frame's locals and at C-x C-e")
    else
      let suffix = "/" ^ ty in
      let candidates =
        List.filter_map
          (fun (s : Tast.structure) ->
             let n = s.Tast.sname in
             let k = String.length n - String.length suffix in
             if k >= 0 && String.equal (String.sub n k (String.length suffix)) suffix
             then Some n else None)
          structs
      in
      (match candidates with
       | [] -> error ("no struct is named " ^ ty)
       | cs ->
         (* Resolved on the client's side, deliberately: two packages can each
            declare [Missing], and picking one of them here would answer a
            layout for a type the asker did not mean. *)
         "(:status \"error\" :message "
         ^ Wire.quote
             (ty ^ " is not a qualified name; a package qualifies its \
                    declarations, so say which one")
         ^ " :candidates " ^ Wire.strings cs ^ ")")

(* What is on offer where the program stopped. [:stopped] and [:condition] are
   not here: the annotation puts them on this reply as it puts them on every
   other, so an editor reads the same two keys whatever it asked. What this op
   adds is the restart names, which cost a second round trip to the program and
   are wanted only when someone is about to choose one. *)
let break t =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match state t with
    | Running -> ok []
    | Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m)
    | Stopped _ ->
      (match restarts t with
       | Ok rs ->
         (* [:restarts] stays a list of names, positional and innermost first,
            with duplicates kept — the position *is* the index, which is what
            [restart-at] takes. [:unreachable] names the positions that are on
            the list and cannot be chosen: a restart below the evaluation the
            break is inside has nowhere for a transfer to land. They are shown
            rather than filtered, because a client that quietly dropped them
            would leave someone asking where their restart went. *)
         ok
           [ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs);
             ":unreachable "
             ^ Wire.ints
                 (List.filter_map
                    (fun (i, ok, _) -> if ok then None else Some i)
                    rs) ]
       | Error m -> error ("the program refused to list its restarts: " ^ m))

(* [(:op "backtrace")] — the frames of a stopped program, innermost first.
   NEXT.md's "Asked for by the editor lanes" had this blocked on exactly the
   frame metadata the shadow stack now carries.

   Refused while the program is running, and that is not a gap in the feature:
   the chain is the game thread's, it is pushed and popped on every call, and
   a walk of it from this end while that thread runs would produce a plausibly
   shaped answer that was never true. Stopped, the thread is parked in the
   break loop and the program itself takes the snapshot.

   Each frame is [(name loc origin nslots)] — four fields in the shape [defs]
   already uses, so an editor reads it with [read] and nothing else. [origin]
   is "program" or "eval": a break inside a C-x C-e thunk has the thunk's
   frames above the program's, and they are shown and labelled rather than
   hidden, the same decision [:unreachable] makes for the restarts under one.
   [nslots] is how many slots the frame has, which is what a client asks about
   before asking for any of them. *)
let backtrace_op t =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match state t with
    | Running ->
      error
        "the program is running; a backtrace is only taken while it is stopped, \
         because the frame chain is the game thread's and it is changing"
    | Unreachable m -> error ("cannot ask the program where it is: " ^ m)
    | Stopped _ ->
      (match backtrace t with
       | Ok (frames, more) ->
         ok
           [ ":frames "
             ^ Wire.list
                 (List.map
                    (fun (name, loc, mine, nslots, _sig, _rsig) ->
                       Wire.list
                         [ Wire.quote name; Wire.quote loc;
                           Wire.quote (if mine then "program" else "eval");
                           string_of_int nslots ])
                    frames);
             Printf.sprintf ":more %d" more ]
       | Error m -> error ("the program refused to say where it is: " ^ m))

(* Build a render thunk, hand it to the program, and read back what it wrote.

   The same five steps for every verb that renders something inside the
   stopped program — [locals], [globals] and [inspect] — and they are here
   once rather than three times because the note this file already carries
   about the fingerprint applies to plumbing too: four of five hand-offs
   present looks exactly like one hand-off dropping a step, and that is a bug
   nobody sees until the one path that lost it is the one being used.

   [tag] only names the [.so] on disk, which is what someone reads when they
   go looking at [t.dir] to find out which verb produced what. *)
let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result =
  let before = match result t with Some (g, _) -> g | None -> 0L in
  t.n <- t.n + 1;
  let out = Filename.concat t.dir (Printf.sprintf "%s%d.so" tag t.n) in
  match
    Build.shared
      ~opts:{ Build.default with Build.dev = true;
                                 Build.debug = t.session.Session.debug }
      ~ir:c.Session.ir ~out ()
  with
  | exception Failure m -> Error m
  | _ ->
    (match deliver t out with
     | exception Unix.Unix_error (e, _, _) ->
       Error ("cannot reach the program: " ^ Unix.error_message e)
     | "ok" ->
       let rec wait ms =
         match result t with
         | Some (g, v) when Int64.compare g before > 0 -> Some v
         | _ when ms <= 0 -> None
         | _ ->
           ignore (Unix.select [] [] [] 0.005);
           if alive t then wait (ms - 5) else None
       in
       (match wait 5000 with
        | Some v -> Ok v
        | None ->
          Error
            "the program did not reach a frame boundary; is it calling \
             (agent/poll)?")
     | reply -> Error ("the program refused the module: " ^ reply))

(* The frame checks, which every verb that reads a *frame* has to make and
   must make the same way. [inspect] exists precisely because the listing is
   frame-accurate and the inspector was not, so it sharing this function with
   [locals] rather than repeating four conditions is the point: an inspector
   that sidestepped the fingerprint would read stale slots out of a frame the
   listing above it is already refusing.

   [what] goes into the wording — "read slot names from" is not the sentence
   [inspect] wants — and nothing else differs. *)
let stopped_frame t ~frame ~what : (string * Tast.fn, string) result =
  if not (alive t) then Error "the program exited; restart flan dev"
  else
    match state t with
    | Running ->
      Error
        (Printf.sprintf
           "the program is running; %s is read from a stopped frame, and \
            nothing in a frame that is still executing holds still"
           what)
    | Unreachable m -> Error ("cannot ask the program where it is: " ^ m)
    | Stopped _ ->
      (match backtrace t with
       | Error m -> Error ("the program refused to say where it is: " ^ m)
       | Ok (frames, _) ->
         (match List.nth_opt frames frame with
          | None ->
            Error
              (Printf.sprintf "there is no frame %d; the backtrace has %d" frame
                 (List.length frames))
          | Some (name, _, mine, nslots, sig_, _rsig) ->
            if not mine then
              Error
                (name
                 ^ " is a frame of the expression this break is inside, not of the program; its thunk is not part of the session, so there is no record of what its slots are called")
            else
              match find_fn t name with
              | None ->
                Error
                  (name
                   ^ " is not a function this session holds; a lifted handler clause has no declaration of its own to read slot names from")
              | Some fn ->
                (* The two body checks come first, including for a frame
                   with no slots. "every slot in it is one the compiler made
                   up" is a claim about the body this session holds, and a
                   zero-slot frame whose body has since been replaced by one
                   with slots is a frame that claim is false about. *)
                if nslots <> Array.length fn.Tast.slots then
                  Error
                    (Printf.sprintf
                       "%s on the stack has %d slots and the %s this session holds has %d: the frame is running a body that has been redefined since, so every slot index here would be a guess"
                       name nslots name (Array.length fn.Tast.slots))
                else if sig_ <> Emit.slot_fingerprint fn then
                  (* The count matching is not the same as the body matching.
                     A redefinition that renames a local, or changes its type
                     to one of the same shape, keeps the count — and then
                     every name here would be the new body's read against the
                     old body's storage, which is the "visible rather than
                     correct" answer this project refuses to give. Said by
                     name, because a frame that is missing and a frame that
                     cannot be trusted are different facts. *)
                  Error
                    (Printf.sprintf
                       "%s on the stack was compiled from a different body than the %s this session holds: this frame's body was redefined since it was entered, so its names no longer describe its values"
                       name name)
                else Ok (name, fn)))

(* [(:op "locals" :frame N)] — what a stopped frame's named locals hold.

   The half of a break loop that the author actually wanted, and the reason
   the shadow stack was built rather than more DWARF: DWARF would have put
   these in lldb, and the point is to need lldb less often.

   Nothing is copied out of the program. A Flan value has no header, so bytes
   read from another process would be bytes with no meaning; what this end has
   is the *type* — [Tast.fn.slots], from the build it owns — and the name
   beside it in [snames]. So it compiles a thunk that renders those types at
   those addresses, in the program, on the stopped thread, and reads the text
   back the way [C-x C-e] does. The only thing that comes from the running
   program is where the frame is.

   Three refusals, each by name and with its reason rather than by omission:
   a slot the compiler invented and nobody named; a slot whose binding had not
   run when the program stopped, which is a null address and would be a fault;
   and a type the structural printer has no arm for. A local that is missing
   and a local that could not be printed are different facts, and a list that
   showed neither would be the same lie twice.

   And two whole frames it refuses: one belonging to a [C-x C-e] thunk, which
   this session does not keep the [Tast] of, and one whose *body* is not the
   body this session holds. The second is the one that needed a fingerprint
   rather than a count: installing while stopped is deliberately allowed — it
   is the fix-it-and-retry loop — so the frame on the stack and the body here
   can be two bodies of one function, and a redefinition that renames a local
   changes neither the count nor the types. [Emit.slot_fingerprint] hashes
   every slot's name together with the spelling of its type, the frame carries
   the value for the body it was compiled from, and this end recomputes it
   from the body it holds. A collision is possible in principle — it is a
   30-bit hash — but only between two differing bodies of the function whose
   qualified name already matched, since [find_fn] gates the comparison. *)
let locals t ~frame =
  match stopped_frame t ~frame ~what:"locals" with
  | Error m -> error m
  | Ok (name, fn) ->
    if Array.length fn.Tast.slots = 0 then
      ok
        [ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()";
          ":note "
          ^ Wire.quote
              "that frame records no slots; every slot in it is one the compiler made up" ]
    else
      (match bound_slots t ~frame with
       | Error m -> error ("the program refused to say which slots are bound: " ^ m)
       | Ok bound ->
         let c, refused = Session.render_locals t.session ~frame ~fn ~bound in
         (match run_render_thunk t ~tag:"l" ~c with
          | Error m -> error m
          | Ok v ->
            (* One line per slot — name, type, value, slot index — tab
               separated, and safe because every string the renderer emits is
               escaped. The index is last and it is what [i] in the break
               buffer hands back to [inspect]: two slots can share a name, so
               the name is not an identifier and the position in this list is
               not one either, since a refused slot is not in it. *)
            let entries =
              List.filter_map
                (fun line ->
                   match String.split_on_char '\t' line with
                   | [ n; ty; value; slot ] ->
                     Some
                       (Wire.list
                          [ Wire.quote n; Wire.quote ty; Wire.quote value; slot ])
                   | _ -> None)
                (String.split_on_char '\n' v)
            in
            ok
              [ ":frame " ^ Wire.quote name;
                ":locals " ^ Wire.list entries;
                ":refused "
                ^ Wire.list
                    (List.map
                       (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ])
                       refused) ]))

(* [(:op "inspect" :frame N :slot I :path (...))] — the inspector's second
   rooting mode. [BUILT.md]'s "Two ways to root a walk" says what each root
   can and cannot do; this is the half that names a frame.

   [i] in the break buffer used to send a local's *name* to be evaluated as an
   expression. On the innermost frame that happens to be right; on any other
   it is evaluated wherever the evaluator stands, so it may resolve to a
   global, to a different binding of the same name, or to nothing — with the
   listing right above it showing the frame's own storage and nothing saying
   the two disagree.

   This roots the walk where the listing roots it: a frame and a slot index,
   which is the address the shadow stack knows, plus the type [Tast.fn.slots]
   knows. A step into a field is then an address plus an offset with that
   field's type, which is arithmetic [Render.render] already does — see
   [Session.render_slot], which is [render_locals] with a path applied to the
   root and one line out instead of one per slot.

   The frame checks are [locals]'s, by construction: both go through
   [stopped_frame]. An inspector that made its own would be free to read a
   frame whose body was redefined since it was entered, which is exactly the
   stale-slot answer the listing refuses.

   The slot is named by *index* and not by name, because a name is not unique:
   [check.ml]'s [fresh_slot] only ever allocates, so (let [v 22] …) inside
   (let [v 11] …) is two slots both called [v], and both are in the listing.
   The index travels out with each line of [locals] for exactly this.

   [:path] is a list the reader parses: a string is a field, an integer is an
   element, and the symbol [some] is an option's payload. Empty means the slot
   itself. *)
let inspect t ~frame ~slot ~path =
  match stopped_frame t ~frame ~what:"a local" with
  | Error m -> error m
  | Ok (name, fn) ->
    (match bound_slots t ~frame with
     | Error m -> error ("the program refused to say which slots are bound: " ^ m)
     | Ok bound ->
       if not (List.mem slot bound) then
         (* The same refusal the listing gives, and for the same reason: an
            unbound slot's entry is null, and a thunk that rendered it would
            fault on the game thread of a program that is already stopped. *)
         error
           (Printf.sprintf
              "slot %d of %s was not bound yet at the point the program \
               stopped; there is nothing at that address to read"
              slot name)
       else
         match Session.render_slot t.session ~frame ~fn ~slot ~path with
         | Error why -> error why
         | Ok (c, label, ty) ->
           (match run_render_thunk t ~tag:"i" ~c with
            | Error m -> error m
            | Ok v ->
              (* One value and nothing else, so the whole of what came back is
                 it — minus the trailing newline the renderer does not write
                 here, because there is no second line to separate it from. *)
              ok
                [ ":frame " ^ Wire.quote name; ":name " ^ Wire.quote label;
                  ":type " ^ Wire.quote ty; ":value " ^ Wire.quote v ]))


(* [(:op "globals")] — the globals the stopped stack reaches, in one section.

   Locals were the half the shadow stack was built for; these are arguably the
   more useful half in this language. A game keeps most of its state in
   top-level [defvar]s and sand.flan holds its entire grid that way, so "what
   is the program's state right now" is a question about globals and there was
   nowhere to ask it.

   **Not per frame, and that is the design.** A global is not part of a frame —
   it is program state the frame happened to touch — so nesting it under one
   implies an ownership that is not there, and repeats the name once per frame
   that reads it. So: one section, whose contents are the union of the globals
   every frame on the current stack references.

   **The compiler does the choosing.** [Reach.expr_refs] is the walk that
   already computes what a function refers to — it is how the link drops a
   package nothing calls — and pointed at one body it answers that body's
   reference set. Listing *all* of a program's globals instead would bury the
   one that matters under the prelude's PRNG state; taking only what the stack
   reaches is the filter the compiler can apply and a person cannot.

   Direct references only, with no transitive closure through the calls a body
   makes. A callee that reads a global is either on this stack — in which case
   it is contributing its own references already — or it is not, in which case
   it is not part of where the program stopped.

   **Each entry says which frames touch it**, by index, which is what the stack
   section already numbers them by. That recovers what per-frame nesting would
   have told you — "the whole chain is reading this" reads differently from
   "only the innermost does" — at no cost in duplication.

   **Ordered by the innermost frame that touches it.** A deep stack makes the
   union large, and proximity to the error is what puts the likely culprit on
   top. Ties keep declaration order, which is the order the source has them in.

   **A frame that cannot be attributed contributes nothing and says so.** An
   eval frame has no declaration in this session; a lifted handler clause has
   none of its own; and a frame whose body has been redefined since it was
   entered holds a body whose reference set is a claim about different code.
   In every case the honest answer is that the union is incomplete and which
   frame made it so — [:skipped] — rather than a list that silently is not the
   union it says it is. The *values* would still have been right; the
   attribution is what goes wrong, and attribution is what this op is for.

   **And the frame check that [locals]'s is not.**
   [Emit.slot_fingerprint] hashes a body's *slots* — every slot's name with the
   spelling of its type — so it catches a redefinition that binds differently
   and misses one that does not. For [locals] that is exactly the right cut:
   if the slots are identical then the names still describe the storage and
   the answer is still true. Here it is not, because a body can change which
   globals it names without touching a single slot, and then this section
   would show the *new* body's reference set attributed to the *old* frame.

   So a second fingerprint, [Reach.ref_fingerprint], over the set of globals
   the body names, carried beside the slot one in [%fninfo] and checked here
   the same way. Two numbers and not one, because they are two facts: a frame
   whose slots match and whose globals do not has readable locals and
   unusable attribution, and combining the hashes would make [locals] refuse
   a frame nothing is wrong with. The values were never the exposure — they
   come from the program's storage by name — and what was, one frame's
   membership in the union and the frame numbers beside an entry, is now a
   named refusal like every other.

   Nothing is copied out of the program here either, and the mechanism is one
   step simpler than [locals]: a global is reached by name rather than by
   address, because [Emit.redefinition] writes a global the host already has as
   [external] and the dynamic linker binds the thunk to the program's own
   storage. So there is no [bound_slots] round trip and no not-yet-bound case —
   a global's storage exists from the moment the process started. *)
let globals_op t =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match state t with
    | Running ->
      error
        "the program is running; globals are read against a stopped stack, and \
         the stack is what decides which of them to show"
    | Unreachable m -> error ("cannot ask the program for its globals: " ^ m)
    | Stopped _ ->
      (match backtrace t with
       | Error m -> error ("the program refused to say where it is: " ^ m)
       | Ok (frames, _) ->
         let all = t.session.Session.program.Tast.globals in
         let is_global n =
           List.exists (fun (g : Tast.global) -> String.equal g.Tast.gname n) all
         in
         (* name -> the frame indices that reference it, innermost lowest *)
         let touched : (string, int list) Hashtbl.t = Hashtbl.create 32 in
         let skipped = ref [] in
         List.iteri
           (fun i (name, _, mine, nslots, sig_, rsig) ->
              let skip why =
                skipped := (Printf.sprintf "%d: %s" i name, why) :: !skipped
              in
              if not mine then
                skip
                  "a frame of the expression this break is inside, not of the \
                   program; its thunk is not part of the session, so there is no \
                   record of what it refers to"
              else
                match find_fn t name with
                | None ->
                  skip
                    "not a function this session holds; a lifted handler clause \
                     has no declaration of its own to read references from"
                | Some fn ->
                  if nslots <> Array.length fn.Tast.slots then
                    skip
                      "the frame is running a body that has been redefined \
                       since, so what this session holds is a different body's \
                       reference set"
                  else if sig_ <> Emit.slot_fingerprint fn then
                    skip
                      "this frame's body was redefined since it was entered, so \
                       what it refers to here is a claim about different code"
                  else if rsig <> Reach.ref_fingerprint ~is_global fn then
                    (* The check the slot fingerprint cannot make. A body that
                       binds the same locals and names different globals passes
                       every test above and is still the wrong body to read a
                       reference set out of: what would go into the union is
                       the *new* body's globals, attributed to the frame of the
                       old one, and the frame numbers beside an entry would say
                       a frame touches something it does not. The values are
                       not what breaks — those are read from the program's own
                       storage by name — so this refuses the frame's
                       attribution and nothing else. [locals] deliberately does
                       not make this check: the slots still describe the
                       storage, so that frame is still readable. *)
                    skip
                      "this frame's body names different globals than the one \
                       this session holds, so which globals it contributes to \
                       this union would be the new body's answer about the old \
                       body's frame"
                  else begin
                    (* Once per frame per name: a body that reads the grid in
                       four places touches it once as far as this is
                       concerned. *)
                    let seen = Hashtbl.create 8 in
                    let note n =
                      if is_global n && not (Hashtbl.mem seen n) then begin
                        Hashtbl.add seen n ();
                        let prev =
                          try Hashtbl.find touched n with Not_found -> []
                        in
                        Hashtbl.replace touched n (prev @ [ i ])
                      end
                    in
                    List.iter (Reach.expr_refs note) fn.Tast.body;
                    List.iter (Reach.expr_refs note) fn.Tast.fdefers
                  end)
           frames;
         let skipped = List.rev !skipped in
         let wanted =
           (* Declaration order first, so a tie on the innermost frame breaks
              the way the source reads. [stable_sort] then keeps it. *)
           List.filter
             (fun (g : Tast.global) -> Hashtbl.mem touched g.Tast.gname)
             all
         in
         let innermost (g : Tast.global) =
           List.fold_left min max_int (Hashtbl.find touched g.Tast.gname)
         in
         let ordered =
           List.stable_sort
             (fun a b -> compare (innermost a) (innermost b))
             wanted
         in
         let where (g : Tast.global) =
           Wire.list
             (List.map string_of_int
                (List.sort_uniq compare (Hashtbl.find touched g.Tast.gname)))
         in
         let skipped_field =
           ":skipped "
           ^ Wire.list
               (List.map
                  (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ])
                  skipped)
         in
         if ordered = [] then
           ok
             [ ":globals ()"; ":refused ()"; skipped_field;
               ":note "
               ^ Wire.quote
                   "no frame on this stack references a global; there is \
                    nothing here that is not already in the locals" ]
         else begin
           let c, refused = Session.render_globals t.session ~globals:ordered in
           match run_render_thunk t ~tag:"g" ~c with
           | Error m -> error m
           | Ok v ->
             (* One line per global, name and type and value, tab separated —
                safe because every string the renderer emits is escaped. The
                frames are added back here, from the table above, because the
                thunk knows nothing about the stack it was chosen for. *)
             let by_name = Hashtbl.create 32 in
             List.iter
               (fun (g : Tast.global) ->
                  Hashtbl.replace by_name g.Tast.gname (where g))
               ordered;
             let entries =
               List.filter_map
                 (fun line ->
                    match String.split_on_char '\t' line with
                    | [ n; ty; value ] ->
                      Some
                        (Wire.list
                           [ Wire.quote n; Wire.quote ty; Wire.quote value;
                             (try Hashtbl.find by_name n
                              with Not_found -> Wire.list []) ])
                    | _ -> None)
                 (String.split_on_char '\n' v)
             in
             ok
               [ ":globals " ^ Wire.list entries;
                 ":refused "
                 ^ Wire.list
                     (List.map
                        (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ])
                        refused);
                 skipped_field ]
         end)

(* A choice is validated by the *program*, on its listener thread, against a
   stack the stopped game thread is holding still — not here. The daemon has no
   copy of that stack and anything it checked would be a guess that was true a
   moment ago.

   "ok" therefore means accepted, and says so: the resume happens when the
   stopped thread next comes round its loop, which is microseconds away and
   still not now. An editor that read [ok] as "running again" would poll once,
   find it stopped, and re-open the prompt it had just answered. *)
let choose_at t ~index ~name =
  if not (alive t) then error "the program exited; restart flan dev"
  else if
    match name with
    | Some n -> String.exists (fun c -> Char.code c < 32 || Char.code c = 127) n
    | None -> false
  then error "a restart name cannot contain a control character"
  else
    let verb =
      "restart-at " ^ string_of_int index
      ^ match name with Some n -> " " ^ n | None -> ""
    in
    match ask t verb with
    | reply when String.trim reply = "ok" ->
      ok
        [ ":index " ^ string_of_int index;
          ":note "
          ^ Wire.quote
              "accepted; the program resumes at its next pass of the break loop"
        ]
    | reply -> error (String.trim reply)
    | exception Unix.Unix_error (e, _, _) ->
      error ("cannot reach the program: " ^ Unix.error_message e)

let choose t ~name =
  if not (alive t) then error "the program exited; restart flan dev"
  else if String.exists (fun c -> Char.code c < 32 || Char.code c = 127) name then
    (* The agent's contract is one line per request. A name carrying a newline
       would be a second request smuggled into the first, and the guarantee is
       this end's to keep: [completing-read] cannot produce one, but the daemon
       is what holds the socket and an editor is not the only thing that can
       speak to it. *)
    error "a restart name cannot contain a control character"
  else
    match ask t ("restart " ^ name) with
    | reply when String.trim reply = "ok" ->
      ok
        [ ":restart " ^ Wire.quote name;
          ":note "
          ^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ]
    | reply -> error (String.trim reply)
    | exception Unix.Unix_error (e, _, _) ->
      error ("cannot reach the program: " ^ Unix.error_message e)

(* The other way out. The program exits 134 where it stopped, which ends this
   daemon too — it owns the program's lifetime and has nothing left to serve.
   Refused while running, by the program, for the same reason a restart is. *)
let abort t =
  if not (alive t) then error "the program exited; restart flan dev"
  else
    match ask t "abort" with
    | reply when String.trim reply = "ok" ->
      ok [ ":note " ^ Wire.quote "the program is exiting; flan dev ends with it" ]
    | reply -> error (String.trim reply)
    | exception Unix.Unix_error (e, _, _) ->
      error ("cannot reach the program: " ^ Unix.error_message e)

(* ── Disassembly ───────────────────────────────────────────────────── *)

(* [flan emit --dev] can print the IR of a whole source file, which is a
   different question from the one an editor asks: not "what would this compile
   to" but "what is the code the running program is calling for this name".
   Only the daemon can answer that, because it built every module it sent and
   still has the .ll and the .so on disk.

   What it cannot do is read a cell back. The agent's socket takes a module
   path, [result], [status], [restarts], [restart] and [abort] — there is no
   verb that reports an address, [flan_dev_cell] lives in the program's address
   space, and an expression evaluated through [eval-expr] renders a pointer as
   [<ptr>] on purpose. So the answer is the last module *delivered* for the
   name, and the reply says exactly that rather than implying more; see
   [basis]. The one case that is certain is the case where nothing has been
   delivered at all, and it says that too.

   SBCL's presentation is worth two things here and not a third. Offsets from
   the function's own start rather than file addresses, because an address into
   a .so means nothing to a reader; and labels for branch targets inside the
   function, which is most of the difference between readable and not. The
   third is source interleaving, which SBCL can do because it has the mapping
   and this build has no line tables — so it is refused by name in the reply
   instead of being faked by printing the listing with no source in it. *)

let objdump = try Sys.getenv "FLAN_OBJDUMP" with Not_found -> "objdump"

let run_capture cmd =
  let ic = Unix.open_process_in (cmd ^ " 2>&1") in
  let b = Buffer.create 4096 in
  let chunk = Bytes.create 4096 in
  let rec go () =
    match input ic chunk 0 4096 with
    | 0 -> ()
    | n -> Buffer.add_subbytes b chunk 0 n; go ()
    | exception End_of_file -> ()
  in
  go ();
  let code = match Unix.close_process_in ic with Unix.WEXITED c -> c | _ -> -1 in
  (code, Buffer.contents b)

let contains 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
  n = 0 || go 0

(* The IR of one function out of a module's text. [Emit] writes a define's
   closing brace at column 0 and nowhere else, so the end is unambiguous
   without parsing LLVM. One .ll can carry several bodies — [C-c C-k] sends a
   buffer's worth as one module — which is why this slices rather than
   returning the file. *)
let ir_of ~ir name =
  let sym = Emit.fname name in
  let rec take = function
    | [] -> []
    | "}" :: _ -> [ "}" ]
    | l :: rest -> l :: take rest
  in
  let rec find = function
    | [] -> None
    | l :: rest ->
      if String.length l > 7 && String.sub l 0 7 = "define " && contains l (sym ^ "(")
      then Some (String.concat "\n" (take (l :: rest)))
      else find rest
  in
  find (String.split_on_char '\n' ir)

(* objdump's own output, rebased and labelled. A line is
   [" 250:<tab>bytes<tab>mnemonic"], with a continuation line carrying only
   bytes when an instruction's encoding does not fit the column. *)
type insn = { off : int; bytes : string; text : string }

let parse_listing ~sym text =
  let head = "<" ^ sym ^ ">:" in
  let lines = String.split_on_char '\n' text in
  let rec drop = function
    | [] -> []
    | l :: rest -> if contains l head then rest else drop rest
  in
  (* objdump prints a blank line after the last instruction of a symbol and
     then whatever follows it in the section. Stopping at that line is what
     keeps a one-function listing from running into the next function. *)
  let rec upto = function
    | [] -> []
    | l :: rest -> if String.trim l = "" then [] else l :: upto rest
  in
  let body = upto (drop lines) in
  let base = ref None in
  let out = ref [] in
  List.iter
    (fun l ->
       match String.split_on_char '\t' l with
       | addr :: bytes :: rest ->
         let a = String.trim addr in
         let a =
           if String.length a > 0 && a.[String.length a - 1] = ':' then
             String.sub a 0 (String.length a - 1)
           else a
         in
         (match int_of_string_opt ("0x" ^ a) with
          | None -> ()
          | Some n ->
            if !base = None then base := Some n;
            let b = match !base with Some b -> b | None -> n in
            out :=
              { off = n - b; bytes = String.trim bytes;
                text = String.trim (String.concat "\t" rest) }
              :: !out)
       | _ -> ())
    body;
  (List.rev !out, !base <> None)

(* A branch inside the function shows as [<flan.step+0x79>] or, for the entry,
   [<flan.step>]. Those become [L0]..[Ln] in address order, as SBCL labels
   them; anything else objdump annotated — a cell, a plt entry, another
   function — is left exactly as it wrote it. *)
let target_of ~sym text =
  if not (contains text ("<" ^ sym)) then None
  else
    match String.index_opt text '<' with
    | None -> None
    | Some i ->
      let rest = String.sub text i (String.length text - i) in
      if String.length rest < 3 || rest.[String.length rest - 1] <> '>' then None
      else
        let inner = String.sub rest 1 (String.length rest - 2) in
        if String.equal inner sym then Some 0
        else
          let p = String.length sym in
          if String.length inner > p + 1 && String.sub inner 0 (p + 1) = sym ^ "+"
          then
            int_of_string_opt (String.sub inner (p + 1) (String.length inner - p - 1))
          else None

let render_listing ~sym insns =
  let targets =
    List.sort_uniq compare
      (List.filter_map (fun i -> target_of ~sym i.text) insns)
  in
  let label n =
    let rec idx k = function
      | [] -> None
      | x :: r -> if x = n then Some (Printf.sprintf "L%d" k) else idx (k + 1) r
    in
    idx 0 targets
  in
  let b = Buffer.create 4096 in
  List.iter
    (fun i ->
       (match label i.off with
        | Some lb -> Buffer.add_string b (lb ^ ":\n")
        | None -> ());
       let text =
         match target_of ~sym i.text with
         | Some n ->
           (match label n with
            | Some lb ->
              (* [jmp 1d9 <flan.step+0x89>] becomes [jmp L1]. The bare number
                 objdump prints is the address the branch encodes *in the
                 file*, which is the one number on the line that means nothing
                 once the listing is rebased — so it goes with the symbol it
                 duplicates. *)
              let j = String.index i.text '<' in
              let head = String.sub i.text 0 j in
              let k = ref (String.length head) in
              while !k > 0 && head.[!k - 1] = ' ' do decr k done;
              while !k > 0
                    && (match head.[!k - 1] with
                        | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
                        | _ -> false)
              do decr k done;
              String.sub head 0 !k ^ lb
            | None -> i.text)
         | None -> i.text
       in
       if text = "" then
         Buffer.add_string b (Printf.sprintf "  %04x  %s\n" i.off i.bytes)
       else
         Buffer.add_string b
           (Printf.sprintf "  %04x  %-22s %s\n" i.off i.bytes text))
    insns;
  Buffer.contents b

let asm_of ~obj name =
  let sym = "flan." ^ name in
  let code, text =
    run_capture
      (String.concat " "
         [ Filename.quote objdump; "-d";
           "--disassemble=" ^ Filename.quote sym; Filename.quote obj ])
  in
  if code <> 0 then
    Error
      (Printf.sprintf "%s failed on %s (exit %d): %s" objdump obj code
         (String.trim text))
  else
    match parse_listing ~sym text with
    | _, false -> Error (Printf.sprintf "%s found no symbol %s in %s" objdump sym obj)
    | insns, true -> Ok (render_listing ~sym insns)

(* Where a name's body was last built, and how much of that is a claim about
   the running process rather than about this daemon's disk. *)
let basis t name =
  match Hashtbl.find_opt t.owners name with
  | None ->
    ( { ogen = 0; oso = t.host_exe; oll = t.host_ll;
        oloc = host_loc t name },
      "the host executable — nothing defining this name has been delivered in \
       this session, so the program's cell still holds this body" )
  | Some o ->
    let m = Filename.basename o.oso in
    ( o,
      match state t with
      | Stopped c ->
        (* Not "so it is not installed yet". The commonest way to stop is to
           install a body and have it error, so a stopped program is more
           likely to be running this code than not — the daemon simply cannot
           read the cell back to find out, and saying otherwise would be the
           [ok]-means-probably failure in the one field that exists to prevent
           it. What is certain is only the second half. *)
        Printf.sprintf
          "%s — the last module delivered for this name, accepted for install; \
           the program is stopped on %s and the daemon cannot read the cell \
           back to say whether it installed this before stopping. Nothing \
           further installs until it resumes"
          m c
      | Running ->
        Printf.sprintf
          "%s — the last module delivered for this name, accepted for install; \
           the program installs it at its next frame boundary and the daemon \
           cannot read the cell back to confirm that it has"
          m
      | Unreachable r ->
        Printf.sprintf
          "%s — the last module delivered for this name; the program is not \
           answering (%s), so whether it installed cannot be said"
          m r )

let kind_of t name =
  let p = t.session.Session.program in
  if List.exists (fun (g : Tast.global) -> String.equal g.Tast.gname name)
       p.Tast.globals
  then Some "a global"
  else if
    List.exists (fun (e : Tast.extern) -> String.equal e.Tast.ename name)
      p.Tast.externs
  then Some "an extern"
  else None

let disassemble t ~name ~form =
  if form <> "ir" && form <> "asm" then
    error
      (Printf.sprintf
         "unknown form %S: disassemble takes :form \"ir\" or :form \"asm\"" form)
  else
    match find_fn t name with
    | None ->
      (match kind_of t name with
       | Some k ->
         error
           (Printf.sprintf
              "%s is %s, not a function: there is no generated code to show for it"
              name k)
       | None -> error (Printf.sprintf "no function named %s in this session" name))
    | Some f ->
      let o, why = basis t name in
      let common =
        [ ":name " ^ Wire.quote name; ":form " ^ Wire.quote form;
          ":generation " ^ string_of_int o.ogen;
          ":signature " ^ Wire.quote (signature_of_fn f);
          (* [o.oloc], not the session's: the session moves on as soon as a
             form checks, and this has to name the source the code being shown
             was built from. *)
          ":loc " ^ Wire.quote o.oloc;
          ":basis " ^ Wire.quote why ]
      in
      if form = "ir" then
        match read_file o.oll with
        | text ->
          (match ir_of ~ir:text name with
           | Some body ->
             ok (common @ [ ":object " ^ Wire.quote o.oll; ":text " ^ Wire.quote body ])
           | None ->
             error (Printf.sprintf "no define for %s in %s" (Emit.fname name) o.oll))
        | exception Sys_error m ->
          error ("the IR this body was built from is gone: " ^ m)
      else if not (Sys.file_exists o.oso) then
        error ("the object this body was linked into is gone: " ^ o.oso)
      else
        match asm_of ~obj:o.oso name with
        | Ok text ->
          ok
            (common
             @ [ ":object " ^ Wire.quote o.oso;
                 ":note "
                 ^ Wire.quote
                     "source interleaving needs line tables this build does not \
                      emit";
                 ":text " ^ Wire.quote text ])
        | Error m -> error m

let handle t req =
  match Wire.string_field req "op" with
  | Some "eval" ->
    (match Wire.string_field req "code" with
     | Some code ->
       let origin =
         match Wire.string_field req "file" with Some f -> f | None -> "<editor>"
       in
       eval t ~code ~origin
     | None -> error "eval needs :code")
  | Some "eval-expr" ->
    (match Wire.string_field req "code" with
     | Some code ->
       let origin =
         match Wire.string_field req "file" with Some f -> f | None -> "<editor>"
       in
       eval_expr t ~code ~origin
     | None -> error "eval-expr needs :code")
  | Some "describe" -> describe t
  | Some "defs" -> defs t
  | Some "break" -> break t
  | Some "backtrace" -> backtrace_op t
  | Some "locals" ->
    locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0)
  (* The path is read by the language's own reader, so it arrives as a form
     and is matched here rather than parsed out of a string: a string element
     is a field, an integer is an element, and the symbol [some] is an
     option's payload. Anything else is refused by name rather than skipped —
     a path with a step silently dropped out of it would render a *different*
     value and say nothing. *)
  | Some "inspect" ->
    (match Wire.int_field req "slot" with
     | None -> error "inspect needs :slot, the index the locals listing gave"
     | Some slot ->
       let frame =
         match Wire.int_field req "frame" with Some n -> n | None -> 0
       in
       let steps =
         match Wire.field req "path" with
         | Some { Form.v = Form.List l; _ } ->
           List.fold_left
             (fun acc (e : Form.t) ->
                match acc with
                | Error _ -> acc
                | Ok got ->
                  (match e.Form.v with
                   | Form.Str f -> Ok (Session.Sfield f :: got)
                   | Form.Int i -> Ok (Session.Sindex (Int64.to_int i) :: got)
                   | Form.Sym "some" -> Ok (Session.Ssome :: got)
                   | _ ->
                     Error
                       "a :path step is a string for a field, an integer for an element, or `some' for an option's payload"))
             (Ok []) l
           |> Result.map List.rev
         (* Emacs prints an empty list as [nil], because it has no other
            spelling for one. Taking it is cheaper than making every client
            in that language special-case the empty path, and [nil] is not a
            step under any other reading. *)
         | Some { Form.v = Form.Sym "nil"; _ } -> Ok []
         | Some _ -> Error "inspect's :path is a list"
         | None -> Ok []
       in
       (match steps with
        | Error m -> error m
        | Ok path -> inspect t ~frame ~slot ~path))
  (* No :frame, and that is the point: the section is the stack's, not a
     frame's. See [globals_op]. *)
  | Some "globals" -> globals_op t
  | Some "layout" ->
    (match Wire.string_field req "type" with
     | Some ty -> layout t ~ty
     | None -> error "layout needs :type")
  | Some "restart" ->
    (match Wire.string_field req "name" with
     | Some name -> choose t ~name
     | None -> error "restart needs :name")
  (* By index, which is the one that can name a shadowed restart. [:name] is
     optional and is not the lookup: it is checked against the name the program
     has at that index and refused if they have drifted apart, so a client that
     listed and then chose cannot take a different restart than the one it
     showed. *)
  | Some "restart-at" ->
    (match Wire.int_field req "index" with
     | Some index -> choose_at t ~index ~name:(Wire.string_field req "name")
     | None -> error "restart-at needs :index")
  | Some "abort" -> abort t
  | Some "disassemble" ->
    (match Wire.string_field req "name" with
     | Some name ->
       let form =
         match Wire.string_field req "form" with Some f -> f | None -> "asm"
       in
       disassemble t ~name ~form
     | None -> error "disassemble needs :name")
  | Some "close" -> ok []
  | Some op -> error ("unknown op: " ^ op)
  | None -> error "no :op"

(* ── The loop ──────────────────────────────────────────────────────── *)

(* One connection at a time. An editor is one client, evaluations are
   sequential by nature — each one is checked against the program the last one
   left behind — and a second concurrent evaluation would be racing for the
   same session anyway. *)
(* Returns whether the client asked to end the session. One editor per daemon,
   so [close] shuts the whole thing down rather than waiting for another
   connection nobody is going to make. *)
let serve t fd =
  let rec go () =
    match Wire.recv fd with
    | src ->
      let op, reply =
        match Wire.parse src with
        | req -> (Wire.string_field req "op", handle t req)
        | exception Loc.Error (_, m) -> (None, error ("bad request: " ^ m))
      in
      Wire.send fd (with_output t (with_break t reply));
      if op = Some "close" then true else go ()
    | exception Wire.Closed -> false
    | exception Unix.Unix_error _ -> false
  in
  go ()

(* [accept] would block past the program's own exit, so it is waited on with
   a timeout and the child checked each time round: a daemon whose program has
   finished has nothing left to do, and an editor waiting on it would wait
   forever. In the merged build [alive] is always true and the loop ends the
   only way it can — the process does, taking the program with it. *)
let accept_loop t ls =
  let rec go () =
    if alive t then
      (* The program's pipe is in the same select as the listening socket: it
         has to be drained whether or not an editor is asking for anything. *)
      match Unix.select [ ls; t.stdout ] [] [] 0.2 with
      | [], _, _ -> go ()
      | ready, _, _ when not (List.mem ls ready) -> drain t; go ()
      | _ ->
        (match Unix.accept ls with
         | fd, _ ->
           let closed = serve t fd in
           (try Unix.close fd with Unix.Unix_error _ -> ());
           if not closed then go ()
         | exception Unix.Unix_error (Unix.EINTR, _, _) -> go ())
      | exception Unix.Unix_error (Unix.EINTR, _, _) -> go ()
  in
  go ()

(* [debug] is off by default, which keeps [flan dev] exactly what it was: a
   -O2 host and -O2 modules. It is opt-in rather than always-on because a debug
   build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg
   deletes it — and silently making every reloaded body -O0 would change the
   frame time of the one function you are iterating on, in the loop whose whole
   point is watching that number. *)
let two_process ?(debug = false) ~file ~sock () =
  let t0 = Unix.gettimeofday () in
  (* Absolute, because every location this daemon ever reports is derived from
     it and an editor is not in this process's working directory. [flan dev
     src/game.flan] run from a project root would otherwise send back
     "src/game.flan:12:7", which the editor can only resolve by guessing which
     directory it was relative to. *)
  let file = try Unix.realpath file with Unix.Unix_error _ -> file in
  let session, l = Session.create ~debug ~file () in
  let dir =
    Filename.concat (Filename.get_temp_dir_name ())
      (Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
  in
  (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  let exe = Filename.concat dir "program" in
  (* [keep] so the host's own IR survives the build. It is the text [llc] was
     actually given, not a second emission of it, which is the difference
     between showing what the process was built from and showing what it
     probably was. [Build.executable] leaves it in its own working directory
     under the module's basename; it is moved here so that nothing else in this
     process can reuse the name. *)
  (* The host and the modules are one decision. DWARF in a redefinition is
     only half a debuggable dev loop: lldb re-resolves a *name* breakpoint
     against each module as it loads either way, but a breakpoint set on a line
     in the .flan buffer needs a line table on both sides — the host's to fire
     before the first C-c C-c, the module's to follow the reload. *)
  ignore
    (Build.executable
       ~opts:{ Build.default with Build.dev = true; Build.keep = true;
                                  Build.debug }
       ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe);
  let host_ll = Filename.concat dir "host.ll" in
  (try
     Sys.rename (Filename.concat (Build.workdir ()) (Filename.basename exe ^ ".ll"))
       host_ll
   with Sys_error _ -> ());
  let agent = Filename.concat dir "agent.sock" in

  (* The program's source names some socket path; the daemon is the one that
     knows where it wants to talk to it, so it overrides through the
     environment. Guessing instead would fail silently — everything compiles,
     the module is built, and nothing ever receives it. *)
  Unix.putenv "FLAN_AGENT_SOCKET" agent;
  (* Through a pipe, so the program's own output can reach an editor instead of
     only the terminal the daemon was started in. *)
  let rd, wr = Unix.pipe ~cloexec:false () in
  let child = Unix.create_process exe [| exe |] Unix.stdin wr Unix.stderr in
  Unix.close wr;
  Unix.set_nonblock rd;

  (* Wait for it to bind before accepting an evaluation. One that arrives first
     would fail for a reason that reads like a compiler bug. *)
  if not (await (fun () -> Sys.file_exists agent)) then begin
    (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
    failwith
      ("the program never listened on " ^ agent
       ^ " — does it call (agent/start ...)?")
  end;

  let t =
    { session; child = Some child; agent; dir; stdout = rd;
      out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
      host_ll; host_exe = exe; finished = false }
  in
  (try Unix.unlink sock with Unix.Unix_error _ -> ());
  let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  Unix.bind ls (Unix.ADDR_UNIX sock);
  Unix.listen ls 4;
  Printf.eprintf "flan dev: %s ready on %s (%.0fms)\n%!" file sock
    ((Unix.gettimeofday () -. t0) *. 1000.);
  Fun.protect
    ~finally:(fun () ->
      (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
      (try Unix.close ls with Unix.Unix_error _ -> ());
      (try Unix.close rd with Unix.Unix_error _ -> ());
      (try Unix.unlink sock with Unix.Unix_error _ -> ()))
    (fun () -> accept_loop t ls)

(* ── One process: the program and the compiler in the same binary ──── *)

(* Everything above this line works the same either way. What follows is the
   merged build: one executable that is the compiled Flan program *and* holds
   the whole OCaml compiler, with the editor's socket served from a thread
   inside it. DISCUSS.md item 14 is the spike this is built from.

   The shape, and it is this way round for a reason:

     main()                       C, the game's thread. Runs the Flan program.
       + a pthread                caml_startup, then [merged_setup] and
                                  [merged_serve] — the compiler and the
                                  editor's listener.
       + a pthread                flan_agent.c's accept loop, as today.

   The game keeps main() because on macOS a window has to be on the main
   thread. The compiler goes to the side, beside the listener that was already
   there. Nothing about that is Linux-specific.

   TWO RULES, and neither is a style preference. Both are the reason this is
   safe at all, and both are silently broken by one convenient shortcut.

   1. THE GAME THREAD MUST NEVER CALL INTO OCAML. OCaml's collector stops
      OCaml threads at safe points. A pure native thread has none, so it cannot
      be stopped — which is exactly why the GC will never pause a frame. That
      holds only while the game thread is not inside an OCaml call: one direct
      call from the frame loop and a major collection can land in the middle of
      it. Requests reach the compiler by being *left somewhere and picked up*,
      never by a call. The agent already works this way — a socket, a ring and
      two atomics — and it stays that way. If a future handler wants something
      from the game thread, it leaves a request and waits; it does not call.

   2. NEVER STORE AN OCAML [value] IN FLAN STORAGE. Not in an arena, not in a
      [Vec], not in a global, not across an allocation. The collector moves its
      own blocks and will not update a word it does not know is a root;
      [caml_register_global_root] (or the generational one) is the only legal
      way. The boundary passes pointers and scalars. This is the chief way the
      "the GC does not touch Flan's memory" measurement stops being true, and
      it would fail intermittently rather than loudly.

   WHERE REPL-FIRST WOULD DIFFER, noted now because it is much cheaper to leave
   room for than to retrofit. Today [main] runs the program and the compiler
   comes up beside it. The SBCL arrangement is the same binary with the two
   swapped: the C [main] would not call [flan_program_main] at all, it would
   park, and opening the window would be something typed at the prompt — one
   more op that asks the game thread to run a named function. The startup below
   is the only place that decides, and it decides in three lines of C. What is
   genuinely open is the *session*: [Session.create ~file] is the only entry
   there is, so a REPL that starts empty and accumulates as files are loaded
   needs [Session] to have a second constructor. It already accumulates; it
   just cannot start from nothing. *)

let ocamlfind = try Sys.getenv "FLAN_OCAMLFIND" with Not_found -> "ocamlfind"

(* The C that owns the process. A string here rather than a file under
   [runtime/] for the reason [Build.wasm_main_source] is one: the compiler
   carries the C it needs instead of looking for it on disk, and only the two
   files [lib/dune] already embeds are reachable that way. *)
let merged_main_source = {c|
/* Generated by flan dev. The merged build's entry point: the Flan program owns
 * the main thread, the OCaml compiler comes up on a thread beside it.
 *
 * See lib/dev.ml for the two rules this arrangement depends on. The short
 * form: this thread — the one running flan_program_main — must never enter
 * OCaml, and no OCaml value may be stored in Flan memory. */
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <pthread.h>
#include <fcntl.h>
#include <stdatomic.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <unistd.h>

/* The Flan program's entry point. Emit writes it as @main; flan dev renames it
 * in the IR so that this file can own main() instead. */
extern int flan_program_main(int argc, char **argv);

/* flan_rt.c's, and the reason the program's exit does not end the session. */
extern void (*flan_exit_hook)(int32_t status);

/* Installed on flan_rt.c's hook, which a Flan main reaches instead of
 * returning: Emit ends @main with a call to flan_exit and an unreachable.
 *
 * In one process that call cannot be allowed to end the process — it would
 * take the compiler, the editor's socket and the session down with a program
 * that merely finished. So it flushes, closes stdout so that the compiler
 * learns the program is done exactly as the daemon learned it (the pipe reads
 * EOF, which is what the child's death used to cause), and parks.
 *
 * Parking rather than exiting is also the REPL-first shape in miniature: the
 * process outliving the program is the whole of the difference between "run a
 * program with a REPL attached" and "an image you run programs in". */
static void flan_merged_exit(int32_t status) {
  (void)status;
  fflush(NULL);
  close(1);
  /* ...and take fd 1 straight back, because POSIX hands out the lowest free
   * descriptor: leave it open and the compiler thread's next socket or file
   * becomes this process's stdout, and the next llc inherits it. The EOF is
   * unaffected — the pipe's write end is genuinely gone. */
  if (open("/dev/null", O_WRONLY) < 0) { /* nothing useful to do about it */ }
  for (;;) pause();
}

static char **g_argv;
/* Atomic, not a plain int: this is the only happens-before edge between the
 * two threads, and everything the compiler set up before it — the listening
 * socket, the redirected stdout — has to be visible to the program after it. */
static atomic_int compiler_ready = 0;

static void flan_merged_nap(long ms) {
  struct timespec t;
  t.tv_sec = ms / 1000;
  t.tv_nsec = (ms % 1000) * 1000000L;
  nanosleep(&t, NULL);
}

static const value *flan_merged_need(const char *n) {
  const value *f = caml_named_value(n);
  if (!f) {
    fprintf(stderr, "flan dev: %s is not registered in this binary\n", n);
    fflush(NULL);
    _exit(70);
  }
  return f;
}

static void *flan_merged_compiler(void *unused) {
  (void)unused;
  caml_startup(g_argv);
  /* Two callbacks and not one: setup has to have finished — the socket bound,
   * stdout redirected — before the program starts, and serve never returns. */
  caml_callback(*flan_merged_need("flan_merged_setup"), Val_unit);
  atomic_store(&compiler_ready, 1);
  caml_callback(*flan_merged_need("flan_merged_serve"), Val_unit);
  fflush(NULL);
  _exit(0);
}

int main(int argc, char **argv) {
  pthread_t compiler;
  int rc;
  g_argv = argv;
  flan_exit_hook = flan_merged_exit;
  if (pthread_create(&compiler, NULL, flan_merged_compiler, NULL) != 0) {
    fprintf(stderr, "flan dev: could not start the compiler thread\n");
    return 1;
  }
  while (!atomic_load(&compiler_ready)) flan_merged_nap(1);

  /* From here the main thread is the program's and nothing else's. It does not
   * enter OCaml, and it is not joined with the compiler thread — that thread
   * is in an accept loop it never leaves. */
  /* Does not come back: a Flan main ends in flan_exit, which is hooked above.
   * The lines below are for a program that somehow does return. */
  rc = flan_program_main(argc, argv);

  /* _exit, not exit, for the reason the break loop gives: the atexit chain and
   * the ELF destructors want the loader lock the agent's listener may be
   * holding inside dlopen, and the merged build adds OCaml's own shutdown to
   * that chain. The streams are flushed by hand instead.
   *
   * This is also the line REPL-first would delete: park here instead, and the
   * window becomes something the prompt asks for rather than the thing the
   * process is. */
  fprintf(stderr,
          "flan dev: the program returned %d; the session ends with it\n", rc);
  fflush(NULL);
  _exit(rc);
}
|c}

(* The OCaml half's roots. [-output-complete-obj] links a .cmxa the way an
   executable does — only the modules something refers to — so this file is
   what pulls [Flan.Dev] and everything under it into the object. *)
let merged_entry_source =
  "let () =\n\
  \  Callback.register \"flan_merged_setup\" Flan.Dev.merged_setup;\n\
  \  Callback.register \"flan_merged_serve\" Flan.Dev.merged_serve\n"

(* Where [flan.cmxa] is, which is the one thing the merged build needs that a
   normal build does not. The compiler finds its own library beside itself;
   [FLAN_LIBDIR] overrides for an install layout that does not match. *)
let libdir () =
  let exe =
    try Unix.realpath Sys.executable_name
    with Unix.Unix_error _ -> Sys.executable_name
  in
  let bin = Filename.dirname exe in
  let candidates =
    (match Sys.getenv_opt "FLAN_LIBDIR" with Some d -> [ d ] | None -> [])
    @ [ Filename.concat (Filename.dirname bin) "lib" ]
  in
  List.find_opt
    (fun d -> Sys.file_exists (Filename.concat d "flan.cmxa"))
    candidates

(* The whole compiler as one object file, cached. Keyed on a digest of
   [flan.cmxa] and [flan.a] rather than on their existence: without that, an
   edit to this very file rebuilds the library and the merged binary goes on
   running the previous one — which costs an hour of chasing a ghost. *)
let compiler_object () =
  match libdir () with
  | None ->
    failwith
      "cannot find flan.cmxa beside this binary, so the compiler cannot be \
       linked into the program. Set FLAN_LIBDIR, or run flan dev \
       --two-process."
  | Some lib ->
    let cmxa = Filename.concat lib "flan.cmxa" in
    let arch = Filename.concat lib "flan.a" in
    let dg f = try Digest.to_hex (Digest.file f) with Sys_error _ -> "-" in
    let key =
      Digest.to_hex
        (Digest.string
           (String.concat "\000"
              [ "flan-merged-compiler-1"; dg cmxa; dg arch;
                Build.stamp_of ocamlfind; merged_entry_source ]))
    in
    let obj = Filename.concat (Build.cachedir ()) ("compiler-" ^ key ^ ".o") in
    if not (Sys.file_exists obj) then begin
      let dir = Build.workdir () in
      let ml = Filename.concat dir "flan_merged_entry.ml" in
      Build.write ml merged_entry_source;
      let tmp =
        Printf.sprintf "%s.%d.o" (Filename.remove_extension obj)
          (Unix.getpid ())
      in
      (* [-output-complete-obj], not [-output-obj]: it bundles the runtime, so
         there is no libasmrun to hunt for. The two [-I]s are dune's own object
         directories — the .cmi and the .cmx of the library the entry module
         refers to. *)
      let cmd =
        String.concat " "
          [ Filename.quote ocamlfind; "ocamlopt"; "-thread";
            "-package"; "unix,threads.posix"; "-linkpkg";
            "-output-complete-obj";
            "-I"; Filename.quote (Filename.concat lib ".flan.objs/byte");
            "-I"; Filename.quote (Filename.concat lib ".flan.objs/native");
            (* [lib] again, as a library search path. The macro work gave
               [lib/dune] a [foreign_stubs] stanza, so [flan.cmxa] now records
               a dependency on [-lflan_stubs] and the linker has to be told
               where dune put the archive. Without this the merged object
               fails with "cannot find -lflan_stubs" and only
               [--two-process] works. *)
            "-cclib"; Filename.quote ("-L" ^ lib);
            "-o"; Filename.quote tmp;
            Filename.quote cmxa; Filename.quote ml ]
      in
      let code = Sys.command cmd in
      if code <> 0 then
        failwith
          (Printf.sprintf
             "%s could not build the compiler object (exit %d); flan dev \
              --two-process still works" ocamlfind code);
      (try Unix.rename tmp obj with Unix.Unix_error _ -> ())
    end;
    obj

let ocaml_where =
  lazy
    (match run_capture "ocamlopt -where" with
     | 0, s -> String.trim s
     | _ -> "")

(* [@main] renamed out of the way, so the C above can own the process. On the
   emitted text rather than in [Emit], because [lib/emit.ml] belongs to another
   lane — and because the spike proved the rename is all it takes. *)
let rename_program_main ir =
  let needle = "define i32 @main(" in
  let n = String.length needle and len = String.length ir in
  let rec find i =
    if i + n > len then None
    else if String.sub ir i n = needle then Some i
    else find (i + 1)
  in
  match find 0 with
  | None ->
    failwith
      "no @main in the emitted IR — the merged build renames it so a C main \
       can own the process"
  | Some i ->
    String.sub ir 0 i ^ "define i32 @flan_program_main("
    ^ String.sub ir (i + n) (len - i - n)

(* The link, which is [Build.executable]'s with three additions: the program's
   [@main] renamed, the C above, and the compiler object.

   It is spelled here rather than as a mode of [Build.executable] because
   [lib/build.ml] belongs to another lane this week. The duplication is real
   and should collapse into [Build] once that lane lands — every piece it uses
   ([compile_c], [cflags], [target_flags], [select_csrcs], [select_lflags]) is
   already [Build]'s and already public. Native only: a wasm target has no
   dlopen, no OCaml runtime and no use for any of this. *)
let merged_executable ~opts ~csrcs ~lflags ~pnames (p : Tast.program) ~out ~ll =
  let open Build in
  (* [Build.executable] forces this and the disassembly machinery believes it:
     a --debug build that came out -O2 makes [basis] and the listing lie. *)
  let opts = if opts.debug then { opts with opt = "-O0" } else opts in
  let tflags = target_flags opts in
  let ir =
    Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames
      ~sanitize:opts.sanitize p
  in
  write ll (rename_program_main ir);
  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)
    (* The caml/ headers, so the entry point can call caml_startup. They ride
       in on [tflags], which is part of the object cache key — an entry point
       compiled against one OCaml must not be served to another. *)
    @ [ compile_c ~opts
          ~tflags:(tflags @ [ "-I"; Filename.quote (Lazy.force ocaml_where) ])
          ~src:merged_main_source ~name:"flan_merged_main.c" () ]
  in
  let cmd =
    String.concat " "
      ([ Filename.quote clang; opts.opt; "-Wno-override-module" ]
       @ cflags opts
       (* Still needed, and for the same reason: a delivered module reaches the
          host's cells and globals through the dynamic symbol table. *)
       @ (if opts.dev then [ "-rdynamic" ] else [])
       @ tflags
       @ [ Filename.quote ll ]
       @ List.map Filename.quote objs
       @ [ Filename.quote (compiler_object ()) ]
       @ select_lflags opts lflags
       (* -lzstd is OCaml 5's, not this project's: 5.x's marshaller is
          compressed, and the missing ZSTD_* symbols are the first thing a
          naive link of the runtime fails on. *)
       @ [ "-lm"; "-lpthread"; "-ldl"; "-lzstd" ]
       @ [ "-o"; Filename.quote out ])
  in
  let code = Sys.command cmd in
  if code <> 0 then
    failwith
      (Printf.sprintf
         "%s failed (exit %d) linking the merged build; the IR is at %s" clang
         code ll);
  out

(* ── The merged process's own two entry points ─────────────────────── *)

(* Held between [merged_setup] and [merged_serve], which are two calls because
   the program must not start until the first has finished and the second never
   returns. *)
let merged_state = ref None

let need_env k =
  match Sys.getenv_opt k with
  | Some v when v <> "" -> v
  | _ ->
    failwith
      (k ^ " is not set: this binary is a [flan dev] build and is started by it")

(* Called from the compiler thread, once, before the program runs. *)
let merged_setup () =
  try
    let t0 = Unix.gettimeofday () in
    let file = need_env "FLAN_DEV_SOURCE" in
    let sock = need_env "FLAN_DEV_SOCK" in
    let dir = need_env "FLAN_DEV_DIR" in
    let host_ll = need_env "FLAN_DEV_HOST_LL" in
    let agent = need_env "FLAN_AGENT_SOCKET" in
    let debug = Sys.getenv_opt "FLAN_DEV_DEBUG" = Some "1" in
    (* The session is built a second time here rather than carried across the
       exec. It is the frontend only — about 12ms — and the alternative is
       marshalling a [Session.t] through a file, which buys nothing: the source
       cannot have changed between the two, because the build that produced
       this binary is the one that exec'd it. *)
    let session, _ = Session.create ~debug ~file () in
    (* The program's output has to reach an editor exactly as it did when the
       daemon held the other end of a pipe. Same pipe, one process: fd 1 is
       replaced before the program starts, and the accept loop drains it —
       which is a liveness requirement and not a nicety, since a pipe nobody
       reads fills at 64K and the next print blocks the game thread for ever. *)
    flush Stdlib.stdout;
    let rd, wr = Unix.pipe ~cloexec:false () in
    Unix.dup2 wr Unix.stdout;
    Unix.close wr;
    Unix.set_nonblock rd;
    let exe =
      try Unix.realpath Sys.executable_name
      with Unix.Unix_error _ -> Sys.executable_name
    in
    let t =
      { session; child = None; agent; dir; stdout = rd;
        out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
        host_ll; host_exe = exe; finished = false }
    in
    (try Unix.unlink sock with Unix.Unix_error _ -> ());
    let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
    Unix.bind ls (Unix.ADDR_UNIX sock);
    Unix.listen ls 4;
    merged_state := Some (t, ls, sock);
    Printf.eprintf "flan dev: %s ready on %s (%.0fms, one process)\n%!" file
      sock ((Unix.gettimeofday () -. t0) *. 1000.)
  with e ->
    Printf.eprintf "flan dev: %s\n%!"
      (match e with Failure m -> m | e -> Printexc.to_string e);
    exit 1

(* Called from the compiler thread after the program has started. Never
   returns: the process ends here or not at all. *)
let merged_serve () =
  match !merged_state with
  | None -> prerr_endline "flan dev: serve was called before setup"; exit 1
  | Some (t, ls, sock) ->
    (* The agent is bound by the program on the main thread, which only starts
       once [merged_setup] has returned — so unlike the daemon, this waits
       *after* it is already serving. An editor connecting in the meantime is
       answered; only a delivery needs the agent. A program that never calls
       [agent/start] is a warning rather than a failure now, because the thing
       the daemon would have killed for it is this process. *)
    if not (await ~ms:10000 (fun () -> Sys.file_exists t.agent)) then
      Printf.eprintf
        "flan dev: the program is not listening on %s — does it call \
         (agent/start ...)?\n%!" t.agent;
    (match accept_loop t ls with
     | () -> ()
     | exception e ->
       Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e));
    (try Unix.close ls with Unix.Unix_error _ -> ());
    (try Unix.unlink sock with Unix.Unix_error _ -> ());
    (* [close] from the editor ends the session, and in one process that means
       the program too — which is what the daemon did by killing its child.
       [_exit] for the loader-lock reason the break loop gives. *)
    flush_all ();
    Unix._exit 0

(* ── Starting a session ────────────────────────────────────────────── *)

(* The merged build is made here and then [exec]'d, so what an editor talks to
   is the program itself rather than something that launched it. The launcher
   does not survive: there is one process from the first reply onwards. *)
let start_merged ?(debug = false) ~file ~sock () =
  let t0 = Unix.gettimeofday () in
  let file = try Unix.realpath file with Unix.Unix_error _ -> file in
  let session, l = Session.create ~debug ~file () in
  let dir =
    Filename.concat (Filename.get_temp_dir_name ())
      (Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
  in
  (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
  let exe = Filename.concat dir "program" in
  (* The host's IR goes straight to its final home rather than being written
     into the build's working directory and moved: the merged link is spelled
     in this file, so it can simply be told where to put it. It is the text
     clang was given, with [@main] renamed — which is what this binary really
     was built from, and what [basis] must not misreport. *)
  let host_ll = Filename.concat dir "host.ll" in
  ignore
    (merged_executable
       ~opts:{ Build.default with Build.dev = true; Build.debug }
       ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags ~pnames:[]
       session.Session.host ~out:exe ~ll:host_ll);
  let agent = Filename.concat dir "agent.sock" in
  (* Every one of these is read by the exec'd binary and by nothing else. They
     are set before the exec rather than by the compiler thread afterwards, so
     that the game thread's [getenv] cannot race the compiler thread's
     [putenv]: there is no ordering left to get wrong. *)
  Unix.putenv "FLAN_AGENT_SOCKET" agent;
  Unix.putenv "FLAN_DEV_SOURCE" file;
  Unix.putenv "FLAN_DEV_SOCK" sock;
  Unix.putenv "FLAN_DEV_DIR" dir;
  Unix.putenv "FLAN_DEV_HOST_LL" host_ll;
  Unix.putenv "FLAN_DEV_DEBUG" (if debug then "1" else "0");
  (try Unix.unlink sock with Unix.Unix_error _ -> ());
  Printf.eprintf "flan dev: built %s in %.0fms\n%!" (Filename.basename file)
    ((Unix.gettimeofday () -. t0) *. 1000.);
  Unix.execv exe [| exe |]

(* [two_process] is still here and still works. It is the escape hatch for a
   machine where the compiler object cannot be built — no ocamlfind, no
   flan.cmxa beside the binary — and it is what every behaviour in this file
   was written against, so it stays until the transport it exists to drive is
   actually deleted. *)
let start ?(debug = false) ?(merged = true) ~file ~sock () =
  if merged then start_merged ~debug ~file ~sock ()
  else two_process ~debug ~file ~sock ()