A method added to a running program, proved end to end

The claim classes were built for, made against a real daemon rather than
at the session's report: dev-class.flan is compiled with one method for
one class, a second method is delivered into the live process, and the
call through the generic's cell answers with the new method's body while
the original one goes on answering. That is what a generic being exactly
one top-level name buys, and it is now pinned rather than argued.

Two things came out of writing it, neither of them about classes.

The x86 backend's redefinition module never emitted the per-type dyn
descriptors. Emit.redefinition has always emitted them, by going through
finish; the x86 twin ended at the rodata section and stopped. Nothing
had reached it, because a redefined body had to construct a struct
holding a dyn to need one, and until NoMethod there was no such struct a
compiler-written body could build. What it looks like is not a bad read
at run time but a link failure — desc_of mints a local label, the body
references it, and ld refuses the module with an undefined symbol. One
line, beside the same call in the executable path.

And the thing the test had to be written around: a dyn value answered by
eval-expr does not come back in the reply's :value at all. It renders to
the program's own stdout, which reaches a *later* reply's :output — the
dyn-global rows already read one that way and say so. So every answer
here is compared inside the expression, and what crosses the wire is a
typed 1 or 0. Left as it is; where a dyn expression's value should
surface is a question about the editor protocol, not about this lane.

The session-level test stays: it pins which names an added method
reports for installation, which is the half a daemon test cannot see.

lib/x86.ml

@@ -4922,6 +4922,17 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
         \t.size\tflan_reload_transient, 1\n\
         flan_reload_transient:\n\t.byte\t1\n"
    | _ -> ());
+  (* The per-type dyn descriptors this module's own bodies asked for, exactly
+     as [program] emits them. They were missing here, and the hole only became
+     reachable when a redefined body first constructed a struct holding a dyn:
+     [desc_of] mints a local label and the body references it, so a module
+     that never wrote the label out is one [ld] refuses with an undefined
+     symbol rather than one that loads and reads garbage. The labels are local
+     in both backends — [desc_of] says so, and this is the other half of that
+     sentence — so emitting the same type's descriptor here and in the host is
+     not a duplicate symbol. [Emit.redefinition] has always emitted them, by
+     going through [finish]. *)
+  Buffer.add_string out (Emit.descriptors_asm md);
   Buffer.add_string out "\n\t.section\t.rodata\n";
   Buffer.add_buffer out rodata;
   Buffer.add_string out "\n\t.section\t.note.GNU-stack,\"\",@progbits\n";

test/programs/dev-class.flan

@@ -0,0 +1,26 @@
+;;;; A class and a generic function, for the dev loop rather than for output.
+;;;;
+;;;; What a session does with this is the question the feature is judged on:
+;;;; adding a method to a running program has to reach the call sites that
+;;;; were compiled before the method existed. It does, and the reason is that
+;;;; a generic is one function — the methods are branches of its body, not
+;;;; functions of their own — so a new method is the ordinary redefinition of
+;;;; one name, through the cell the call already goes through.
+;;;;
+;;;; It keeps running rather than returning, for dev-repl.flan's reason: an
+;;;; expression typed at the editor is a thunk the agent runs at a frame
+;;;; boundary, and a parked program has none.
+(import agent "vendor:agent")
+
+(defclass point [x y])
+(defclass circle [r])
+
+(defgeneric area [self] dyn)
+
+(defmethod area point [p] (* (get p :x) (get p :y)))
+
+(defn main [] i32
+  (agent/start "/tmp/flan-dev-class-fallback.sock")
+  (dotimes [i 4000]
+    (agent/wait 5))
+  0)

test/test_dev.ml

@@ -4899,6 +4899,91 @@ let () =
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ gsock; gout ];
 
+    (* ── A method added to a running program ───────────────────────
+       The one claim classes rest on, made end to end rather than at the
+       session's report: a generic function compiled with one method gets a
+       second one delivered into the live process, and the call that goes
+       through its cell answers with the new method's body. The session test
+       pins which name is installed; this pins that installing it works.
+
+       Its own daemon over [programs/dev-class.flan], which keeps running so
+       that an expression has a frame boundary to be run at. *)
+    let csock = tmp "class.sock" and cout = tmp "class.out" in
+    (try Sys.remove csock with Sys_error _ -> ());
+    let cfd = Unix.openfile cout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+    let cpid =
+      Unix.create_process flan
+        [| flan; "dev"; "programs/dev-class.flan"; "-s"; csock |]
+        Unix.stdin cfd Unix.stderr
+    in
+    Unix.close cfd;
+    if not (listening ~pid:cpid csock) then begin
+      fail "the class daemon %s (%S)" !listen_why
+        (In_channel.with_open_bin cout In_channel.input_all);
+      (try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ())
+    end
+    else begin
+      let c = connect csock in
+      let said r = Option.value ~default:"" (Wire.string_field r "message") in
+      let value r = Option.value ~default:"" (Wire.string_field r "value") in
+      let ask code =
+        request c
+          (Printf.sprintf
+             "(:op \"eval-expr\" :code %S :file \"programs/dev-class.flan\")"
+             code)
+      in
+      (* Every answer is compared inside the expression rather than read out
+         of it. A generic answers a dyn, and a dyn value is rendered to the
+         program's own stdout rather than into the reply's :value — it does
+         reach a later reply's :output, which is how the dyn-global rows
+         below read one, but the flush is the next reply's and not this one's.
+         Asking the running program whether the answer is 12 puts a typed
+         value in :value and takes the timing out of the test.
+
+         The first ask is retried: the agent's thread is let go only after the
+         socket is bound, so an early ask is a race with the startup and not a
+         result. *)
+      let answered = ref "" in
+      let asked () =
+        let r = ask "(if (= (area (point 3 4)) 12) 1 0)" in
+        status r = "ok" && (answered := value r; true)
+      in
+      if not (await asked) then
+        fail "the class daemon never reached a frame boundary"
+      else begin
+        if !answered <> "1" then
+          fail "the method the program was built with answered %S" !answered;
+        (* A circle has no method yet, so the dispatch misses and the generic
+           signals NoMethod — the answer a program handles, spelled here as
+           the thing that makes the next step's success mean something. *)
+        let r =
+          request c
+            "(:op \"eval\" :code \"(defmethod area circle [q] (* 3 (* (get q \
+             :r) (get q :r))))\" :file \"programs/dev-class.flan\")"
+        in
+        if status r <> "ok" then fail "delivering a new method: %s" (said r)
+        else begin
+          (* The call site in the generic's own cell now reaches a branch that
+             did not exist when the process started. *)
+          let r = ask "(if (= (area (circle 2)) 12) 1 0)" in
+          if status r <> "ok" then
+            fail "calling a generic after a method was added: %s" (said r)
+          else if value r <> "1" then
+            fail "the added method did not answer 12 (%S)" (value r);
+          (* And the method that was already there still answers, which is
+             what says the generic was extended rather than replaced. *)
+          let r = ask "(if (= (area (point 3 4)) 12) 1 0)" in
+          if value r <> "1" then
+            fail "the original method stopped answering (%S)" (value r)
+        end
+      end;
+      (try Unix.close c with Unix.Unix_error _ -> ());
+      (try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ());
+      (try ignore (Unix.waitpid [] cpid) with Unix.Unix_error _ -> ())
+    end;
+    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
+      [ csock; cout ];
+
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ sock; out; bsock; bout ];
     Test_support.report ~label:"dev" ()

test/test_session.ml

@@ -303,6 +303,53 @@ let () =
    | _ -> ()
    | exception Loc.Error { Loc.dmsg = m; _ } -> fail "a name added earlier was forgotten: %s" m);
 
+  (* ── A method added to a running program ────────────────────────
+     The dev loop is what classes were built for, so this is the case that
+     decides whether the feature is usable at all. A generic function is one
+     top-level name whose body dispatches, and a method is a branch of it —
+     so adding a method has to install the *generic's* body, not a function
+     of the method's own, and it has to do it through the cell the call site
+     already goes through. If it reported only the method's own declaration
+     name, [report]'s compiled call to [area] would go on running the body it
+     was built with and the new method would be invisible. *)
+  let t, _ = Session.create ~file:"programs/dev-class.flan" () in
+  let c = Session.eval t "(defmethod area circle [c] (* 3 (* (get c :r) (get c :r))))" in
+  if not c.Session.installs then
+    fail "adding a method had nothing to install";
+  if not (List.mem "area" c.Session.fns) then
+    fail "adding a method installed %s, not the generic's body"
+      (String.concat " " c.Session.fns);
+  (* Redefining one is the same path, and the declaration is replaced rather
+     than appended: a second (defmethod area circle ...) is not a duplicate
+     method, it is this one again. *)
+  let c = Session.eval t "(defmethod area circle [c] 0)" in
+  if not (List.mem "area" c.Session.fns) then
+    fail "redefining a method installed %s" (String.concat " " c.Session.fns);
+  (* And it stays in the session: the class the method dispatches on, the
+     generic it extends, and the method itself are all still there for the
+     next form to check against. *)
+  (match Session.eval t "(defmethod area point [p] (+ (get p :x) (get p :y)))" with
+   | _ -> ()
+   | exception Loc.Error { Loc.dmsg = m; _ } ->
+     fail "a method added earlier left the session broken: %s" m);
+  (* A method for a class that is not there is refused, and refusing leaves
+     the session exactly as it was — the same rule every other refusal here
+     follows. *)
+  (match Session.eval t "(defmethod area square [s] 1)" with
+   | _ -> fail "a method dispatching on an unknown class was accepted"
+   | exception Loc.Error _ -> ());
+  (* A whole new class and a method for it, in one form — the shape of
+     actually growing a program in the loop. The constructor is a name the
+     process was never built with, so it goes through the registry the way
+     any added function does, and the generic is redefined around it. *)
+  let c =
+    Session.eval t
+      "(do (defclass square [s]) (defmethod area square [q] (* (get q :s) (get q :s))))"
+  in
+  if not (List.mem "square" c.Session.fns && List.mem "area" c.Session.fns) then
+    fail "adding a class and a method installed %s"
+      (String.concat " " c.Session.fns);
+
   (* 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. *)