A method of update-instance-for-redefined-class runs on each instance as it migrates, and one that signals offers migrate-by-name

TODO.org

@@ -549,13 +549,10 @@ dispatch values. With single dispatch on literal values there is no specificity
 question, and inheritance or multiple dispatch would create one. Unknown-slot
 checking needs class-typed tracking the dyn side deliberately does not have.
 
-** NEXT update-instance-for-redefined-class, the user hook
+** DONE update-instance-for-redefined-class, the user hook
-Decided 2026-09-25: build it after typed class slots land, shaped for the REPL — written and installed from a live session as a one-time "here is how to migrate this", without restarting. It receives the instance with the added and discarded slots and their old values, and runs at each instance's lazy migration. A hook that signals parks in the break buffer with a restart that falls back to name-matching migration.
+CLOSED: [2026-09-25]
-Left out of v1 because name matching is the half that makes redefinition usable
+Taking =migrate-by-name= keeps the name-matched instance, not SBCL's obsolete one,
-and the hook is what makes it expressive. The obvious spelling is a generic riding
+and retries nothing; a transfer from the method to a restart below it traps.
-the dispatch that exists, and the migration already computes both the added and
-the discarded lists. Rolling a failed migration back becomes a real question the
-day this lands.
 
 ** DONE The module system stays directory-as-package
 Several files in one directory are one module; a loose file is a module of one,
@@ -1367,7 +1364,7 @@ sibling".
 
 ** DONE A redefined defclass migrates its instances lazily
 CLOSED: [2026-09-20]
-CLHS 4.3.6 minus the user hook. Nothing is enumerated and no heap is walked — the
+CLHS 4.3.6. Nothing is enumerated and no heap is walked — the
 redefinition is constant time and each instance pays once, at its next touch.
 Neither printer migrates, so a stale instance shows its old slots to the editor
 until something touches it. The registry is advisory: a key the class never
@@ -1976,18 +1973,10 @@ specification's own branch — the flag is the command and the printed shape is
 error pattern, so anyone who wants one has the four lines, and the manual carries
 them.
 
-** NEXT defclass slots take types, checked on write
+** DONE defclass slots take types, checked on write
-Decided 2026-09-25: slots are name/type pairs checked on write; an untyped slot stays legal and holds any =dyn=. A migration keeps a stored value that no longer fits the new type, warns once, and the next write is checked. One lane with the =set= entry below.
+CLOSED: [2026-09-25]
-=(defclass State [pause bool step bool])= reads as four untyped slots and
+The constructor's parameters stay dyn and every store checks at run time; no int
-reports a duplicate =bool=. Wanted: the slot list is name/type pairs, as CLOS
+converts into a float slot, nil does not fit a typed slot, and a class is no slot type.
-does it. The type is a declaration about the values and not a layout — an
-instance stays a map, so redefinition and lazy migration are unchanged. SBCL
-checks it on write (=src/pcl/slots.lisp:160=, the typecheck before the store),
-which is where the bad value is, so =put= is the site here.
-
-Open: what migration does with a stored value that no longer fits a changed
-slot type, and whether an untyped slot stays legal (it should — =dyn= is a type
-and writing nothing should mean it).
 
 ** NEXT println takes up to a second to appear
 Decided 2026-09-25: the daemon pushes program output on the editor's connection as it is written. Rules out a faster poll.
@@ -1997,15 +1986,10 @@ composed, so anything the program prints after that waits for the next tick.
 Polling faster costs a request a second for nothing most of the time; the
 daemon pushing on its own connection is the other shape. Decide which.
 
-** NEXT set writes a class slot; put is for maps
+** DONE set writes a class slot; put is for maps
-Decided 2026-09-25: as written; one lane with typed slots.
+CLOSED: [2026-09-25]
-=put= exists because an absent map key has no location to store into, which is
+=put= on an instance still checks a declared slot's type and still inserts an
-why =(get m k)= is refused as a place (=lib/parse.ml:1159=). A class instance is
+undeclared key; only =set= refuses one, since a slot it writes has to exist.
-not in that situation: its slots are fixed by the =defclass=, so a declared slot
-always exists and =(set (get state :pause) true)= is a field store like
-=(set (.velocity g) 0.0)=. Make =set= take it, and leave =put= to maps, where
-insertion is real. Writing an undeclared slot through =set= is then a refusal
-naming the class.
 
 ** NEXT update: change a place by applying a function to it
 Decided 2026-09-25: every place evaluates each of its subexpressions once, C's compound-assignment rule, which also fixes =++= and =--=; =update= is built on that. Rules out refusing side effects in a place.

lib/classes.ml

@@ -49,6 +49,45 @@ let dispatch_slot = "~dispatch"
    the prelude; this is the only place that builds one. *)
 let no_method = "NoMethod"
 
+(* CLHS's update-instance-for-redefined-class: what a redefined class does to
+   each of its instances, run once per instance at the first [get], [put] or
+   [set] that reaches it after the redefinition. By then the instance already
+   holds the new slots, each kept one with its old value and each gained one
+   nil; [added] is a vec of the gained slots' keywords and [discarded] a map
+   from each lost slot's keyword to the value it held. A method is written for
+   a class, from a live session, and is how a migration does more than match
+   slots by name:
+
+     (defmethod update-instance-for-redefined-class point [p added discarded]
+       (set (get p :radius) (get discarded :r))
+       nil)
+
+   A method that signals stops in the break loop with [migrate-by-name] on
+   offer, which keeps the instance as name-matching left it.
+
+   The generic and its :else method, which does nothing, are written here
+   rather than in the prelude, and only into a program that has a class or a
+   method of the generic: a program with neither would otherwise carry a dyn
+   function and pay for the collector it never uses. [Session] registers the
+   dispatcher's body with the runtime whenever a reload could have changed
+   it. *)
+let migrate_generic = "update-instance-for-redefined-class"
+
+let migrate_decls loc : Ast.decl list =
+  let p n = { Ast.fname = n; fty = dyn_at loc; floc = loc } in
+  let fn body =
+    { Ast.name = migrate_generic;
+      params = [ p "instance"; p "added"; p "discarded" ]; praw = None;
+      ret = Some (dyn_at loc); fwhere = []; fbody = body; nloc = loc;
+      fprivate = Ast.Exported }
+  in
+  [ { Ast.d = Ast.Defgeneric (fn []); dloc = loc };
+    { Ast.d =
+        Ast.Defmethod
+          { Ast.mgen = migrate_generic; mkey = Ast.Delse;
+            mfn = fn [ ex loc (Ast.Var "nil") ]; mkloc = loc };
+      dloc = loc } ]
+
 (* ── Collecting ────────────────────────────────────────────────────── *)
 
 type generic = {
@@ -348,6 +387,27 @@ let expand (decls : Ast.decl list) : Ast.decl list =
   in
   if not has then decls
   else begin
+    let decls =
+      let wants =
+        List.find_opt
+          (fun (d : Ast.decl) ->
+             match d.Ast.d with
+             | Ast.Defclass _ -> true
+             | Ast.Defmethod m -> String.equal m.Ast.mgen migrate_generic
+             | _ -> false)
+          decls
+      and declared =
+        List.exists
+          (fun (d : Ast.decl) ->
+             match d.Ast.d with
+             | Ast.Defgeneric f -> String.equal f.Ast.name migrate_generic
+             | _ -> false)
+          decls
+      in
+      match wants with
+      | Some d when not declared -> decls @ migrate_decls d.Ast.dloc
+      | _ -> decls
+    in
     let _classes, generics = collect decls in
     List.filter_map
       (fun (d : Ast.decl) ->

lib/emit.ml

@@ -4376,6 +4376,7 @@ declare void @flan_dyn_slot_init(i64, i64, i64)
 declare void @flan_dyn_map_put(i64, i64, i64, ptr, i64)
 declare i64 @flan_dyn_class_of(i64)
 declare void @flan_dyn_class_def(i64, ptr, i64)
+declare void @flan_dyn_class_hook(ptr)
 declare i64 @flan_dyn_kw(ptr, i64)
 declare i64 @flan_dyn_map_get(i64, i64)
 declare void @flan_dyn_map_set(i64, i64, i64)

lib/session.ml

@@ -965,7 +965,25 @@ let eval ?(origin = "<eval>") ?pause t src : change =
      definition the registry has never seen has to arrive somehow. *)
   let class_body =
     let str s : Tast.expr = { Tast.e = Tast.Str s; ty = Types.String; loc } in
-    List.map
+    (* And the hook a migration calls, re-registered by every module that
+       could have changed what it should be: one carrying a class, since
+       that is what makes migrations happen, and one carrying a method of
+       the generic, since that is what changes the body. The address is the
+       cell's contents at the time the thunk runs — after this module's
+       bodies are published — so it is the body just installed. *)
+    let hook =
+      let n = Classes.migrate_generic in
+      if incoming_classes <> [] || List.mem n names then
+        let ty =
+          Types.CFn ([ Types.Dyn; Types.Dyn; Types.Dyn ], Types.Dyn)
+        in
+        [ { Tast.e =
+              Tast.Prim (Tast.Rt "flan_dyn_class_hook",
+                         [ { Tast.e = Tast.FnAddr (Tast.Fnval n); ty; loc } ]);
+            ty = Types.Unit; loc } ]
+      else []
+    in
+    hook @ List.map
       (fun (n, slots) : Tast.expr ->
          let kw : Tast.expr =
            { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_kw", [ str n ]);

runtime/flan_dyn.c

@@ -1153,8 +1153,8 @@ flan_dyn flan_dyn_map_new(void) {
  *
  * The registry a redefined (defclass ...) updates, and the lazy migration
  * that makes the instances built against the old definition answer the new
- * one. This is CLHS 4.3.6 — [update-instance-for-redefined-class] — with the
+ * one. This is CLHS 4.3.6, [update-instance-for-redefined-class] included —
- * user hook left out; docs/SBCL-REDEFINITION-NOTES.md is where the protocol
+ * see [class_hook]; docs/SBCL-REDEFINITION-NOTES.md is where the protocol
  * was read off and candidate C is this.
  *
  * **Why a registry at all, when a class instance is already just a map.**
@@ -1427,6 +1427,101 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
   class_add(k, list, types, count);
 }
 
+/* update-instance-for-redefined-class's dispatcher, as the last reload that
+ * installed a class or one of its methods left it; NULL until then. Set by a
+ * thunk and not found by name, because the name is a Flan symbol this file
+ * cannot spell and the body behind it moves with every method added. */
+static void *migrate_fn;
+
+void flan_dyn_class_hook(void *fn) { migrate_fn = fn; }
+
+extern int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance,
+                                    uint64_t added, uint64_t discarded);
+
+/* Allocation and the map operations are further down, under their own
+ * headings; the hook's arguments are built with them. */
+flan_dyn flan_dyn_vec_new(void);
+flan_dyn flan_dyn_map_new(void);
+void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen);
+void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v);
+
+/* The user hook, run on an instance the name-matching has just brought up to
+ * date. [inst], [added] and [gone] are rooted by the caller.
+ *
+ * Two things are kept for the length of the call, because the call is
+ * arbitrary Flan and may allocate as much as it likes:
+ *
+ * - the name-matched entries, rooted, so that taking the restart puts the
+ *   instance back exactly as name-matching left it, whatever the method did
+ *   to it before it signalled. That is the restart's whole meaning, and it
+ *   is SBCL's choice of what a failed update leaves (std-class.lisp, the
+ *   nlx-protect around the call) moved one step: SBCL restores the obsolete
+ *   instance and retries at the next access, where here the name-matched
+ *   one is kept and nothing is retried.
+ * - the temporaries ring, saved and put back. A migration starts inside
+ *   [get] or [put], whose caller may be holding an object only the ring
+ *   keeps alive — the result of the call beside it in the same expression.
+ *   A method that allocates more than the ring holds would push it out and
+ *   let the next collection free it, so the ring is rooted for the call and
+ *   restored after it, and the caller sees the ring it left. */
+static void class_hook(flan_obj *o, flan_dyn inst, flan_dyn added,
+                       flan_dyn gone, int64_t n) {
+  flan_dyn *snap = NULL;
+  flan_obj *ring_was[RING];
+  flan_dyn  ring_rooted[RING];
+  unsigned  ring_at_was = ring_at, k;
+  int64_t   j, roots_at = roots_n;
+  int       r;
+  if (n > 0) {
+    snap = (flan_dyn *)malloc((size_t)n * 2 * sizeof *snap);
+    if (snap == NULL) trap_oom(NULL, 0, n * 2 * (int64_t)sizeof *snap);
+    memcpy(snap, o->u.v.items, (size_t)n * 2 * sizeof *snap);
+    for (j = 0; j < n; j++) root_add(&snap[j * 2 + 1], NULL);
+  }
+  memcpy(ring_was, ring, sizeof ring);
+  for (k = 0; k < RING; k++) {
+    ring_rooted[k] = ring[k] == NULL
+      ? dyn_make(BOX_NIL, 0)
+      : dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)ring[k]);
+    root_add(&ring_rooted[k], NULL);
+  }
+  r = flan_dyn_migrate_hook(migrate_fn, inst, added, gone);
+  memcpy(ring, ring_was, sizeof ring);
+  ring_at = ring_at_was;
+  /* Nothing below allocates on the collector's heap, so the roots into
+     [snap] and this frame can go before either does. */
+  roots_n = roots_at;
+  if (r == 1) {
+    /* The restart: the entries name-matching left, in a block of their own,
+     * whatever the method grew or shrank the instance to. */
+    flan_dyn *back = NULL;
+    if (n > 0) {
+      back = (flan_dyn *)malloc((size_t)n * 2 * sizeof *back);
+      if (back == NULL) trap_oom(NULL, 0, n * 2 * (int64_t)sizeof *back);
+      memcpy(back, snap, (size_t)n * 2 * sizeof *back);
+    }
+    gc_bytes += (n - o->u.v.cap) * 2 * (int64_t)sizeof(flan_dyn);
+    free(o->u.v.items);
+    o->u.v.items = back;
+    o->u.v.cap = n;
+    o->len = n;
+  }
+  free(snap);
+  if (r == 2) {
+    kw_entry *c = o->u.v.klass;
+    fflush(stdout);
+    fprintf(stderr,
+            "dyn migrate: update-instance-for-redefined-class, migrating an "
+            "instance of %.*s, was left for a restart established outside "
+            "it. A migration runs inside get, put or set, and cannot be "
+            "left for one of their callers; the instance is kept as its "
+            "slots matched by name. Take migrate-by-name, or handle the "
+            "condition inside the method\n",
+            (int)c->len, (const char *)(c + 1));
+    flan_trap((const uint8_t *)"DynMigrate", 10);
+  }
+}
+
 /* The migration. [o] is left holding exactly the class's current slots, in
  * the class's order, with the values it already had for the ones it still
  * has and nil for the ones it has just gained — which is precisely the
@@ -1440,8 +1535,10 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
  * and count in insertion order and would have. One malloc per instance per
  * redefinition is the price, and a migration happens once.
  *
- * Nothing here allocates on the collector's heap, so no collection can run
+ * The name-matching allocates nothing on the collector's heap, so no
- * part-way through and see an object whose [len] and [items] disagree.
+ * collection can run part-way through it and see an object whose [len] and
+ * [items] disagree. The hook's arguments are built before it starts, while
+ * [o] still holds its old entries whole, and the hook runs after it ends.
  *
  * Nor can it free a block something above it is walking. The block it frees
  * is [o]'s, and every caller syncs [o] before it starts walking [o] — so a
@@ -1453,9 +1550,48 @@ static void class_sync(flan_obj *o) {
   class_entry *e;
   flan_dyn *fresh = NULL;
   int64_t i, j;
+  /* The hook's three arguments, rooted by address for as long as the hook
+   * may run: each is a collector object held nowhere else. */
+  flan_dyn inst, added, gone;
+  int64_t roots_at = roots_n;
+  int hook;
   if (o->kind != OBJ_MAP || o->u.v.klass == NULL) return;
   e = class_find(o->u.v.klass);
   if (e == NULL || e->gen == o->gen) return;
+  /* CLHS 4.3.6: the method runs on every instance a redefinition reaches,
+   * whether or not the slot names moved — a changed type is a change a
+   * method may want to convert for. */
+  hook = migrate_fn != NULL && flan_dyn_migrate_hook != NULL;
+  inst = dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
+  added = gone = dyn_make(BOX_NIL, 0);
+  if (hook) {
+    root_add(&inst, NULL);
+    added = flan_dyn_vec_new();
+    root_add(&added, NULL);
+    gone = flan_dyn_map_new();
+    root_add(&gone, NULL);
+    for (j = 0; j < e->nslots; j++) {
+      for (i = 0; i < o->len; i++) {
+        flan_dyn key = o->u.v.items[i * 2];
+        if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD
+            && dyn_kw(key) == e->slots[j]) break;
+      }
+      if (i == o->len)
+        flan_dyn_push(added,
+                      dyn_make(BOX_KW, (uint64_t)(uintptr_t)e->slots[j]),
+                      NULL, 0);
+    }
+    /* Every key the class no longer declares, a raw [put]'s included:
+     * CLHS's discarded slots and their property list, as one map. */
+    for (i = 0; i < o->len; i++) {
+      flan_dyn key = o->u.v.items[i * 2];
+      int kept = 0;
+      if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD)
+        for (j = 0; j < e->nslots; j++)
+          if (dyn_kw(key) == e->slots[j]) { kept = 1; break; }
+      if (!kept) flan_dyn_map_set(gone, key, o->u.v.items[i * 2 + 1]);
+    }
+  }
   if (e->nslots > 0) {
     fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh);
     if (fresh == NULL) trap_oom(NULL, 0, e->nslots * 2 * (int64_t)sizeof *fresh);
@@ -1506,7 +1642,11 @@ static void class_sync(flan_obj *o) {
   o->u.v.items = fresh;
   o->u.v.cap = e->nslots;
   o->len = e->nslots;
+  /* Current before the hook runs, so a method that reads or writes the
+   * instance finds it migrated and does not start a second migration. */
   o->gen = e->gen;
+  if (hook) class_hook(o, inst, added, gone, e->nslots);
+  roots_n = roots_at;
 }
 
 /* The same map with a shape tag on it: what a (defclass ...) constructor

runtime/flan_dyn.h

@@ -120,7 +120,7 @@ flan_dyn flan_dyn_class_of(flan_dyn v);
  * [len] or equality comparison: slots the class still has keep their values
  * matched by name, slots it has gained appear as nil, and keys it no longer
  * declares are dropped. The instance's identity is preserved throughout;
- * this is CLHS 4.3.6 without the user hook.
+ * this is CLHS 4.3.6, and [flan_dyn_class_hook] is its user hook.
  *
  * The drop is unconditional, which is the honest cost of a class instance
  * being an open map: a key written by a raw [put] that the class never
@@ -128,6 +128,13 @@ flan_dyn flan_dyn_class_of(flan_dyn v);
  * class's intention and does not enforce it. */
 void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n);
 
+/* The body update-instance-for-redefined-class dispatches through, as a
+ * reload last saw it. Each migration after this calls it, through
+ * flan_rt.c's [flan_dyn_migrate_hook], with the instance already matched by
+ * name. A reload that installs a class or a method of that generic calls
+ * this again, so the body is never older than the last one installed. */
+void flan_dyn_class_hook(void *fn);
+
 /* [sizeof(flan_obj)], for the one test that asserts it. The generation a
  * class instance carries was fitted into the padding between [mark] and
  * [len] precisely so that this number did not move; a field that pushed it

runtime/flan_rt.c

@@ -620,6 +620,26 @@ void (*flan_break_hook)(const uint8_t *name, int64_t namelen, void *condition,
  * site printed just above carries the detail. */
 void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
 
+/* The call a class migration makes to update-instance-for-redefined-class:
+ * [fn] is the method dispatcher's current body, and the three words are the
+ * instance, the vec of slots it gained and the map of the slots it lost to
+ * the values they held — dyn words, as [uint64_t] here because this file
+ * does not include flan_dyn.h.
+ *
+ * Here and not in flan_dyn.c because it is set by the agent, and the agent
+ * must link against a program with no collector in it; and not called from
+ * here because what makes it a hook is the restart it runs under, which is
+ * the agent's business — the floor a break inside it reads is the agent's.
+ * NULL, and no hook runs, outside a dev session: a class is redefined only
+ * by a reload, and a reload only arrives through the agent.
+ *
+ * The answer is 0 when the method returned, 1 when the restart the call
+ * established was taken, and 2 when some other transfer came back through
+ * it — one aimed at a restart below the call, which a C frame cannot carry
+ * on. */
+int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance, uint64_t added,
+                             uint64_t discarded);
+
 static _Noreturn void rt_trap(const uint8_t *name, int64_t namelen) {
   if (flan_trap_hook != NULL) flan_trap_hook(name, namelen);
   rt_die();

test/programs/dev-hook.flan

@@ -0,0 +1,21 @@
+;;;; A class redefined under its instances, with update-instance-for-
+;;;; redefined-class written from the session to carry a lost slot's value
+;;;; into a gained one. dev-classes.flan is the name-matching half; this is
+;;;; the half a method adds, and the method that signals.
+;;;;
+;;;; The instances are pushed by the editor for dev-classes.flan's reason: a
+;;;; compiled caller of the constructor would pin its slot count.
+(import agent "vendor:agent")
+
+(defclass point [x y])
+
+(defstruct Refused [why i32])
+
+(defonce instances dyn)
+
+(defn main [] i32
+  (agent/start "/tmp/flan-dev-hook-fallback.sock")
+  (set instances (vec-new dyn))
+  (dotimes [i 4000]
+    (agent/wait 5))
+  0)

test/test_dev.ml

@@ -7481,6 +7481,162 @@ let () =
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ lsock2; lout2 ];
 
+    (* ── update-instance-for-redefined-class, written from the session ──
+       The method is written and installed while the program runs, then the
+       class is redefined, and each instance runs the method at its first
+       touch after that. On both backends, because the method is Flan code
+       the C runtime calls from inside [get], and that call is the one piece
+       of this each backend's calling convention has to agree with.
+
+       Three claims, in order: a method carries a lost slot's value into a
+       gained one; a method that signals stops the program with
+       [migrate-by-name] on offer, and taking it leaves the instance as
+       name-matching made it, the method's own write included; and a kept
+       value that no longer fits its slot's new type stays, with a warning.
+       stdout and stderr go to one file, which is where the warning is read
+       from. *)
+    let hook_block ~llvm =
+      let what = if llvm then "llvm: " else "" in
+      let hsock = tmp (if llvm then "hook-llvm.sock" else "hook.sock")
+      and hout = tmp (if llvm then "hook-llvm.out" else "hook.out") in
+      (try Sys.remove hsock with Sys_error _ -> ());
+      let hfd =
+        Unix.openfile hout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
+      in
+      let argv =
+        Array.append
+          [| flan; "dev"; "programs/dev-hook.flan"; "-s"; hsock |]
+          (if llvm then [| "--llvm" |] else [||])
+      in
+      let hpid = Unix.create_process flan argv Unix.stdin hfd hfd in
+      Unix.close hfd;
+      let output () = In_channel.with_open_bin hout In_channel.input_all in
+      if not (listening ~pid:hpid hsock) then begin
+        fail "%sthe hook daemon %s (%S)" what !listen_why (output ());
+        (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ())
+      end
+      else begin
+        let c = connect hsock 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 file = " :file \"programs/dev-hook.flan\")" in
+        let ask code =
+          request c (Printf.sprintf "(:op \"eval-expr\" :code %S%s" code file)
+        in
+        let redefine code =
+          request c (Printf.sprintf "(:op \"eval\" :code %S%s" code file)
+        in
+        let holds claim code =
+          let r = ask code in
+          if status r <> "ok" then fail "%s%s: %s" what claim (said r)
+          else if value r <> "1" then
+            fail "%s%s answered %S (%s)" what claim (value r) code
+        in
+        let defined claim code =
+          let r = redefine code in
+          if status r <> "ok" then (fail "%s%s: %s" what claim (said r); false)
+          else true
+        in
+        let stopped r =
+          match Wire.field r "stopped" with
+          | Some { Form.v = Form.Sym "t"; _ } -> true
+          | _ -> false
+        in
+        let started () =
+          status (ask "(do (push instances (point 3 4)) 1)") = "ok"
+        in
+        if not (await started) then
+          fail "%sthe hook daemon never reached a frame boundary" what
+        else begin
+          holds "a second instance" "(do (push instances (point 5 6)) 1)";
+          (* ── A method that carries a value across ── *)
+          if defined "a method of the migration generic, from the session"
+               "(defmethod update-instance-for-redefined-class point \
+                [p added discarded] \
+                (set (get p :radius) (get discarded :y)) nil)"
+          && defined "a class redefined under a method"
+               "(defclass point [x radius])"
+          then begin
+            holds "the method moved the lost slot's value into the new one"
+              "(if (= (get (at instances 0) :radius) 4) 1 0)";
+            holds "a kept slot is untouched by the method"
+              "(if (= (get (at instances 0) :x) 3) 1 0)";
+            holds "the lost slot is gone"
+              "(if (= (length (at instances 0)) 2) 1 0)";
+            holds "each instance runs the method at its own first touch"
+              "(if (= (get (at instances 1) :radius) 6) 1 0)"
+          end;
+          (* ── A method that signals ── *)
+          if defined "a method that signals"
+               "(defmethod update-instance-for-redefined-class point \
+                [p added discarded] \
+                (set (get p :x) 99) (error (Refused {.why 1})) nil)"
+          && defined "a class redefined under a method that signals"
+               "(defclass point [x radius z])"
+          then begin
+            let r = ask "(get (at instances 0) :x)" in
+            if status r <> "error" then
+              fail "%sa migration whose method signals answered %s" what
+                (status r);
+            let r = request c "(:op \"break\")" in
+            let names =
+              match Wire.field r "restarts" with
+              | Some { Form.v = Form.List l; _ } ->
+                List.filter_map
+                  (fun (n : Form.t) ->
+                     match n.Form.v with Form.Str x -> Some x | _ -> None)
+                  l
+              | _ -> []
+            in
+            (match names with
+             | "migrate-by-name" :: _ -> ()
+             | _ ->
+               fail "%sthe restarts at a signalling method: %s" what
+                 (String.concat ", " names));
+            let r = request c "(:op \"restart\" :name \"migrate-by-name\")" in
+            if status r <> "ok" then
+              fail "%smigrate-by-name was refused: %s" what (said r);
+            if not
+                 (await (fun () -> not (stopped (request c "(:op \"describe\")"))))
+            then fail "%sthe program did not run again after migrate-by-name" what
+            else begin
+              holds "migrate-by-name undoes the method's write"
+                "(if (= (get (at instances 0) :x) 3) 1 0)";
+              holds "and keeps what name-matching kept"
+                "(if (= (get (at instances 0) :radius) 4) 1 0)";
+              holds "and has the new definition's slots"
+                "(if (= (length (at instances 0)) 3) 1 0)"
+            end
+          end;
+          (* ── A type that no longer fits ── *)
+          if defined "a method that does nothing"
+               "(defmethod update-instance-for-redefined-class point \
+                [p added discarded] nil)"
+          && defined "a slot's type changed to one its value does not fit"
+               "(defclass point [x string radius z])"
+          then begin
+            holds "a value that no longer fits is kept"
+              "(if (= (get (at instances 0) :x) 3) 1 0)";
+            let warned () =
+              contains_sub (output ())
+                "warning: point was redefined, and its slot :x is now \
+                 declared string"
+            in
+            if not (await warned) then
+              fail "%sno warning for a kept value that does not fit: %S" what
+                (output ())
+          end
+        end;
+        (try Unix.close c with Unix.Unix_error _ -> ());
+        (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ());
+        (try ignore (Unix.waitpid [] hpid) with Unix.Unix_error _ -> ())
+      end;
+      List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
+        [ hsock; hout ]
+    in
+    hook_block ~llvm:false;
+    hook_block ~llvm:true;
+
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ sock; out; bsock; bout ];
     Test_support.report ~label:"dev" ()

test/test_session.ml

@@ -1384,6 +1384,25 @@ let () =
          (String.concat " " c.Session.fns)
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "a class and its caller evaluated together: %s" m);
+  (* A method of update-instance-for-redefined-class, from the session. The
+     generic is written by [Classes.expand], not by the program, so this is
+     the case where the declaration being extended is nowhere in the
+     session's own list — and the method still has to install the generic's
+     dispatch, and the module has to hand the runtime the body it just
+     installed, or migrations go on calling the old one. *)
+  (let t, _ = Session.create ~file:"programs/dev-class.flan" () in
+   match
+     Session.eval t
+       "(defmethod update-instance-for-redefined-class point \
+        [p added discarded] nil)"
+   with
+   | c ->
+     if not (List.mem Classes.migrate_generic c.Session.fns) then
+       fail "a migration method installed %s" (String.concat " " c.Session.fns);
+     if not (has c.Session.ir "call void @flan_dyn_class_hook") then
+       fail "a migration method did not re-register the hook"
+   | exception Loc.Error { Loc.dmsg = m; _ } ->
+     fail "a migration method was refused: %s" m);
   (* A slot's type changed and nothing else. Every constructor parameter is
      dyn whatever the slot says, so the signature is the one it was and a
      compiled caller is no reason to refuse — the type is checked where a

vendor/agent/flan_agent.c

@@ -336,6 +336,8 @@ extern int64_t        flan_break_site_len;
  * shadow-stack frame's shape does: the struct is declared in one file. */
 extern void *flan_restart_push_c(const uint8_t *name, int64_t namelen);
 extern void  flan_restart_pop_c(void *frame);
+extern int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance,
+                                    uint64_t added, uint64_t discarded);
 
 /* -- How far down a transfer can actually land ----------------------- */
 
@@ -402,6 +404,44 @@ static int32_t frame_floor = -1;
 static void *eval_boundary;
 static const uint8_t abandon_name[] = "abandon-evaluation";
 
+/* -- update-instance-for-redefined-class ------------------------------ */
+
+/* A class migration calls the method from inside [get], [put] or [set] —
+ * a C frame with no transfer channel of its own — so the call is made the
+ * way a thunk's is: behind a floor, with a channel of its own and a restart
+ * of its own above the floor. A break inside the method then offers
+ * [migrate-by-name] and nothing below the call, which it could not reach.
+ * Taking it leaves the instance as name-matching made it; flan_dyn.c's
+ * [class_hook] puts that back.
+ *
+ * [eval_boundary] is cleared for the call: an evaluation in progress
+ * underneath is below this floor, and offering to abandon it would be a
+ * choice nothing can carry out. Everything saved is restored, so a
+ * migration inside a thunk inside a break nests like the rest. */
+static const uint8_t migrate_name[] = "migrate-by-name";
+
+typedef uint64_t (*migrate_fn_t)(uint64_t, uint64_t, uint64_t, void *);
+
+static int migrate_call(void *fn, uint64_t instance, uint64_t added,
+                        uint64_t discarded) {
+  int32_t outer = restart_floor;
+  int32_t oframe = frame_floor;
+  void   *obound = eval_boundary;
+  void   *xfer = NULL;
+  void   *mine;
+  restart_floor = flan_restart_count();
+  frame_floor = flan_dev_frame_count();
+  eval_boundary = NULL;
+  mine = flan_restart_push_c(migrate_name, sizeof migrate_name - 1);
+  ((migrate_fn_t)fn)(instance, added, discarded, &xfer);
+  flan_restart_pop_c(mine);
+  eval_boundary = obound;
+  restart_floor = outer;
+  frame_floor = oframe;
+  if (xfer == NULL) return 0;
+  return (mine != NULL && xfer == mine) ? 1 : 2;
+}
+
 /* The three of them, dropped between two runs of [main]. The counterpart of
  * flan_rt.c's [flan_condition_stacks_reset] and flan_dev.c's
  * [flan_dev_frames_reset], called from the same one place and for the same
@@ -864,6 +904,9 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
               !s->resumable   ? "   (cannot be taken from this trap)"
               : i == s->boundary
                 ? "   (stop running the expression; the program carries on)"
+              : strcmp(s->names + s->off[i], (const char *)migrate_name) == 0
+                  && s->reachable[i]
+                ? "   (keep the instance as its slots matched by name)"
               : s->reachable[i] ? ""
                                 : "   (below this break; cannot be taken)");
     if (s->total > s->n)
@@ -2114,6 +2157,7 @@ static int32_t start_on(const char *path) {
    * to do, and stopping forever is worse than the abort it replaces. */
   flan_break_hook = break_loop;
   flan_trap_hook  = trap_stop;
+  flan_dyn_migrate_hook = migrate_call;
   return 0;
 
 failed:

web/index.html

@@ -2220,7 +2220,14 @@ bumps a generation counter, which is O(1) and walks no heap; every live instance
 migrates at its next touch. Slots matched by name keep their values, a gained slot
 appears as <code>nil</code>, a dropped one goes, the object is the same object, and
 <code>class-of</code> still answers the same tag, so every method still reaches it.
-That is CLHS 4.3.6's protocol without the user hook, which is not built.</p>
+That is CLHS 4.3.6's protocol. Its user hook is
+<code>update-instance-for-redefined-class</code>: a method of it written for a
+class, from the running session, runs on each instance as it migrates, with a
+vec of the slots it gained and a map from each slot it lost to the value that slot
+held. A method that signals stops the program with <code>migrate-by-name</code>
+on offer, which keeps the instance as matching by name left it. A kept value that
+no longer fits its slot's new type is kept, with a warning, and the next write to
+the slot is checked.</p>
 
 <p><kbd>C-c C-x</kbd> rebuilds, relaunches and reconnects, and is the way out while the
 above is true. It costs the program's state, which is why it is a key you press rather than