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