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

@@ -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
+The constructor's parameters stay dyn and every store checks at run time; an int
-converts into a float slot, nil does not fit a typed slot, and a class is no slot type.
+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]

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
+(* A class slot's type, held to the set a stored dyn value can be checked
-   be checked against: its tag says bool, int, float or text and nothing
+   against. A class's name is a type here, and only here: it is not a type
-   finer, so those are the types there are. A narrower integer is a range on
+   anywhere else in the language, since an instance is a dyn value. Every
-   top of the int tag. Everything else a type can be — a struct, a Vec, a
+   other type a slot could name — a struct, a Vec, a pointer — does not cross
-   pointer — does not cross into dyn at all, so a slot of one could never be
+   into dyn at all, so a slot of one could never be written. *)
-   written. *)
+(* A class named in [cls]'s slot vector: [n] as written, or [n] in [cls]'s own
-let slot_type env cls (f : Ast.field) : Types.t =
+   package, since [Load] leaves a bare name in a slot vector unqualified. *)
-  let t = resolve env f.Ast.fty in
+let class_named ~classes cls n =
-  match t with
+  if List.mem n classes then Some n
-  | Types.Dyn | Types.Bool | Types.Int _ | Types.Float _ | Types.String -> t
+  else
-  | other ->
+    match String.rindex_opt cls '/' with
-    Loc.failk "check/slot-type" f.Ast.fty.Ast.tloc
+    | 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. \
+       which can be checked as bool, an integer type, f32, f64, string, a \
-       Write one of those, or leave the type out and the slot holds any dyn \
+       class, or (Option T) of one of those. Write one of those, or leave the \
-       value: [%s]"
+       type out and the slot holds any dyn value: [%s]"
-      f.Ast.fname cls (Types.to_string other) f.Ast.fname
+      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) ->
+       (fun (n, t) -> match t with Sany -> n | t -> n ^ " " ^ slot_word 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
 
+(* 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) ->
+        (fun ((k : Ast.expr), v) ->
-           rt loc Types.Unit store
+           let args =
-             [ mval; check ctx ~want:Types.Dyn k;
+             [ mval; check ctx ~want:Types.Dyn k; check ctx ~want:Types.Dyn v ]
-               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

lib/dev.ml

@@ -1553,8 +1553,8 @@ let defs t =
               List.map
                 (fun (s, ty) ->
                    match ty with
-                   | Types.Dyn -> s
+                   | Check.Sany -> s
-                   | ty -> s ^ " " ^ Types.to_string ty)
+                   | ty -> s ^ " " ^ Check.slot_text ty)
                 slots,
               d.Ast.dloc)
          | _ -> None)

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)

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
+       [MapLit] arm above takes about a map literal's keys. The vector is
-       a type like any other, and the vector is unpaired, so it goes through
+       unpaired, so a bare symbol in it may be a slot's name, and none is
-       [rename_pitem] as a [defn]'s does: a bare symbol the package owns is a
+       touched; a type written as a form is renamed as any type is. A bare
-       type of this package, since no slot name is ever an owned name that
+       class name in a type position is found by [Check.pair_slots] against
-       matters. The *class's* name is qualified, so [pkg/point] is what an
+       the class's own package instead. The *class's* name is qualified, so
-       instance's shape tag reads and two packages' [point] classes are two
+       [pkg/point] is what an instance's shape tag reads and two packages'
-       classes. *)
+       [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. *)

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
+ * 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
+ * narrower integer type, the significand a float slot holds exactly, a
- * defclass wrote it, for the sentence a refusal prints. */
+ * class for a slot declared with one, and whether nil is admitted, which is
-enum { ST_ANY, ST_BOOL, ST_INT, ST_FLOAT, ST_TEXT };
+ * 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[] = {
+  static const struct {
-    { "bool", ST_BOOL, 0, 0 },
+    const char *w; uint8_t kind, fbits; int64_t lo, hi;
-    { "string", ST_TEXT, 0, 0 },
+  } known[] = {
-    { "f32", ST_FLOAT, 0, 0 },
+    { "bool", ST_BOOL, 0, 0, 0 },
-    { "f64", ST_FLOAT, 0, 0 },
+    { "string", ST_TEXT, 0, 0, 0 },
-    { "i8", ST_INT, INT8_MIN, INT8_MAX },
+    { "f32", ST_FLOAT, 24, 0, 0 },
-    { "i16", ST_INT, INT16_MIN, INT16_MAX },
+    { "f64", ST_FLOAT, 53, 0, 0 },
-    { "i32", ST_INT, INT32_MIN, INT32_MAX },
+    { "i8", ST_INT, 0, INT8_MIN, INT8_MAX },
-    { "i64", ST_INT, INT64_MIN, INT64_MAX },
+    { "i16", ST_INT, 0, INT16_MIN, INT16_MAX },
-    { "u8", ST_INT, 0, UINT8_MAX },
+    { "i32", ST_INT, 0, INT32_MIN, INT32_MAX },
-    { "u16", ST_INT, 0, UINT16_MAX },
+    { "i64", ST_INT, 0, INT64_MIN, INT64_MAX },
-    { "u32", ST_INT, 0, UINT32_MAX },
+    { "u8", ST_INT, 0, 0, UINT8_MAX },
-    { "u64", ST_INT, 0, INT64_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
+        if (e->slots[i] != list[i] || !slot_type_eq(&e->types[i], &types[i])) {
-            || e->types[i].lo != types[i].lo || e->types[i].hi != types[i].hi) {
           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
+ * has — which is the property CLHS 4.3.6 guarantees, matched by name, with
- * property CLHS 4.3.6 guarantees, matched by name, with the instance's
+ * the instance's identity preserved because none of this allocates a new
- * identity preserved because none of this allocates a new object.
+ * 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,101 +1650,113 @@ 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
+ * In three steps, and the order is what keeps it sound.
- * 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
+ * First, everything that allocates on the collector's heap: the hook's
- * is [o]'s, and every caller syncs [o] before it starts walking [o] — so a
+ * arguments, and an empty string for a gained string slot. A collection may
- * re-entry through a nested [dyn_equal], including a map used as a key of
+ * run here, while [o] still holds its old entries whole. Nothing in this
- * itself, finds [o] already current and returns at the generation compare.
+ * step compares a key with [dyn_equal] — see [map_append] — so nothing in it
- * The key scan here uses the interned identity compare and calls
+ * can migrate another instance and run a hook inside this migration.
- * [dyn_equal] not at all, so it cannot re-enter from inside. */
+ *
-static void class_sync(flan_obj *o) {
+ * Second, the name-matching, which allocates nothing on the collector's
-  class_entry *e;
+ * 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;
+  int64_t i, j, n;
-  /* The hook's three arguments, rooted by address for as long as the hook
+  /* Rooted by address for as long as they may be needed: each is a
-   * may run: each is a collector object held nowhere else. */
+   * collector object held nowhere else. */
-  flan_dyn inst, added, gone;
+  flan_dyn inst, added, gone, empty;
   int64_t roots_at = roots_n;
-  int hook;
+  int hook, need_empty = 0;
-  if (o->kind != OBJ_MAP || o->u.v.klass == NULL) return;
+  n = e->nslots;
-  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;
+  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 (j = 0; j < n; j++)
-      for (i = 0; i < o->len; i++) {
+      if (entry_of(o, e->slots[j]) < 0)
-        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. */
+     * 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) {
+  if (n > 0) {
-    fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh);
+    fresh = (flan_dyn *)malloc((size_t)n * 2 * sizeof *fresh);
-    if (fresh == NULL) trap_oom(NULL, 0, e->nslots * 2 * (int64_t)sizeof *fresh);
+    if (fresh == NULL) trap_oom(NULL, 0, n * 2 * (int64_t)sizeof *fresh);
   }
-  for (j = 0; j < e->nslots; j++) {
+  for (j = 0; j < n; j++) {
-    flan_dyn v = dyn_make(BOX_NIL, 0);
+    const slot_type *t = &e->types[j];
-    for (i = 0; i < o->len; i++) {
+    flan_dyn v;
-      flan_dyn key = o->u.v.items[i * 2];
+    i = entry_of(o, e->slots[j]);
-      /* [flan_dyn_tag] and not a bare [dyn_box]: a float is not boxed at
+    if (i >= 0) {
-         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
+         write to the slot is checked like any other. */
-           has only just gained holds nil without a word: it holds nothing,
+      if (!slot_fits(t, v) && e->warned[j] != e->gen) {
-           rather than something of the wrong type. */
+        char sv[SAY_MAX], st[128];
-        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);
+        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), e->types[j].word, sv,
+                (int)sl->len, (const char *)(sl + 1), st, sv,
                 tag_of(v), (int)sl->len, (const char *)(sl + 1));
       }
-        break;
     }
+    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;
@@ -1637,18 +1764,31 @@ static void class_sync(flan_obj *o) {
   /* 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->u.v.cap = n;
-  o->len = e->nslots;
+  o->len = n;
-  /* 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);
+  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);
+          cn, cs, st);
-  /* An int of the wrong size is the right tag, so the tag is not the news. */
+  /* A number of the right kind that does not fit is not news about its tag. */
-  if (e->types[j].kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT)
+  if ((t->kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT)
-    fprintf(stderr, "%s is outside its range — ", sv);
+      || (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,
+/* The value a store into [o] under [k] actually stores: [v], or the float an
-                       flan_obj *o, flan_dyn m, flan_dyn k, flan_dyn v) {
+ * int widens to in a float slot. A class with no typed slot answers at its
-  class_entry *e;
+ * 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;
+  flan_dyn out;
-  e = class_find(o->u.v.klass);
+  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. */
+ * wrote, and placed at the slot's declaration. */
-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) {
   flan_obj *o = want_map("construct", m, k);
-  check_slot(NULL, 0, BY_NEW, o, m, k, v);
+  class_entry *e = o->u.v.klass == NULL ? NULL : class_find(o->u.v.klass);
-  map_store(o, k, v);
+  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 "
+            "this is %s%s — %s. A map's entries are written with put\n",
-            "(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_sync(o);
-  e = class_find(o->u.v.klass);
   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 "
+    fprintf(stderr, "; a key the class does not declare is added with put, "
-                    "(put inst k v)\n");
+                    "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);
+  flan_obj *o;
-  check_slot(loc, loclen, BY_PUT, o, m, k, v);
+  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;

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

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;

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)

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)

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, \
+        [ ("0", "dyn-slot-trap.flan:4:18: dyn construct: the slot :pause of \
-                 and this is int — (state ...) with :pause 1");
+                 state is declared bool, and this is int — (state ...) with \
-          ("1", "dyn-slot-trap.flan:14:19: dyn put: the slot :pause of state \
+                 :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 \
+          ("2", "dyn-slot-trap.flan:16:19: dyn set: the slot :step of state \
-                 is declared i32, and 5000000000 is outside its range");
+                 is declared i32, and 5000000000 is not a value it holds \
-          ("3", "dyn-slot-trap.flan:16:19: dyn set: state has no slot :paws. \
+                 exactly");
-                 Its slots are :pause :step :tag");
+          ("3", "dyn-slot-trap.flan:17:19: dyn set: state has no slot :paws. \
-          ("4", "dyn-slot-trap.flan:17:13: dyn set: (get m k) is a place only \
+                 Its slots are :pause :step :tag; a key the class does not \
-                 on a class instance, and this is a map with no class") ];
+                 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 ();

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 \

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;

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)";

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].

web/index.html

@@ -714,7 +714,8 @@ slots, and a slot may be followed by a type, the way a parameter is:
 <code>[x y]</code> is two slots that hold any value, and <code>[pause bool]</code>
 is one that holds only a bool. The type is checked whenever a value is stored,
 and a slot may be <code>bool</code>, an integer type, <code>f32</code>,
-<code>f64</code> or <code>string</code>. The constructor is the class's own name
+<code>f64</code>, <code>string</code>, a class, or <code>(Option T)</code> of one of
+those, which also admits <code>nil</code>. The constructor is the class's own name
 and is positional, and <code>class-of</code> answers the tag, or <code>nil</code>
 for anything that is not an instance. The slots are map keys: <code>get</code>
 reads one, and <code>set</code> writes one, as in