From 6d8ced2ba33ebfc2a7671103ef62bc92a6e87c48 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 11:48:01 +0700 Subject: [PATCH 1/4] A dyn text becomes a str as its own bytes, a dyn view becomes its own storage, and a dyn vec or map becomes a checked copy in a [const T], a fixed array or a struct, while a writable [T] is never a copy. --- TODO.org | 6 + lib/check.ml | 59 +++- lib/emit.ml | 1 + runtime/flan_dyn.c | 446 +++++++++++++++++++++++++++++- runtime/flan_dyn.h | 12 + runtime/flan_rt.c | 34 +++ test/dyn_ops.c | 26 ++ test/programs/dyn-into-typed.flan | 115 ++++++++ test/test_acceptance.ml | 61 ++++ test/test_flan.ml | 13 +- 10 files changed, 767 insertions(+), 6 deletions(-) create mode 100644 test/programs/dyn-into-typed.flan diff --git a/TODO.org b/TODO.org index 6a35158f..fe0c4a6b 100644 --- a/TODO.org +++ b/TODO.org @@ -28,6 +28,12 @@ class's float slot's rule), and a u64 above the largest i64 traps when read. A v storage its own dyn global's initialiser built is refused. Rules out copying at the crossing, a dyn big int for u64, and any check in a release build. +** DONE A dyn value crosses into a str, a slice, an array or a struct +CLOSED: [2026-09-26] +A writable [T] is never a copy: a plain dyn vec into one traps and names [const T], so a +write can never miss the vec. A str from a text is its own bytes, live at least until the +next free-temp. Rules out copy-in/copy-out at a call, and rooting the text in the crossing's frame. + ** NEXT Dyn unless annotated Decided 2026-09-26, replacing the plain rule: number, bool and char literals are typed, their type inferred from their uses inside the function (never across functions); an diff --git a/lib/check.ml b/lib/check.ml index aa7423a1..c649db42 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3639,8 +3639,11 @@ let no_dyn_yet loc ~into t extra = dyn value cannot be read out of or written into without a meaning nobody has decided. A str is read as a copy and never written, since a dyn text is a collector pointer and typed storage is never scanned; a - [const] slice is refused because a dyn view can be written through. *) -let rec view_desc structs (t : Types.t) : (string, Types.t) result = + [const] slice is refused because a dyn view can be written through. One + is described only [~into] a written type ([into_typed]), as [c]. *) +let rec view_desc ?(into = false) structs (t : Types.t) + : (string, Types.t) result = + let view_desc = view_desc ~into in let ( let* ) = Result.bind in match t with | Types.Int k -> @@ -3655,6 +3658,8 @@ let rec view_desc structs (t : Types.t) : (string, Types.t) result = let* d = view_desc structs e in Ok (Printf.sprintf "a%Ld;%s" n d) | Types.Slice (Types.Mut, e) -> let* d = view_desc structs e in Ok ("s" ^ d) + | Types.Slice (Types.Const, e) when into -> + let* d = view_desc structs e in Ok ("c" ^ d) | Types.Vec e -> let* d = view_desc structs e in Ok ("v" ^ d) | Types.Named n -> (match Hashtbl.find_opt structs n with @@ -4215,6 +4220,48 @@ let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = then "f64" else "i64")) | _ -> no_dyn_yet loc ~into:false want "" +(* A dyn where a str, a slice, a fixed array or a struct was written: + [flan_dyn_need_as] with the written type's descriptor, answering through + a slot of that type. The runtime decides, since only it can see what the + dyn holds: a text is a str's own bytes, a view of the wanted elements is + their own storage, a vec or a map is a checked copy, and a [T] that can be + written through is never a copy — a write through one would not reach the + dyn vec, so the answer would differ with the vec typed or dyn. Its comment + in runtime/flan_dyn.c says where the copies live and how long a str from a + text lasts. + + A fixed array or a struct that holds a Vec is refused: from a view it + would be a second copy of an owning header. *) +let into_typed ctx loc (want : Types.t) (got : Tast.expr) : Tast.expr = + let structs = ctx.env.structs in + let rec owns (t : Types.t) = + match t with + | Types.Vec _ -> true + | Types.Array (_, e) -> owns e + | Types.Named n -> + (match Hashtbl.find_opt structs n with + | Some st -> List.exists (fun (f : Tast.field) -> owns f.Tast.fty) st.Tast.fields + | None -> false) + | _ -> false + in + match view_desc ~into:true structs want with + | Error inner -> + no_dyn_yet loc ~into:false want + (if Types.equal inner want then "" + else Printf.sprintf " — a dyn value has no %s to become" (tyname loc inner)) + | Ok _ when owns want -> + no_dyn_yet loc ~into:false want " — it holds a Vec, which owns its storage" + | Ok d -> + let ds = fresh_slot ctx Types.Dyn and out = fresh_slot ctx want in + let local s ty = mk loc ty (Tast.Local s) in + mk loc want + (Tast.Let + ([ (ds, got); (out, mk loc want (Tast.Zero want)) ], + [ rt loc Types.Unit "flan_dyn_need_as" + [ local ds Types.Dyn; mk loc Types.String (Tast.Str d); + addr_of loc (local out want); here loc ]; + local out want ])) + (* ── A numeric cast written on a dyn ───────────────────────────────── * TODO.org, "A numeric cast opens a dyn box". @@ -4581,6 +4628,14 @@ let expect ctx loc ~want (got : Tast.expr) = or to dyn itself; wrap the type in Option, or keep the value dyn" (tyname loc w) | _, Types.Dyn when Types.fits ~expected:w ~actual:Types.Dyn -> got + | (Types.String | Types.Slice _ | Types.Array _), Types.Dyn -> + let opened = into_typed ctx loc w got in + Opened.replace opened_by_want opened got; + opened + | Types.Named n, Types.Dyn when Hashtbl.mem ctx.env.structs n -> + let opened = into_typed ctx loc w got in + Opened.replace opened_by_want opened got; + opened | _, Types.Dyn -> let opened = unbox loc w got in Opened.replace opened_by_want opened got; diff --git a/lib/emit.ml b/lib/emit.ml index 97240c6e..a40ef2f2 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5079,6 +5079,7 @@ declare i64 @flan_dyn_need_not_nil(i64) declare i32 @flan_dyn_truthy(i64) declare i64 @flan_dyn_view_slice(ptr, i64, ptr, i64, i32) declare i64 @flan_dyn_view_at(ptr, i64, ptr, i64, i32, i32) +declare void @flan_dyn_need_as(i64, ptr, i64, ptr, ptr, i64) declare void @flan_dyn_root_push(ptr) declare void @flan_dyn_root_push_desc(ptr, ptr) declare ptr @flan_dyn_env_new(i64, ptr) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 00dced35..8807deb9 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1525,9 +1525,71 @@ static void mark_desc(char *base, const flan_desc *d) { } } +/* ── Texts a str was taken from ──────────────────────────────────────── + * + * A dyn text crossing into a str ([flan_dyn_need_as]) is not copied: the str + * is the text's own bytes, which never move, since this collector never + * moves anything. What could happen is a free — a str in a typed local, + * field or Vec is not a root, and typed storage is never scanned — so the + * crossing pins the text here, keyed by the temp arena's stamp, and every + * collection marks the pins whose stamp is still live. The str then lasts + * as long as the text is reachable from dyn or until the next free-temp, + * whichever is later: the lifetime i64->bytes's text already has, and text + * kept longer is cloned, as there. + * + * Rooting the text in the crossing's frame would be shorter than that and + * wrong for a str returned or stored, and a pin for good would keep every + * text a frame loop ever crossed. A copy into the temp arena would be sound + * too; this is the same lifetime without the copy. */ +const void *flan_temp_stamp(uint64_t *inc, uint64_t *epoch); +int32_t flan_temp_stamp_live(const void *a, uint64_t inc, uint64_t epoch); + +typedef struct text_pin { + flan_obj *o; + const void *a; + uint64_t inc, epoch; +} text_pin; + +static text_pin *pins; +static int64_t pins_n, pins_cap; + +static void pins_prune(void) { + int64_t i, k = 0; + for (i = 0; i < pins_n; i++) + if (flan_temp_stamp_live(pins[i].a, pins[i].inc, pins[i].epoch)) + pins[k++] = pins[i]; + pins_n = k; +} + +static void pin_text(flan_obj *o) { + uint64_t inc, epoch; + const void *a = flan_temp_stamp(&inc, &epoch); + text_pin *last = pins_n > 0 ? &pins[pins_n - 1] : NULL; + if (last != NULL && last->o == o && last->a == a && last->inc == inc + && last->epoch == epoch) + return; + if (pins_n == pins_cap) { + pins_prune(); + if (pins_n == pins_cap) { + int64_t cap = pins_cap ? pins_cap * 2 : 64; + text_pin *p = (text_pin *)realloc(pins, (size_t)cap * sizeof *p); + if (p == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *p); + pins = p; + pins_cap = cap; + } + } + pins[pins_n].o = o; + pins[pins_n].a = a; + pins[pins_n].inc = inc; + pins[pins_n].epoch = epoch; + pins_n++; +} + static void gc_mark_all(void) { int64_t i; unsigned k; + pins_prune(); + for (i = 0; i < pins_n; i++) mark_push(pins[i].o); for (i = 0; i < roots_n; i++) { const flan_desc *d = roots[i].desc; if (d == NULL) mark_value(*(flan_dyn *)roots[i].base); @@ -3106,6 +3168,9 @@ static inline int is_map(flan_dyn v) { * t str (read as a copy; never written from here) * a;T a fixed [n T] * sT a slice [T] + * cT a [const T]: only in what a crossing *into* a + * written type wants ([flan_dyn_need_as]); no view + * is ever of one * vT a (Vec T) * {Name;f1;T1f2;T2} a struct, its fields in declaration order * @@ -3136,7 +3201,7 @@ static const uint8_t *desc_name_end(const uint8_t *d) { static const uint8_t *desc_skip(const uint8_t *d) { switch (*d) { case 'a': d++; desc_int(&d); return desc_skip(d); - case 's': case 'v': return desc_skip(d + 1); + case 's': case 'c': case 'v': return desc_skip(d + 1); case '{': d = desc_name_end(d + 1); while (*d != '}') d = desc_skip(desc_name_end(d)); @@ -3152,7 +3217,7 @@ static void desc_lay(const uint8_t *d, int64_t *size, int64_t *align) { case 'b': case 'B': case '?': *size = 1; *align = 1; return; case 'h': case 'H': *size = 2; *align = 2; return; case 'i': case 'I': case 'f': *size = 4; *align = 4; return; - case 't': case 's': *size = 16; *align = 8; return; + case 't': case 's': case 'c': *size = 16; *align = 8; return; case 'v': *size = 40; *align = 8; return; case 'a': { int64_t n, s, a; @@ -3271,6 +3336,10 @@ static void desc_spell(const uint8_t *d, char *buf, size_t cap) { desc_spell(d + 1, inner, sizeof inner); snprintf(buf, cap, "[%s]", inner); return; + case 'c': + desc_spell(d + 1, inner, sizeof inner); + snprintf(buf, cap, "[const %s]", inner); + return; case 'v': desc_spell(d + 1, inner, sizeof inner); snprintf(buf, cap, "(Vec %s)", inner); @@ -3916,6 +3985,379 @@ flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { return view_make(data, len, old_elem_desc(elem), VIEW_FLAT, 0); } +/* ── Dyn into a written type ─────────────────────────────────────────── + * + * The reverse of a view: a dyn value reaching typed code that wrote a str, a + * slice, a fixed array or a struct (lib/check.ml, [into_typed]). [want] is + * the written type's descriptor, the prefix code above, with [c] for a + * [const T]; [out] is where the typed value goes — a str's or slice's two + * words, or the array's or struct's bytes. Four answers, in order: + * + * a text its own bytes, for a str or a [const u8], pinned + * ([pin_text]) and never copied; + * a view of typed storage whose element type is the one wanted: that + * storage, checked for staleness in a dev build, never copied; + * a vec, map copied and unboxed element by element, each checked, for a + * [const T], a fixed array or a struct — a [const T]'s block + * in the temp arena ([flan_temp_block]); + * anything else traps, naming the element and what it is. + * + * A [T] that can be written through is never a copy. A write through a copy + * would not reach the dyn vec, and the same program would then answer + * differently with the vec typed or dyn; so a plain dyn vec, or a view of + * other elements, into a [T] traps and names [const T]. A fixed array and a + * struct are values, copied on the typed side as well, so a copy there + * changes nothing. */ + +void *flan_temp_block(int64_t bytes, int64_t align, int64_t elem, + const char *type, int64_t typelen); + +typedef struct into_site { + const uint8_t *loc; + int64_t loclen; + char op[140]; /* "into [const i64]" */ + char where[192]; /* "element 2", "field :x of element 2"; "" */ +} into_site; + +static _Noreturn void into_trap(into_site *s, const char *trap, + const char *fmt, ...) { + char msg[640]; + va_list ap; + va_start(ap, fmt); + vsnprintf(msg, sizeof msg, fmt, ap); + va_end(ap); + flan_say(s->loc, s->loclen, "dyn %s: %s", s->op, msg); + dyn_trap((const uint8_t *)trap, (int64_t)strlen(trap)); +} + +static const char *into_who(into_site *s) { + return s->where[0] ? s->where : "this"; +} + +/* "element 2 is a text, "a", and an i64 is wanted there". A view is checked + * for staleness before it is rendered, since rendering reads it. */ +static _Noreturn void into_wrong(into_site *s, flan_dyn x, const char *why) { + char sx[SAY_MAX]; + const char *t = tag_of(x); + if (dyn_boxed(x) && dyn_box(x) == BOX_OBJ && dyn_obj(x) != NULL + && dyn_obj(x)->kind == OBJ_VIEW) + view_guard_check(s->loc, s->loclen, s->op, dyn_obj(x)); + if (flan_dyn_tag(x) == FLAN_DYN_TAG_NIL) + into_trap(s, "DynType", "%s is nil, and %s", into_who(s), why); + say(sx, SAY_MAX, x); + into_trap(s, "DynType", "%s is %s %s, %s, and %s", into_who(s), an(t), t, + sx, why); +} + +/* "an i64 is wanted there". */ +static void into_wanted(char *buf, size_t cap, const uint8_t *d) { + char ty[128]; + desc_spell(d, ty, sizeof ty); + snprintf(buf, cap, "%s %s is wanted there", an(ty), ty); +} + +/* Whether a view's descriptor [a] starts with the whole of the code [b]. + * The code is prefix-free, so a view's (inside a longer one) matches exactly + * when these bytes do. */ +static int desc_same(const uint8_t *a, const uint8_t *b) { + size_t n = (size_t)(desc_skip(b) - b); + return memcmp(a, b, n) == 0; +} + +/* A vec's length and element [i], a plain one's word or a view's element + * boxed. [o] is a vec-tagged object whose guard has been checked. */ +static int64_t into_len(into_site *s, flan_obj *o) { + return o->kind == OBJ_VIEW ? view_len(s->loc, s->loclen, s->op, o) : o->len; +} + +static flan_dyn into_at(into_site *s, flan_obj *o, int64_t i) { + if (o->kind == OBJ_VIEW) + return view_read(s->loc, s->loclen, s->op, o, o->u.view.desc, + view_elem_at(o, i)); + return o->u.v.items[i]; +} + +/* A view object, or NULL; checked for staleness when it is one. */ +static flan_obj *into_view(into_site *s, flan_dyn x) { + flan_obj *o; + if (!dyn_boxed(x) || dyn_box(x) != BOX_OBJ) return NULL; + o = dyn_obj(x); + if (o == NULL || o->kind != OBJ_VIEW) return NULL; + view_guard_check(s->loc, s->loclen, s->op, o); + return o; +} + +/* Steps [s->where] into a part of what it names; [into_leave] steps back. */ +static void into_enter(into_site *s, const char *fmt, ...) { + char part[96], rest[192]; + va_list ap; + va_start(ap, fmt); + vsnprintf(part, sizeof part, fmt, ap); + va_end(ap); + memcpy(rest, s->where, sizeof rest); + if (rest[0] == '\0') snprintf(s->where, sizeof s->where, "%s", part); + else snprintf(s->where, sizeof s->where, "%s of %s", part, rest); +} + +static void into_leave(into_site *s, const char *saved) { + memcpy(s->where, saved, sizeof s->where); +} + +static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p); +static void into_slice(into_site *s, const uint8_t *d, flan_dyn x, + uint8_t *p); + +/* A text's bytes as a str's two words, pinned. */ +static void into_text(flan_dyn x, uint8_t *p) { + flan_obj *o = dyn_obj(x); + const uint8_t *b = obj_text_bytes(o); + pin_text(o); + memcpy(p, &b, 8); + memcpy(p + 8, &o->len, 8); +} + +/* [n] elements of [e] from the vec-tagged [o] into [p]. */ +static void into_elems(into_site *s, const uint8_t *e, flan_obj *o, int64_t n, + uint8_t *p) { + int64_t i, sz = desc_size(e); + char saved[192]; + memcpy(saved, s->where, sizeof saved); + for (i = 0; i < n; i++) { + flan_dyn x; + into_enter(s, "element %lld", (long long)i); + x = into_at(s, o, i); + into_put(s, e, x, p + i * sz); + into_leave(s, saved); + } +} + +static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) { + char why[256], ty[128]; + int64_t lo, hi; + if (int_range(*d, &lo, &hi)) { + int64_t n; + if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) { + into_wanted(why, sizeof why, d); + into_wrong(s, x, why); + } + n = dyn_int_value(x); + if (n < lo || n > hi) { + desc_spell(d, ty, sizeof ty); + if (*d == 'L') + into_trap(s, "DynRange", "%s is %lld, and a u64 holds no negative " + "number", into_who(s), (long long)n); + into_trap(s, "DynRange", "%s is %lld, and %s %s holds %lld to %lld", + into_who(s), (long long)n, an(ty), ty, (long long)lo, + (long long)hi); + } + switch (*d) { + case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; } + case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; } + case 'i': case 'I': { uint32_t w = (uint32_t)n; memcpy(p, &w, 4); return; } + default: memcpy(p, &n, 8); return; + } + } + switch (*d) { + case 'f': case 'd': { + double f = 0; + /* An int goes into a float when the float holds it exactly: a view's + element write and a class's float slot take the same rule. */ + if (flan_dyn_tag(x) == FLAN_DYN_TAG_INT) { + int64_t n = dyn_int_value(x); + f = *d == 'f' ? (double)(float)n : (double)n; + if (!(f >= -9223372036854775808.0 && f < 9223372036854775808.0) + || (int64_t)f != n) + into_trap(s, "DynRange", "%s is %lld, which has no exact %s. Write " + "it as a float, as in %lld.0", into_who(s), (long long)n, + *d == 'f' ? "f32" : "f64", (long long)n); + } else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) + f = dyn_num_value(x); + else { + into_wanted(why, sizeof why, d); + into_wrong(s, x, why); + } + if (*d == 'f') { float g = (float)f; memcpy(p, &g, 4); } + else memcpy(p, &f, 8); + return; + } + case '?': + if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) { + into_wanted(why, sizeof why, d); + into_wrong(s, x, why); + } + *p = dyn_payload(x) ? 1 : 0; + return; + case 't': + if (!is_text(x)) + into_wrong(s, x, "a str is wanted there, which only a text becomes"); + into_text(x, p); + return; + case 'a': { + const uint8_t *e = d + 1; + int64_t n = desc_int(&e), len; + flan_obj *o; + if (!is_vec(x)) { + desc_spell(d, ty, sizeof ty); + snprintf(why, sizeof why, "%s %s is made from a vec", an(ty), ty); + into_wrong(s, x, why); + } + o = into_view(s, x); + if (o == NULL) o = dyn_obj(x); + len = into_len(s, o); + if (len != n) { + desc_spell(d, ty, sizeof ty); + into_trap(s, "DynRange", "%s has %lld element%s, and %s %s holds " + "exactly %lld", s->where[0] ? s->where : "this vec", + (long long)len, len == 1 ? "" : "s", an(ty), ty, + (long long)n); + } + /* A view of the same elements is the same bytes: an array is a value, + copied on the typed side too. */ + if (o->kind == OBJ_VIEW && desc_same(o->u.view.desc, e)) { + if (n > 0) memcpy(p, view_base(o), (size_t)(n * desc_size(e))); + return; + } + into_elems(s, e, o, n, p); + return; + } + case '{': { + const uint8_t *at, *name, *fty; + int64_t off, namelen, foff; + flan_obj *o; + char saved[192]; + if (!is_map(x)) { + desc_spell(d, ty, sizeof ty); + snprintf(why, sizeof why, "%s %s is made from a map", an(ty), ty); + into_wrong(s, x, why); + } + o = into_view(s, x); + if (o != NULL && desc_same(o->u.view.desc, d)) { + memcpy(p, o->u.view.base, (size_t)desc_size(d)); + return; + } + memcpy(saved, s->where, sizeof saved); + at = desc_fields(d, &off); + while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) { + flan_dyn k = flan_dyn_kw(name, namelen), v; + if (!flan_dyn_truthy(flan_dyn_map_contains_at(x, k, s->loc, + s->loclen))) { + desc_spell(d, ty, sizeof ty); + into_trap(s, "DynType", "%s has no :%.*s, and %s %s needs every " + "field", s->where[0] ? s->where : "this map", + (int)namelen, (const char *)name, an(ty), ty); + } + v = flan_dyn_get(x, k, s->loc, s->loclen); + into_enter(s, "field :%.*s", (int)namelen, (const char *)name); + into_put(s, fty, v, p + foff); + into_leave(s, saved); + } + return; + } + case 's': case 'c': + into_slice(s, d, x, p); + return; + default: + desc_spell(d, ty, sizeof ty); + snprintf(why, sizeof why, "%s %s is not made from a dyn value", an(ty), ty); + into_wrong(s, x, why); + } +} + +/* The copy a [const T] reads, of a plain vec or a view of other elements. */ +static void into_copy(into_site *s, const uint8_t *e, flan_obj *o, + uint8_t *out) { + static const char scalars[] = "bBhHiIlLfd?t"; + static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32", + "i64", "u64", "f32", "f64", "bool", + "str" }; + const char *w = *e != '\0' ? strchr(scalars, *e) : NULL; + /* The registry keeps the name by pointer, so it is static text. */ + const char *type = w != NULL ? words[w - scalars] : "element"; + int64_t n = into_len(s, o), size, align; + uint8_t *block = NULL; + desc_lay(e, &size, &align); + if (n > 0 && size > 0) { + block = (uint8_t *)flan_temp_block(n * size, align, size, type, + (int64_t)strlen(type)); + if (block == NULL) trap_oom(s->loc, s->loclen, n * size); + memset(block, 0, (size_t)(n * size)); + into_elems(s, e, o, n, block); + } + memcpy(out, &block, 8); + memcpy(out + 8, &n, 8); +} + +/* A [T] or a [const T], at the top or inside an array or a struct. A text + * is a [const u8]'s bytes, a view of the very elements wanted is its own + * storage, and a [const T] of anything else vec-shaped is a copy; a [T] + * never is, since a write through it would not reach the vec. */ +static void into_slice(into_site *s, const uint8_t *d, flan_dyn x, + uint8_t *p) { + const uint8_t *e = d + 1; + int mut = *d == 's'; + const char *who = s->where[0] ? s->where : "this vec"; + char ty[128], ety[128], why[256]; + flan_obj *o; + desc_spell(d, ty, sizeof ty); + desc_spell(e, ety, sizeof ety); + if (is_text(x) && *e == 'B') { + if (mut) + into_wrong(s, x, "a text is read-only, so it becomes a str or a " + "[const u8] and never a [u8]"); + into_text(x, p); + return; + } + if (!is_vec(x)) { + snprintf(why, sizeof why, "only a vec becomes %s %s", an(ty), ty); + into_wrong(s, x, why); + } + o = into_view(s, x); + if (o != NULL && desc_same(o->u.view.desc, e)) { + void *b = view_base(o); + int64_t n = view_len(s->loc, s->loclen, s->op, o); + memcpy(p, &b, 8); + memcpy(p + 8, &n, 8); + return; + } + if (mut) { + char have[128]; + if (o != NULL) { + desc_spell(o->u.view.desc, have, sizeof have); + into_trap(s, "DynType", "%s is a view of %s elements, so %s %s of it " + "would be a copy, and a write through the copy would never " + "reach the vec. Take it as [const %s], which reads a copy", + who, have, an(ty), ty, ety); + } + into_trap(s, "DynType", "%s is a dyn vec, so %s %s of it would be a " + "copy, and a write through the copy would never reach the vec. " + "Take it as [const %s], which reads a copy", who, an(ty), ty, + ety); + } + into_copy(s, e, o != NULL ? o : dyn_obj(x), p); +} + +void flan_dyn_need_as(flan_dyn v, const uint8_t *want, int64_t wantlen, + void *out, const uint8_t *loc, int64_t loclen) { + into_site s; + char ty[128]; + uint8_t *p = (uint8_t *)out; + (void)wantlen; + s.loc = loc; + s.loclen = loclen; + s.where[0] = '\0'; + desc_spell(want, ty, sizeof ty); + snprintf(s.op, sizeof s.op, "into %s", ty); + switch (*want) { + case 't': + if (!is_text(v)) into_wrong(&s, v, "only a text becomes a str"); + into_text(v, p); + return; + default: + into_put(&s, want, v, p); + return; + } +} + static flan_dyn len_walk(flan_dyn v) { if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len); /* A map's length is its slot count, so a stale instance would answer the diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 01a29f12..b18c353f 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -348,6 +348,18 @@ flan_dyn flan_dyn_view_slice(void *data, int64_t len, const uint8_t *desc, flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc, int64_t desclen, int32_t shape, int32_t here); +/* The other direction: a dyn value where typed code wrote a str, a [T], a + * [const T], a fixed [n T] or a struct. [want] is that type's descriptor + * (the code above, and 'c' before a [const T]'s element); [out] receives the + * str's or slice's two words, or the array's or struct's bytes. A text + * becomes a str or a [const u8] as its own bytes, kept from the collector + * until the temp arena's next free-all; a view of the wanted elements + * becomes its own storage; a vec or a map becomes a checked copy — for a + * [const T] in the temp arena — and a [T] is never a copy. Anything else + * traps at [loc], naming the element and what it holds. */ +void flan_dyn_need_as(flan_dyn v, const uint8_t *want, int64_t wantlen, + void *out, const uint8_t *loc, int64_t loclen); + /* print, =, length and has-key? with the site they were written at: a view * that traps inside one names it. */ void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen); diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index b841fec7..59cd0d2a 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -2593,6 +2593,40 @@ int8_t flan_f64_temp(double x, flan_slice *out) { return flan_temp_text(render_f64, &x, out); } +/* For flan_dyn.c's crossing of a dyn value into a written type + * ([flan_dyn_need_as]). A dyn vec copied into a [const T] or a text's bytes + * lent to a str live exactly as long as i64->bytes's text does: until the + * temp arena's next free-all. [flan_temp_block] is the copy's block, noted + * in a dev build's registry like any temp slice so a read after free-temp + * traps or reads poison; NULL only when malloc itself failed. The stamp is + * the arena and the incarnation and epoch it is at now, and a stamp is live + * while that arena is still at both — a free-temp, the agent's wipe, the end + * of a scratch evaluation or a destroy ends it. An arena record is never + * freed (see [flan_retired]), so an old stamp is always safe to read. */ +void *flan_temp_block(int64_t bytes, int64_t align, int64_t elem, + const char *type, int64_t typelen) { + flan_allocator *a = flan_context_temp(); + void *q; + if (a == NULL || bytes <= 0) return NULL; + q = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, align); + if (q != NULL) flan_dev_reg_note_sliced(q, bytes, elem, type, typelen, a); + return q; +} + +const void *flan_temp_stamp(uint64_t *inc, uint64_t *epoch) { + flan_allocator *a = flan_context_temp(); + *inc = a ? a->incarnation : 0; + *epoch = a ? a->epoch : 0; + return a; +} + +int32_t flan_temp_stamp_live(const void *p, uint64_t inc, uint64_t epoch) { + const flan_allocator *a = (const flan_allocator *)p; + /* No temp arena could be made: the pin is kept for good. */ + if (a == NULL) return 1; + return a->incarnation == inc && a->epoch == epoch; +} + /* The allocator's identity, for the condition's :allocator field. The pointer * is the identity — the same thing the epoch hangs off. */ int64_t flan_alloc_id(flan_allocator *a) { return (int64_t)(intptr_t)a; } diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 7a0c1a33..04c8efd5 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -1386,6 +1386,31 @@ static void walk_hook(const uint8_t *name, int64_t namelen) { longjmp(walk_out, 1); } +/* flan_dyn_need_as: a text is a str's own bytes, a view of the same + * elements its own storage, and a plain vec a checked copy. */ +static void into(void) { + static int64_t a[3] = { 1, 2, 3 }; + struct { const uint8_t *p; int64_t n; } s; + int64_t arr[2]; + flan_dyn t, v, w; + flan_gc_init(); + t = flan_dyn_from_bytes((const uint8_t *)"abc", 3); + flan_dyn_root_push(&t); + flan_dyn_need_as(t, (const uint8_t *)"t", 1, &s, NULL, 0); + check(s.n == 3 && memcmp(s.p, "abc", 3) == 0, "into str"); + v = flan_dyn_view_slice(a, 3, (const uint8_t *)"l", 1, 0); + flan_dyn_root_push(&v); + flan_dyn_need_as(v, (const uint8_t *)"sl", 2, &s, NULL, 0); + check((const void *)s.p == (const void *)a && s.n == 3, "into [i64] view"); + w = flan_dyn_vec_new(); + flan_dyn_root_push(&w); + flan_dyn_push(w, flan_dyn_from_i64(7), NULL, 0); + flan_dyn_push(w, flan_dyn_from_i64(8), NULL, 0); + flan_dyn_need_as(w, (const uint8_t *)"a2;l", 4, arr, NULL, 0); + check(arr[0] == 7 && arr[1] == 8, "into [2 i64] copy"); + flan_dyn_root_pop(3); +} + static void walkreset(void) { static uint64_t big[1] = { UINT64_MAX }; flan_dyn v, w, m; @@ -1416,6 +1441,7 @@ int main(int argc, char **argv) { } if (strcmp(argv[1], "ops") == 0) { ops(); + into(); printf(failures == 0 ? "ops ok\n" : "ops failed\n"); return failures == 0 ? 0 : 1; } diff --git a/test/programs/dyn-into-typed.flan b/test/programs/dyn-into-typed.flan new file mode 100644 index 00000000..22db7401 --- /dev/null +++ b/test/programs/dyn-into-typed.flan @@ -0,0 +1,115 @@ +;;;; A dyn value where typed code wrote a str, a slice, a fixed array or a +;;;; struct. Mode 0 is the survey; the others are one trap each, since a trap +;;;; ends the process. test_acceptance.ml runs it on both backends and under +;;;; --dev, where mode 8 (a view of a returned call's local) traps as well. + +(declare gc-collect [] () "flan_gc_collect") +(declare gc-count [] i64 "flan_gc_count") + +(defstruct Point [x f64 y i32]) +(defstruct Named [name str id u32]) +(defclass pt [x y]) + +;; Unannotated parameters and returns are dyn. +(defn keep [d] dyn d) +(defn text-of [d] dyn (slice d 0 5)) + +(defn shout [s str] () (println s)) +(defn keep-str [s str] str s) +;; The text crosses in this frame, whose dyn slots are gone once it returns. +(defn fetch [] str (keep-str (text-of (keep "pinned text")))) +(defn sum [xs [const i64]] i64 + (let [t (i64 0)] + (dotimes [i (length xs)] (set t (+ t (at xs i)))) + t)) +(defn bump [xs [i64]] () + (dotimes [i (length xs)] (set (at xs i) (+ (at xs i) 100)))) +(defn sumf [xs [const f64]] f64 + (let [t 0.0] + (dotimes [i (length xs)] (set t (+ t (at xs i)))) + t)) +(defn bytes-sum [xs [const u8]] i64 + (let [t (i64 0)] + (dotimes [i (length xs)] (set t (+ t (i64 (at xs i))))) + t)) +(defn names [xs [const str]] () + (dotimes [i (length xs)] (println (at xs i)))) +(defn words [xs [const [const u8]]] i64 (length (at xs 1))) +(defn triple [a [3 i64]] i64 (+ (at a 0) (at a 2))) +(defn grid [g [2 [2 i32]]] i32 (at g 1 0)) +(defn px [p Point] f64 (+ (.x p) (f64 (.y p)))) +(defn named [n Named] () (println (.name n) (.id n))) +(defn f64s [xs [f64]] () (println (length xs))) +(defn raw [xs [u8]] () (println (length xs))) + +;; A view of a local, kept past the call that owns the local. +(defonce held dyn nil) +(defn leak-local [] () + (let [a [(i64 1) 2 3]] + (set held (keep a)))) + +(defn main [args [str]] i32 + (let [n (i32 (bytes->i64 (bytes-view (at args 1))))] + (cond + (= n 0) + (do + ;; A text becomes a str. + (shout (keep "hello")) + (println (length (keep-str (keep "four")))) + ;; A str kept past its crossing, the text reachable only through + ;; the pin, while collections run and the heap is refilled. + (let [s (fetch)] + (gc-collect) + (dotimes [i 20000] (text-of (keep "XXXXXXXXXX"))) + (gc-collect) + (dotimes [i 20000] (text-of (keep "XXXXXXXXXX"))) + (println s)) + ;; A pin ends at free-temp: a thousand crossed texts are collected. + (free-temp) + (gc-collect) + (let [before (gc-count)] + (dotimes [i 1000] (keep-str (text-of (keep "abcdefgh")))) + (free-temp) + (gc-collect) + (println (< (- (gc-count) before) 100))) + ;; A view of typed storage comes back as that storage. + (let [a [(i64 1) 2 3]] + (bump (keep a)) + (println a) + (println (sum (keep a)))) + (let [v (vec-new i64)] + (push v 5) (push v 6) + (bump (keep v)) + (println (at v 0) (at v 1)) + (free v)) + ;; A plain dyn vec is a checked copy for a [const T]. + (println (sum (the dyn [1 2 3 4]))) + (println (sumf (the dyn [1 2.5]))) + (println (bytes-sum (the dyn [1 2 255]))) + (println (bytes-sum (keep "AB"))) + (names (the dyn ["ada" "bo"])) + (println (words (the dyn ["x" "yyy"]))) + ;; A view of other elements too. + (let [b [(i32 7) 8]] + (println (sum (keep b)))) + ;; A fixed array and a struct are values: a copy either way. + (println (triple (the dyn [10 20 30]))) + (let [a [(i64 4) 5 6]] (println (triple (keep a)))) + (println (grid (the dyn [[1 2] [3 4]]))) + (println (px (the dyn {:x 1.5 :y 2}))) + (println (px (pt 2.5 3))) + (let [p (Point {.x 0.25 .y 4})] (println (px (keep p)))) + (named (the dyn {:name "cy" :id 9})) + 0) + (= n 1) (do (println (sum (the dyn [1 "a" 3]))) 0) + (= n 2) (do (bump (the dyn [1 2])) 0) + (= n 3) (do (println (sum (keep "abc"))) 0) + (= n 4) (do (println (bytes-sum (the dyn [1 300]))) 0) + (= n 5) (do (println (triple (the dyn [1 2]))) 0) + (= n 6) (do (println (px (the dyn {:x 1.5}))) 0) + (= n 7) (do (shout (keep 5)) 0) + (= n 8) (do (leak-local) (bump held) 0) + (= n 9) (do (raw (keep "abc")) 0) + (= n 10) (let [a [(f32 1) 2]] (f64s (keep a)) 0) + (= n 11) (do (println (px (the dyn {:x 1.5 :y "no"}))) 0) + :else 1))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index bb0d75f7..d666a42e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -6023,6 +6023,67 @@ level "1" dyn_view_any ~dev:true (); dyn_view_any ~dev:true ~x86:true (); + (* ── A dyn value into a written type ─────────────────────────────── + programs/dyn-into-typed.flan: a text into a str, kept past the frame + it crossed in while collections run; a view back into its own + storage, written through; a dyn vec, map or instance copied into a + [const T], a fixed array or a struct (mode 0); then one trap per mode, + each naming the element and what it holds. Mode 8, a view of a + returned call's local, traps under --dev only. *) + let into_out = + "hello\n4\npinne\ntrue\n[101 102 103]\n306\n105 106\n10\n3.5\n258\n\ + 131\nada\nbo\n3\n15\n40\n10\n3\n3.5\n5.5\n4.25\ncy 9\n" + and into_traps = + [ ("1", "dyn-into-typed.flan:104:33: dyn into [const i64]: element 1 \ + is a text, \"a\", and an i64 is wanted there"); + ("2", "dyn into [i64]: this vec is a dyn vec, so a [i64] of it would \ + be a copy, and a write through the copy would never reach the \ + vec. Take it as [const i64], which reads a copy"); + ("3", "this is a text, \"abc\", and only a vec becomes a [const i64]"); + ("4", "element 1 is 300, and a u8 holds 0 to 255"); + ("5", "this vec has 2 elements, and a [3 i64] holds exactly 3"); + ("6", "dyn into Point: this map has no :y, and a Point needs every \ + field"); + ("7", "dyn into str: this is an int, 5, and only a text becomes a str"); + ("9", "a text is read-only, so it becomes a str or a [const u8] and \ + never a [u8]"); + ("10", "this vec is a view of f32 elements"); + ("11", "field :y is a text, \"no\", and an i32 is wanted there") ] + and into_stale = + [ ("8", "dyn into [i64]: this view points into a local of leak-local, \ + and that call has returned") ] + in + let dyn_into ?opt ?(x86 = false) ?(dev = false) () = + let exe = compile ?opt ~x86 ~dev "programs/dyn-into-typed.flan" in + let name what = + "dyn: into a written type" ^ what + ^ (match opt with Some o -> ", " ^ o | None -> "") + ^ (if x86 then ", --x86" else "") ^ (if dev then ", --dev" else "") + in + let code, text = run exe (Some "0") in + if code <> 0 || text <> into_out then begin + incr failures; + Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n" + (name "") text code into_out + end; + List.iter + (fun (mode, needle) -> + let code, text = run exe (Some mode) in + if code <> 134 || not (contains text needle) then begin + incr failures; + Printf.printf + "FAIL %s\n got: %S (exit %d)\n wanted a trap \ + saying %S\n" (name (", mode " ^ mode)) text code needle + end) + (into_traps @ if dev then into_stale else []); + (try Sys.remove exe with Sys_error _ -> ()) + in + dyn_into (); + dyn_into ~opt:"-O0" (); + dyn_into ~x86:true (); + dyn_into ~dev:true (); + dyn_into ~dev:true ~x86:true (); + (* The root count, which is the part of this feature the runs above cannot check — and the reason has outlived the stub it was first written about. flan_dyn.c's trigger has a one-megabyte floor, and not one diff --git a/test/test_flan.ml b/test/test_flan.ml index 6b853e5f..0d60369d 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -7713,9 +7713,18 @@ let () = rejects_check "the refuses a dyn and names the cast" "(defn f [x dyn] i32 (the i32 x))" ~needle:"write (i32 x) to convert it"; accepts "the cast that refusal names compiles" "(defn f [x dyn] i32 (i32 x))"; - rejects_check "the refuses a dyn at a type a dyn does not become" + rejects_check "the refuses a dyn at str, which a dyn becomes where passed" "(defn f [x dyn] str (the str x))" - ~needle:"dyn — str does not cross into a written type yet"; + ~needle:"a dyn becomes a str where a str is passed"; + accepts "a dyn becomes a slice, an array and a struct where passed" + "(defstruct P [x i32]) (defn f [a [const i64] b [2 f32] c P s str] () ()) \ + (defn g [d dyn] () (f d d d d))"; + rejects_check "a dyn does not become an array of Vecs" + "(defn f [d dyn] [2 (Vec i64)] d)" + ~needle:"it holds a Vec, which owns its storage"; + rejects_check "a dyn does not become a slice of dyn" + "(defn f [d dyn] [const dyn] d)" + ~needle:"[const dyn] does not cross into a written type yet"; rejects_check "the refuses a dyn at bool, which a dyn becomes where passed" "(defn f [x dyn] bool (the bool x))" ~needle:"a dyn becomes a bool where a bool is passed"; From ca9e28860a665716cdcd20cd74e7e29557ca7e59 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 11:52:13 +0700 Subject: [PATCH 2/4] A dyn value into a written type has a checker row that compiles. --- test/test_flan.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/test_flan.ml b/test/test_flan.ml index 0d60369d..6ea5cb04 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -7717,8 +7717,8 @@ let () = "(defn f [x dyn] str (the str x))" ~needle:"a dyn becomes a str where a str is passed"; accepts "a dyn becomes a slice, an array and a struct where passed" - "(defstruct P [x i32]) (defn f [a [const i64] b [2 f32] c P s str] () ()) \ - (defn g [d dyn] () (f d d d d))"; + "(defstruct P [x i32]) (defn f [a [const i64] b [2 f32] c P s str] i64 (length a)) \ + (defn g [d dyn] i64 (f d d d d))"; rejects_check "a dyn does not become an array of Vecs" "(defn f [d dyn] [2 (Vec i64)] d)" ~needle:"it holds a Vec, which owns its storage"; From 78e25dfa48ba4e4307481bb42bbf1d7660832094 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 12:09:25 +0700 Subject: [PATCH 3/4] A str from dyn text is pinned once per temp stamp and is a poisoned temp copy in a dev build, a float past f32's range and a map key a struct lacks trap, and a struct's refusal names what the value is. --- runtime/flan_dyn.c | 179 ++++++++++++++++++++++++------ test/programs/dyn-into-typed.flan | 23 ++++ test/test_acceptance.ml | 22 +++- 3 files changed, 185 insertions(+), 39 deletions(-) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 375be79a..83ac74d8 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1540,56 +1540,97 @@ static void mark_desc(char *base, const flan_desc *d) { * Rooting the text in the crossing's frame would be shorter than that and * wrong for a str returned or stored, and a pin for good would keep every * text a frame loop ever crossed. A copy into the temp arena would be sound - * too; this is the same lifetime without the copy. */ + * too; this is the same lifetime without the copy, and a dev build takes the + * copy instead ([into_text]) so that a str kept past free-temp reads the + * arena's poison, as i64->bytes's text does, rather than whatever text the + * allocator put there next. + * + * A text is pinned once per stamp, however often it crosses: the stamp's + * number is written into the text's [gen], which nothing else reads for a + * text, so a program that never calls free-temp and passes the same texts + * in a loop keeps a flat list. Distinct texts cost one pointer each here, + * and each keeps its own object alive until the stamp ends — heavier than + * i64->bytes's few bytes of arena, since the object has a header. The pins + * sit in runs, one per stamp, so an entry is a pointer and a run's stamp is + * kept once. */ const void *flan_temp_stamp(uint64_t *inc, uint64_t *epoch); int32_t flan_temp_stamp_live(const void *a, uint64_t inc, uint64_t epoch); -typedef struct text_pin { - flan_obj *o; +typedef struct pin_run { const void *a; uint64_t inc, epoch; -} text_pin; + int64_t start; /* its first entry in [pins] */ +} pin_run; -static text_pin *pins; -static int64_t pins_n, pins_cap; +static flan_obj **pins; +static int64_t pins_n, pins_cap; +static pin_run *runs; +static int64_t runs_n, runs_cap; +/* The number the newest run's texts carry in [gen]; never 0, which is what + a text is made with. A wrap would take four billion stamps, and costs one + duplicate entry when it lands on an old text's number. */ +static uint32_t pin_gen; + +static int64_t pins_count(void) { return pins_n; } static void pins_prune(void) { - int64_t i, k = 0; - for (i = 0; i < pins_n; i++) - if (flan_temp_stamp_live(pins[i].a, pins[i].inc, pins[i].epoch)) - pins[k++] = pins[i]; + int64_t r, k = 0, rk = 0; + for (r = 0; r < runs_n; r++) { + int64_t lo = runs[r].start; + int64_t hi = r + 1 < runs_n ? runs[r + 1].start : pins_n; + if (!flan_temp_stamp_live(runs[r].a, runs[r].inc, runs[r].epoch)) continue; + memmove(pins + k, pins + lo, (size_t)(hi - lo) * sizeof *pins); + runs[rk] = runs[r]; + runs[rk].start = k; + k += hi - lo; + rk++; + } pins_n = k; + runs_n = rk; +} + +static void *pins_grow(void *p, int64_t *cap, size_t each) { + int64_t c = *cap ? *cap * 2 : 64; + void *q = realloc(p, (size_t)c * each); + if (q == NULL) trap_oom(NULL, 0, c * (int64_t)each); + *cap = c; + return q; } static void pin_text(flan_obj *o) { uint64_t inc, epoch; const void *a = flan_temp_stamp(&inc, &epoch); - text_pin *last = pins_n > 0 ? &pins[pins_n - 1] : NULL; - if (last != NULL && last->o == o && last->a == a && last->inc == inc - && last->epoch == epoch) + pin_run *last = runs_n > 0 ? &runs[runs_n - 1] : NULL; + if (last == NULL || last->a != a || last->inc != inc + || last->epoch != epoch) { + if (runs_n == runs_cap) { + pins_prune(); + if (runs_n == runs_cap) runs = pins_grow(runs, &runs_cap, sizeof *runs); + } + runs[runs_n].a = a; + runs[runs_n].inc = inc; + runs[runs_n].epoch = epoch; + runs[runs_n].start = pins_n; + runs_n++; + if (++pin_gen == 0) pin_gen = 1; + } else if (o->gen == pin_gen) return; if (pins_n == pins_cap) { pins_prune(); - if (pins_n == pins_cap) { - int64_t cap = pins_cap ? pins_cap * 2 : 64; - text_pin *p = (text_pin *)realloc(pins, (size_t)cap * sizeof *p); - if (p == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *p); - pins = p; - pins_cap = cap; - } + if (pins_n == pins_cap) pins = pins_grow(pins, &pins_cap, sizeof *pins); } - pins[pins_n].o = o; - pins[pins_n].a = a; - pins[pins_n].inc = inc; - pins[pins_n].epoch = epoch; - pins_n++; + o->gen = pin_gen; + pins[pins_n++] = o; } +/* How many texts are pinned now, for a test that the list stays flat. */ +int64_t flan_dyn_pin_count(void) { return pins_count(); } + static void gc_mark_all(void) { int64_t i; unsigned k; pins_prune(); - for (i = 0; i < pins_n; i++) mark_push(pins[i].o); + for (i = 0; i < pins_n; i++) mark_push(pins[i]); for (i = 0; i < roots_n; i++) { const flan_desc *d = roots[i].desc; if (d == NULL) mark_value(*(flan_dyn *)roots[i].base); @@ -4219,10 +4260,23 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p); static void into_slice(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p); -/* A text's bytes as a str's two words, pinned. */ +/* A text's bytes as a str's two words, pinned — or, in a dev build, copied + * into the temp arena, whose registry note and poison catch a str kept past + * free-temp (see [pin_text]). */ static void into_text(flan_dyn x, uint8_t *p) { flan_obj *o = dyn_obj(x); const uint8_t *b = obj_text_bytes(o); + if (flan_dev_reg_enabled()) { + uint8_t *q = NULL; + if (o->len > 0) { + q = (uint8_t *)flan_temp_block(o->len, 1, 1, "u8", 2); + if (q == NULL) trap_oom(NULL, 0, o->len); + memcpy(q, b, (size_t)o->len); + } + memcpy(p, &q, 8); + memcpy(p + 8, &o->len, 8); + return; + } pin_text(o); memcpy(p, &b, 8); memcpy(p + 8, &o->len, 8); @@ -4282,9 +4336,18 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) { into_trap(s, "DynRange", "%s is %lld, which has no exact %s. Write " "it as a float, as in %lld.0", into_who(s), (long long)n, *d == 'f' ? "f32" : "f64", (long long)n); - } else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) + } else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) { f = dyn_num_value(x); - else { + /* A finite float past f32's range would become inf, which is a change + of value and not a rounding: refused, as an int out of range is. */ + if (*d == 'f' && f == f && f - f == 0 && (f > 3.4028234663852886e38 + || f < -3.4028234663852886e38)) { + char sx[SAY_MAX]; + say(sx, SAY_MAX, x); + into_trap(s, "DynRange", "%s is %s, and an f32 holds -3.4028235e38 " + "to 3.4028235e38", into_who(s), sx); + } + } else { into_wanted(why, sizeof why, d); into_wrong(s, x, why); } @@ -4348,16 +4411,60 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) { return; } memcpy(saved, s->where, sizeof saved); + /* What the value is called in a sentence: its place inside the whole, + else what it is — a struct's view, a class's instance, a map. */ + { + char what[160]; + flan_obj *m = dyn_obj(x); + int64_t i, n; + if (s->where[0]) snprintf(what, sizeof what, "%s", s->where); + else if (o != NULL) { + const char *nm; + int64_t nl; + view_struct_name(o, &nm, &nl); + snprintf(what, sizeof what, "this %.*s", (int)nl, nm); + } else if (m->u.v.klass != NULL) { + kw_entry *k = m->u.v.klass; + snprintf(what, sizeof what, "this %.*s", (int)k->len, + (const char *)kw_bytes(k)); + } else + snprintf(what, sizeof what, "this map"); + at = desc_fields(d, &off); + while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) + if (!flan_dyn_truthy(flan_dyn_map_contains_at( + x, flan_dyn_kw(name, namelen), s->loc, s->loclen))) { + desc_spell(d, ty, sizeof ty); + into_trap(s, "DynType", "%s has no :%.*s, and %s %s needs every " + "field", what, (int)namelen, (const char *)name, an(ty), + ty); + } + /* A key the struct has no field for is refused, as a class refuses a + slot it does not declare: dropping it would lose what was written. */ + if (o == NULL) class_sync(m); + n = o != NULL ? view_nfields(o) : m->len; + for (i = 0; i < n; i++) { + flan_dyn k = o != NULL ? view_field_key(o, i) : m->u.v.items[2 * i]; + int64_t foff2; + if (desc_field(d, k, &foff2) == NULL) { + char sk[SAY_MAX]; + int64_t off2; + const uint8_t *at2; + say(sk, SAY_MAX, k); + desc_spell(d, ty, sizeof ty); + said_len = 0; + said_add("dyn %s: %s has %s, and %s %s has no field %s. Its fields " + "are", s->op, what, sk, an(ty), ty, sk); + at2 = desc_fields(d, &off2); + while (desc_next(&at2, &off2, &name, &namelen, &foff, &fty)) + said_add(" :%.*s", (int)namelen, (const char *)name); + flan_say(s->loc, s->loclen, "%s", said_buf); + dyn_trap((const uint8_t *)"DynType", 7); + } + } + } at = desc_fields(d, &off); while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) { flan_dyn k = flan_dyn_kw(name, namelen), v; - if (!flan_dyn_truthy(flan_dyn_map_contains_at(x, k, s->loc, - s->loclen))) { - desc_spell(d, ty, sizeof ty); - into_trap(s, "DynType", "%s has no :%.*s, and %s %s needs every " - "field", s->where[0] ? s->where : "this map", - (int)namelen, (const char *)name, an(ty), ty); - } v = flan_dyn_get(x, k, s->loc, s->loclen); into_enter(s, "field :%.*s", (int)namelen, (const char *)name); into_put(s, fty, v, p + foff); diff --git a/test/programs/dyn-into-typed.flan b/test/programs/dyn-into-typed.flan index 22db7401..cc70fe4d 100644 --- a/test/programs/dyn-into-typed.flan +++ b/test/programs/dyn-into-typed.flan @@ -42,6 +42,15 @@ (defn f64s [xs [f64]] () (println (length xs))) (defn raw [xs [u8]] () (println (length xs))) +(declare pin-count [] i64 "flan_dyn_pin_count") +(defn slen [s str] i64 (length s)) +(defn f32s [xs [const f32]] () (println (length xs))) +(defclass pq [x]) + +;; A str kept in a global past free-temp: a dev build's copy is poisoned. +(defonce kept str "") +(defn stash-str [] () (set kept (keep-str (keep "kept text")))) + ;; A view of a local, kept past the call that owns the local. (defonce held dyn nil) (defn leak-local [] () @@ -72,6 +81,10 @@ (free-temp) (gc-collect) (println (< (- (gc-count) before) 100))) + ;; The same texts crossing again and again are pinned once each. + (let [t1 (keep "one") t2 (keep "two") n (i64 0)] + (dotimes [i 100000] (set n (+ n (slen t1) (slen t2)))) + (println n (< (pin-count) 10))) ;; A view of typed storage comes back as that storage. (let [a [(i64 1) 2 3]] (bump (keep a)) @@ -112,4 +125,14 @@ (= n 9) (do (raw (keep "abc")) 0) (= n 10) (let [a [(f32 1) 2]] (f64s (keep a)) 0) (= n 11) (do (println (px (the dyn {:x 1.5 :y "no"}))) 0) + (= n 12) (do (f32s (the dyn [1.5 1e300])) 0) + (= n 13) (do (println (px (pq 1.5))) 0) + (= n 14) (do (println (px (the dyn {:x 1.5 :y 2 :z 3}))) 0) + (= n 15) + (do (stash-str) + (free-temp) + (gc-collect) + (dotimes [i 1000] (text-of (keep "XXXXXXXXXX"))) + (println (at kept 0)) + 0) :else 1))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 629ffb34..d5591101 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -6106,10 +6106,10 @@ level "1" each naming the element and what it holds. Mode 8, a view of a returned call's local, traps under --dev only. *) let into_out = - "hello\n4\npinne\ntrue\n[101 102 103]\n306\n105 106\n10\n3.5\n258\n\ + "hello\n4\npinne\ntrue\n600000 true\n[101 102 103]\n306\n105 106\n10\n3.5\n258\n\ 131\nada\nbo\n3\n15\n40\n10\n3\n3.5\n5.5\n4.25\ncy 9\n" and into_traps = - [ ("1", "dyn-into-typed.flan:104:33: dyn into [const i64]: element 1 \ + [ ("1", "dyn-into-typed.flan:117:33: dyn into [const i64]: element 1 \ is a text, \"a\", and an i64 is wanted there"); ("2", "dyn into [i64]: this vec is a dyn vec, so a [i64] of it would \ be a copy, and a write through the copy would never reach the \ @@ -6123,7 +6123,13 @@ level "1" ("9", "a text is read-only, so it becomes a str or a [const u8] and \ never a [u8]"); ("10", "this vec is a view of f32 elements"); - ("11", "field :y is a text, \"no\", and an i32 is wanted there") ] + ("11", "field :y is a text, \"no\", and an i32 is wanted there"); + ("12", "element 1 is 1e+300, and an f32 holds -3.4028235e38 to \ + 3.4028235e38"); + ("13", "dyn into Point: this pq has no :y, and a Point needs every \ + field"); + ("14", "dyn into Point: this map has :z, and a Point has no field \ + :z. Its fields are :x :y") ] and into_stale = [ ("8", "dyn into [i64]: this view points into a local of leak-local, \ and that call has returned") ] @@ -6151,6 +6157,16 @@ level "1" saying %S\n" (name (", mode " ^ mode)) text code needle end) (into_traps @ if dev then into_stale else []); + (* A str from a text kept in a global past free-temp: a dev build's + copy reads the arena's poison (0xEF), never another text's bytes. *) + if dev then begin + let code, text = run exe (Some "15") in + if code <> 0 || text <> "239\n" then begin + incr failures; + Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n" + (name ", a str kept past free-temp") text code "239\n" + end + end; (try Sys.remove exe with Sys_error _ -> ()) in dyn_into (); From 0b568185695820afa4dc592ba291d61fedf94450 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 12:23:17 +0700 Subject: [PATCH 4/4] Dev bookkeeping per temp allocation grows without free-temp, recorded. --- TODO.org | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/TODO.org b/TODO.org index 1725ed97..5a4856fc 100644 --- a/TODO.org +++ b/TODO.org @@ -1548,6 +1548,10 @@ are a dyn vector, except numbers with no common type, which are refused. Rules out the first element typing the rest. * Dev loop +** TODO --dev bookkeeping per temp allocation grows without free-temp +Under --dev each temp allocation (i64->bytes, dyn text crossing into str) costs about +340 bytes of registry notes until free-temp; a loop passing dyn text as str 4M times +without free-temp reaches 2.7 GB. Release stays flat. A CLI that never frees temp hits it. ** WAIT A _ caller whose type follows a redefined callee Its signature changes in the session but its body is not recompiled, so every call