(* C-x C-e: evaluating an expression inside a program that is running.

   A different primitive from redefining a name, and the difference is the
   whole test: there is no name to install a body into, so the expression is
   compiled into a thunk with nowhere to be called from, the module says "run
   this once", and the agent does — at a frame boundary, on the game thread.

   Nothing is marshalled back. A Flan value carries no header, so nothing at
   run time could say what it is; the compiler knows the type and renders it
   there. That is the layout decision's bill, and it is why only the scalars
   work so far.

   The case that matters most is the same expression evaluated twice with
   different answers: that is what says it read the live process's state rather
   than a copy of it. *)

open Flan

(* The watchdog first: a hang is the one failure mode that reports
   nothing at all. See watchdog.ml. *)
let () = Watchdog.arm ~seconds:600 "test_repl"

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

let scratch = Filename.get_temp_dir_name ()
let tmp n = Filename.concat scratch ("flan-repl-" ^ n)

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

(* One timer covers two waits here — [flan dev] builds the whole program and
   only then binds — so the failure has to say which of them it was. See
   [listening] in test_dev.ml for the whole of the reasoning; this is the same
   helper, kept here rather than shared because these three files have no
   module between them. Watching the process as well as the socket is what
   makes a crash fail in milliseconds instead of costing the full timeout. *)
let listen_why = ref ""

let listening ?(ms = 30000) ~pid path =
  let died = ref None in
  ignore
    (await ~ms (fun () ->
         Sys.file_exists path
         ||
         match Unix.waitpid [ Unix.WNOHANG ] pid with
         | 0, _ -> false
         | _, st -> died := Some st; true
         | exception Unix.Unix_error _ -> false));
  if Sys.file_exists path then true
  else begin
    listen_why :=
      (match !died with
       | Some (Unix.WEXITED n) ->
         Printf.sprintf "exited with status %d before binding %s" n path
       | Some (Unix.WSIGNALED n) ->
         Printf.sprintf "was killed by signal %d before binding %s" n path
       (* Unreachable without WUNTRACED, and here only for exhaustiveness. *)
       | Some (Unix.WSTOPPED n) ->
         Printf.sprintf "stopped on signal %d without binding %s" n path
       | None ->
         Printf.sprintf
           "was still running after %ds without binding %s, so it was the \
            build that did not finish, not the socket"
           (ms / 1000) path);
    false
  end

let rec connect ?(ms = 8000) path =
  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  match Unix.connect s (Unix.ADDR_UNIX path) with
  | () -> s
  | exception Unix.Unix_error _ when ms > 0 ->
    Unix.close s;
    ignore (Unix.select [] [] [] 0.005);
    connect ~ms:(ms - 5) path

let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd)
let field r k = Wire.string_field r k
let status r = match field r "status" with Some s -> s | None -> "<none>"

let quote s =
  let b = Buffer.create (String.length s + 8) in
  Buffer.add_char b '"';
  String.iter
    (fun c ->
       if c = '"' || c = '\\' then Buffer.add_char b '\\';
       Buffer.add_char b c)
    s;
  Buffer.add_char b '"';
  Buffer.contents b

let () =
  match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
  | 0 ->
    let sock = tmp "dev.sock" and out = tmp "prog.out" in
    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
    let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
    let flan = "../bin/main.exe" in
    let pid =
      Unix.create_process flan
        [| flan; "dev"; "programs/printers.flan"; "-s"; sock |]
        Unix.stdin fd Unix.stderr
    in
    Unix.close fd;
    (* Thirty seconds and not the 8s default: this waits on an llc-and-link of
       the whole program, ~0.5s warm and 2s cold, worst measured at 6.8s with
       this suite's other binaries running beside it. The watchdog bounds the
       run; a crash no longer waits for either. *)
    if not (listening ~pid sock) then
      fail "the daemon %s" !listen_why
    else begin
      let c = connect sock in
      let evals code =
        request c
          (Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")"
             (quote code))
      in
      let value name code expected =
        let r = evals code in
        match field r "value" with
        | Some v when v = expected -> ()
        | Some v -> fail "%s\n        got: %S\n     wanted: %S" name v expected
        | None ->
          fail "%s: %s" name (Option.value ~default:(status r) (field r "message"))
      in
      value "arithmetic" "(+ 1 2)" "3";
      value "a comparison" "(< 1 2)" "true";
      (* Quoted and escaped, in the runtime: a string whose content is not
         escaped does not round-trip and reads as a framing bug. *)
      value "a string" "\"hi\"" "\"hi\"";
      value "an escaped string" "(.name b)" "\"sandy \\\"quoted\\\"\"";
      (* A defconst: its value is in the program's memory and this reads it. *)
      value "a constant" "step-by" "3";
      (* Rendered in C, because the language's own i64->bytes is signed and
         this would otherwise come back as -1. *)
      value "u64 at its maximum" "big" "18446744073709551615";
      (* A struct, nested, with a fixed array inside it. *)
      value "a struct" "(.pos b)" "(V {.x 1.5 .y 0})";
      value "a nested struct" "b"
        "(Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y 0}) .tags [ 0 42 0]})";
      value "a fixed array" "arr" "[ 0 0 9 0]";
      (* A slice's length is not known until it runs, so this one renders
         through a loop rather than by unrolling. *)
      value "a slice" "(slice (.tags b) 0 3)" "[ 0 42 0]";
      (* An enum's members are erased to i32 before the backend sees them, so
         the name is recovered from the checker's table. *)
      value "an enum" "col" ":blue";
      (* A Unit expression is almost always a call made for its effect, so it
         has to be *evaluated* and then reported as (). Emitting the literal
         without running it made the prompt answer while nothing happened. *)
      value "a call made for its effect" "(println \"printed\")" "()";
      (* A macro, over the socket. [Parse.expr] ran no expander at all until
         now, so this was an unknown name — the prelude's macros included,
         which is what said the gap was older than importable macros. [clamp]
         is a prelude [defmacro] and [unless] is the one that stopped being a
         special form, so between them they cover both shapes: one that
         answers a value and one that answers unit. *)
      value "a prelude macro" "(clamp 9 0 3)" "3";
      value "a prelude macro for its effect" "(unless false 1 2)" "()";
      (* And the buffer's own, which is the set nobody held. [Macro.program]
         collects macros by scanning the forms it is handed and an evaluation
         hands it one form, so [tenfold] — declared in printers.flan, a few
         lines above [main] — was an unknown name in its own file while the
         prelude's and an import's both worked. The session seeds it from the
         same read that built the program. Over a real socket, because that is
         the path a person is on; test_session has the in-process halves. *)
      value "the file's own macro" "(tenfold 7)" "70";

      (* The one that proves it ran inside the process: the program increments
         [ticks] every frame, so two evaluations of it must disagree. A copy
         of the program's state, or a value computed here, would not. *)
      let read () =
        match field (evals "ticks") "value" with
        | Some v -> int_of_string_opt v
        | None -> None
      in
      (match (read (), read ()) with
       | Some a, Some b when b > a -> ()
       | Some a, Some b ->
         fail "ticks read %d then %d — the expression did not see the live \
               program advancing" a b
       | _ -> fail "ticks did not evaluate");

      let refuses name code reason =
        let r = evals code in
        match field r "message" with
        | Some m when
            (let n = String.length reason and h = String.length m in
             let rec go i = i + n <= h && (String.sub m i n = reason || go (i + 1)) in
             go 0) -> ()
        | Some m -> fail "%s said %S, wanted it to mention %S" name m reason
        | None -> fail "%s was accepted" name
      in
      (* A declaration is refused by name. It used to come back as "unknown
         name defvar", which is why the reason asserted here was empty; now
         that an expression expands, a macro can produce one, and the head
         says what it is wherever it appears. *)
      refuses "a declaration" "(defvar nope i64)" "top-level declaration";
      refuses "a declaration inside an expression" "(do 1 (defn f [] i32 1))"
        "top-level declaration";
      refuses "an unknown name" "no-such-name" "unknown name";
      (* [defmacro] is in that same head list, and it is the shape that stays
         refused now that a [defmacro] typed at the editor means something: a
         person will reach for C-x C-e on one by reflex, and what they get is
         the sentence naming it a declaration rather than an arity complaint
         about an unknown function. C-c C-c is where a declaration goes, which
         is the case below. *)
      refuses "a defmacro at C-x C-e" "(defmacro m [args] args)"
        "top-level declaration";

      (* And the session is untouched by all of it: an evaluation is not a
         declaration, so nothing named eval/N accumulates in the program. *)
      let r = request c "(:op \"describe\")" in
      if status r <> "ok" then fail "describe after evaluating: %s" (status r);

      (* Below the line above deliberately, because this one *does* change the
         session: a macro the file never had, typed at the editor and then
         called. It is the shape the fix chose — a [defmacro] evaluated into a
         session joins it, exactly as a [defn] does, and the next evaluation
         can call it. Two round trips, because that is the whole of the
         claim. *)
      (let r =
         request c
           (Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\")"
              (quote "(defmacro thrice [args] `(* ~(at args 0) 3))"))
       in
       if status r <> "ok" then
         fail "evaluating a defmacro over the socket: %s"
           (Option.value ~default:(status r) (field r "message")));
      value "a macro defined at the editor" "(thrice 14)" "42";

      (* ── C-c C-m over the socket ────────────────────────────────────
         [test_session] drives the expansion itself and is where the cases
         live; this is the same question asked the way a person asks it, and
         what it adds is the daemon: the reply's fields, the pretty text
         surviving the framing, and — the part worth a socket — that a request
         which compiles a macro module and refuses it comes back as a reply
         rather than as a daemon that stopped answering.

         The macro set here is [printers.flan]'s, so it covers the prelude's
         and the buffer's own; the imported-package half is [test_session]'s,
         over [pkg-macro.flan]. *)
      let expands ?(all = false) name code want =
        let r =
          request c
            (Printf.sprintf
               "(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\" :all %s)"
               (quote code) (if all then "t" else "nil"))
        in
        match field r "flat" with
        | Some v when v = want -> ()
        | Some v -> fail "%s\n        got: %S\n     wanted: %S" name v want
        | None ->
          fail "%s: %s" name (Option.value ~default:(status r) (field r "message"))
      in
      expands "a prelude macro, expanded" "(clamp 9 0 3)" "(min 3 (max 0 9))";
      expands "the file's own macro, expanded" "(tenfold 7)" "(* 7 10)";
      (* And the one typed at the editor a moment ago, which is the session's
         set rather than the file's: nothing on disk declares [thrice]. *)
      expands "a macro defined at the editor, expanded" "(thrice 14)" "(* 14 3)";
      (* Every escape the reader knows, through the printer and then through
         the wire, and back out as the same text. This is the one field in the
         protocol that carries arbitrary literal data — a macro may build any
         literal at all, which is why [Form.to_source] exists beside
         [Form.to_string] — and [Wire.quote] escapes only the quote and the
         backslash, on the stated ground that both readers take everything
         else as itself. This is that ground, checked. *)
      expands "every string escape survives the printer and the wire"
        "\"a\\nb\\0c\\\"d\\\\e\\tf\\rg\"" "\"a\\nb\\0c\\\"d\\\\e\\tf\\rg\"";
      (* And the byte literals, where [to_string] would have written a NUL and
         a carriage return into the middle of the line. *)
      expands "a byte literal is written as a name the reader has"
        "[\\nul \\return \\space \\tab \\newline \\A]"
        "[\\nul \\return \\space \\tab \\newline \\A]";
      (* A float that is a whole number, which [to_string]'s %g writes as an
         integer — and an integer is what it would read back as. *)
      expands "a whole float keeps its point" "[1.0 0.5 -2.0]" "[1.0 0.5 -2.0]";

      (* A form with no macro in it comes back as itself, and says so rather
         than echoing and leaving the editor to diff. *)
      (let r =
         request c
           (Printf.sprintf
              "(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
              (quote "(+ 1 2)"))
       in
       (* [:expanded] is a flag and therefore a symbol, not a string — the
          spelling [:stopped] and [:overflow] already use — so it is read out
          of the form rather than through [Wire.string_field]. *)
       let flag k =
         match Wire.field r k with
         | Some f -> Form.to_source f
         | None -> "<none>"
       in
       if flag "expanded" <> "nil" then
         fail "a form that is not a macro call reported :expanded %s"
           (flag "expanded");
       if field r "note" = None then
         fail "a form that is not a macro call gave no reason");
      (* The name of the macro that ran rides on the reply, because the text
         cannot carry it: [Loc.from_macro] is outermost-wins. *)
      (let r =
         request c
           (Printf.sprintf
              "(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
              (quote "(tenfold 7)"))
       in
       if field r "macro" <> Some "tenfold" then
         fail "the reply named %s as the macro that ran"
           (Option.value ~default:"<none>" (field r "macro")));
      (* :text is the same expansion with the line breaks in it. Nothing here
         asserts where they go — that is [Form.pretty]'s and the editor's — only
         that the field is there and reads back as the same form. *)
      (let r =
         request c
           (Printf.sprintf
              "(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
              (quote "(tenfold 7)"))
       in
       match field r "text" with
       | Some t when t = "(* 7 10)" -> ()
       | Some t -> fail ":text was %S" t
       | None -> fail ":text was missing");
      (* And the session is untouched by having been asked: a [defmacro] handed
         to C-c C-m does not join it. C-c C-c is where a declaration goes, and
         the round trip below is the only way to check the aftermath. *)
      ignore
        (request c
           (Printf.sprintf
              "(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
              (quote "(defmacro looked-at [args] `(* ~(at args 0) 5))")));
      (let r = evals "(looked-at 3)" in
       if status r = "ok" then
         fail "a defmacro joined the session by being macroexpanded");

      ignore (request c "(:op \"close\")");
      Unix.close c
    end;
    (try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
    (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
    if !failures = 0 then print_endline "repl: all tests passed"
    else begin
      Printf.printf "\n%d failure(s)\n" !failures;
      exit 1
    end
  | _ -> print_endline "repl: skipped (no clang or llc on PATH)"