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

A dyn value crosses into typed code wanting a str, a slice, a fixed array or a struct, checked at the crossing, and a writable slice is never a copy.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 12:23:05 +07:00
commit 83fa52a9c3
10 changed files with 913 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO.org
View File

@ -37,6 +37,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

59
lib/check.ml
View File

@ -3643,8 +3643,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 ->
@ -3659,6 +3662,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
@ -4219,6 +4224,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".
@ -4585,6 +4632,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;

1
lib/emit.ml
View File

@ -5138,6 +5138,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)

553
runtime/flan_dyn.c
View File

@ -1525,9 +1525,112 @@ 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, 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 pin_run {
const void *a;
uint64_t inc, epoch;
int64_t start; /* its first entry in [pins] */
} pin_run;
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 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);
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) pins = pins_grow(pins, &pins_cap, sizeof *pins);
}
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]);
for (i = 0; i < roots_n; i++) {
const flan_desc *d = roots[i].desc;
if (d == NULL) mark_value(*(flan_dyn *)roots[i].base);
@ -3218,6 +3321,9 @@ static inline int is_map(flan_dyn v) {
* t str (read as a copy; never written from here)
* a<n>;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
*
@ -3248,7 +3354,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));
@ -3264,7 +3370,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;
@ -3383,6 +3489,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);
@ -4028,6 +4138,445 @@ 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 — 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);
}
/* [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);
/* 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);
}
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);
/* 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;
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

12
runtime/flan_dyn.h
View File

@ -362,6 +362,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);

34
runtime/flan_rt.c
View File

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

26
test/dyn_ops.c
View File

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

138
test/programs/dyn-into-typed.flan Normal file
View File

@ -0,0 +1,138 @@
;;;; 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)))
(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 [] ()
(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)))
;; 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))
(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)
(= 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)))

77
test/test_acceptance.ml
View File

@ -6098,6 +6098,83 @@ 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\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: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 \
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");
("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") ]
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 []);
(* 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 ();
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

13
test/test_flan.ml
View File

@ -7796,9 +7796,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] 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";
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";