flan/lib/session.ml

(** A live program: the declarations a running process was built from, plus
    every change accepted since.

    This is what makes an editor possible. [Check.program] builds a fresh
    environment from a declaration list on every call, which is exactly the
    property a session needs and the reason there is no scratch-environment
    machinery here: a form that fails to check leaves nothing behind, because
    nothing was mutated. The list is only replaced once the check has
    succeeded. Re-checking the whole program each time costs the whole frontend,
    which is under 10ms — less than the [llc] that follows it.

    Two things the session knows that no single evaluation could:

    - **which names the running process was built with.** A name it has is a
      symbol the loaded module binds to; a name it lacks goes through the
      by-name registry in runtime/flan_dev.c. Getting this wrong is silent:
      treating [print-line] as new gives it a registry cell nobody publishes,
      and the first call jumps to null. It has to come from the *checked*
      program, because [Check.program] prepends the prelude and no accumulated
      AST contains it.
    - **what the memory of that process looks like.** A cell is a bare pointer
      and carries no signature, so a redefined function whose parameters
      changed is called by every existing call site with the old ones — no link
      error, no trap, a wrong number. Struct fields and global types are the
      same class. Those are refused here, with the reason, rather than loaded.

    Not here, and deliberately: evaluating an expression. That is a separate
    primitive — synthesize a function around the form, call it, render the
    value — and it is not what redefining a name is. *)

type t = {
  file            : string;              (* resolves an import's relative path *)
  mutable decls   : Ast.decl list;       (* post-Load: flat, one namespace *)
  mutable program : Tast.program;        (* the last thing that checked *)
  host            : Tast.program;        (* what the process was built from *)
}

let fail = Loc.fail

let create ~file =
  let l = Load.program ~file (Parse.program (Reader.read_file file)) in
  let p = Check.program l.Load.decls in
  ({ file; decls = l.Load.decls; program = p; host = p }, l)

(* A name the running process exports. Everything else is looked up by name at
   install time — see [Emit.redefinition]'s [known]. *)
let known t n =
  List.exists (fun (f : Tast.fn) -> String.equal f.Tast.name n) t.host.Tast.fns
  || List.exists
       (fun (g : Tast.global) -> String.equal g.Tast.gname n)
       t.host.Tast.globals

(* ── What a running process cannot be told ─────────────────────────── *)

(* Everything here is a change that would load cleanly and then be wrong. The
   house rule (NEXT.md, Watch for) says recognise it and refuse with the
   reason, so each one names what it would have broken. *)
let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) =
  let find_fn p n =
    List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns
  in
  List.iter
    (fun (f : Tast.fn) ->
       match find_fn old_ f.Tast.name with
       | None -> ()
       | Some g ->
         let same =
           List.length f.Tast.params = List.length g.Tast.params
           && List.for_all2 Types.equal f.Tast.params g.Tast.params
           && Types.equal f.Tast.ret g.Tast.ret
         in
         (* A cell holds a bare pointer. Every call site compiled before this
            change still passes the old arguments through it. *)
         if not same then
           fail loc
             "%s changes signature, from (Fn [%s] %s) to (Fn [%s] %s); \
              the calls already compiled into the running program pass the old \
              one. Restart to change it."
             f.Tast.name
             (String.concat " " (List.map Types.to_string g.Tast.params))
             (Types.to_string g.Tast.ret)
             (String.concat " " (List.map Types.to_string f.Tast.params))
             (Types.to_string f.Tast.ret))
    new_.Tast.fns;
  List.iter
    (fun (g : Tast.global) ->
       match
         List.find_opt
           (fun (h : Tast.global) -> String.equal h.Tast.gname g.Tast.gname)
           old_.Tast.globals
       with
       | Some h when not (Types.equal g.Tast.gty h.Tast.gty) ->
         (* The storage exists and has a shape. Reusing it for another one
            reads fields at the wrong offsets; allocating fresh storage would
            silently discard the state the reload exists to preserve. *)
         fail loc
           "%s changes type, from %s to %s; the running program already laid \
            that storage out. Restart to change it."
           g.Tast.gname (Types.to_string h.Tast.gty) (Types.to_string g.Tast.gty)
       | _ -> ())
    new_.Tast.globals;
  List.iter
    (fun (s : Tast.structure) ->
       match
         List.find_opt
           (fun (r : Tast.structure) -> String.equal r.Tast.sname s.Tast.sname)
           old_.Tast.structs
       with
       | Some r ->
         let fields (x : Tast.structure) =
           List.map (fun (f : Tast.field) -> (f.Tast.fname, f.Tast.fty))
             x.Tast.fields
         in
         let same =
           List.length s.Tast.fields = List.length r.Tast.fields
           && List.for_all2
                (fun (an, at) (bn, bt) -> String.equal an bn && Types.equal at bt)
                (fields s) (fields r)
         in
         (* Every value of this type in the running program has the old layout,
            including ones held in globals that the reload is preserving. *)
         if not same then
           fail loc
             "%s changes layout; the values the running program is holding have \
              the old one. Restart to change it."
             s.Tast.sname
       | None -> ())
    new_.Tast.structs

(* ── Accepting a change ────────────────────────────────────────────── *)

(* The redefinition unit is a list of top-level forms, so this is one path for
   both editor commands: C-c C-c sends one form, C-c C-k sends a file. *)
type change = {
  ir      : string;             (* the module to build and send *)
  names   : string list;        (* everything the forms declared *)
  fns     : string list;        (* the subset that has a body to install *)
}

let eval ?(origin = "<eval>") t src : change =
  let forms = Reader.read_all ~file:origin src in
  (* Through [Load] like any other source, so an evaluated (import ...) means
     what it means in a file. Its expansion is what gets spliced, which is also
     why the accumulated list is the post-Load one: re-evaluating a file that
     imports something would otherwise append a second copy of the import and
     the duplicate-name pass would reject it. *)
  let incoming = (Load.program ~file:t.file (Parse.program forms)).Load.decls in
  let loc =
    match incoming with d :: _ -> d.Ast.dloc | [] -> Loc.unknown
  in
  let names = List.filter_map Ast.declared_name incoming in
  let replacement n =
    List.find_opt
      (fun (d : Ast.decl) -> Ast.declared_name d = Some n)
      incoming
  in
  (* Replaced in place and appended only when genuinely new, so declaration
     order — which is emission order for globals — does not shuffle on every
     evaluation. *)
  let replaced = ref [] in
  let kept =
    List.map
      (fun (d : Ast.decl) ->
         match Ast.declared_name d with
         | Some n ->
           (match replacement n with
            | Some nd -> replaced := n :: !replaced; nd
            | None -> d)
         | None -> d)
      t.decls
  in
  let added =
    List.filter
      (fun (d : Ast.decl) ->
         match Ast.declared_name d with
         | Some n -> not (List.exists (String.equal n) !replaced)
         | None -> false)
      incoming
  in
  let decls = kept @ added in
  (* Nothing above this line has changed the session. A [Loc.Error] from here
     leaves it exactly as it was. *)
  let program = Check.program decls in
  compatible ~loc t.program program;
  let fns =
    List.filter
      (fun n ->
         List.exists
           (fun (f : Tast.fn) -> String.equal f.Tast.name n)
           program.Tast.fns)
      names
  in
  let ir = Emit.redefinition ~dev:true ~known:(known t) program ~fns in
  t.decls <- decls;
  t.program <- program;
  { ir; names; fns }