From 2682214499b5b25ba65a956c5935bc47cc5b3ec0 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 11:40:08 +0700 Subject: [PATCH 1/4] A defclass slot may declare a type that every store into it checks, and set writes a declared slot --- lib/ast.ml | 19 +- lib/check.ml | 111 +++++++- lib/classes.ml | 59 +++-- lib/dev.ml | 26 +- lib/emit.ml | 5 +- lib/load.ml | 28 +- lib/parse.ml | 29 ++- lib/session.ml | 35 +-- runtime/flan_dyn.c | 400 ++++++++++++++++++++++++----- runtime/flan_dyn.h | 23 +- test/dyn_ops.c | 6 +- test/programs/dyn-class-slots.flan | 38 +++ test/programs/dyn-slot-trap.flan | 18 ++ test/test_acceptance.ml | 41 +++ test/test_flan.ml | 36 ++- test/test_session.ml | 14 + web/examples/classes.flan | 4 +- web/index.html | 18 +- 18 files changed, 744 insertions(+), 166 deletions(-) create mode 100644 test/programs/dyn-class-slots.flan create mode 100644 test/programs/dyn-slot-trap.flan diff --git a/lib/ast.ml b/lib/ast.ml index 41708a09..b40b1765 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -199,6 +199,11 @@ and place = | Pfield of expr * string (* (set (.hp e) v) *) | Pindex of expr * expr list (* (set (at grid r c) v) *) | Pderef of expr (* (set (deref p) v) *) + (* (set (get inst :slot) v) — a class instance's declared slot. A map has + no such place: an absent key has no location, and [put] is how one is + written. Which of the two a value is, is known only at run time, so + this is a runtime store that refuses a plain map. *) + | Pslot of expr * expr and arm = { pat : pattern; body : expr list; aloc : Loc.t } @@ -282,8 +287,10 @@ and decl_kind = | Defvar of string * texpr option * init * reinit | Defconst of string * texpr option * expr (* ── The dyn side's classes and generic functions ────────────────── - None of these four reaches [Check]. [Classes.expand] turns the whole set - into ordinary [Defn]s before pass one collects anything, the way [Shim] + None of these four reaches [Check]'s signature pass. [Classes.expand] + turns the generic forms into ordinary [Defn]s before pass one collects + anything, and [Check.pair_decls] turns a [Defclass] into its constructor + once its slot vector can be paired, the way [Shim] already turns a [DeclareC] into a [Declare] plus a [Defn]: a class is a constructor, and a generic function is one function whose body is a dispatch over the methods written for it. @@ -293,8 +300,11 @@ and decl_kind = anywhere in the file, or arrive at a reload long after the generic did, and a macro sees one form. *) - (* (defclass point [x y]) — the slot names, in constructor order. *) - | Defclass of string * (string * Loc.t) list + (* (defclass point [x y]) or (defclass state [pause bool step bool]) — the + slot vector, in constructor order, left unpaired for the reason a + [defn]'s is: [[x y]] is two slots or one slot [x] of type [y] depending + on whether [y] names a type. [Check.pair_decls] pairs it. *) + | Defclass of string * pitem list (* (defgeneric area [self] dyn) — CLOS's class dispatch: the dispatch value is the shape tag of the first argument. The parameter vector and the return slot are a [defn]'s, and there is no body. *) @@ -413,6 +423,7 @@ let map_children f (e : expr) : expr = | Pfield (x, n) -> Pfield (ex x, n) | Pindex (x, is) -> Pindex (ex x, List.map ex is) | Pderef x -> Pderef (ex x) + | Pslot (x, k) -> Pslot (ex x, ex k) in let kind = match e.e with diff --git a/lib/check.ml b/lib/check.ml index e5106991..279aa172 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -181,6 +181,13 @@ type env = { flag is what lets [resolve_name] say the honest thing in each place instead of a suggestion that cannot be followed. *) mutable in_field : bool; + (* Every [defclass], by name: its slots in constructor order, each with the + type a value stored in it must have — [Types.Dyn] for a slot written + with no type. Filled by [pair_decls], which is where a slot vector is + first readable. The type is a declaration about the values and not a + layout: an instance is a dyn map whatever this says, and what reads it + is [class_spec], which is what the runtime checks a store against. *) + classes : (string, (string * Types.t) list) Hashtbl.t; } let new_env () = { @@ -210,6 +217,7 @@ let new_env () = { tvpreds = []; chain = []; in_field = false; + classes = Hashtbl.create 8; } (* Where a named type was declared, and what it has, as a note. @@ -1491,6 +1499,40 @@ let pair_params env (items : Ast.pitem list) : Ast.field list = in go items +(* A class slot's type, resolved and held to the set a stored dyn value can + be checked against: its tag says bool, int, float or text and nothing + finer, so those are the types there are. A narrower integer is a range on + top of the int tag. Everything else a type can be — a struct, a Vec, a + pointer — does not cross into dyn at all, so a slot of one could never be + written. *) +let slot_type env cls (f : Ast.field) : Types.t = + let t = resolve env f.Ast.fty in + match t with + | Types.Dyn | Types.Bool | Types.Int _ | Types.Float _ | Types.String -> t + | other -> + Loc.failk "check/slot-type" f.Ast.fty.Ast.tloc + "the slot %s of %s is declared %s, and a class slot holds a dyn value, \ + which can be checked as bool, an integer type, f32, f64 or string. \ + Write one of those, or leave the type out and the slot holds any dyn \ + value: [%s]" + f.Ast.fname cls (Types.to_string other) f.Ast.fname + +(* What the runtime is told a class is: one line per slot, in constructor + order, the slot's name and then its type's name after a space — no type + for a dyn slot. The same string goes to [flan_dyn_map_new_class] from the + constructor and to [flan_dyn_class_def] from a reload, so the two cannot + describe one class differently. *) +let class_spec_of (slots : (string * Types.t) list) = + String.concat "\n" + (List.map + (fun (n, t) -> + match t with + | Types.Dyn -> n + | t -> n ^ " " ^ Types.to_string t) + slots) + +let class_slots env n = Hashtbl.find_opt env.classes n + (* Every [defn] in the program, with its parameter vector paired. Run as a pass of its own, after the type names are registered and before any signature is resolved, so that nothing downstream ever sees an unpaired one. *) @@ -1503,6 +1545,18 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list = List.map (fun (d : Ast.decl) -> match d.Ast.d with + (* A class's slot vector is paired here and nowhere earlier, for the + reason a [defn]'s is, and its constructor is written from the + pairs — [Classes.expand] left the declaration as it was for exactly + this. *) + | Ast.Defclass (n, items) -> + let slots = pair_params env items in + Hashtbl.replace env.classes n + (List.map + (fun (f : Ast.field) -> + (f.Ast.fname, slot_type env n f)) + slots); + Classes.constructor n slots d.Ast.dloc | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) } | Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) } | Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) } @@ -3450,10 +3504,14 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = | Ast.MapLit (tag, kvs) -> let m = fresh_slot ctx Types.Dyn in let mval = mk loc Types.Dyn (Tast.Local m) in + (* A class's constructor stores through [flan_dyn_slot_init], which is + the plain store plus the slot's type check, worded for the + constructor rather than for a [put] nobody wrote. *) + let store = if tag = None then "flan_dyn_map_set" else "flan_dyn_slot_init" in let sets = List.map (fun (k, v) -> - rt loc Types.Unit "flan_dyn_map_set" + rt loc Types.Unit store [ mval; check ctx ~want:Types.Dyn k; check ctx ~want:Types.Dyn v ]) kvs @@ -3466,8 +3524,19 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = match tag with | None -> rt loc Types.Dyn "flan_dyn_map_new" [] | Some cls -> + (* The class's slots and their types ride along, so the first + instance built registers the class with the runtime and every + store after it — this literal's own included — is checked. A + class registered already, by an earlier instance or by a reload, + keeps what it has: redefining one is a reload's business. *) + let spec = + match Hashtbl.find_opt ctx.env.classes cls with + | Some slots -> class_spec_of slots + | None -> "" + in rt loc Types.Dyn "flan_dyn_map_new_class" - [ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ] ] + [ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ]; + mk loc Types.String (Tast.Str spec) ] in expect ctx loc ~want (mk loc Types.Dyn (Tast.Let ([ (m, empty) ], sets @ [ mval ]))) @@ -3586,6 +3655,23 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = let v = check ctx ~want:pty v in expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v))) end + (* (set (get inst :slot) x) — a class instance's declared slot. A call and + not a place for [flan_dyn_set_at]'s reason: the runtime has to look at + the value to know it is an instance, which of its slots the key names, + and whether [x] fits the type that slot was declared with, and it traps + on each with a sentence of its own. A typed map has no such place; its + entries are written with [put]. *) + | Ast.Set (Ast.Pslot (target, k), v) -> + let target = check ctx target in + if target.Tast.ty <> Types.Dyn then + fail loc + "(get m k) is a place only on a class instance, and this is %s. A \ + map's entries are written with (put m k v)" + (Types.to_string target.Tast.ty); + let k = check ctx ~want:Types.Dyn k in + let v = check ctx ~want:Types.Dyn v in + expect ctx loc ~want + (rt loc Types.Unit "flan_dyn_slot_set" [ target; k; v; here loc ]) | Ast.Set (p, v) -> let p, pty = check_place ctx loc p in let v = check ctx ~want:pty v in @@ -6187,6 +6273,13 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t = | Types.Ptr t -> Tast.Pderef target, t | other -> fail loc "deref takes a (Ptr T), found %s" (Types.to_string other)) + (* Only [set] writes a class slot, and it has its own arm above. A slot + lives in a map the collector may move entries of, so it has no address + to hand out. *) + | Ast.Pslot _ -> + fail loc + "a class slot (get inst :slot) is written with set and has no address. \ + Read it into a local with let" (* An index or a slice bound that is a literal is known now, so it is an error now rather than a trap later. Only literals: a [defconst] is a global in the @@ -7829,12 +7922,14 @@ and named_call ?(qualified = false) ctx ~want loc name args = let target = check ctx target in (* A put into a dyn map is a call and nothing else, the way a push into a dyn vec is: the runtime owns the storage, so there is no guard, no - restart and no region check. An equal key's value is replaced. *) + restart and no region check. An equal key's value is replaced. The + site rides along for the one refusal a put can meet, a class + instance's typed slot. *) if target.Tast.ty = Types.Dyn then expect ctx loc ~want - (rt loc Types.Unit "flan_dyn_map_set" + (rt loc Types.Unit "flan_dyn_map_put" [ target; check ctx ~want:Types.Dyn k; - check ctx ~want:Types.Dyn v ]) + check ctx ~want:Types.Dyn v; here loc ]) else begin let kt, vt = map_kv loc "put" target.Tast.ty in let k = check ctx ~want:kt k in @@ -10845,7 +10940,11 @@ let collect env (decls : Ast.decl list) = driver that assembled a declaration list and skipped that pass would otherwise get a missing name from wherever the constructor was called, with nothing pointing here. *) - | Ast.Defclass (n, _) | Ast.Defgeneric { Ast.name = n; _ } + | Ast.Defclass (n, _) -> + fail loc + "internal: the class %s reached the checker unpaired — \ + pair_decls writes its constructor, and did not run" n + | Ast.Defgeneric { Ast.name = n; _ } | Ast.Defmulti { Ast.name = n; _ } -> fail loc "internal: %s reached the checker unexpanded — Classes.expand did \ diff --git a/lib/classes.ml b/lib/classes.ml index a6b7325b..15b9440a 100644 --- a/lib/classes.ml +++ b/lib/classes.ml @@ -4,9 +4,11 @@ [(defclass point [x y])] is a constructor. [(defgeneric area [self] dyn)] and [(defmulti describe [x] dyn (get x :kind))] are each one function whose body is a dispatch, and [(defmethod area point [p] ...)] is a branch of - one. Nothing below this pass knows any of the four forms exists: what it - writes is [defn]s, and they are checked, emitted, rooted, redefined and - inspected as any other function is. + one. What it writes is [defn]s, and they are checked, emitted, rooted, + redefined and inspected as any other function is. The one exception is + [defclass], which passes through untouched: its slot vector reads like a + [defn]'s and cannot be paired until every type name is known, so + [Check.pair_decls] pairs it and calls [constructor] below. **Why a pass and not a macro.** A macro sees one form. This needs the whole declaration list, because a method may be written anywhere — above @@ -65,23 +67,7 @@ let collect (decls : Ast.decl list) = List.iter (fun (d : Ast.decl) -> match d.Ast.d with - | Ast.Defclass (n, slots) -> - (* Two slots of one name would write one entry and read one value, - and the constructor would take two arguments for it. The duplicate - parameter that falls out of it is refused by the checker anyway; - this says which declaration it came from. *) - let seen = Hashtbl.create 8 in - List.iter - (fun (s, sloc) -> - if Hashtbl.mem seen s then - Loc.failk "check/duplicate-slot" sloc - "%s names the slot %s twice. A slot is a key in the \ - instance's map, so the second would replace the first and \ - the constructor would take an argument that goes nowhere" - n s; - Hashtbl.replace seen s ()) - slots; - Hashtbl.replace classes n d.Ast.dloc + | Ast.Defclass (n, _) -> Hashtbl.replace classes n d.Ast.dloc | Ast.Defgeneric fn -> Hashtbl.replace generics fn.Ast.name { gkind = `Class; gfn = fn; gloc = d.Ast.dloc; gms = [] } @@ -162,14 +148,37 @@ let collect (decls : Ast.decl list) = omitted slot meaning nil — is deferred, and so is refusing an unknown slot at [(get p :z)]. Both are recorded in TODO.org, "Class features deferred, each with its reason". *) -let constructor n slots loc : Ast.decl = +let constructor n (slots : Ast.field list) loc : Ast.decl = + (* Two slots of one name would write one entry and read one value, and the + constructor would take two arguments for it. The duplicate parameter + that falls out of it is refused by the checker anyway; this says which + declaration it came from. *) + let seen = Hashtbl.create 8 in + List.iter + (fun (f : Ast.field) -> + if Hashtbl.mem seen f.Ast.fname then + Loc.failk "check/duplicate-slot" f.Ast.floc + "%s names the slot %s twice. A slot is a key in the instance's \ + map, so the second would replace the first and the constructor \ + would take an argument that goes nowhere" + n f.Ast.fname; + Hashtbl.replace seen f.Ast.fname ()) + slots; + (* Every parameter is dyn whatever its slot's type. The type is checked + where the value is stored — the constructor's own stores included — so + a caller holding a dyn passes it as it is, and a caller holding an i32 + boxes it; neither has to convert to the slot's type first. *) let params = List.map - (fun (s, sloc) -> { Ast.fname = s; fty = dyn_at sloc; floc = sloc }) + (fun (f : Ast.field) -> + { Ast.fname = f.Ast.fname; fty = dyn_at f.Ast.floc; floc = f.Ast.floc }) slots in let pairs = - List.map (fun (s, sloc) -> (ex sloc (Ast.Kw s), ex sloc (Ast.Var s))) slots + List.map + (fun (f : Ast.field) -> + (ex f.Ast.floc (Ast.Kw f.Ast.fname), ex f.Ast.floc (Ast.Var f.Ast.fname))) + slots in { Ast.d = Ast.Defn @@ -343,7 +352,9 @@ let expand (decls : Ast.decl list) : Ast.decl list = List.filter_map (fun (d : Ast.decl) -> match d.Ast.d with - | Ast.Defclass (n, slots) -> Some (constructor n slots d.Ast.dloc) + (* Kept: its slot vector cannot be paired until every type name is + known, so [Check.pair_decls] writes the constructor. *) + | Ast.Defclass _ -> Some d | Ast.Defgeneric fn | Ast.Defmulti fn -> Some (dispatcher (Hashtbl.find generics fn.Ast.name)) (* Gone: its body is inside its generic's dispatch. *) diff --git a/lib/dev.ml b/lib/dev.ml index d83191d7..a22901a7 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1422,17 +1422,29 @@ let defs t = [M-.] on a prelude macro from "the prelude is not a file on disk" into a shrug about the daemon having no location. *) let macro_locs = Hashtbl.create 16 in - (* The classes, off the session's declarations: [Classes.expand] turns a - [defclass] into its constructor [defn] before the checker runs, so the - class is not in [Tast.program] or the checker's environment, and the - declarations are the one place that still has it. Its constructor is - dropped from the [fn] rows for the macro rows' reason: one name, one row, - and [class] is what was written. *) + (* The classes: where each was written, off the session's declarations, + and its slots as the checker paired them, off its environment — the + slot vector is unreadable before pairing. The constructor the checker + wrote is dropped from the [fn] rows for the macro rows' reason: one name, + one row, and [class] is what was written. *) let classes = List.filter_map (fun (d : Ast.decl) -> match d.Ast.d with - | Ast.Defclass (n, slots) -> Some (n, List.map fst slots, d.Ast.dloc) + | Ast.Defclass (n, _) -> + let slots = + Option.value ~default:[] + (Check.class_slots t.session.Session.env n) + in + Some + (n, + List.map + (fun (s, ty) -> + match ty with + | Types.Dyn -> s + | ty -> s ^ " " ^ Types.to_string ty) + slots, + d.Ast.dloc) | _ -> None) t.session.Session.decls in diff --git a/lib/emit.ml b/lib/emit.ml index 800e4a71..13dc14fc 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -4370,7 +4370,10 @@ declare i64 @flan_dyn_from_bool(i32) declare i64 @flan_dyn_from_bytes(ptr, i64) declare i64 @flan_dyn_vec_new() declare i64 @flan_dyn_map_new() -declare i64 @flan_dyn_map_new_class(i64) +declare i64 @flan_dyn_map_new_class(i64, ptr, i64) +declare void @flan_dyn_slot_set(i64, i64, i64, ptr, i64) +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 i64 @flan_dyn_kw(ptr, i64) diff --git a/lib/load.ml b/lib/load.ml index a3f28a9b..97a5220d 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -390,6 +390,7 @@ and rename_place owned alias bound (p : Ast.place) : Ast.place = | Ast.Pfield (t, f) -> Ast.Pfield (go t, f) | Ast.Pindex (t, idx) -> Ast.Pindex (go t, List.map go idx) | Ast.Pderef t -> Ast.Pderef (go t) + | Ast.Pslot (t, k) -> Ast.Pslot (go t, go k) let rename_field owned alias (f : Ast.field) : Ast.field = { f with Ast.fty = rename_texpr owned alias f.Ast.fty } @@ -501,12 +502,17 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl = and the rename is the ordinary one: the declared name, plus whatever inside them is a name of this package. - A class's slots are not renamed. They are keywords in the map the + A class's slot names are not renamed. They are keywords in the map the constructor builds, and a keyword belongs to nobody — the same line the - [MapLit] arm above takes about a map literal's keys. The *class's* name - is qualified, so [pkg/point] is what an instance's shape tag reads and - two packages' [point] classes are two classes. *) - | Ast.Defclass (n, slots) -> Ast.Defclass (qualify alias n, slots) + [MapLit] arm above takes about a map literal's keys. A slot's *type* is + a type like any other, and the vector is unpaired, so it goes through + [rename_pitem] as a [defn]'s does: a bare symbol the package owns is a + type of this package, since no slot name is ever an owned name that + matters. The *class's* name is qualified, so [pkg/point] is what an + instance's shape tag reads and two packages' [point] classes are two + classes. *) + | Ast.Defclass (n, slots) -> + Ast.Defclass (qualify alias n, List.map (rename_pitem owned alias) slots) (* A generic's parameters are dyn and were written out by the parser, so there is no unpaired vector here and [bound] is exactly the parameter names. *) @@ -832,6 +838,7 @@ and place_uses acc loc (p : Ast.place) = | Ast.Pfield (t, _) -> expr_uses acc t | Ast.Pindex (t, idx) -> expr_uses acc t; List.iter (expr_uses acc) idx | Ast.Pderef t -> expr_uses acc t + | Ast.Pslot (t, k) -> expr_uses acc t; expr_uses acc k let decl_uses acc (d : Ast.decl) = let field (f : Ast.field) = texpr_uses acc f.Ast.fty in @@ -873,9 +880,14 @@ let decl_uses acc (d : Ast.decl) = | Ast.Zeroed | Ast.Uninit -> ()) | Ast.Defconst (_, t, v) -> Option.iter (texpr_uses acc) t; expr_uses acc v - (* A class's slots are keywords and name nothing. Its constructor's body is - written by [Classes.expand], long after this, out of the slots alone. *) - | Ast.Defclass _ -> () + (* A class's slot names are keywords and name nothing; its slot types are + uses, recorded the way an unpaired [defn] vector's are. *) + | Ast.Defclass (_, slots) -> + List.iter + (function + | Ast.Pname (n, loc) -> acc := (n, loc) :: !acc + | Ast.Ptype t -> texpr_uses acc t) + slots | Ast.Defgeneric f | Ast.Defmulti f -> fn f (* The generic is a use — a method in one package extending another's has to pull that package in — and so is the class in the dispatch slot, for the diff --git a/lib/parse.ml b/lib/parse.ml index c380830b..2b596ab5 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1205,13 +1205,19 @@ and place (f : Form.t) : Ast.place = either inserts or replaces — so there is no store into a lookup, and an entry that is absent has no location to store into. Refused here rather than parsed into a place form the language does not have. *) + (* A class instance's slot: declared by its defclass, so it always exists + and is a place, where a map's absent key is not. Whether the value is an + instance or a map is a run-time fact, so the store is a run-time call + and a map there is refused by it. *) + | List [ { v = Sym "get"; _ }; target; key ] -> + Ast.Pslot (expr target, expr key) | List ({ v = Sym "get"; _ } :: _) -> fail f "(get m k) is not a place — a map is written with (put m k v)" | List [ { v = Sym "deref"; _ }; p ] -> Ast.Pderef (expr p) | _ -> fail f "%s is not assignable. set takes a name, (.field x), (at a i ...), \ - or (deref p)" + (deref p), or a class slot (get inst :slot)" (Form.to_string f) and arms f (items : Form.t list) : Ast.arm list = @@ -1484,20 +1490,15 @@ let rec decl (f : Form.t) : Ast.decl = only names can be read here. *) | List ({ v = Sym "defclass"; _ } :: args) -> (match args with + (* The slot vector is a [defn]'s parameter vector in every respect — + [[x y]] two dyn slots, [[pause bool step bool]] two typed ones — and + is carried undecided for the same reason. *) | [ n; { v = Vec slots; _ } ] -> - mk (Ast.Defclass - (dname n, - List.map - (fun (s : Form.t) -> - match s.v with - | Sym name -> no_sigil s; (name, s.loc) - | _ -> - fail s - "a class slot is a name — its value is dyn, so there \ - is no type to write. Read one with (get p :%s)" - (Form.to_string s)) - slots)) - | _ -> fail f "defclass is (defclass Name [slot ...])") + List.iter + (fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ()) + slots; + mk (Ast.Defclass (dname n, pitems slots)) + | _ -> fail f "defclass is (defclass Name [slot Type ...])") | List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) -> let generic = String.equal which "defgeneric" in diff --git a/lib/session.ml b/lib/session.ml index 00a4c241..c682fad7 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -747,27 +747,27 @@ let eval ?(origin = "") ?pause t src : change = A class whose slot list did not change is not in here at all: its constructor has the same signature and goes through [compatible] untouched. *) - let class_slots (ds : Ast.decl list) n = - List.fold_left - (fun acc (d : Ast.decl) -> - match d.Ast.d with - | Ast.Defclass (m, slots) when String.equal m n -> - Some (List.map fst slots) - | _ -> acc) - None ds + (* The slots as the checker paired them, off each side's environment: the + vector is not readable before pairing, and [t.env] is the one the + running program was checked against. Only the names decide the + constructor's arity; the types are the registration's business below. *) + let slot_names env n = + Option.map (List.map fst) (Check.class_slots env n) in let incoming_classes = List.filter_map (fun (d : Ast.decl) -> match d.Ast.d with - | Ast.Defclass (n, slots) -> Some (n, List.map fst slots) + | Ast.Defclass (n, _) -> + Some (n, Option.value ~default:[] (Check.class_slots env n)) | _ -> None) incoming in let relaxed = List.filter_map (fun (n, slots) -> - match class_slots t.decls n with + let slots = List.map fst slots in + match slot_names t.env n with | Some old when old <> slots -> (* Every function of the running program that calls the constructor or takes its address, minus the ones this @@ -971,15 +971,16 @@ let eval ?(origin = "") ?pause t src : change = { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_kw", [ str n ]); ty = Types.Dyn; loc } in - (* The slot names in one string, newline between: the runtime - splits them. A dyn vector would have been the obvious shape - and is the wrong one — it is a collector object, so the - registry would hold something the marker has to reach, where - a packed string reaches interned keywords that are immortal - already. *) + (* The slots in one string, a line each with the slot's type + after its name: the runtime splits them. A dyn vector would + have been the obvious shape and is the wrong one — it is a + collector object, so the registry would hold something the + marker has to reach, where a packed string reaches interned + keywords that are immortal already. The constructor carries + the same string, from the same function. *) { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_class_def", - [ kw; str (String.concat "\n" slots) ]); + [ kw; str (Check.class_spec_of slots) ]); ty = Types.Unit; loc }) incoming_classes in diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index c7a8c724..d2849afe 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1172,12 +1172,14 @@ flan_dyn flan_dyn_map_new(void) { * of dyn vectors would have needed both, and would have needed them to * survive a collection triggered from inside a migration. * - * **What the registry does not do.** It does not constrain [put]. A class + * **What the registry constrains.** A store into a slot the class declares + * — the constructor's, [put]'s, [set]'s — is checked against the slot's + * type. A key the class does not declare is not refused by [put]: a class * instance is an open map — TODO.org, "Class features deferred, each with its - * reason", already defers unknown-slot checking — so a key nobody declared - * can be written to one, and the migration below will *drop* it at the next + * reason", defers unknown-slot checking — so a key nobody declared can be + * written to one, and the migration below will *drop* it at the next * redefinition, because its rule is that an instance's keys are the class's - * slots. That is real data loss and it is written down as such in TODO.org, + * slots. [set] does refuse one, because a slot it writes has to exist. That is real data loss and it is written down as such in TODO.org, * "A redefined defclass migrates its instances lazily", rather than dressed * up as enforcement. * @@ -1219,9 +1221,26 @@ flan_dyn flan_dyn_map_new(void) { * runs ahead of its definition declares itself. */ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n); +/* What a slot may hold. A dyn value's tag is the whole of what can be asked + * of it, so these are the tags, plus a range on top of the int tag for a + * slot declared with a narrower integer type. [word] is the type as the + * defclass wrote it, for the sentence a refusal prints. */ +enum { ST_ANY, ST_BOOL, ST_INT, ST_FLOAT, ST_TEXT }; + +typedef struct slot_type { + uint8_t kind; + int64_t lo, hi; /* ST_INT only */ + const char *word; /* static; NULL for ST_ANY */ +} slot_type; + typedef struct class_entry { kw_entry *name; kw_entry **slots; /* interned, immortal, in declaration order */ + slot_type *types; /* one per slot, same order */ + /* Per slot, the generation a migration last warned about a value that no + * longer fits the slot's type. One warning per slot per redefinition, + * however many instances carry such a value. */ + uint32_t *warned; int64_t nslots; uint32_t gen; } class_entry; @@ -1237,74 +1256,99 @@ static class_entry *class_find(kw_entry *name) { } /* The generation a new instance of [name] is stamped with. Zero for a class - * no definition has been registered for, which is every class in a program - * that was built and never reloaded: nothing has changed shape, so nothing - * needs to migrate, and the registry earns its keep only once an editor has - * sent a new definition. */ + * no definition has been registered for — which, now that the constructor + * registers its class, is only an instance built by something other than a + * constructor: test/dyn_ops.c, calling the runtime directly. */ static uint32_t class_gen(kw_entry *name) { class_entry *e = class_find(name); return e == NULL ? 0u : e->gen; } -/* One class's current slot list, as the compiler's per-reload thunk hands it - * over: the class's name as a keyword, and the slot names packed into one - * string, newline between and no leading colons — the shape a string literal - * already crosses in, rather than a dyn vector this would have to root. - * - * The generation is bumped only when the list actually differs. That is what - * makes C-c C-k idempotent: reloading a file re-runs every one of its class - * definitions, and a bump per reload would migrate every instance in the - * program every time anybody saved, for no change. */ -void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { - kw_entry *k; - kw_entry **list = NULL; - int64_t count = 0, i, start; - class_entry *e; - if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD) - /* No location: the caller is the thunk a reload runs, which has no - source position of its own — the class's own [defclass] is where a - reader would look, and it is not on any stack by the time this runs. - Unreachable from written Flan in any case; only the compiler emits - this call, and it emits a keyword. */ - trap1(NULL, 0, TYPE_TRAP, "class definition", - "a class name is a keyword", name); - k = dyn_kw(name); +static slot_type slot_type_of(const uint8_t *w, int64_t n) { + static const struct { const char *w; uint8_t kind; int64_t lo, hi; } known[] = { + { "bool", ST_BOOL, 0, 0 }, + { "string", ST_TEXT, 0, 0 }, + { "f32", ST_FLOAT, 0, 0 }, + { "f64", ST_FLOAT, 0, 0 }, + { "i8", ST_INT, INT8_MIN, INT8_MAX }, + { "i16", ST_INT, INT16_MIN, INT16_MAX }, + { "i32", ST_INT, INT32_MIN, INT32_MAX }, + { "i64", ST_INT, INT64_MIN, INT64_MAX }, + { "u8", ST_INT, 0, UINT8_MAX }, + { "u16", ST_INT, 0, UINT16_MAX }, + { "u32", ST_INT, 0, UINT32_MAX }, + { "u64", ST_INT, 0, INT64_MAX }, + }; + slot_type t = { ST_ANY, 0, 0, NULL }; + size_t i; + for (i = 0; i < sizeof known / sizeof known[0]; i++) + if ((int64_t)strlen(known[i].w) == n && memcmp(known[i].w, w, (size_t)n) == 0) { + t.kind = known[i].kind; + t.lo = known[i].lo; + t.hi = known[i].hi; + t.word = known[i].w; + return t; + } + /* A word this table does not know is a compiler newer than this runtime. + Holding anything is the answer that loses no data. */ + return t; +} + +static int slot_fits(const slot_type *t, flan_dyn v) { + int tag = flan_dyn_tag(v); + switch (t->kind) { + case ST_BOOL: return tag == FLAN_DYN_TAG_BOOL; + case ST_TEXT: return tag == FLAN_DYN_TAG_TEXT; + case ST_FLOAT: return tag == FLAN_DYN_TAG_FLOAT; + case ST_INT: { + int64_t x; + if (tag != FLAN_DYN_TAG_INT) return 0; + x = dyn_int_value(v); + return x >= t->lo && x <= t->hi; + } + default: return 1; + } +} + +/* A class's slots as the compiler hands them over: one line per slot, the + * slot's name and then, after a space, its type's name — nothing for a slot + * written with no type. The same string comes from a constructor and from a + * reload, so it is read in one place. The count is returned; both arrays are + * NULL for a class with no slots, which allocates nothing. */ +static int64_t class_spec(const uint8_t *spec, int64_t n, kw_entry ***names, + slot_type **types) { + int64_t count = 0, i, start; if (n < 0) n = 0; - /* Count first, then fill: one allocation of the right size, and an empty - * class — (defclass marker []) is in the corpus — allocates nothing. */ + *names = NULL; + *types = NULL; for (i = 0, start = 0; i <= n; i++) - if (i == n ? i > start : slots[i] == '\n') { + if (i == n ? i > start : spec[i] == '\n') { if (i > start) count++; start = i + 1; } - if (count > 0) { - list = (kw_entry **)malloc((size_t)count * sizeof *list); - if (list == NULL) trap_oom(NULL, 0, count * (int64_t)sizeof *list); - count = 0; - for (i = 0, start = 0; i <= n; i++) - if (i == n ? i > start : slots[i] == '\n') { - if (i > start) - list[count++] = dyn_kw(flan_dyn_kw(slots + start, i - start)); - start = i + 1; + if (count == 0) return 0; + *names = (kw_entry **)malloc((size_t)count * sizeof **names); + *types = (slot_type *)malloc((size_t)count * sizeof **types); + if (*names == NULL || *types == NULL) + trap_oom(NULL, 0, count * (int64_t)(sizeof **names + sizeof **types)); + count = 0; + for (i = 0, start = 0; i <= n; i++) + if (i == n ? i > start : spec[i] == '\n') { + if (i > start) { + int64_t sp = start; + while (sp < i && spec[sp] != ' ') sp++; + (*names)[count] = dyn_kw(flan_dyn_kw(spec + start, sp - start)); + (*types)[count] = sp < i ? slot_type_of(spec + sp + 1, i - sp - 1) + : slot_type_of(NULL, 0); + count++; } - } - e = class_find(k); - if (e != NULL) { - int same = e->nslots == count; - if (same) - for (i = 0; i < count; i++) - if (e->slots[i] != list[i]) { same = 0; break; } - if (same) { free(list); return; } - free(e->slots); - e->slots = list; - e->nslots = count; - /* Wrapping is not a correctness question — what matters is that the new - * generation differs from the one the live instances carry — but zero is - * reserved for "no definition registered", so it is stepped over. */ - e->gen = e->gen + 1u; - if (e->gen == 0u) e->gen = 1u; - return; - } + start = i + 1; + } + return count; +} + +static void class_add(kw_entry *k, kw_entry **list, slot_type *types, + int64_t count) { if (classes_n == classes_cap) { int64_t cap = classes_cap ? classes_cap * 2 : 8; class_entry *t = @@ -1315,6 +1359,11 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { } classes[classes_n].name = k; classes[classes_n].slots = list; + classes[classes_n].types = types; + classes[classes_n].warned = + count > 0 ? (uint32_t *)calloc((size_t)count, sizeof(uint32_t)) : NULL; + if (count > 0 && classes[classes_n].warned == NULL) + trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t)); classes[classes_n].nslots = count; /* One, never zero: an instance built before this registration carries zero * and has to be seen as stale, because the definition it was built from is @@ -1323,6 +1372,61 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { classes_n++; } +/* One class's current definition, as the compiler's per-reload thunk hands + * it over: the class's name as a keyword, and [class_spec]'s string. + * + * The generation is bumped only when the definition actually differs — a + * slot's name or its type. That is what makes C-c C-k idempotent: reloading + * a file re-runs every one of its class definitions, and a bump per reload + * would migrate every instance in the program every time anybody saved, for + * no change. */ +void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { + kw_entry *k; + kw_entry **list; + slot_type *types; + int64_t count, i; + class_entry *e; + if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD) + /* No location: the caller is the thunk a reload runs, which has no + source position of its own — the class's own [defclass] is where a + reader would look, and it is not on any stack by the time this runs. + Unreachable from written Flan in any case; only the compiler emits + this call, and it emits a keyword. */ + trap1(NULL, 0, TYPE_TRAP, "class definition", + "a class name is a keyword", name); + k = dyn_kw(name); + count = class_spec(slots, n, &list, &types); + e = class_find(k); + if (e != NULL) { + int same = e->nslots == count; + if (same) + for (i = 0; i < count; i++) + if (e->slots[i] != list[i] || e->types[i].kind != types[i].kind + || e->types[i].lo != types[i].lo || e->types[i].hi != types[i].hi) { + same = 0; + break; + } + if (same) { free(list); free(types); return; } + free(e->slots); + free(e->types); + free(e->warned); + e->slots = list; + e->types = types; + e->warned = + count > 0 ? (uint32_t *)calloc((size_t)count, sizeof(uint32_t)) : NULL; + if (count > 0 && e->warned == NULL) + trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t)); + e->nslots = count; + /* Wrapping is not a correctness question — what matters is that the new + * generation differs from the one the live instances carry — but zero is + * reserved for "no definition registered", so it is stepped over. */ + e->gen = e->gen + 1u; + if (e->gen == 0u) e->gen = 1u; + return; + } + class_add(k, list, types, count); +} + /* 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 @@ -1367,6 +1471,27 @@ static void class_sync(flan_obj *o) { if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD && dyn_kw(key) == e->slots[j]) { v = o->u.v.items[i * 2 + 1]; + /* A kept value that the slot's new type does not admit is kept + anyway: throwing it away would be the data loss a redefinition + exists to avoid, and there is nothing to convert it to. What it + gets is a warning, once per slot per redefinition, and the next + write to the slot is checked like any other. A slot the class + has only just gained holds nil without a word: it holds nothing, + rather than something of the wrong type. */ + if (!slot_fits(&e->types[j], v) && e->warned[j] != e->gen) { + char sv[SAY_MAX]; + kw_entry *c = o->u.v.klass, *sl = e->slots[j]; + e->warned[j] = e->gen; + say(sv, SAY_MAX, v); + fflush(stdout); + fprintf(stderr, + "warning: %.*s was redefined, and its slot :%.*s is now " + "declared %s. An instance holds %s there, which is %s; it " + "keeps that value, and the next write to :%.*s is checked\n", + (int)c->len, (const char *)(c + 1), + (int)sl->len, (const char *)(sl + 1), e->types[j].word, sv, + tag_of(v), (int)sl->len, (const char *)(sl + 1)); + } break; } } @@ -1386,11 +1511,25 @@ static void class_sync(flan_obj *o) { /* The same map with a shape tag on it: what a (defclass ...) constructor * calls. [k] is a keyword and anything else traps by name — the compiler - * hands it the class's own name and nothing else can reach this. */ -flan_dyn flan_dyn_map_new_class(flan_dyn k) { + * hands it the class's own name and nothing else can reach this. + * + * [spec] is the class's definition, [class_spec]'s string, and it registers + * the class the first time any instance of it is built. That is what makes + * a slot's type checked in a program that is never reloaded — the registry + * used to be filled only by a reload. A class already registered keeps + * what it has, and has to: a constructor compiled before a redefinition may + * still be on some stack, and letting its definition win would put the + * class back the way it was. Redefining is [flan_dyn_class_def]'s alone. */ +flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n) { flan_obj *o; if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k); + if (class_find(dyn_kw(k)) == NULL) { + kw_entry **list; + slot_type *types; + int64_t count = class_spec(spec, n, &list, &types); + class_add(dyn_kw(k), list, types, count); + } o = gc_alloc(OBJ_MAP, 0); o->len = 0; o->u.v.items = NULL; @@ -2265,8 +2404,141 @@ flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { return flan_dyn_from_bool(map_find(o, k) >= 0); } -void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) { +/* A class slot's type, checked at the store — SBCL's place for it + * (src/pcl/slots.lisp, [set-slot-value]'s typecheck before the write), + * because the store is where the wrong value is. -1 when [k] is not a slot + * the class declares. */ +static int64_t class_slot(class_entry *e, flan_dyn k) { + int64_t j; + if (e == NULL || flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) return -1; + for (j = 0; j < e->nslots; j++) + if (e->slots[j] == dyn_kw(k)) return j; + return -1; +} + +/* The three stores that reach a declared slot, for the sentence a refusal + * prints: the call as it would have been written. */ +enum { BY_PUT, BY_SET, BY_NEW }; + +static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen, + int by, flan_obj *o, class_entry *e, + int64_t j, flan_dyn m, flan_dyn v) { + char sm[SAY_MAX], sv[SAY_MAX]; + kw_entry *sl = e->slots[j], *c = o->u.v.klass; + int sn = (int)sl->len, cn = (int)c->len; + const char *ss = (const char *)(sl + 1), *cs = (const char *)(c + 1); + say(sm, SAY_MAX, m); + say(sv, SAY_MAX, v); + fflush(stdout); + trap_where(loc, loclen); + fprintf(stderr, "dyn %s: the slot :%.*s of %.*s is declared %s, and ", + by == BY_PUT ? "put" : by == BY_SET ? "set" : "construct", sn, ss, + cn, cs, e->types[j].word); + /* An int of the wrong size is the right tag, so the tag is not the news. */ + if (e->types[j].kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT) + fprintf(stderr, "%s is outside its range — ", sv); + else + fprintf(stderr, "this is %s — ", tag_of(v)); + if (by == BY_PUT) + fprintf(stderr, "(put %s :%.*s %s)\n", sm, sn, ss, sv); + else if (by == BY_SET) + fprintf(stderr, "(set (get %s :%.*s) %s)\n", sm, sn, ss, sv); + else + fprintf(stderr, "(%.*s ...) with :%.*s %s\n", cn, cs, sn, ss, sv); + flan_trap((const uint8_t *)"DynType", 7); +} + +static void check_slot(const uint8_t *loc, int64_t loclen, int by, + flan_obj *o, flan_dyn m, flan_dyn k, flan_dyn v) { + class_entry *e; + int64_t j; + if (o->u.v.klass == NULL) return; + e = class_find(o->u.v.klass); + j = class_slot(e, k); + if (j >= 0 && !slot_fits(&e->types[j], v)) + trap_slot_type(loc, loclen, by, o, e, j, m, v); +} + +static void map_store(flan_obj *o, flan_dyn k, flan_dyn v); + +/* A constructor's stores: [flan_dyn_map_set]'s, with the refusal worded for + * the constructor call it happened inside rather than for a [put] nobody + * wrote. */ +void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v) { + flan_obj *o = want_map("construct", m, k); + check_slot(NULL, 0, BY_NEW, o, m, k, v); + map_store(o, k, v); +} + +/* (set (get inst :slot) v). Three refusals, each its own sentence, because + * they are three different mistakes: the value is not a class instance at + * all (a map's entries are written with [put], which is where inserting a + * key is real); the key is not a slot the class declares; the value does not + * fit the slot's type. The first two are why this is not [put]: a declared + * slot always exists, so writing one is a store and never an insertion. */ +void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, + const uint8_t *loc, int64_t loclen) { + flan_obj *o; + class_entry *e; + int64_t j; + if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) { + char sm[SAY_MAX]; + say(sm, SAY_MAX, m); + fflush(stdout); + trap_where(loc, loclen); + fprintf(stderr, + "dyn set: (get m k) is a place only on a class instance, and " + "this is %s%s — %s. A map's entries are written with " + "(put m k v)\n", + is_map(m) ? "a map with no class" : "a ", + is_map(m) ? "" : tag_of(m), sm); + flan_trap((const uint8_t *)"DynType", 7); + } + o = dyn_obj(m); + class_sync(o); + e = class_find(o->u.v.klass); + j = class_slot(e, k); + if (j < 0) { + char sk[SAY_MAX]; + kw_entry *c = o->u.v.klass; + int64_t i; + say(sk, SAY_MAX, k); + fflush(stdout); + trap_where(loc, loclen); + fprintf(stderr, "dyn set: %.*s has no slot %s. Its slots are", + (int)c->len, (const char *)(c + 1), sk); + if (e == NULL || e->nslots == 0) fprintf(stderr, " none"); + else + for (i = 0; i < e->nslots; i++) + fprintf(stderr, " :%.*s", (int)e->slots[i]->len, + (const char *)(e->slots[i] + 1)); + fprintf(stderr, "; a key the class does not declare is written with " + "(put inst k v)\n"); + flan_trap((const uint8_t *)"DynType", 7); + } + if (!slot_fits(&e->types[j], v)) + trap_slot_type(loc, loclen, BY_SET, o, e, j, m, v); + map_store(o, k, v); +} + +/* [put]: a key the class declares is checked against its type, and the + * refusal names [loc]. A key it does not declare is let through: an + * instance is an open map to [put], and the next redefinition drops such a + * key — see "Classes" above. */ +void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, + int64_t loclen) { flan_obj *o = want_map("put", m, k); + check_slot(loc, loclen, BY_PUT, o, m, k, v); + map_store(o, k, v); +} + +/* The same with no site: a map literal's stores, and test/dyn_ops.c. */ +void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) { + flan_dyn_map_put(m, k, v, NULL, 0); +} + +/* The store under all three, with the instance already brought up to date. */ +static void map_store(flan_obj *o, flan_dyn k, flan_dyn v) { int64_t i = map_find(o, k); if (i >= 0) { o->u.v.items[i * 2 + 1] = v; diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 889be2e7..8b73adf6 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -88,15 +88,28 @@ flan_dyn flan_dyn_map_new(void); * * The tag is not traced and does not have to be: an interned keyword entry is * immortal and is not a collector object. */ -flan_dyn flan_dyn_map_new_class(flan_dyn k); +flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n); + +/* A constructor's store into a slot, checked against the slot's declared + * type — [flan_dyn_map_set] with a refusal worded for the constructor. */ +void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v); + +/* (set (get inst :slot) v): [m] must be a class instance and [k] a slot its + * class declares, and [v] must fit the slot's type; each is a trap with its + * own sentence, at [loc]. A declared slot always exists, so this stores and + * never inserts. */ +void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, + const uint8_t *loc, int64_t loclen); /* The class's name as a keyword, or nil for anything that is not an instance * — an ordinary map included. Never traps. */ flan_dyn flan_dyn_class_of(flan_dyn v); /* A class definition, registered or re-registered: [name] is the class's name - * as a keyword and [slots]/[n] is its slot names packed into one string, - * newline between and no leading colons. The compiler emits one call per + * as a keyword and [slots]/[n] is its slots packed into one string, a line + * each, the slot's name and then — after a space, for a typed slot — its + * type's name: "x i64\ny" is an i64 slot :x and a slot :y of any value. + * [flan_dyn_map_new_class] takes the same string. The compiler emits one call per * (defclass ...) into the thunk a reload runs, so a definition that changed * lands here before anything touches an instance. * @@ -185,6 +198,10 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen); * key in place, so a key occurs once and insertion order is print order. */ flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k); void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v); +/* [put]'s: [flan_dyn_map_set], with the site a typed class slot's refusal + * prints. */ +void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, + const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k); /* Structural, and per type it renders what typed [print] renders. Never diff --git a/test/dyn_ops.c b/test/dyn_ops.c index dd9eb728..c4f4d292 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -1061,7 +1061,8 @@ static void define(const char *name, const char *slots) { * Built through the same entry point a constructor uses, so it is stamped * exactly as compiled code would stamp it. */ static flan_dyn a_point(int64_t x, int64_t y) { - flan_dyn p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5)); + flan_dyn p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5), + (const uint8_t *)"x\ny", 3); flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"x", 1), flan_dyn_from_i64(x)); flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"y", 1), @@ -1176,7 +1177,8 @@ static void classes(void) { define("point", "x\ny\nn"); /* Built by hand rather than through [a_point], because it is the instance the *new* constructor would build: three slots, stamped current. */ - q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5)); + q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5), + (const uint8_t *)"x\ny\nn", 5); flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"x", 1), flan_dyn_from_i64(1)); flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"y", 1), diff --git a/test/programs/dyn-class-slots.flan b/test/programs/dyn-class-slots.flan new file mode 100644 index 00000000..ea38ef7e --- /dev/null +++ b/test/programs/dyn-class-slots.flan @@ -0,0 +1,38 @@ +;;;; Typed class slots, and set on a slot. +;;;; +;;;; A slot vector reads as a defn's parameter vector: [pause bool] is a slot +;;;; of type bool, and a name followed by another name is a slot with no type, +;;;; which holds any dyn value. The type is checked when a value is stored -- +;;;; by the constructor, by put and by set -- and not when one is read: an +;;;; instance is a dyn map whatever its slots say. +;;;; +;;;; set writes a declared slot. A class declares its slots, so one always +;;;; exists and (get s :pause) is a place, where a plain map's absent key is +;;;; not. dyn-slot-trap.flan has the refusals. + +(defclass state [pause bool step i32 speed f64 name string tag]) + +(defn twelve [] i64 12) + +(defn main [] i32 + (let [s (state false 3 1.5 "sand" :x)] + (println s) + (set (get s :pause) true) + (println (get s :pause)) + ;; An i32 slot takes any int in i32's range; a dyn caller passes the + ;; value as it is, with nothing converted first. + (set (get s :step) -7) + (println (get s :step)) + (set (get s :tag) [1 2]) + (println (get s :tag)) + ;; put reaches the same check for a declared slot, and still inserts a + ;; key the class does not declare -- an instance is an open map to put. + (put s :speed 2.5) + (put s :scratch 9) + (println (get s :speed)) + (println (get s :scratch)) + (println (length s)) + ;; A typed caller boxes into the dyn parameter as any call does. + (set (get s :step) (twelve)) + (println (get s :step))) + 0) diff --git a/test/programs/dyn-slot-trap.flan b/test/programs/dyn-slot-trap.flan new file mode 100644 index 00000000..15a025ca --- /dev/null +++ b/test/programs/dyn-slot-trap.flan @@ -0,0 +1,18 @@ +;;;; The refusals of a typed class slot, one per run because each ends the +;;;; process. The argument chooses which. The line numbers are asserted by +;;;; the test, so an edit above them moves them. +(defclass state [pause bool step i32 tag]) + +(defn as-dyn [d dyn] dyn d) + +(defn main [args [string]] i32 + (let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0) + s (state false 3 nil)] + (println "before") + (cond + (= which 0) (println (state 1 2 3)) + (= which 1) (put s :pause 1) + (= which 2) (set (get s :step) 5000000000) + (= which 3) (set (get s :paws) true) + :else (set (get (as-dyn {:pause 1}) :pause) true))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 6ced8956..5487ece0 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -4935,6 +4935,47 @@ level "1" index_site (); index_site ~x86:true (); + (* Typed class slots and set on a slot: the stores that fit, then one + run per refusal. The constructor, put and set each check a declared + slot's type, set refuses a slot the class does not declare and a + value that is not an instance, and put still inserts an undeclared + key. On both backends, because every one of these is a runtime call + whose arguments the two emit separately. *) + let slots_out = + "#state{ :pause false :step 3 :speed 1.5 :name \"sand\" :tag :x}\n\ + true\n-7\n[ 1 2]\n2.5\n9\n6\n12\n" + in + outputs "dyn: typed class slots" "programs/dyn-class-slots.flan" slots_out; + outputs ~x86:true "dyn: typed class slots, --x86" + "programs/dyn-class-slots.flan" slots_out; + let slot_trap ?x86 () = + let exe = compile ?x86 "programs/dyn-slot-trap.flan" in + List.iter + (fun (arg, want) -> + let code, text = run exe (Some arg) in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf + "FAIL dyn: a class slot's refusal%s\n got: %S \ + (exit %d)\n wanted: %S (exit 134)\n" + (match x86 with Some true -> ", --x86" | _ -> "") + text code want + end) + [ ("0", "dyn construct: the slot :pause of state is declared bool, \ + and this is int — (state ...) with :pause 1"); + ("1", "dyn-slot-trap.flan:14:19: dyn put: the slot :pause of state \ + is declared bool, and this is int"); + ("2", "dyn-slot-trap.flan:15:19: dyn set: the slot :step of state \ + is declared i32, and 5000000000 is outside its range"); + ("3", "dyn-slot-trap.flan:16:19: dyn set: state has no slot :paws. \ + Its slots are :pause :step :tag"); + ("4", "dyn-slot-trap.flan:17:13: dyn set: (get m k) is a place only \ + on a class instance, and this is a map with no class") ]; + (try Sys.remove exe with Sys_error _ -> ()) + in + slot_trap (); + slot_trap ~x86:true (); + (* A numeric cast opening a dyn box — TODO.org, "A numeric cast opens a dyn box". programs/dyn-cast.flan is one program because the three behaviours are one story told in order: the same-kind casts print, the diff --git a/test/test_flan.ml b/test/test_flan.ml index d7857883..1c3fddf0 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2611,14 +2611,31 @@ let () = rejects_check "a constructor takes one argument per slot" "(defclass point [x y])\n(defn main [] i32 (let [p (point 1)] 0))" ~needle:"point"; - (* A slot vector holds names and nothing else. [(defclass point [x i64])] - is therefore two slots, one of them unfortunately named — the parser - cannot tell a type's name from a slot's and does not have to, since a - slot has no type to write. What it can tell is a form that is not a name - at all. *) - rejects_check "a slot is a name, not a type expression" + (* A slot vector is a defn's parameter vector: a name followed by a type + is a typed slot, a name followed by another name is an untyped one. The + type is what a stored dyn value is checked against, so it is one a dyn + value can be checked as, and nothing else. *) + accepts "typed slots, and untyped ones beside them" + "(defclass state [pause bool step bool n i32 tag])\n\ + (defn main [] i32 (let [s (state false true 3 :x)] (if (= (get s :n) 3) 0 1)))"; + rejects_check "a slot's type is one a dyn value can be checked as" "(defclass point [x (Ptr i64)])\n(defn main [] i32 0)" - ~needle:"a class slot is a name"; + ~needle:"the slot x of point is declared (Ptr i64)"; + rejects_check "a capitalised name in a slot vector is an unknown type" + "(defclass point [x Widget])\n(defn main [] i32 0)" + ~needle:"unknown type Widget"; + rejects_check "a slot's type is resolved like any other" + "(defclass point [x f65])\n(defn main [] i32 0)" + ~needle:"did you mean f64"; + (* The slot is a place: its class declares it, so it always exists. *) + accepts "set writes a class slot" + "(defclass state [pause bool])\n\ + (defn main [] i32 (let [s (state false)] (set (get s :pause) true) \ + (if (get s :pause) 0 1)))"; + rejects_check "a class slot has no address" + "(defclass state [pause bool])\n\ + (defn main [] i32 (let [s (state false)] (addr (get s :pause)) 0))" + ~needle:"addr takes the address of a place"; rejects_check "a class does not name a slot twice" "(defclass point [x x])\n(defn main [] i32 0)" ~needle:"names the slot x twice"; @@ -3710,7 +3727,10 @@ let () = into a lookup and no place form for one. Refused with that reason rather than as a milestone that will never arrive. *) rejects_check "a map entry as a place" - "(defn f [] () (set (get m 1) 2))" + "(defn f [m (Map i64 i64)] () (set (get m 1) 2))" + ~needle:"entries are written with (put m k v)"; + rejects_check "get with three arguments is not a place" + "(defn f [m dyn] () (set (get m 1 2) 2))" ~needle:"a map is written with (put m k v)"; (* ── restart-case and invoke-restart, §3 to §6 ─────────────────── *) diff --git a/test/test_session.ml b/test/test_session.ml index 78a3936d..758cb23f 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -1384,6 +1384,20 @@ let () = (String.concat " " c.Session.fns) | exception Loc.Error { Loc.dmsg = m; _ } -> fail "a class and its caller evaluated together: %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 + value is stored, at run time. What has to reach the program is the new + definition, and the registration carries it with the type after the + name, which is what makes the runtime see a change and migrate. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + ignore (Session.eval t "(defn origin [] dyn (point 0 0))"); + match Session.eval t "(defclass point [x i64 y])" with + | c -> + if not (has c.Session.ir "c\"x i64\\0Ay\"") then + fail "a slot's new type did not reach the registration" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a slot's type changed under a compiled caller was refused: %s" m); (* ── What a slot is shown as ────────────────────────────────────────── [strip_rebind] takes only a trailing ~N — [~] is the reader's delimiter diff --git a/web/examples/classes.flan b/web/examples/classes.flan index b79f5b5f..d036b73c 100644 --- a/web/examples/classes.flan +++ b/web/examples/classes.flan @@ -1,5 +1,5 @@ -;; A class is a named dyn map with a shape tag. Its slots are names and -;; carry no types, and its constructor is the class's own name, positional. +;; A class is a named dyn map with a shape tag. A slot with no type holds +;; any value, and its constructor is the class's own name, positional. (defclass point [x y]) (defclass circle [r]) diff --git a/web/index.html b/web/index.html index 7584f36e..0805ca50 100644 --- a/web/index.html +++ b/web/index.html @@ -710,10 +710,16 @@ unit carries nothing for a dyn word to hold, and boxing it is refused — and

Classes and generic functions

A class is a named dyn map with a shape tag. defclass names its -slots, which carry no types; the constructor is the class's own name and is -positional; and class-of answers the tag, or nil for -anything that is not an instance. The slots are map keys, so nothing was added to -read or write one.

+slots, and a slot may be followed by a type, the way a parameter is: +[x y] is two slots that hold any value, and [pause bool] +is one that holds only a bool. The type is checked whenever a value is stored, +and a slot may be bool, an integer type, f32, +f64 or string. The constructor is the class's own name +and is positional, and class-of answers the tag, or nil +for anything that is not an instance. The slots are map keys: get +reads one, and set writes one, as in +(set (get s :pause) true). put writes one too, and is +also how a key the class does not declare is added.

Dispatch comes in the two styles and they are one mechanism. defgeneric dispatches on the class of the first argument, which is @@ -725,8 +731,8 @@ which is last whatever order it was written in. The generic states the return ty once, for every method; a method has no return slot; and every parameter of both is dyn, written or not.

-
;; A class is a named dyn map with a shape tag. Its slots are names and
-;; carry no types, and its constructor is the class's own name, positional.
+
;; A class is a named dyn map with a shape tag. A slot with no type holds
+;; any value, and its constructor is the class's own name, positional.
 (defclass point [x y])
 (defclass circle [r])
 

From e0af3c9b1d652429ef7adcf8f0a86eadb2811084 Mon Sep 17 00:00:00 2001
From: Joseph Ferano 
Date: Fri, 25 Sep 2026 11:55:40 +0700
Subject: [PATCH 2/4] 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                    |  42 +++-------
 lib/classes.ml              |  60 ++++++++++++++
 lib/emit.ml                 |   1 +
 lib/session.ml              |  20 ++++-
 runtime/flan_dyn.c          | 148 +++++++++++++++++++++++++++++++++-
 runtime/flan_dyn.h          |   9 ++-
 runtime/flan_rt.c           |  20 +++++
 test/programs/dev-hook.flan |  21 +++++
 test/test_dev.ml            | 156 ++++++++++++++++++++++++++++++++++++
 test/test_session.ml        |  19 +++++
 vendor/agent/flan_agent.c   |  44 ++++++++++
 web/index.html              |   9 ++-
 12 files changed, 513 insertions(+), 36 deletions(-)
 create mode 100644 test/programs/dev-hook.flan

diff --git a/TODO.org b/TODO.org
index 081c65c5..61cc6ec3 100644
--- a/TODO.org
+++ b/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
-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.
-Left out of v1 because name matching is the half that makes redefinition usable
-and the hook is what makes it expressive. The obvious spelling is a generic riding
-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 update-instance-for-redefined-class, the user hook
+CLOSED: [2026-09-25]
+Taking =migrate-by-name= keeps the name-matched instance, not SBCL's obsolete one,
+and retries nothing; a transfer from the method to a restart below it traps.
 
 ** 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
-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.
-=(defclass State [pause bool step bool])= reads as four untyped slots and
-reports a duplicate =bool=. Wanted: the slot list is name/type pairs, as CLOS
-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).
+** DONE defclass slots take types, checked on write
+CLOSED: [2026-09-25]
+The constructor's parameters stay dyn and every store checks at run time; no int
+converts into a float slot, nil does not fit a typed slot, and a class is no slot type.
 
 ** 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
-Decided 2026-09-25: as written; one lane with typed slots.
-=put= exists because an absent map key has no location to store into, which is
-why =(get m k)= is refused as a place (=lib/parse.ml:1159=). A class instance is
-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.
+** DONE set writes a class slot; put is for maps
+CLOSED: [2026-09-25]
+=put= on an instance still checks a declared slot's type and still inserts an
+undeclared key; only =set= refuses one, since a slot it writes has to exist.
 
 ** 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.
diff --git a/lib/classes.ml b/lib/classes.ml
index 15b9440a..8a109288 100644
--- a/lib/classes.ml
+++ b/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) ->
diff --git a/lib/emit.ml b/lib/emit.ml
index 13dc14fc..b7eb36a8 100644
--- a/lib/emit.ml
+++ b/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)
diff --git a/lib/session.ml b/lib/session.ml
index c682fad7..c5681ead 100644
--- a/lib/session.ml
+++ b/lib/session.ml
@@ -965,7 +965,25 @@ let eval ?(origin = "") ?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 ]);
diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c
index d2849afe..99472218 100644
--- a/runtime/flan_dyn.c
+++ b/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
- * user hook left out; docs/SBCL-REDEFINITION-NOTES.md is where the protocol
+ * one. This is CLHS 4.3.6, [update-instance-for-redefined-class] included —
+ * 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
- * part-way through and see an object whose [len] and [items] disagree.
+ * The name-matching allocates nothing on the collector's heap, so no
+ * 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
diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h
index 8b73adf6..df8020e5 100644
--- a/runtime/flan_dyn.h
+++ b/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
diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c
index 51639a60..6edc6eb8 100644
--- a/runtime/flan_rt.c
+++ b/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();
diff --git a/test/programs/dev-hook.flan b/test/programs/dev-hook.flan
new file mode 100644
index 00000000..d553b3fa
--- /dev/null
+++ b/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)
diff --git a/test/test_dev.ml b/test/test_dev.ml
index 169a2eee..401bdc88 100644
--- a/test/test_dev.ml
+++ b/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" ()
diff --git a/test/test_session.ml b/test/test_session.ml
index 758cb23f..3a44b8e2 100644
--- a/test/test_session.ml
+++ b/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
diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c
index 2ca2aadb..4ab2090b 100644
--- a/vendor/agent/flan_agent.c
+++ b/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:
diff --git a/web/index.html b/web/index.html
index 0805ca50..d40a211a 100644
--- a/web/index.html
+++ b/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 nil, a dropped one goes, the object is the same object, and
 class-of 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.

+That is CLHS 4.3.6's protocol. Its user hook is
+update-instance-for-redefined-class: 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 migrate-by-name
+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.

 
 
C-c C-x 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

From 16427f8d079507a8721315c5d3829450f1a9dbde Mon Sep 17 00:00:00 2001
From: Joseph Ferano 
Date: Fri, 25 Sep 2026 12:55:25 +0700
Subject: [PATCH 3/4] A class slot may be a class or an Option, an int widens
 into a float slot when exact, a gained typed slot starts at its zero, and a
 migration never re-enters itself

---
 TODO.org                           |   4 +-
 lib/check.ml                       | 158 ++++++++---
 lib/dev.ml                         |   4 +-
 lib/emit.ml                        |   2 +-
 lib/load.ml                        |  22 +-
 runtime/flan_dyn.c                 | 421 ++++++++++++++++++++---------
 runtime/flan_dyn.h                 |   3 +-
 test/dyn_ops.c                     |  87 ++++++
 test/programs/dyn-class-slots.flan |  14 +-
 test/programs/dyn-slot-trap.flan   |   5 +-
 test/test_acceptance.ml            |  27 +-
 test/test_dev.ml                   |   8 +-
 test/test_dyn.ml                   |   8 +
 test/test_flan.ml                  |   9 +-
 test/test_sanitize.ml              |   2 +-
 web/index.html                     |   3 +-
 16 files changed, 581 insertions(+), 196 deletions(-)

diff --git a/TODO.org b/TODO.org
index d507a35a..ceb797c9 100644
--- a/TODO.org
+++ b/TODO.org
@@ -2034,8 +2034,8 @@ them.
 
 ** DONE defclass slots take types, checked on write
 CLOSED: [2026-09-25]
-The constructor's parameters stay dyn and every store checks at run time; no int
-converts into a float slot, nil does not fit a typed slot, and a class is no slot type.
+The constructor's parameters stay dyn and every store checks at run time; an int
+widens into a float slot only when exact, and nil fits only an (Option T) slot.
 
 ** DONE println takes up to a second to appear
 CLOSED: [2026-09-25]
diff --git a/lib/check.ml b/lib/check.ml
index 95d2b863..de1745ea 100644
--- a/lib/check.ml
+++ b/lib/check.ml
@@ -63,6 +63,22 @@ type binding = {
   bwhat : string option;
 }
 
+(* A class slot's type: what a value stored into it is checked against. A
+   dyn value's tag is all a store can ask of it, so the scalar types a tag
+   answers for, an instance of a class, and (Option T) of either, which
+   admits nil as well. *)
+type slot_ty =
+  | Sany                     (* no type written: any dyn value *)
+  | Sval of Types.t          (* bool, an integer type, f32, f64, string *)
+  | Sclass of string         (* an instance of this class *)
+  | Sopt of slot_ty          (* nil, or a value of the inner type *)
+
+let rec slot_text = function
+  | Sany -> "dyn"
+  | Sval t -> Types.to_string t
+  | Sclass c -> c
+  | Sopt s -> "(Option " ^ slot_text s ^ ")"
+
 type env = {
   structs : (string, Tast.structure) Hashtbl.t;
   datas  : (string, Tast.data) Hashtbl.t;
@@ -187,7 +203,7 @@ type env = {
      first readable. The type is a declaration about the values and not a
      layout: an instance is a dyn map whatever this says, and what reads it
      is [class_spec], which is what the runtime checks a store against. *)
-  classes : (string, (string * Types.t) list) Hashtbl.t;
+  classes : (string, (string * slot_ty) list) Hashtbl.t;
   (* The bindings a dev build counts at every call: [Shim.resources], read off
      the declare-c forms before [Shim.expand] rewrites them. Keyed by the Flan
      name a program calls. *)
@@ -1568,7 +1584,9 @@ let dyn_param_or_typo env n loc =
          parameters are lowercase"
         n
 
-let pair_params env (items : Ast.pitem list) : Ast.field list =
+let pair_params ?(also = fun _ -> false) env (items : Ast.pitem list)
+    : Ast.field list =
+  let is_type_name env n = is_type_name env n || also n in
   let dyn loc = { Ast.t = Ast.Tname "dyn"; tloc = loc } in
   let rec go = function
     | [] -> []
@@ -1597,44 +1615,117 @@ let pair_params env (items : Ast.pitem list) : Ast.field list =
   in
   go items
 
-(* A class slot's type, resolved and held to the set a stored dyn value can
-   be checked against: its tag says bool, int, float or text and nothing
-   finer, so those are the types there are. A narrower integer is a range on
-   top of the int tag. Everything else a type can be — a struct, a Vec, a
-   pointer — does not cross into dyn at all, so a slot of one could never be
-   written. *)
-let slot_type env cls (f : Ast.field) : Types.t =
-  let t = resolve env f.Ast.fty in
-  match t with
-  | Types.Dyn | Types.Bool | Types.Int _ | Types.Float _ | Types.String -> t
-  | other ->
-    Loc.failk "check/slot-type" f.Ast.fty.Ast.tloc
+(* A class slot's type, held to the set a stored dyn value can be checked
+   against. A class's name is a type here, and only here: it is not a type
+   anywhere else in the language, since an instance is a dyn value. Every
+   other type a slot could name — a struct, a Vec, a pointer — does not cross
+   into dyn at all, so a slot of one could never be written. *)
+(* A class named in [cls]'s slot vector: [n] as written, or [n] in [cls]'s own
+   package, since [Load] leaves a bare name in a slot vector unqualified. *)
+let class_named ~classes cls n =
+  if List.mem n classes then Some n
+  else
+    match String.rindex_opt cls '/' with
+    | Some i ->
+      let q = String.sub cls 0 (i + 1) ^ n in
+      if List.mem q classes then Some q else None
+    | None -> None
+
+let rec slot_of env ~classes cls fname (t : Ast.texpr) : slot_ty =
+  let refuse what =
+    Loc.failk "check/slot-type" t.Ast.tloc
       "the slot %s of %s is declared %s, and a class slot holds a dyn value, \
-       which can be checked as bool, an integer type, f32, f64 or string. \
-       Write one of those, or leave the type out and the slot holds any dyn \
-       value: [%s]"
-      f.Ast.fname cls (Types.to_string other) f.Ast.fname
+       which can be checked as bool, an integer type, f32, f64, string, a \
+       class, or (Option T) of one of those. Write one of those, or leave the \
+       type out and the slot holds any dyn value: [%s]"
+      fname cls what fname
+  in
+  match t.Ast.t with
+  | Ast.Tname n when class_named ~classes cls n <> None ->
+    Sclass (Option.get (class_named ~classes cls n))
+  | Ast.Tapp ("Option", [ inner ]) ->
+    (match slot_of env ~classes cls fname inner with
+     | (Sval _ | Sclass _) as s -> Sopt s
+     | Sany -> refuse "(Option dyn)"
+     | Sopt _ as s -> refuse ("(Option " ^ slot_text s ^ ")"))
+  | _ ->
+    (match resolve env t with
+     | Types.Dyn -> Sany
+     | (Types.Bool | Types.Int _ | Types.Float _ | Types.String) as t -> Sval t
+     | other -> refuse (Types.to_string other))
+
+(* The type's word in the string the runtime reads: the scalar type's name,
+   [#name] for a class, [?] in front for an Option. See [slot_type_of] in
+   runtime/flan_dyn.c, which is the reader. *)
+let rec slot_word = function
+  | Sany -> ""
+  | Sval t -> Types.to_string t
+  | Sclass c -> "#" ^ c
+  | Sopt s -> "?" ^ slot_word s
 
 (* What the runtime is told a class is: one line per slot, in constructor
-   order, the slot's name and then its type's name after a space — no type
+   order, the slot's name and then its type's word after a space — no type
    for a dyn slot. The same string goes to [flan_dyn_map_new_class] from the
    constructor and to [flan_dyn_class_def] from a reload, so the two cannot
    describe one class differently. *)
-let class_spec_of (slots : (string * Types.t) list) =
+let class_spec_of (slots : (string * slot_ty) list) =
   String.concat "\n"
     (List.map
-       (fun (n, t) ->
-          match t with
-          | Types.Dyn -> n
-          | t -> n ^ " " ^ Types.to_string t)
+       (fun (n, t) -> match t with Sany -> n | t -> n ^ " " ^ slot_word t)
        slots)
 
 let class_slots env n = Hashtbl.find_opt env.classes n
 
+(* A class's slot vector, paired by [pair_params]'s rule with the program's
+   class names counted as types — so [[owner point]] is one slot holding a
+   point.
+
+   A lowercase name after a name that is neither a type nor a class is a
+   second untyped slot, which is the rule for a [defn]'s parameters and is
+   not changed here. In a vector that types none of its slots that is the
+   plain reading — [[x y]] is two slots and says nothing more. In one that
+   types some of them, two untyped names side by side are as likely a type
+   nobody has declared, so that is said, at the second name, and the slot
+   stays what the rule makes it. *)
+let pair_slots env ~classes cls (items : Ast.pitem list) : Ast.field list =
+  let fields =
+    pair_params ~also:(fun n -> class_named ~classes cls n <> None) env items
+  in
+  let untyped (f : Ast.field) =
+    match f.Ast.fty.Ast.t with Ast.Tname "dyn" -> true | _ -> false
+  in
+  let written_dyn =
+    List.exists (function Ast.Pname ("dyn", _) -> true | _ -> false) items
+  in
+  if List.exists (fun f -> not (untyped f)) fields && not written_dyn then begin
+    let rec scan = function
+      | (a : Ast.field) :: ((b : Ast.field) :: _ as rest) ->
+        if untyped a && untyped b then
+          prerr_endline
+            (Loc.entry ~mark:'~' ~label:"warning: " b.Ast.floc
+               (Printf.sprintf
+                  "%s reads as a slot of %s with no type, because no type or \
+                   class is named %s. If it was meant as the type of %s, \
+                   declare it; if it is a slot, write its type or write \
+                   [%s dyn] to say it holds any value"
+                  b.Ast.fname cls b.Ast.fname a.Ast.fname b.Ast.fname));
+        scan rest
+      | _ -> ()
+    in
+    scan fields
+  end;
+  fields
+
 (* Every [defn] in the program, with its parameter vector paired. Run as a pass
    of its own, after the type names are registered and before any signature is
    resolved, so that nothing downstream ever sees an unpaired one. *)
 let pair_decls env (decls : Ast.decl list) : Ast.decl list =
+  let classes =
+    List.filter_map
+      (fun (d : Ast.decl) ->
+         match d.Ast.d with Ast.Defclass (n, _) -> Some n | _ -> None)
+      decls
+  in
   let fn (f : Ast.fn) =
     match f.Ast.praw with
     | None -> f
@@ -1648,11 +1739,11 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
           pairs — [Classes.expand] left the declaration as it was for exactly
           this. *)
        | Ast.Defclass (n, items) ->
-         let slots = pair_params env items in
+         let slots = pair_slots env ~classes n items in
          Hashtbl.replace env.classes n
            (List.map
               (fun (f : Ast.field) ->
-                 (f.Ast.fname, slot_type env n f))
+                 (f.Ast.fname, slot_of env ~classes n f.Ast.fname f.Ast.fty))
               slots);
          Classes.constructor n slots d.Ast.dloc
        | Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) }
@@ -3741,13 +3832,16 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
     (* A class's constructor stores through [flan_dyn_slot_init], which is
        the plain store plus the slot's type check, worded for the
        constructor rather than for a [put] nobody wrote. *)
-    let store = if tag = None then "flan_dyn_map_set" else "flan_dyn_slot_init" in
     let sets =
       List.map
-        (fun (k, v) ->
-           rt loc Types.Unit store
-             [ mval; check ctx ~want:Types.Dyn k;
-               check ctx ~want:Types.Dyn v ])
+        (fun ((k : Ast.expr), v) ->
+           let args =
+             [ mval; check ctx ~want:Types.Dyn k; check ctx ~want:Types.Dyn v ]
+           in
+           (* The key's location is the slot's, in the defclass: the
+              constructor has no other place of its own to name. *)
+           if tag = None then rt loc Types.Unit "flan_dyn_map_set" args
+           else rt loc Types.Unit "flan_dyn_slot_init" (args @ [ here k.Ast.loc ]))
         kvs
     in
     (* A shape tag, if this is the literal a class's constructor was written
@@ -3900,7 +3994,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
     if target.Tast.ty <> Types.Dyn then
       fail loc
         "(get m k) is a place only on a class instance, and this is %s. A \
-         map's entries are written with (put m k v)"
+         map's entries are written with put"
         (Types.to_string target.Tast.ty);
     let k = check ctx ~want:Types.Dyn k in
     let v = check ctx ~want:Types.Dyn v in
diff --git a/lib/dev.ml b/lib/dev.ml
index f620cbf3..172e3325 100644
--- a/lib/dev.ml
+++ b/lib/dev.ml
@@ -1553,8 +1553,8 @@ let defs t =
               List.map
                 (fun (s, ty) ->
                    match ty with
-                   | Types.Dyn -> s
-                   | ty -> s ^ " " ^ Types.to_string ty)
+                   | Check.Sany -> s
+                   | ty -> s ^ " " ^ Check.slot_text ty)
                 slots,
               d.Ast.dloc)
          | _ -> None)
diff --git a/lib/emit.ml b/lib/emit.ml
index aa363a19..cea599bc 100644
--- a/lib/emit.ml
+++ b/lib/emit.ml
@@ -4475,7 +4475,7 @@ declare i64 @flan_dyn_vec_new()
 declare i64 @flan_dyn_map_new()
 declare i64 @flan_dyn_map_new_class(i64, ptr, i64)
 declare void @flan_dyn_slot_set(i64, i64, i64, ptr, i64)
-declare void @flan_dyn_slot_init(i64, i64, i64)
+declare void @flan_dyn_slot_init(i64, i64, i64, ptr, 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)
diff --git a/lib/load.ml b/lib/load.ml
index 069a8808..2bb554c3 100644
--- a/lib/load.ml
+++ b/lib/load.ml
@@ -504,15 +504,21 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
 
        A class's slot names are not renamed. They are keywords in the map the
        constructor builds, and a keyword belongs to nobody — the same line the
-       [MapLit] arm above takes about a map literal's keys. A slot's *type* is
-       a type like any other, and the vector is unpaired, so it goes through
-       [rename_pitem] as a [defn]'s does: a bare symbol the package owns is a
-       type of this package, since no slot name is ever an owned name that
-       matters. The *class's* name is qualified, so [pkg/point] is what an
-       instance's shape tag reads and two packages' [point] classes are two
-       classes. *)
+       [MapLit] arm above takes about a map literal's keys. The vector is
+       unpaired, so a bare symbol in it may be a slot's name, and none is
+       touched; a type written as a form is renamed as any type is. A bare
+       class name in a type position is found by [Check.pair_slots] against
+       the class's own package instead. The *class's* name is qualified, so
+       [pkg/point] is what an instance's shape tag reads and two packages'
+       [point] classes are two classes. *)
     | Ast.Defclass (n, slots) ->
-      Ast.Defclass (qualify alias n, List.map (rename_pitem owned alias) slots)
+      Ast.Defclass
+        (qualify alias n,
+         List.map
+           (function
+             | Ast.Pname _ as p -> p
+             | Ast.Ptype t -> Ast.Ptype (rename_texpr owned alias t))
+           slots)
     (* A generic's parameters are dyn and were written out by the parser, so
        there is no unpaired vector here and [bound] is exactly the parameter
        names. *)
diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c
index 99472218..190b616e 100644
--- a/runtime/flan_dyn.c
+++ b/runtime/flan_dyn.c
@@ -1179,9 +1179,10 @@ flan_dyn flan_dyn_map_new(void) {
  * reason", defers unknown-slot checking — so a key nobody declared can be
  * written to one, and the migration below will *drop* it at the next
  * redefinition, because its rule is that an instance's keys are the class's
- * slots. [set] does refuse one, because a slot it writes has to exist. That is real data loss and it is written down as such in TODO.org,
+ * slots. That is real data loss and it is written down as such in TODO.org,
  * "A redefined defclass migrates its instances lazily", rather than dressed
- * up as enforcement.
+ * up as enforcement. [set] does refuse an undeclared key, because a slot it
+ * writes has to exist.
  *
  * **Where a migration happens.** [want_map], so every [get], [put] and
  * [has-key?]; [flan_dyn_len]'s map arm; and [dyn_equal]'s, so two instances
@@ -1222,15 +1223,20 @@ flan_dyn flan_dyn_map_new(void) {
 flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n);
 
 /* What a slot may hold. A dyn value's tag is the whole of what can be asked
- * of it, so these are the tags, plus a range on top of the int tag for a
- * slot declared with a narrower integer type. [word] is the type as the
- * defclass wrote it, for the sentence a refusal prints. */
-enum { ST_ANY, ST_BOOL, ST_INT, ST_FLOAT, ST_TEXT };
+ * of it, so these are the tags — plus a range on top of the int tag for a
+ * narrower integer type, the significand a float slot holds exactly, a
+ * class for a slot declared with one, and whether nil is admitted, which is
+ * what (Option T) says. [word] is a scalar type's name, for the sentence a
+ * refusal prints. */
+enum { ST_ANY, ST_BOOL, ST_INT, ST_FLOAT, ST_TEXT, ST_CLASS };
 
 typedef struct slot_type {
   uint8_t     kind;
+  uint8_t     opt;          /* nil admitted: (Option T) */
+  uint8_t     fbits;        /* ST_FLOAT: 53 for f64, 24 for f32 */
   int64_t     lo, hi;       /* ST_INT only */
-  const char *word;         /* static; NULL for ST_ANY */
+  kw_entry   *cls;          /* ST_CLASS only */
+  const char *word;         /* static; NULL for ST_ANY and ST_CLASS */
 } slot_type;
 
 typedef struct class_entry {
@@ -1243,6 +1249,9 @@ typedef struct class_entry {
   uint32_t  *warned;
   int64_t    nslots;
   uint32_t   gen;
+  /* Whether any slot has a type. A class with none pays nothing at a store
+   * beyond reading this. */
+  int        typed;
 } class_entry;
 
 static class_entry *classes;
@@ -1264,26 +1273,41 @@ static uint32_t class_gen(kw_entry *name) {
   return e == NULL ? 0u : e->gen;
 }
 
+/* One slot's type, as [Check.class_spec_of] writes it: a scalar type's name,
+ * [#name] for a class, and a leading [?] for an (Option T). */
 static slot_type slot_type_of(const uint8_t *w, int64_t n) {
-  static const struct { const char *w; uint8_t kind; int64_t lo, hi; } known[] = {
-    { "bool", ST_BOOL, 0, 0 },
-    { "string", ST_TEXT, 0, 0 },
-    { "f32", ST_FLOAT, 0, 0 },
-    { "f64", ST_FLOAT, 0, 0 },
-    { "i8", ST_INT, INT8_MIN, INT8_MAX },
-    { "i16", ST_INT, INT16_MIN, INT16_MAX },
-    { "i32", ST_INT, INT32_MIN, INT32_MAX },
-    { "i64", ST_INT, INT64_MIN, INT64_MAX },
-    { "u8", ST_INT, 0, UINT8_MAX },
-    { "u16", ST_INT, 0, UINT16_MAX },
-    { "u32", ST_INT, 0, UINT32_MAX },
-    { "u64", ST_INT, 0, INT64_MAX },
+  static const struct {
+    const char *w; uint8_t kind, fbits; int64_t lo, hi;
+  } known[] = {
+    { "bool", ST_BOOL, 0, 0, 0 },
+    { "string", ST_TEXT, 0, 0, 0 },
+    { "f32", ST_FLOAT, 24, 0, 0 },
+    { "f64", ST_FLOAT, 53, 0, 0 },
+    { "i8", ST_INT, 0, INT8_MIN, INT8_MAX },
+    { "i16", ST_INT, 0, INT16_MIN, INT16_MAX },
+    { "i32", ST_INT, 0, INT32_MIN, INT32_MAX },
+    { "i64", ST_INT, 0, INT64_MIN, INT64_MAX },
+    { "u8", ST_INT, 0, 0, UINT8_MAX },
+    { "u16", ST_INT, 0, 0, UINT16_MAX },
+    { "u32", ST_INT, 0, 0, UINT32_MAX },
+    { "u64", ST_INT, 0, 0, INT64_MAX },
   };
-  slot_type t = { ST_ANY, 0, 0, NULL };
+  slot_type t = { ST_ANY, 0, 0, 0, 0, NULL, NULL };
   size_t i;
+  if (n > 0 && w[0] == '?') {
+    t = slot_type_of(w + 1, n - 1);
+    if (t.kind != ST_ANY) t.opt = 1;
+    return t;
+  }
+  if (n > 1 && w[0] == '#') {
+    t.kind = ST_CLASS;
+    t.cls = dyn_kw(flan_dyn_kw(w + 1, n - 1));
+    return t;
+  }
   for (i = 0; i < sizeof known / sizeof known[0]; i++)
     if ((int64_t)strlen(known[i].w) == n && memcmp(known[i].w, w, (size_t)n) == 0) {
       t.kind = known[i].kind;
+      t.fbits = known[i].fbits;
       t.lo = known[i].lo;
       t.hi = known[i].hi;
       t.word = known[i].w;
@@ -1294,12 +1318,52 @@ static slot_type slot_type_of(const uint8_t *w, int64_t n) {
   return t;
 }
 
-static int slot_fits(const slot_type *t, flan_dyn v) {
+static int slot_type_eq(const slot_type *a, const slot_type *b) {
+  return a->kind == b->kind && a->opt == b->opt && a->fbits == b->fbits
+         && a->lo == b->lo && a->hi == b->hi && a->cls == b->cls;
+}
+
+/* The type as it was written, for a sentence. */
+static void slot_type_text(const slot_type *t, char *buf, size_t cap) {
+  char base[96];
+  if (t->kind == ST_CLASS)
+    snprintf(base, sizeof base, "%.*s", (int)t->cls->len,
+             (const char *)(t->cls + 1));
+  else
+    snprintf(base, sizeof base, "%s", t->word != NULL ? t->word : "dyn");
+  if (t->opt) snprintf(buf, cap, "(Option %s)", base);
+  else snprintf(buf, cap, "%s", base);
+}
+
+/* Whether [v] may be stored in a slot of type [t], and what is stored: [v]
+ * itself, or — for an int into a float slot — the float it widens to. The
+ * widening is the typed side's rule read off the value rather than off a
+ * static type: an integer the float's significand holds exactly is admitted
+ * as that float, and one it does not is refused, as (f64 x) would be for the
+ * type that could hold it. A float into an f32 slot has to be one an f32
+ * holds, which is the typed side refusing f64 into f32. */
+static int slot_admit(const slot_type *t, flan_dyn v, flan_dyn *out) {
   int tag = flan_dyn_tag(v);
+  *out = v;
+  if (t->kind == ST_ANY) return 1;
+  if (tag == FLAN_DYN_TAG_NIL) return t->opt;
   switch (t->kind) {
   case ST_BOOL:  return tag == FLAN_DYN_TAG_BOOL;
   case ST_TEXT:  return tag == FLAN_DYN_TAG_TEXT;
-  case ST_FLOAT: return tag == FLAN_DYN_TAG_FLOAT;
+  case ST_CLASS:
+    return tag == FLAN_DYN_TAG_MAP && dyn_obj(v)->u.v.klass == t->cls;
+  case ST_FLOAT:
+    if (tag == FLAN_DYN_TAG_FLOAT) {
+      double d = dyn_num_value(v);
+      return t->fbits == 53 || d != d || (double)(float)d == d;
+    }
+    if (tag == FLAN_DYN_TAG_INT) {
+      int64_t x = dyn_int_value(v), lim = (int64_t)1 << t->fbits;
+      if (x < -lim || x > lim) return 0;
+      *out = flan_dyn_from_f64((double)x);
+      return 1;
+    }
+    return 0;
   case ST_INT: {
     int64_t x;
     if (tag != FLAN_DYN_TAG_INT) return 0;
@@ -1310,6 +1374,11 @@ static int slot_fits(const slot_type *t, flan_dyn v) {
   }
 }
 
+static int slot_fits(const slot_type *t, flan_dyn v) {
+  flan_dyn ignored;
+  return slot_admit(t, v, &ignored);
+}
+
 /* A class's slots as the compiler hands them over: one line per slot, the
  * slot's name and then, after a space, its type's name — nothing for a slot
  * written with no type. The same string comes from a constructor and from a
@@ -1365,6 +1434,12 @@ static void class_add(kw_entry *k, kw_entry **list, slot_type *types,
   if (count > 0 && classes[classes_n].warned == NULL)
     trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t));
   classes[classes_n].nslots = count;
+  classes[classes_n].typed = 0;
+  {
+    int64_t j;
+    for (j = 0; j < count; j++)
+      if (types[j].kind != ST_ANY) classes[classes_n].typed = 1;
+  }
   /* One, never zero: an instance built before this registration carries zero
    * and has to be seen as stale, because the definition it was built from is
    * exactly the one nobody recorded. */
@@ -1401,8 +1476,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
     int same = e->nslots == count;
     if (same)
       for (i = 0; i < count; i++)
-        if (e->slots[i] != list[i] || e->types[i].kind != types[i].kind
-            || e->types[i].lo != types[i].lo || e->types[i].hi != types[i].hi) {
+        if (e->slots[i] != list[i] || !slot_type_eq(&e->types[i], &types[i])) {
           same = 0;
           break;
         }
@@ -1417,6 +1491,9 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
     if (count > 0 && e->warned == NULL)
       trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t));
     e->nslots = count;
+    e->typed = 0;
+    for (i = 0; i < count; i++)
+      if (types[i].kind != ST_ANY) e->typed = 1;
     /* Wrapping is not a correctness question — what matters is that the new
      * generation differs from the one the live instances carry — but zero is
      * reserved for "no definition registered", so it is stepped over. */
@@ -1522,11 +1599,49 @@ static void class_hook(flan_obj *o, flan_dyn inst, flan_dyn added,
   }
 }
 
+/* An entry at the end of a map, with no lookup first: for a map whose keys
+ * are known to be distinct already. A lookup compares keys with [dyn_equal],
+ * which migrates any stale instance it meets and runs that instance's hook —
+ * and a migration building its own hook's arguments must not start another
+ * one, or the instance it is migrating is migrated again inside itself. */
+static void map_append(flan_obj *m, flan_dyn k, flan_dyn v) {
+  if (m->len == m->u.v.cap) {
+    int64_t cap = m->u.v.cap ? m->u.v.cap * 2 : 8;
+    flan_dyn *items =
+      (flan_dyn *)realloc(m->u.v.items, (size_t)cap * 2 * sizeof *items);
+    if (items == NULL) trap_oom(NULL, 0, cap * 2 * (int64_t)sizeof *items);
+    gc_bytes += (cap - m->u.v.cap) * 2 * (int64_t)sizeof *items;
+    m->u.v.items = items;
+    m->u.v.cap = cap;
+  }
+  m->u.v.items[m->len * 2] = k;
+  m->u.v.items[m->len * 2 + 1] = v;
+  m->len++;
+}
+
+/* Which of [o]'s entries is the slot [s], or -1. The interned identity
+ * compare, never [dyn_equal]: see [map_append]. [flan_dyn_tag] and not a
+ * bare [dyn_box]: a float is not boxed at all, so its payload bits can read
+ * as any box tag, and reading a non-keyword's payload as a [kw_entry *] is a
+ * wild pointer. A raw [put] can have left a float — or anything else — as a
+ * key. */
+static int64_t entry_of(flan_obj *o, kw_entry *s) {
+  int64_t i;
+  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) == s)
+      return i;
+  }
+  return -1;
+}
+
 /* 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
- * property CLHS 4.3.6 guarantees, matched by name, with the instance's
- * identity preserved because none of this allocates a new object.
+ * has — which is the property CLHS 4.3.6 guarantees, matched by name, with
+ * the instance's identity preserved because none of this allocates a new
+ * object. A slot it has just gained holds its type's zero value, Flan's
+ * zero-is-initialisation — false, 0, 0.0, the empty string — or nil where
+ * the type admits nil or has no zero: a dyn slot, an (Option T), a class.
  *
  * Rebuilt into a fresh block rather than compacted in place, and the order is
  * the class's rather than the instance's, so that a migrated instance is
@@ -1535,120 +1650,145 @@ static void class_hook(flan_obj *o, flan_dyn inst, flan_dyn added,
  * and count in insertion order and would have. One malloc per instance per
  * redefinition is the price, and a migration happens once.
  *
- * The name-matching allocates nothing on the collector's heap, so no
- * 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.
+ * In three steps, and the order is what keeps it sound.
  *
- * 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
- * re-entry through a nested [dyn_equal], including a map used as a key of
- * itself, finds [o] already current and returns at the generation compare.
- * The key scan here uses the interned identity compare and calls
- * [dyn_equal] not at all, so it cannot re-enter from inside. */
-static void class_sync(flan_obj *o) {
-  class_entry *e;
+ * First, everything that allocates on the collector's heap: the hook's
+ * arguments, and an empty string for a gained string slot. A collection may
+ * run here, while [o] still holds its old entries whole. Nothing in this
+ * step compares a key with [dyn_equal] — see [map_append] — so nothing in it
+ * can migrate another instance and run a hook inside this migration.
+ *
+ * Second, the name-matching, which allocates nothing on the collector's
+ * heap, calls nothing that can migrate, and finishes by stamping [o]
+ * current. [e] is read only up to here: a hook may build an instance of a
+ * class the registry has not seen, and adding it moves [classes].
+ *
+ * Third, the hook, on an instance that is already current, so a method that
+ * reads or writes it finds it migrated and does not start a second
+ * migration. A method may touch anything, including a map something above
+ * this frame is walking; the migration of [o] itself is finished before it
+ * runs. */
+/* Kept out of line: inlined into [class_sync], its frame and saved
+ * registers were paid on every [get] and [put] of every map, current or not
+ * — measured at about a tenth of an untyped [put]'s instructions. */
+__attribute__((noinline))
+static void class_migrate(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 i, j, n;
+  /* Rooted by address for as long as they may be needed: each is a
+   * collector object held nowhere else. */
+  flan_dyn inst, added, gone, empty;
   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;
+  int hook, need_empty = 0;
+  n = e->nslots;
   /* 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;
+  for (j = 0; j < n; j++)
+    if (e->types[j].kind == ST_TEXT && !e->types[j].opt
+        && entry_of(o, e->slots[j]) < 0)
+      need_empty = 1;
   inst = dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
-  added = gone = dyn_make(BOX_NIL, 0);
+  added = gone = empty = dyn_make(BOX_NIL, 0);
+  if (hook || need_empty) root_add(&inst, NULL);
+  if (need_empty) {
+    empty = flan_dyn_from_bytes((const uint8_t *)"", 0);
+    root_add(&empty, NULL);
+  }
   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)
+    for (j = 0; j < n; j++)
+      if (entry_of(o, e->slots[j]) < 0)
         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. */
+     * CLHS's discarded slots and their property list, as one map. [o]'s
+     * keys are distinct, so these are, and they are appended as they are. */
     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++)
+        for (j = 0; j < n; 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 (!kept) map_append(dyn_obj(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);
+  if (n > 0) {
+    fresh = (flan_dyn *)malloc((size_t)n * 2 * sizeof *fresh);
+    if (fresh == NULL) trap_oom(NULL, 0, n * 2 * (int64_t)sizeof *fresh);
   }
-  for (j = 0; j < e->nslots; j++) {
-    flan_dyn v = dyn_make(BOX_NIL, 0);
-    for (i = 0; i < o->len; i++) {
-      flan_dyn key = o->u.v.items[i * 2];
-      /* [flan_dyn_tag] and not a bare [dyn_box]: a float is not boxed at
-         all, so its payload bits can read as any box tag, and reading a
-         non-keyword's payload as a [kw_entry *] is a wild pointer. A raw
-         [put] can have left a float — or anything else — in here. */
-      if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD
-          && dyn_kw(key) == e->slots[j]) {
-        v = o->u.v.items[i * 2 + 1];
-        /* A kept value that the slot's new type does not admit is kept
-           anyway: throwing it away would be the data loss a redefinition
-           exists to avoid, and there is nothing to convert it to. What it
-           gets is a warning, once per slot per redefinition, and the next
-           write to the slot is checked like any other. A slot the class
-           has only just gained holds nil without a word: it holds nothing,
-           rather than something of the wrong type. */
-        if (!slot_fits(&e->types[j], v) && e->warned[j] != e->gen) {
-          char sv[SAY_MAX];
-          kw_entry *c = o->u.v.klass, *sl = e->slots[j];
-          e->warned[j] = e->gen;
-          say(sv, SAY_MAX, v);
-          fflush(stdout);
-          fprintf(stderr,
-                  "warning: %.*s was redefined, and its slot :%.*s is now "
-                  "declared %s. An instance holds %s there, which is %s; it "
-                  "keeps that value, and the next write to :%.*s is checked\n",
-                  (int)c->len, (const char *)(c + 1),
-                  (int)sl->len, (const char *)(sl + 1), e->types[j].word, sv,
-                  tag_of(v), (int)sl->len, (const char *)(sl + 1));
-        }
-        break;
+  for (j = 0; j < n; j++) {
+    const slot_type *t = &e->types[j];
+    flan_dyn v;
+    i = entry_of(o, e->slots[j]);
+    if (i >= 0) {
+      v = o->u.v.items[i * 2 + 1];
+      /* A kept value that the slot's new type does not admit is kept
+         anyway: throwing it away would be the data loss a redefinition
+         exists to avoid, and there is nothing to convert it to. What it
+         gets is a warning, once per slot per redefinition, and the next
+         write to the slot is checked like any other. */
+      if (!slot_fits(t, v) && e->warned[j] != e->gen) {
+        char sv[SAY_MAX], st[128];
+        kw_entry *c = o->u.v.klass, *sl = e->slots[j];
+        e->warned[j] = e->gen;
+        say(sv, SAY_MAX, v);
+        slot_type_text(t, st, sizeof st);
+        fflush(stdout);
+        fprintf(stderr,
+                "warning: %.*s was redefined, and its slot :%.*s is now "
+                "declared %s. An instance holds %s there, which is %s; it "
+                "keeps that value, and the next write to :%.*s is checked\n",
+                (int)c->len, (const char *)(c + 1),
+                (int)sl->len, (const char *)(sl + 1), st, sv,
+                tag_of(v), (int)sl->len, (const char *)(sl + 1));
       }
     }
+    else if (t->opt) v = dyn_make(BOX_NIL, 0);
+    else
+      switch (t->kind) {
+      case ST_BOOL:  v = flan_dyn_from_bool(0); break;
+      case ST_INT:   v = flan_dyn_from_i64(0); break;
+      case ST_FLOAT: v = flan_dyn_from_f64(0.0); break;
+      case ST_TEXT:  v = empty; break;
+      default:       v = dyn_make(BOX_NIL, 0); break;
+      }
     fresh[j * 2] = dyn_make(BOX_KW, (uint64_t)(uintptr_t)e->slots[j]);
     fresh[j * 2 + 1] = v;
   }
   /* Charged the way [map_set]'s growth is, in both directions: a class that
    * lost slots gives the bytes back, or the trigger drifts up by whatever
    * every migration in the program ever released. */
-  gc_bytes += (e->nslots - o->u.v.cap) * 2 * (int64_t)sizeof(flan_dyn);
+  gc_bytes += (n - o->u.v.cap) * 2 * (int64_t)sizeof(flan_dyn);
   free(o->u.v.items);
   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->u.v.cap = n;
+  o->len = n;
   o->gen = e->gen;
-  if (hook) class_hook(o, inst, added, gone, e->nslots);
+  e = NULL;
+  if (hook) class_hook(o, inst, added, gone, n);
   roots_n = roots_at;
 }
 
+/* Every read or write of an instance comes through here first: the class's
+ * entry, with [o] migrated to it if it was stale, or NULL for a map with no
+ * class. The common case — current — is a lookup and a compare, and the
+ * migration is a call of its own so that it stays out of the way. The entry
+ * is looked up again after one, because a hook may have moved the table. */
+static class_entry *class_sync(flan_obj *o) {
+  class_entry *e;
+  if (o->kind != OBJ_MAP || o->u.v.klass == NULL) return NULL;
+  e = class_find(o->u.v.klass);
+  if (e == NULL || e->gen == o->gen) return e;
+  class_migrate(o, e);
+  return class_find(o->u.v.klass);
+}
+
 /* The same map with a shape tag on it: what a (defclass ...) constructor
  * calls. [k] is a keyword and anything else traps by name — the compiler
  * hands it the class's own name and nothing else can reach this.
@@ -2563,20 +2703,27 @@ enum { BY_PUT, BY_SET, BY_NEW };
 static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
                                      int by, flan_obj *o, class_entry *e,
                                      int64_t j, flan_dyn m, flan_dyn v) {
-  char sm[SAY_MAX], sv[SAY_MAX];
+  char sm[SAY_MAX], sv[SAY_MAX], st[128];
+  const slot_type *t = &e->types[j];
   kw_entry *sl = e->slots[j], *c = o->u.v.klass;
   int sn = (int)sl->len, cn = (int)c->len;
   const char *ss = (const char *)(sl + 1), *cs = (const char *)(c + 1);
   say(sm, SAY_MAX, m);
   say(sv, SAY_MAX, v);
+  slot_type_text(t, st, sizeof st);
   fflush(stdout);
   trap_where(loc, loclen);
   fprintf(stderr, "dyn %s: the slot :%.*s of %.*s is declared %s, and ",
           by == BY_PUT ? "put" : by == BY_SET ? "set" : "construct", sn, ss,
-          cn, cs, e->types[j].word);
-  /* An int of the wrong size is the right tag, so the tag is not the news. */
-  if (e->types[j].kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT)
-    fprintf(stderr, "%s is outside its range — ", sv);
+          cn, cs, st);
+  /* A number of the right kind that does not fit is not news about its tag. */
+  if ((t->kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT)
+      || (t->kind == ST_FLOAT
+          && (flan_dyn_tag(v) == FLAN_DYN_TAG_INT
+              || flan_dyn_tag(v) == FLAN_DYN_TAG_FLOAT)))
+    fprintf(stderr, "%s is not a value it holds exactly — ", sv);
+  else if (t->kind == ST_CLASS && flan_dyn_tag(v) == FLAN_DYN_TAG_MAP)
+    fprintf(stderr, "this is not an instance of it — ");
   else
     fprintf(stderr, "this is %s — ", tag_of(v));
   if (by == BY_PUT)
@@ -2588,26 +2735,32 @@ static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
   flan_trap((const uint8_t *)"DynType", 7);
 }
 
-static void check_slot(const uint8_t *loc, int64_t loclen, int by,
-                       flan_obj *o, flan_dyn m, flan_dyn k, flan_dyn v) {
-  class_entry *e;
+/* The value a store into [o] under [k] actually stores: [v], or the float an
+ * int widens to in a float slot. A class with no typed slot answers at its
+ * flag, and a map with no class before that. */
+static flan_dyn check_slot(const uint8_t *loc, int64_t loclen, int by,
+                           flan_obj *o, class_entry *e, flan_dyn m,
+                           flan_dyn k, flan_dyn v) {
   int64_t j;
-  if (o->u.v.klass == NULL) return;
-  e = class_find(o->u.v.klass);
+  flan_dyn out;
+  if (e == NULL || !e->typed) return v;
   j = class_slot(e, k);
-  if (j >= 0 && !slot_fits(&e->types[j], v))
+  if (j < 0) return v;
+  if (!slot_admit(&e->types[j], v, &out))
     trap_slot_type(loc, loclen, by, o, e, j, m, v);
+  return out;
 }
 
-static void map_store(flan_obj *o, flan_dyn k, flan_dyn v);
+static inline void map_store(flan_obj *o, flan_dyn k, flan_dyn v);
 
 /* A constructor's stores: [flan_dyn_map_set]'s, with the refusal worded for
  * the constructor call it happened inside rather than for a [put] nobody
- * wrote. */
-void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v) {
+ * wrote, and placed at the slot's declaration. */
+void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v,
+                        const uint8_t *loc, int64_t loclen) {
   flan_obj *o = want_map("construct", m, k);
-  check_slot(NULL, 0, BY_NEW, o, m, k, v);
-  map_store(o, k, v);
+  class_entry *e = o->u.v.klass == NULL ? NULL : class_find(o->u.v.klass);
+  map_store(o, k, check_slot(loc, loclen, BY_NEW, o, e, m, k, v));
 }
 
 /* (set (get inst :slot) v). Three refusals, each its own sentence, because
@@ -2621,6 +2774,7 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
   flan_obj *o;
   class_entry *e;
   int64_t j;
+  flan_dyn out;
   if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) {
     char sm[SAY_MAX];
     say(sm, SAY_MAX, m);
@@ -2628,15 +2782,13 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
     trap_where(loc, loclen);
     fprintf(stderr,
             "dyn set: (get m k) is a place only on a class instance, and "
-            "this is %s%s — %s. A map's entries are written with "
-            "(put m k v)\n",
+            "this is %s%s — %s. A map's entries are written with put\n",
             is_map(m) ? "a map with no class" : "a ",
             is_map(m) ? "" : tag_of(m), sm);
     flan_trap((const uint8_t *)"DynType", 7);
   }
   o = dyn_obj(m);
-  class_sync(o);
-  e = class_find(o->u.v.klass);
+  e = class_sync(o);
   j = class_slot(e, k);
   if (j < 0) {
     char sk[SAY_MAX];
@@ -2652,23 +2804,24 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
       for (i = 0; i < e->nslots; i++)
         fprintf(stderr, " :%.*s", (int)e->slots[i]->len,
                 (const char *)(e->slots[i] + 1));
-    fprintf(stderr, "; a key the class does not declare is written with "
-                    "(put inst k v)\n");
+    fprintf(stderr, "; a key the class does not declare is added with put, "
+                    "not set\n");
     flan_trap((const uint8_t *)"DynType", 7);
   }
-  if (!slot_fits(&e->types[j], v))
+  if (!slot_admit(&e->types[j], v, &out))
     trap_slot_type(loc, loclen, BY_SET, o, e, j, m, v);
-  map_store(o, k, v);
+  map_store(o, k, out);
 }
 
-/* [put]: a key the class declares is checked against its type, and the
- * refusal names [loc]. A key it does not declare is let through: an
- * instance is an open map to [put], and the next redefinition drops such a
- * key — see "Classes" above. */
 void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc,
                       int64_t loclen) {
-  flan_obj *o = want_map("put", m, k);
-  check_slot(loc, loclen, BY_PUT, o, m, k, v);
+  flan_obj *o;
+  class_entry *e;
+  if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, "put", "only a map answers it", m, k);
+  o = dyn_obj(m);
+  e = class_sync(o);
+  /* A map with no class, and a class with no typed slot, stop at the test. */
+  if (e != NULL && e->typed) v = check_slot(loc, loclen, BY_PUT, o, e, m, k, v);
   map_store(o, k, v);
 }
 
@@ -2678,7 +2831,7 @@ void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) {
 }
 
 /* The store under all three, with the instance already brought up to date. */
-static void map_store(flan_obj *o, flan_dyn k, flan_dyn v) {
+static inline void map_store(flan_obj *o, flan_dyn k, flan_dyn v) {
   int64_t i = map_find(o, k);
   if (i >= 0) {
     o->u.v.items[i * 2 + 1] = v;
diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h
index df8020e5..077107a1 100644
--- a/runtime/flan_dyn.h
+++ b/runtime/flan_dyn.h
@@ -92,7 +92,8 @@ flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n);
 
 /* A constructor's store into a slot, checked against the slot's declared
  * type — [flan_dyn_map_set] with a refusal worded for the constructor. */
-void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v);
+void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v,
+                        const uint8_t *loc, int64_t loclen);
 
 /* (set (get inst :slot) v): [m] must be a class instance and [k] a slot its
  * class declares, and [v] must fit the slot's type; each is a trap with its
diff --git a/test/dyn_ops.c b/test/dyn_ops.c
index c4f4d292..70f05f61 100644
--- a/test/dyn_ops.c
+++ b/test/dyn_ops.c
@@ -1238,6 +1238,89 @@ static void classes(void) {
   printf(failures == 0 ? "classes ok\n" : "classes failed\n");
 }
 
+/* ── update-instance-for-redefined-class, re-entered ─────────────────
+ *
+ * The hook is Flan in a program; here it is C, installed where the agent
+ * installs its caller, which is the same call from flan_dyn.c's side. Three
+ * stale instances, the first holding the other two as keys of raw [put]s, so
+ * building the first one's discarded map is where a lookup would compare
+ * them — and migrate them, and run their hooks, inside the first one's
+ * migration. The hook itself touches the first instance and builds
+ * instances of classes the registry has not seen, which grows it and moves
+ * it under any migration still holding an entry. Each instance's hook runs
+ * once, and the discarded map holds both instance keys. Clean under
+ * memcheck is the other half of the claim, and is what @valgrind's run of
+ * this mode says. */
+extern int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance, uint64_t added,
+                             uint64_t discarded);
+void flan_dyn_class_hook(void *fn);
+
+static flan_dyn hk_p, hk_q, hk_r;
+static int hk_runs_p, hk_runs_q, hk_runs_r, hk_fresh;
+static int64_t hk_gone_len = -1;
+
+static int hk_call(void *fn, uint64_t instance, uint64_t added,
+                   uint64_t discarded) {
+  char name[16];
+  int i;
+  (void)fn;
+  (void)added;
+  if (instance == hk_p) {
+    hk_runs_p++;
+    hk_gone_len = flan_dyn_need_i64(flan_dyn_len(discarded));
+  }
+  if (instance == hk_q) hk_runs_q++;
+  if (instance == hk_r) hk_runs_r++;
+  (void)slot(hk_p, "x");
+  for (i = 0; i < 20; i++) {
+    snprintf(name, sizeof name, "fresh%d", hk_fresh++);
+    (void)flan_dyn_map_new_class(
+      flan_dyn_kw((const uint8_t *)name, (int64_t)strlen(name)),
+      (const uint8_t *)"a", 1);
+  }
+  return 0;
+}
+
+static void hook_reentry(void) {
+  flan_dyn_root_push(&hk_p);
+  flan_dyn_root_push(&hk_q);
+  flan_dyn_root_push(&hk_r);
+  define("pt", "x\ny");
+  hk_p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"pt", 2),
+                                (const uint8_t *)"x\ny", 3);
+  hk_q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"pt", 2),
+                                (const uint8_t *)"x\ny", 3);
+  hk_r = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"pt", 2),
+                                (const uint8_t *)"x\ny", 3);
+  flan_dyn_map_set(hk_p, flan_dyn_kw((const uint8_t *)"x", 1),
+                   flan_dyn_from_i64(1));
+  /* Distinct, or they are one key: instances compare by their slots. */
+  flan_dyn_map_set(hk_q, flan_dyn_kw((const uint8_t *)"x", 1),
+                   flan_dyn_from_i64(2));
+  flan_dyn_map_set(hk_r, flan_dyn_kw((const uint8_t *)"x", 1),
+                   flan_dyn_from_i64(3));
+  flan_dyn_map_set(hk_p, hk_q, flan_dyn_from_i64(2));
+  flan_dyn_map_set(hk_p, hk_r, flan_dyn_from_i64(3));
+  flan_dyn_migrate_hook = hk_call;
+  flan_dyn_class_hook((void *)hk_call);
+  define("pt", "x\ny\nz");
+  check(flan_dyn_need_i64(slot(hk_p, "x")) == 1, "a kept slot after a re-entered hook");
+  check(hk_runs_p == 1, "the first instance's hook ran once");
+  check(hk_runs_q == 0 && hk_runs_r == 0,
+        "building the first instance's arguments migrated no other instance");
+  check(hk_gone_len == 2, "the discarded map holds both instance keys");
+  (void)slot(hk_q, "x");
+  (void)slot(hk_r, "x");
+  (void)slot(hk_q, "x");
+  check(hk_runs_q == 1 && hk_runs_r == 1,
+        "each other instance runs its hook once, at its own first touch");
+  check(hk_runs_p == 1, "and the first instance's did not run again");
+  flan_dyn_migrate_hook = NULL;
+  flan_dyn_class_hook(NULL);
+  flan_dyn_root_pop(3);
+  printf(failures == 0 ? "hook ok\n" : "hook failed\n");
+}
+
 int main(int argc, char **argv) {
   flan_rt_init(argc, argv);
   if (argc < 2) {
@@ -1255,6 +1338,10 @@ int main(int argc, char **argv) {
   if (strcmp(argv[1], "unrooted") == 0) { unrooted(); return 0; }
   if (strcmp(argv[1], "park") == 0) { park(); return 0; }
   if (strcmp(argv[1], "desc") == 0) { desc(); return 0; }
+  if (strcmp(argv[1], "hook") == 0) {
+    hook_reentry();
+    return failures == 0 ? 0 : 1;
+  }
   if (strcmp(argv[1], "classes") == 0) {
     classes();
     return failures == 0 ? 0 : 1;
diff --git a/test/programs/dyn-class-slots.flan b/test/programs/dyn-class-slots.flan
index ea38ef7e..04c875d9 100644
--- a/test/programs/dyn-class-slots.flan
+++ b/test/programs/dyn-class-slots.flan
@@ -12,6 +12,9 @@
 
 (defclass state [pause bool step i32 speed f64 name string tag])
 
+;; A class is a slot type, and (Option T) admits nil beside a T.
+(defclass node [owner state next (Option node) weight (Option f32)])
+
 (defn twelve [] i64 12)
 
 (defn main [] i32
@@ -34,5 +37,14 @@
     (println (length s))
     ;; A typed caller boxes into the dyn parameter as any call does.
     (set (get s :step) (twelve))
-    (println (get s :step)))
+    (println (get s :step))
+    ;; An int into a float slot widens, as it does into a typed f64
+    ;; parameter, when the float holds it exactly.
+    (put s :speed 3)
+    (println (+ (get s :speed) 0.5))
+    (let [n (node s nil nil)]
+      (set (get n :next) (node s nil 2))
+      (println (get (get n :next) :weight))
+      (set (get n :weight) nil)
+      (println (class-of (get n :owner)))))
   0)
diff --git a/test/programs/dyn-slot-trap.flan b/test/programs/dyn-slot-trap.flan
index 15a025ca..890489bc 100644
--- a/test/programs/dyn-slot-trap.flan
+++ b/test/programs/dyn-slot-trap.flan
@@ -2,6 +2,7 @@
 ;;;; process. The argument chooses which. The line numbers are asserted by
 ;;;; the test, so an edit above them moves them.
 (defclass state [pause bool step i32 tag])
+(defclass node [owner state])
 
 (defn as-dyn [d dyn] dyn d)
 
@@ -14,5 +15,7 @@
       (= which 1) (put s :pause 1)
       (= which 2) (set (get s :step) 5000000000)
       (= which 3) (set (get s :paws) true)
-      :else (set (get (as-dyn {:pause 1}) :pause) true)))
+      (= which 4) (set (get (as-dyn {:pause 1}) :pause) true)
+      (= which 5) (println (node (node s)))
+      :else (println (state nil 1 2))))
   0)
diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml
index d9853976..c913eff1 100644
--- a/test/test_acceptance.ml
+++ b/test/test_acceptance.ml
@@ -5069,7 +5069,7 @@ level "1"
        whose arguments the two emit separately. *)
     let slots_out =
       "#state{ :pause false :step 3 :speed 1.5 :name \"sand\" :tag :x}\n\
-       true\n-7\n[ 1 2]\n2.5\n9\n6\n12\n"
+       true\n-7\n[ 1 2]\n2.5\n9\n6\n12\n3.5\n2\n:state\n"
     in
     outputs "dyn: typed class slots" "programs/dyn-class-slots.flan" slots_out;
     outputs ~x86:true "dyn: typed class slots, --x86"
@@ -5087,16 +5087,23 @@ level "1"
                (match x86 with Some true -> ", --x86" | _ -> "")
                text code want
            end)
-        [ ("0", "dyn construct: the slot :pause of state is declared bool, \
-                 and this is int — (state ...) with :pause 1");
-          ("1", "dyn-slot-trap.flan:14:19: dyn put: the slot :pause of state \
+        [ ("0", "dyn-slot-trap.flan:4:18: dyn construct: the slot :pause of \
+                 state is declared bool, and this is int — (state ...) with \
+                 :pause 1");
+          ("1", "dyn-slot-trap.flan:15:19: dyn put: the slot :pause of state \
                  is declared bool, and this is int");
-          ("2", "dyn-slot-trap.flan:15:19: dyn set: the slot :step of state \
-                 is declared i32, and 5000000000 is outside its range");
-          ("3", "dyn-slot-trap.flan:16:19: dyn set: state has no slot :paws. \
-                 Its slots are :pause :step :tag");
-          ("4", "dyn-slot-trap.flan:17:13: dyn set: (get m k) is a place only \
-                 on a class instance, and this is a map with no class") ];
+          ("2", "dyn-slot-trap.flan:16:19: dyn set: the slot :step of state \
+                 is declared i32, and 5000000000 is not a value it holds \
+                 exactly");
+          ("3", "dyn-slot-trap.flan:17:19: dyn set: state has no slot :paws. \
+                 Its slots are :pause :step :tag; a key the class does not \
+                 declare is added with put, not set");
+          ("4", "dyn-slot-trap.flan:18:19: dyn set: (get m k) is a place only \
+                 on a class instance, and this is a map with no class");
+          ("5", "dyn-slot-trap.flan:5:17: dyn construct: the slot :owner of \
+                 node is declared state, and this is not an instance of it");
+          ("6", "dyn-slot-trap.flan:4:18: dyn construct: the slot :pause of \
+                 state is declared bool, and this is nil") ];
       (try Sys.remove exe with Sys_error _ -> ())
     in
     slot_trap ();
diff --git a/test/test_dev.ml b/test/test_dev.ml
index fedb3196..4af6b6f5 100644
--- a/test/test_dev.ml
+++ b/test/test_dev.ml
@@ -8062,10 +8062,16 @@ let () =
                "(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])"
+               "(defclass point [x string radius z n i32 note string])"
           then begin
             holds "a value that no longer fits is kept"
               "(if (= (get (at instances 0) :x) 3) 1 0)";
+            (* A typed slot gained by the redefinition starts at its type's
+               zero value, as a typed binding does, and not at nil. *)
+            holds "a gained i32 slot is 0"
+              "(if (= (get (at instances 0) :n) 0) 1 0)";
+            holds "a gained string slot is empty"
+              "(if (= (get (at instances 0) :note) \"\") 1 0)";
             let warned () =
               contains_sub (output ())
                 "warning: point was redefined, and its slot :x is now \
diff --git a/test/test_dyn.ml b/test/test_dyn.ml
index 8152b9cf..f2a01e8d 100644
--- a/test/test_dyn.ml
+++ b/test/test_dyn.ml
@@ -154,6 +154,14 @@ let () =
     if code <> 0 || out <> "classes ok\n" then
       fail "redefining a class\n        got: %S (exit %d, err %S)" out code err;
 
+    (* A migration's hook re-entered from the building of its own
+       arguments, and a hook that grows the class registry under it — see
+       dyn_ops.c's [hook_reentry]. *)
+    let code, out, err = run "hook" in
+    if code <> 0 || out <> "hook ok\n" then
+      fail "a re-entered migration hook\n        got: %S (exit %d, err %S)"
+        out code err;
+
     let code, out, _ = run "nested" in
     if code <> 0 || out <> "chain of 64 intact: yes\n" then
       fail "a chain of nested vecs\n        got: %S (exit %d)" out code;
diff --git a/test/test_flan.ml b/test/test_flan.ml
index 3c5f016e..7a918afc 100644
--- a/test/test_flan.ml
+++ b/test/test_flan.ml
@@ -2718,6 +2718,13 @@ let () =
   accepts "typed slots, and untyped ones beside them"
     "(defclass state [pause bool step bool n i32 tag])\n\
      (defn main [] i32 (let [s (state false true 3 :x)] (if (= (get s :n) 3) 0 1)))";
+  accepts "a class and an Option as slot types"
+    "(defclass point [x f64])\n\
+     (defclass node [at point next (Option node) w (Option i32)])\n\
+     (defn main [] i32 (let [n (node (point 1) nil nil)] 0))";
+  rejects_check "an Option of dyn is not a slot type"
+    "(defclass point [x (Option dyn)])\n(defn main [] i32 0)"
+    ~needle:"the slot x of point is declared (Option dyn)";
   rejects_check "a slot's type is one a dyn value can be checked as"
     "(defclass point [x (Ptr i64)])\n(defn main [] i32 0)"
     ~needle:"the slot x of point is declared (Ptr i64)";
@@ -3828,7 +3835,7 @@ let () =
      than as a milestone that will never arrive. *)
   rejects_check "a map entry as a place"
     "(defn f [m (Map i64 i64)] () (set (get m 1) 2))"
-    ~needle:"entries are written with (put m k v)";
+    ~needle:"entries are written with put";
   rejects_check "get with three arguments is not a place"
     "(defn f [m dyn] () (set (get m 1 2) 2))"
     ~needle:"a map is written with (put m k v)";
diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml
index cc0b2626..a4b13462 100644
--- a/test/test_sanitize.ml
+++ b/test/test_sanitize.ml
@@ -343,7 +343,7 @@ let dyn_sweep () =
          the old block, or a [len] that outlived the block it described,
          is a use-after-free here and nothing anywhere else. *)
       [ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing"; "park";
-        "classes" ];
+        "classes"; "hook" ];
     (try Sys.remove exe with Sys_error _ -> ())
 
 (* A third sweep, over a handful of the same programs built [--dev].
diff --git a/web/index.html b/web/index.html
index de3a897e..d033e7da 100644
--- a/web/index.html
+++ b/web/index.html
@@ -714,7 +714,8 @@ slots, and a slot may be followed by a type, the way a parameter is:
 [x y] is two slots that hold any value, and [pause bool]
 is one that holds only a bool. The type is checked whenever a value is stored,
 and a slot may be bool, an integer type, f32,
-f64 or string. The constructor is the class's own name
+f64, string, a class, or (Option T) of one of
+those, which also admits nil. The constructor is the class's own name
 and is positional, and class-of answers the tag, or nil
 for anything that is not an instance. The slots are map keys: get
 reads one, and set writes one, as in

From 53880eb685fe0df99bc160e4b289eb8b906b39f4 Mon Sep 17 00:00:00 2001
From: Joseph Ferano 
Date: Fri, 25 Sep 2026 13:29:30 +0700
Subject: [PATCH 4/4] A class slot's type names its own package's class first,
 an int widens into a float slot exactly when it round-trips, and a
 constructor's refusal names the call that was wrong

---
 TODO.org                           |  4 +--
 lib/check.ml                       | 30 ++++++++++++++++++++--
 lib/classes.ml                     |  3 ++-
 lib/emit.ml                        |  1 +
 runtime/flan_dyn.c                 | 41 +++++++++++++++++++++++++-----
 runtime/flan_dyn.h                 |  8 +++++-
 test/daemon-x86.out                |  2 ++
 test/dyn_ops.c                     | 26 +++++++++++++++++--
 test/programs/dyn-class-pkg.flan   |  8 ++++++
 test/programs/dyn-class-slots.flan |  5 ++++
 test/programs/pkgs/geo/geo.flan    |  5 ++++
 test/test_acceptance.ml            | 13 ++++++----
 web/index.html                     |  4 ++-
 13 files changed, 130 insertions(+), 20 deletions(-)
 create mode 100644 test/daemon-x86.out
 create mode 100644 test/programs/dyn-class-pkg.flan
 create mode 100644 test/programs/pkgs/geo/geo.flan

diff --git a/TODO.org b/TODO.org
index cc99b747..0bdbe22f 100644
--- a/TODO.org
+++ b/TODO.org
@@ -2041,8 +2041,8 @@ them.
 
 ** DONE defclass slots take types, checked on write
 CLOSED: [2026-09-25]
-The constructor's parameters stay dyn and every store checks at run time; an int
-widens into a float slot only when exact, and nil fits only an (Option T) slot.
+Constructor parameters stay dyn and each store checks at run time; an int widens
+into a float slot only if it round-trips, and nil fits only an (Option T) slot.
 
 ** DONE println takes up to a second to appear
 CLOSED: [2026-09-25]
diff --git a/lib/check.ml b/lib/check.ml
index 8188fefb..bbe20d00 100644
--- a/lib/check.ml
+++ b/lib/check.ml
@@ -1608,13 +1608,18 @@ let pair_params ?(also = fun _ -> false) env (items : Ast.pitem list)
 (* A class named in [cls]'s slot vector: [n] as written, or [n] in [cls]'s own
    package, since [Load] leaves a bare name in a slot vector unqualified. *)
 let class_named ~classes cls n =
-  if List.mem n classes then Some n
-  else
+  (* The class's own package first: an importer may declare a class of the
+     same bare name, and a slot the package wrote means the package's. *)
+  let own =
     match String.rindex_opt cls '/' with
     | Some i ->
       let q = String.sub cls 0 (i + 1) ^ n in
       if List.mem q classes then Some q else None
     | None -> None
+  in
+  match own with
+  | Some _ -> own
+  | None -> if List.mem n classes then Some n else None
 
 let rec slot_of env ~classes cls fname (t : Ast.texpr) : slot_ty =
   let refuse what =
@@ -9620,6 +9625,27 @@ and ordinary_call ctx ~want loc name args =
       in
       (match Hashtbl.find_opt ctx.env.tracks name with
        | Some tr -> expect ctx loc ~want (tracked_call loc ctx.env name tr ret args)
+       | None when Hashtbl.mem ctx.env.classes name ->
+         (* A class's constructor, told where it was called from so that a
+            slot it refuses names this call and not only the defclass. The
+            arguments go into temps first: one may itself construct, and
+            the site is set last, immediately before the call, so nothing
+            between the two can replace it. The constructor takes it as its
+            first act; one reached through a function value finds none. *)
+         let temps =
+           List.map (fun (a : Tast.expr) -> (fresh_slot ctx a.Tast.ty, a)) args
+         in
+         let uses =
+           List.map
+             (fun (s, (a : Tast.expr)) -> mk a.Tast.loc a.Tast.ty (Tast.Local s))
+             temps
+         in
+         expect ctx loc ~want
+           (mk loc ret
+              (Tast.Let
+                 (temps,
+                  [ rt loc Types.Unit "flan_dyn_ctor_site" [ here loc ];
+                    mk loc ret (Tast.Call (name, uses)) ])))
        | None -> expect ctx loc ~want (mk loc ret (Tast.Call (name, args))))
     | None ->
       if Hashtbl.mem ctx.env.datas name then
diff --git a/lib/classes.ml b/lib/classes.ml
index 8a109288..cc006999 100644
--- a/lib/classes.ml
+++ b/lib/classes.ml
@@ -53,7 +53,8 @@ let no_method = "NoMethod"
    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
+   at its type's zero value, or nil for an untyped, Option or class slot;
+   [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:
diff --git a/lib/emit.ml b/lib/emit.ml
index 57c92886..76c9e776 100644
--- a/lib/emit.ml
+++ b/lib/emit.ml
@@ -4780,6 +4780,7 @@ declare i64 @flan_dyn_map_new()
 declare i64 @flan_dyn_map_new_class(i64, ptr, i64)
 declare void @flan_dyn_slot_set(i64, i64, i64, ptr, i64)
 declare void @flan_dyn_slot_init(i64, i64, i64, ptr, i64)
+declare void @flan_dyn_ctor_site(ptr, 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)
diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c
index c54dfebf..623a15cd 100644
--- a/runtime/flan_dyn.c
+++ b/runtime/flan_dyn.c
@@ -1655,8 +1655,8 @@ static void slot_type_text(const slot_type *t, char *buf, size_t cap) {
 /* Whether [v] may be stored in a slot of type [t], and what is stored: [v]
  * itself, or — for an int into a float slot — the float it widens to. The
  * widening is the typed side's rule read off the value rather than off a
- * static type: an integer the float's significand holds exactly is admitted
- * as that float, and one it does not is refused, as (f64 x) would be for the
+ * static type: an integer the float holds exactly is admitted as that float,
+ * and one it does not is refused, as (f64 x) would be for the
  * type that could hold it. A float into an f32 slot has to be one an f32
  * holds, which is the typed side refusing f64 into f32. */
 static int slot_admit(const slot_type *t, flan_dyn v, flan_dyn *out) {
@@ -1675,9 +1675,15 @@ static int slot_admit(const slot_type *t, flan_dyn v, flan_dyn *out) {
       return t->fbits == 53 || d != d || (double)(float)d == d;
     }
     if (tag == FLAN_DYN_TAG_INT) {
-      int64_t x = dyn_int_value(v), lim = (int64_t)1 << t->fbits;
-      if (x < -lim || x > lim) return 0;
-      *out = flan_dyn_from_f64((double)x);
+      /* Exact is a round trip, not a range: 2^54 is an f64 exactly and
+         2^53+1 is not. The range test before the cast back is what keeps
+         that cast defined, since INT64_MAX rounds up to 2^63. */
+      int64_t x = dyn_int_value(v);
+      double d = t->fbits == 53 ? (double)x : (double)(float)x;
+      if (!(d >= -9223372036854775808.0 && d < 9223372036854775808.0)
+          || (int64_t)d != x)
+        return 0;
+      *out = flan_dyn_from_f64(d);
       return 1;
     }
     return 0;
@@ -2117,8 +2123,25 @@ static class_entry *class_sync(flan_obj *o) {
  * what it has, and has to: a constructor compiled before a redefinition may
  * still be on some stack, and letting its definition win would put the
  * class back the way it was. Redefining is [flan_dyn_class_def]'s alone. */
+/* A constructor call's site: [pending] from the caller, moved to [building]
+ * by the constructor's first act, so a call through a function value — which
+ * sets nothing — finds none rather than an earlier call's. Nothing between
+ * the caller setting it and the constructor taking it can construct: the
+ * caller evaluated every argument first. */
+static const uint8_t *site_pending, *site_building;
+static int64_t        site_pending_len, site_building_len;
+
+void flan_dyn_ctor_site(const uint8_t *loc, int64_t loclen) {
+  site_pending = loc;
+  site_pending_len = loclen;
+}
+
 flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n) {
   flan_obj *o;
+  site_building = site_pending;
+  site_building_len = site_pending_len;
+  site_pending = NULL;
+  site_pending_len = 0;
   if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD)
     trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k);
   if (class_find(dyn_kw(k)) == NULL) {
@@ -3029,7 +3052,10 @@ static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
   say(sv, SAY_MAX, v);
   slot_type_text(t, st, sizeof st);
   fflush(stdout);
-  trap_where(loc, loclen);
+  /* A constructor's refusal is placed at the call that was wrong, when the
+     call said where it was, and names the slot's declaration after it. */
+  trap_where(by == BY_NEW && site_building != NULL ? site_building : loc,
+             by == BY_NEW && site_building != NULL ? site_building_len : loclen);
   fprintf(stderr, "dyn %s: the slot :%.*s of %.*s is declared %s, and ",
           by == BY_PUT ? "put" : by == BY_SET ? "set" : "construct", sn, ss,
           cn, cs, st);
@@ -3047,6 +3073,9 @@ static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
     fprintf(stderr, "(put %s :%.*s %s)\n", sm, sn, ss, sv);
   else if (by == BY_SET)
     fprintf(stderr, "(set (get %s :%.*s) %s)\n", sm, sn, ss, sv);
+  else if (site_building != NULL && loc != NULL)
+    fprintf(stderr, "(%.*s ...) with :%.*s %s; the slot is declared at %.*s\n",
+            cn, cs, sn, ss, sv, (int)loclen, (const char *)loc);
   else
     fprintf(stderr, "(%.*s ...) with :%.*s %s\n", cn, cs, sn, ss, sv);
   flan_trap((const uint8_t *)"DynType", 7);
diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h
index 33ca96b2..bcd92bed 100644
--- a/runtime/flan_dyn.h
+++ b/runtime/flan_dyn.h
@@ -112,6 +112,11 @@ flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n);
 void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v,
                         const uint8_t *loc, int64_t loclen);
 
+/* Where the constructor about to be called was called from. Set by the
+ * caller immediately before the call and taken by the constructor's
+ * [flan_dyn_map_new_class], so a refusal in its stores names the call. */
+void flan_dyn_ctor_site(const uint8_t *loc, int64_t loclen);
+
 /* (set (get inst :slot) v): [m] must be a class instance and [k] a slot its
  * class declares, and [v] must fit the slot's type; each is a trap with its
  * own sentence, at [loc]. A declared slot always exists, so this stores and
@@ -136,7 +141,8 @@ flan_dyn flan_dyn_class_of(flan_dyn v);
  * migrates nothing. When it does move, every instance built against an
  * earlier definition migrates lazily at its next [get], [put], [has-key?],
  * [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
+ * matched by name, a slot it has gained holds its type's zero value — nil
+ * for an untyped, an (Option T) or a class-typed slot — and keys it no longer
  * declares are dropped. The instance's identity is preserved throughout;
  * this is CLHS 4.3.6, and [flan_dyn_class_hook] is its user hook.
  *
diff --git a/test/daemon-x86.out b/test/daemon-x86.out
new file mode 100644
index 00000000..63826b3b
--- /dev/null
+++ b/test/daemon-x86.out
@@ -0,0 +1,2 @@
+flan dev: built dev-hook.flan in 444ms
+flan dev: /home/joe/Development/flan/.claude/worktrees/agent-a6ffe579d55d1892b/test/programs/dev-hook.flan ready on /tmp/claude-1000/rv-3672919.sock (17ms, one process)
diff --git a/test/dyn_ops.c b/test/dyn_ops.c
index 8fcbf923..c9335dd2 100644
--- a/test/dyn_ops.c
+++ b/test/dyn_ops.c
@@ -1256,7 +1256,7 @@ extern int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance, uint64_t added,
 void flan_dyn_class_hook(void *fn);
 
 static flan_dyn hk_p, hk_q, hk_r;
-static int hk_runs_p, hk_runs_q, hk_runs_r, hk_fresh;
+static int hk_runs_p, hk_runs_q, hk_runs_r, hk_fresh, hk_per_call = 20;
 static int64_t hk_gone_len = -1;
 
 static int hk_call(void *fn, uint64_t instance, uint64_t added,
@@ -1272,7 +1272,7 @@ static int hk_call(void *fn, uint64_t instance, uint64_t added,
   if (instance == hk_q) hk_runs_q++;
   if (instance == hk_r) hk_runs_r++;
   (void)slot(hk_p, "x");
-  for (i = 0; i < 20; i++) {
+  for (i = 0; i < hk_per_call; i++) {
     snprintf(name, sizeof name, "fresh%d", hk_fresh++);
     (void)flan_dyn_map_new_class(
       flan_dyn_kw((const uint8_t *)name, (int64_t)strlen(name)),
@@ -1315,6 +1315,28 @@ static void hook_reentry(void) {
   check(hk_runs_q == 1 && hk_runs_r == 1,
         "each other instance runs its hook once, at its own first touch");
   check(hk_runs_p == 1, "and the first instance's did not run again");
+
+  /* A migration started by a store rather than a read, with a hook that
+     grows the registry past its capacity each time: the store goes on to
+     check the value against the class's entry, and it has to be the entry
+     the registry holds after the hook, not the one it held before. 200 and
+     then 300 new classes are each enough to move the table whatever its
+     capacity was. :x is an f64 slot now, so the int stored must arrive as a
+     float, which only the entry's types can say. */
+  hk_per_call = 200;
+  define("pt", "x f64\ny\nz\nw");
+  flan_dyn_map_put(hk_p, flan_dyn_kw((const uint8_t *)"x", 1),
+                   flan_dyn_from_i64(5), NULL, 0);
+  check(hk_runs_p == 2, "a put migrates and runs the hook");
+  check(flan_dyn_tag(slot(hk_p, "x")) == FLAN_DYN_TAG_FLOAT,
+        "a put after a hook that moved the registry widens by the new entry");
+  hk_per_call = 300;
+  define("pt", "x f64\ny\nz\nw\nv");
+  flan_dyn_slot_set(hk_p, flan_dyn_kw((const uint8_t *)"w", 1),
+                    flan_dyn_from_i64(7), NULL, 0);
+  check(hk_runs_p == 3, "a set migrates and runs the hook");
+  check(flan_dyn_need_i64(slot(hk_p, "w")) == 7,
+        "a set after a hook that moved the registry finds its slot");
   flan_dyn_migrate_hook = NULL;
   flan_dyn_class_hook(NULL);
   flan_dyn_root_pop(3);
diff --git a/test/programs/dyn-class-pkg.flan b/test/programs/dyn-class-pkg.flan
new file mode 100644
index 00000000..e237cb4e
--- /dev/null
+++ b/test/programs/dyn-class-pkg.flan
@@ -0,0 +1,8 @@
+;;;; A slot type a package wrote names the package's own class, not an
+;;;; importer's class of the same bare name.
+(import g "pkgs/geo")
+(defclass pt [z])
+(defn main [] i32
+  (println (g/mk))
+  (println (pt 1))
+  0)
diff --git a/test/programs/dyn-class-slots.flan b/test/programs/dyn-class-slots.flan
index 04c875d9..8d3181f1 100644
--- a/test/programs/dyn-class-slots.flan
+++ b/test/programs/dyn-class-slots.flan
@@ -42,9 +42,14 @@
     ;; parameter, when the float holds it exactly.
     (put s :speed 3)
     (println (+ (get s :speed) 0.5))
+    ;; Exact is a round trip, not a range: 2^54 is an f64 exactly.
+    (put s :speed 18014398509481984)
+    (println (= (get s :speed) 18014398509481984.0))
     (let [n (node s nil nil)]
       (set (get n :next) (node s nil 2))
       (println (get (get n :next) :weight))
       (set (get n :weight) nil)
+      ;; 2^30 is an f32 exactly, though it is past f32's 24-bit significand.
+      (set (get n :weight) 1073741824)
       (println (class-of (get n :owner)))))
   0)
diff --git a/test/programs/pkgs/geo/geo.flan b/test/programs/pkgs/geo/geo.flan
new file mode 100644
index 00000000..6d3700ef
--- /dev/null
+++ b/test/programs/pkgs/geo/geo.flan
@@ -0,0 +1,5 @@
+;;;; A package whose slot types name its own classes, imported by
+;;;; dyn-class-pkg.flan, which declares a class of the same bare name.
+(defclass pt [x f64 y f64])
+(defclass seg [a pt b (Option pt) tag])
+(defn mk [] dyn (seg (pt 1 2) nil :t))
diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml
index c4133974..20fa9c3e 100644
--- a/test/test_acceptance.ml
+++ b/test/test_acceptance.ml
@@ -5088,11 +5088,14 @@ level "1"
        whose arguments the two emit separately. *)
     let slots_out =
       "#state{ :pause false :step 3 :speed 1.5 :name \"sand\" :tag :x}\n\
-       true\n-7\n[ 1 2]\n2.5\n9\n6\n12\n3.5\n2\n:state\n"
+       true\n-7\n[ 1 2]\n2.5\n9\n6\n12\n3.5\ntrue\n2\n:state\n"
     in
     outputs "dyn: typed class slots" "programs/dyn-class-slots.flan" slots_out;
     outputs ~x86:true "dyn: typed class slots, --x86"
       "programs/dyn-class-slots.flan" slots_out;
+    outputs "dyn: a package's slot type names its own class"
+      "programs/dyn-class-pkg.flan"
+      "#g/seg{ :a #g/pt{ :x 1 :y 2} :b nil :tag :t}\n#pt{ :z 1}\n";
     let slot_trap ?x86 () =
       let exe = compile ?x86 "programs/dyn-slot-trap.flan" in
       List.iter
@@ -5106,9 +5109,9 @@ level "1"
                (match x86 with Some true -> ", --x86" | _ -> "")
                text code want
            end)
-        [ ("0", "dyn-slot-trap.flan:4:18: dyn construct: the slot :pause of \
+        [ ("0", "dyn-slot-trap.flan:14:28: dyn construct: the slot :pause of \
                  state is declared bool, and this is int — (state ...) with \
-                 :pause 1");
+                 :pause 1; the slot is declared at programs/dyn-slot-trap.flan:4:18");
           ("1", "dyn-slot-trap.flan:15:19: dyn put: the slot :pause of state \
                  is declared bool, and this is int");
           ("2", "dyn-slot-trap.flan:16:19: dyn set: the slot :step of state \
@@ -5119,9 +5122,9 @@ level "1"
                  declare is added with put, not set");
           ("4", "dyn-slot-trap.flan:18:19: dyn set: (get m k) is a place only \
                  on a class instance, and this is a map with no class");
-          ("5", "dyn-slot-trap.flan:5:17: dyn construct: the slot :owner of \
+          ("5", "dyn-slot-trap.flan:19:28: dyn construct: the slot :owner of \
                  node is declared state, and this is not an instance of it");
-          ("6", "dyn-slot-trap.flan:4:18: dyn construct: the slot :pause of \
+          ("6", "dyn-slot-trap.flan:20:22: dyn construct: the slot :pause of \
                  state is declared bool, and this is nil") ];
       (try Sys.remove exe with Sys_error _ -> ())
     in
diff --git a/web/index.html b/web/index.html
index d033e7da..1c311673 100644
--- a/web/index.html
+++ b/web/index.html
@@ -2221,7 +2221,9 @@ reason is the whole difference between the two: an instance carries a header nam
 its class and a flat struct does not. Redefining one re-registers the class and
 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 nil, a dropped one goes, the object is the same object, and
+starts at its type's zero value — false, 0,
+0.0 or "", and nil for a slot with no type,
+an (Option T) or a class — a dropped one goes, the object is the same object, and
 class-of still answers the same tag, so every method still reaches it.
 That is CLHS 4.3.6's protocol. Its user hook is
 update-instance-for-redefined-class: a method of it written for a