(* The session: the declarations a running process was built from, plus every
   change accepted since (NEXT.md, the dev loop).

   Two halves. First, what a session refuses — every case here is a change that
   would compile, load, install, and then be wrong, because a cell is a bare
   pointer and storage that already exists already has a shape. Second, that
   refusing leaves the session usable, which is the failure people actually hit:
   one typo must not poison every later evaluation. *)

open Flan

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

let has hay needle =
  let n = String.length needle and h = String.length hay in
  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
  go 0

(* Every rejection is asserted on its reason, not just on the failure: the
   reason is the part that has to survive a refactor. *)
let refuses ?(file = "programs/reload.flan") name src reason =
  let t, _ = Session.create ~file in
  match Session.eval t src with
  | _ -> fail "%s was accepted" name
  | exception Loc.Error (_, msg) ->
    if not (has msg reason) then
      fail "%s\n        said: %S\n     wanted it to mention: %S" name msg reason

let () =
  (* A cell carries no signature, so every call site compiled before the change
     still passes the old arguments through it. *)
  (* [outer] is called only from C, and [spare] is read by nothing, so the
     checker has no complaint about either change and the session is the only
     thing that can refuse them. A change something else in the program uses is
     an ordinary type error first, which is a different and louder failure. *)
  refuses "a changed parameter type"
    "(defn outer [x i64] i64 (bump))"
    "changes signature";
  refuses "a changed return type"
    "(defn outer [] i32 (i32 (bump)))"
    "changes signature";
  refuses "a changed arity"
    "(defn outer [a i64 b i64] i64 (bump))"
    "changes signature";
  (* The storage exists and has a shape: reusing it reads at the wrong offsets,
     and replacing it discards the state the reload exists to preserve. *)
  refuses "a retyped global"
    "(defvar spare i32)"
    "changes type";
  (* Values of the type are already in the running program's memory. *)
  refuses ~file:"programs/values.flan" "a restructured struct"
    "(defstruct P [x i32 y i32])"
    "changes layout";

  (* An ordinary redefinition, and what the session works out about it. *)
  let t, _ = Session.create ~file:"programs/reload.flan" in
  let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 5)) counter)" in
  if c.Session.fns <> [ "bump" ] then
    fail "redefining bump reported %s" (String.concat " " c.Session.fns);
  (* The prelude is in the checked program and in no accumulated AST, so a
     session that derived [known] from declarations would call print-line
     through a registry cell nobody ever publishes. *)
  if not (has c.Session.ir "@\"flan.cell.print-line\" = external global ptr") then
    fail "the prelude was treated as new";
  if has c.Session.ir "flan_dev_cell" then
    fail "a name the host has went through the registry";

  (* A form that does not check must leave the session exactly as it was. This
     is the one that decides whether a REPL survives a typo. *)
  (match Session.eval t "(defn bump [] i64 nonsense)" with
   | _ -> fail "an unresolvable name was accepted"
   | exception Loc.Error _ -> ());
  (match Session.eval t "(defn bump [] i64 (set counter (+ counter 6)) counter)" with
   | c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover"
   | exception Loc.Error (_, m) -> fail "the session was poisoned by a typo: %s" m);

  (* Names the process was never built with go through the registry instead of
     binding to a symbol, and adding one is allowed where retyping one is not. *)
  let c = Session.eval t "(defvar fresh i64) (defn use-fresh [] i64 (set fresh 3) fresh)" in
  if not (List.mem "fresh" c.Session.names && List.mem "use-fresh" c.Session.fns) then
    fail "adding a var and a function reported %s" (String.concat " " c.Session.names);
  if not (has c.Session.ir "call ptr @flan_dev_global") then
    fail "a new global did not go through the registry";
  (* And once added, it is part of the session: a later form can use it. *)
  (match Session.eval t "(defn use-fresh [] i64 (set fresh 4) fresh)" with
   | _ -> ()
   | exception Loc.Error (_, m) -> fail "a name added earlier was forgotten: %s" m);

  (* A file with imports, re-evaluated whole — the C-c C-k case. The session
      keeps the *expanded* declarations, so the package's names are replaced in
      place rather than appended a second time and rejected as duplicates. *)
  let t, _ = Session.create ~file:"../sand.flan" in
  let src = In_channel.with_open_bin "../sand.flan" In_channel.input_all in
  (match Session.eval t src with
   | c ->
     if not (List.mem "game-draw" c.Session.fns) then
       fail "reloading sand.flan did not include its own functions"
   | exception Loc.Error (_, m) ->
     fail "reloading a file with imports failed: %s" m);

  if !failures = 0 then print_endline "session: all tests passed"
  else begin
    Printf.printf "\n%d failure(s)\n" !failures;
    exit 1
  end