JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 13:29:30 +07:00
parent 9aeee9d676
commit 53880eb685
13 changed files with 130 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.org
View File

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

30
lib/check.ml
View File

@ -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

3
lib/classes.ml
View File

@ -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:

1
lib/emit.ml
View File

@ -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)

41
runtime/flan_dyn.c
View File

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

8
runtime/flan_dyn.h
View File

@ -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.
*

2
test/daemon-x86.out Normal file
View File

@ -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)

26
test/dyn_ops.c
View File

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

8
test/programs/dyn-class-pkg.flan Normal file
View File

@ -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)

5
test/programs/dyn-class-slots.flan
View File

@ -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)

5
test/programs/pkgs/geo/geo.flan Normal file
View File

@ -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))

13
test/test_acceptance.ml
View File

@ -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

4
web/index.html
View File

@ -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 <code>nil</code>, a dropped one goes, the object is the same object, and
starts at its type's zero value — <code>false</code>, <code>0</code>,
<code>0.0</code> or <code>""</code>, and <code>nil</code> for a slot with no type,
an <code>(Option T)</code> or a class — a dropped one goes, the object is the same object, and
<code>class-of</code> still answers the same tag, so every method still reaches it.
That is CLHS 4.3.6's protocol. Its user hook is
<code>update-instance-for-redefined-class</code>: a method of it written for a