/* flan_dyn — tagged values, a mark-sweep heap, and the operations over them. * * Milestone 1 of dynamic-by-default: code nobody annotated computes with * values that carry their type at run time, code that is fully annotated * compiles to exactly what it compiled to before, and a build that asks for * neither a collector nor a tag can be told that it has one. * * The argument for every decision in here — why NaN-boxing rather than low-bit * tagging, why mark-sweep rather than anything cleverer, why the roots are * pushed rather than found — is docs/SPIKE-DYNAMIC.md. This file carries the * parts of it a reader needs *while reading the code*, and points at the doc * for the rest. * * ── What this file may depend on ────────────────────────────────────── * * flan_rt.c, and nothing else in the tree. The dependency does not run the * other way: no line of flan_rt.c or flan_dev.c names anything defined here. * That is the whole of what makes a `--no-gc` build possible — not because the * linker drops this object (it does not; a named object is linked whole, and * `nm` on any corpus program finds flan_dyn_add in it), but because nothing * else needs it, so *not compiling it* is a change at the three sites that * name it and nowhere else. A single back-reference from the release runtime * would make the collector unconditional and the refusal a lie. See the doc's * "Dropping the collector". * * ── Threads ─────────────────────────────────────────────────────────── * * There are none, and the globals below are plain globals for the reason the * handler stack, the restart stack and the frame chain in the other two files * are: one thread runs Flan. The dev agent's listener thread runs C and the * loader and never enters a Flan body, so it never allocates and never marks. * If the language grows threads, the heap needs a lock and the roots need to * be thread-local, and that is one change in two places rather than a rewrite. */ #include #include #include #include #include /* ── What we borrow from flan_rt.c ───────────────────────────────────── * * Declared rather than included: the build hands clang each runtime .c on its * own with no include path (see [Build.compile_c]), so a #include of * flan_dyn.h would not resolve. runtime/flan_dyn.h says the same things a * second time and test/dyn_ops.c includes it, which is what keeps the two * copies honest. */ void flan_write_stdout(const uint8_t *p, int64_t n); /* The one non-local exit a dyn operation can take. flan_rt.c's [rt_trap] is * static, and re-implementing what it does — the break-loop hook, the flush, * the socket, [_exit(134)] — would be a second answer to "how does a Flan * program die where it stands", which that file went to some trouble to have * only one of. So flan_rt.c exports a thin wrapper and this calls it. */ _Noreturn void flan_trap(const uint8_t *name, int64_t namelen); /* Growing a Vec through a dyn view borrows flan_rt.c's own growth: doubling, * allocator adoption and the epoch check all live in [flan_vec_push], and * re-implementing any of that here would be a second copy of logic the * duplicity doctrine (docs/SPIKE-DUPLICITY.md) says belongs on one side only. * [v] is declared [void *] rather than [flan_vec *] so this file need not * name flan_rt.c's type; the two structs' layouts must agree, which is * [flan_dyn_vec_hdr] below, restated for the same reason [flan_desc] is. */ int8_t flan_vec_push(void *v, const void *elem, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen); /* ── The representation ──────────────────────────────────────────────── * * NaN-boxed, in a word. A double is *itself*: the 2^64 minus a NaN's worth of * bit patterns that are not quiet NaNs are read straight back as f64, at no * cost, which is what a language where f64 is first class and where sand.flan * runs a physics loop wants. Everything else hides inside the quiet-NaN space. * * The box is sign bit + all-ones exponent + quiet bit, which is * 0xFFF8000000000000. Bits 50..48 are three tag bits; bits 47..0 are the * payload, which is exactly the width of an x86-64 user-space pointer. * * 63 62..52 51 50..48 47..0 * 1 1...1 1 tag payload * * The collision this scheme always has to answer for is a real f64 that is * already a *negative* quiet NaN: those bits are indistinguishable from a box. * [flan_dyn_from_f64] answers it by canonicalising every NaN to the positive * quiet NaN on the way in. That is not a new rule invented here — flan_rt.c's * [flan_f64_to_bytes] already renders every NaN as "nan" with no sign, and * carries three paragraphs on why the sign bit of a NaN is not a fact about * the arithmetic and should not be shown. A dyn value takes the same line one * step further and does not *store* it. Nothing observable changes: NaN is not * equal to itself, so no comparison can see which NaN it is, and the printer * was already refusing to say. * * Integers. i64 is first class here and 48 bits is not 64, so an int that fits * the payload is inline and one that does not is a heap box. The inline range * is ±2^47, which is every array index, every counter and every timestamp in * milliseconds until the year 6429; the box is what keeps the other end of the * type honest rather than quietly wrapping. See the doc. * * Tags 5, 6 and 7 are unspoken for — keywords and maps took 4 and BOX_OBJ's * [kind] field, not new top-level tags — and that is where a typed handle * goes when interop arrives — a (Vec i64) crossing into dyn without being * copied. Again, the doc. */ typedef uint64_t flan_dyn; /* A type's dyn map: where the dyn words are inside one instance of it. The * compiler emits one of these per type that has any, as static data, and hands * a pointer to it to [flan_dyn_root_push_desc]. Nothing here ever writes one. * [size] is not read by the collector; it is the stride an array of the type * has, which is what the typed-container view will need. */ typedef struct flan_desc { int64_t size; int64_t n; const int64_t *offs; } flan_desc; #define DYN_QNAN 0xFFF8000000000000ULL #define DYN_TAGMASK 0x0007000000000000ULL #define DYN_PAYMASK 0x0000FFFFFFFFFFFFULL #define DYN_TAGSHIFT 48 /* The four box tags. Not the same numbers as FLAN_DYN_TAG_* in the header: * those are what a *reader* is told (float and int are two answers), these are * how the word is laid out (a float is not boxed at all, and a big int is a * pointer). [flan_dyn_tag] is the translation. */ #define BOX_NIL 0u #define BOX_BOOL 1u #define BOX_INT 2u #define BOX_OBJ 3u /* A keyword. The payload is a pointer to an interned entry that is not a GC * object at all: keywords are immortal by construction — the intern table * below holds the only copy of each name, nothing ever removes one, and the * collector never sees the tag ([mark_value] walks BOX_OBJ and nothing else). * Interning is what buys the Lisp symbol model: two keywords with the same * name are the same word, so equality is the identity compare [dyn_equal] * already opens with, never a memcmp. */ #define BOX_KW 4u /* Restated from flan_dyn.h — a view's element kind. */ #define FLAN_VIEW_I64 0 #define FLAN_VIEW_F64 1 #define FLAN_VIEW_BOOL 2 /* Spelled as a negated positive rather than as a shift of -1: shifting a * negative value left is undefined, and this file is swept by UBSan. */ #define DYN_INT_MAX (((int64_t)1 << 47) - 1) #define DYN_INT_MIN (-DYN_INT_MAX - 1) static inline int dyn_boxed(flan_dyn v) { return (v & DYN_QNAN) == DYN_QNAN; } static inline unsigned dyn_box(flan_dyn v) { return (unsigned)((v & DYN_TAGMASK) >> DYN_TAGSHIFT); } static inline uint64_t dyn_payload(flan_dyn v) { return v & DYN_PAYMASK; } static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) { return DYN_QNAN | ((uint64_t)tag << DYN_TAGSHIFT) | (payload & DYN_PAYMASK); } /* ── The heap ────────────────────────────────────────────────────────── * * One header, three kinds, and a singly-linked list of everything ever * allocated. The list is the sweep's; there is no other index, no free list * and no size class, because the collector's stated job is to be small enough * to read in one sitting. A heap that wants to be faster than this wants the * program to be typed instead. * * [mark] is a byte and not a bit in a side table for the same reason. A side * table is the right answer when the sweep is the cost, and the sweep is never * going to be the cost here. * * A vec's elements live in a plain malloc block hanging off the header rather * than in a GC object of their own. Two reasons: a growth is then a [realloc] * and not a copy this file writes, and the elements are never reachable except * through their vec, so giving them an identity would buy nothing and cost a * header. Their bytes are counted in [gc_bytes] and freed when the vec is * swept, which is the whole of their lifetime. */ #define OBJ_TEXT 0 #define OBJ_VEC 1 #define OBJ_INT 2 /* an i64 too wide for the payload */ #define OBJ_MAP 3 /* keys and values interleaved: k0 v0 k1 v1 ... */ #define OBJ_VIEW 4 /* a typed container crossing into dyn as a view */ /* flan_vec, restated. This file must not name flan_rt.c's [flan_vec] — see * the "if either table changes, change both" note above [flan_vec_push] — * so a view over a [(Vec T)] is built from an address whose first five words * this mirrors exactly. Only [ptr], [len] and [epoch]/[alloc] are ever read * through it; nothing here writes one. */ typedef struct flan_dyn_vec_hdr { void *ptr; int64_t len; int64_t cap; void *alloc; int64_t epoch; } flan_dyn_vec_hdr; /* This mirror's own layout, reported the same way flan_rt.c's * [flan_vec_layout] reports the original's — see that function's comment * for what ties the two together and why nothing at compile time otherwise * does. */ void flan_dyn_vec_hdr_layout(int64_t out[6]) { out[0] = (int64_t)sizeof(flan_dyn_vec_hdr); out[1] = (int64_t)offsetof(flan_dyn_vec_hdr, ptr); out[2] = (int64_t)offsetof(flan_dyn_vec_hdr, len); out[3] = (int64_t)offsetof(flan_dyn_vec_hdr, cap); out[4] = (int64_t)offsetof(flan_dyn_vec_hdr, alloc); out[5] = (int64_t)offsetof(flan_dyn_vec_hdr, epoch); } /* flan_allocator's prefix, far enough to read the one word a stale-container * check needs. The struct has more fields after [epoch]; this file never * touches them; and the alignment of a leading same-typed prefix is the same * in any translation unit that agrees on the field order, which is the * "change both" this comment is the other half of. */ typedef struct flan_dyn_alloc_hdr { void *proc; void *data; uint32_t caps; uint64_t epoch; } flan_dyn_alloc_hdr; /* A keyword's interned entry, declared here because a map's shape tag is one. * The definition, the table and the argument for interning are further down, * under "Keywords". */ struct kw_entry; typedef struct flan_obj { struct flan_obj *next; /* every object ever allocated, newest first */ uint8_t kind; uint8_t mark; int64_t len; /* bytes of a text, elements of a vec or entries of a map */ union { int64_t i; /* OBJ_INT */ struct { flan_dyn *items; int64_t cap; /* OBJ_MAP only, and NULL for every map that is not a defclass instance: the shape tag. It is the interned entry of the class's name — :point for (defclass point [x y]) — so the identity compare that makes keyword equality cheap is also what makes a class check cheap, and the tag needs no marking because an interned entry is immortal and is not a GC object (see [mark_value], which follows BOX_OBJ and nothing else). It lives in the header rather than in a reserved entry of the map itself, which is the one place this departs from the queue's note: an entry would be counted by [len], walked by [render], and compared by [dyn_equal]'s key loop, so every instance would answer a length one larger than its slot count and print a key nobody wrote. A field cannot be reached by [get] or [put] at all, so no user key can collide with it. A vec leaves it NULL. The arm is shared, so the field exists for both kinds; nothing reads it for an OBJ_VEC. */ struct kw_entry *klass; } v; /* OBJ_VEC and OBJ_MAP — a map shares the vec's arm on purpose: its entries are the same malloc block of dyn words, interleaved key then value, with [len] counting entries and [cap] counting entries too. Sharing the arm is what lets the marker and the sweep treat the two kinds with one load and a doubled count rather than a second field to keep in step. */ /* OBJ_VIEW: a typed container's elements, native words this file did not allocate and does not own. [is_vec] set means [base] is a [flan_dyn_vec_hdr *] and [len] here is unused — the live length is read from the header on every operation, which is the whole of why a Vec growing through the view cannot go stale. [is_vec] clear means [base] is the first element's address and [len] is the snapshot taken at the crossing, for a slice or a fixed array, neither of which moves. [elem] is one of FLAN_VIEW_I64/F64/BOOL. */ struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view; /* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */ } u; } flan_obj; /* How many dyn words hang off an object's items block — the count the marker * walks and the sweep charges. A map holds two per entry. * * OBJ_VIEW answers 0 explicitly rather than falling into the [o->len] arm. * [mark_push] never puts a view on the mark stack — it traces only * OBJ_VEC/OBJ_MAP — so this is not reachable today, but [o->u.view.base] * aliases [o->u.v.items] in the union, and a native array of i64 or f64 * reinterpreted as dyn words is exactly the kind of thing this file's * roots contract exists to prevent happening by accident. Answering 0 here * is what keeps a future change to the marking gate from silently trusting * this function's default arm instead of failing loudly. */ static inline int64_t obj_words(flan_obj *o) { if (o->kind == OBJ_VIEW) return 0; return o->kind == OBJ_MAP ? o->len * 2 : o->len; } static inline uint8_t *obj_text_bytes(flan_obj *o) { return (uint8_t *)(o + 1); } static flan_obj *gc_all; /* the sweep list */ static int64_t gc_bytes; /* what the live objects hold, headers included */ static int64_t gc_count; static int64_t gc_next; /* collect when an allocation would pass this */ static int64_t gc_floor = 1 << 20; static int gc_ready; /* ── Roots ───────────────────────────────────────────────────────────── * * Addresses of slots, pushed by the code that owns them. Not a conservative * scan of the C stack, and the reason is worth stating once here rather than * only in the doc: a conservative scan has to decide whether an arbitrary word * is a pointer, and NaN-boxing makes that decision *wrong* in both directions * — a live double is bit-identical to a boxed pointer often enough to retain * garbage, and a payload with the box stripped is not the pointer the scanner * would look for. Precision here is cheaper than the arguments about it. * * Growable, because a deep recursion over dyn locals is an ordinary program * and a fixed table would be a limit nobody could predict. The array holds the * addresses, so growing it moves the array and not the slots. * * A root is an address and a shape. The shape is NULL for the common case — * the address is a dyn word and marking it is one call — and a [flan_desc] for * an aggregate, which is a struct or an array of them with dyn fields * somewhere inside. The descriptor is static data the compiler emitted for * that type, and the pairing of address with descriptor is made at the *push*, * by the code that knows what is at that address, which is why nothing in the * heap or on the stack needs a header word for the collector to read. See * flan_dyn.h's [flan_dyn_root_push_desc] for the whole of that argument. */ typedef struct { void *base; const flan_desc *desc; /* NULL: [base] is one flan_dyn */ } flan_root; static flan_root *roots; static int64_t roots_n, roots_cap; /* How much of the bottom of that stack belongs to the globals rather than to * any frame. The globals are pushed once, before the first frame runs, and * never popped — so they are exactly the entries below this line, and every * frame's roots are exactly the entries above it. Zero until a [main] says * otherwise, which is also the right answer for a program that has no dyn * globals to push. See [flan_dyn_root_globals_begin]. */ static int64_t roots_base; /* ── The temporaries ring ────────────────────────────────────────────── * * The hazard this exists for, plainly: mark-sweep frees what is unreachable, * and a freshly allocated object is unreachable until somebody roots it. So * * flan_dyn_push(v, flan_dyn_add(flan_dyn_from_bytes(p, n), ...)); * * — or any expression with two allocating calls in it — can have the second * allocation collect the result of the first, in the window before the * compiler has stored either into a rooted slot. C's argument evaluation order * is unspecified, so this is not even a window a careful emitter could close * by ordering its calls. * * The answer is the smallest one that does not need the other lane to have * read a document: every object this file allocates is written into a fixed * ring, and the marker roots the whole ring unconditionally. Any expression * making at most RING allocations before rooting its result is then safe, with * no ABI change and no contract for anybody to get wrong. The cost is a store * and a masked increment per allocation, and up to RING objects' worth of * float in the heap — which the trigger absorbs, because the trigger is a * fraction of live bytes and not a count. * * 64 slots. An expression with 65 allocating calls in it and no intervening * root would be a single Flan form with 65 constructors in it, which is not a * form anybody writes; if it ever is, the compiler roots its intermediates and * this ring is belt on top of braces. */ #define RING 64 static flan_obj *ring[RING]; static unsigned ring_at; /* ── Tag words ───────────────────────────────────────────────────────── * * One table. The trap messages below and [flan_dyn_tag_name] read it, so a * sentence a program dies with and a name an inspector shows cannot drift * apart. Words and never numbers: "cannot add int and text" is a sentence * somebody can act on and "tag 2 and tag 4" is a puzzle. */ static const char *const tag_words[] = { "nil", "bool", "int", "float", "text", "vec", "keyword", "map" }; #define FLAN_DYN_TAG_NIL 0 #define FLAN_DYN_TAG_BOOL 1 #define FLAN_DYN_TAG_INT 2 #define FLAN_DYN_TAG_FLOAT 3 #define FLAN_DYN_TAG_TEXT 4 #define FLAN_DYN_TAG_VEC 5 #define FLAN_DYN_TAG_KEYWORD 6 #define FLAN_DYN_TAG_MAP 7 static inline flan_obj *dyn_obj(flan_dyn v) { return (flan_obj *)(uintptr_t)dyn_payload(v); } /* An interned keyword's entry: the name's bytes trail the length, one malloc * per distinct name, never freed. Not a flan_obj — the collector has no * business with something immortal — and the tag alone says which it is. */ typedef struct kw_entry { int64_t len; /* bytes trail */ } kw_entry; static inline kw_entry *dyn_kw(flan_dyn v) { return (kw_entry *)(uintptr_t)dyn_payload(v); } static inline uint8_t *kw_bytes(kw_entry *k) { return (uint8_t *)(k + 1); } int32_t flan_dyn_tag(flan_dyn v) { if (!dyn_boxed(v)) return FLAN_DYN_TAG_FLOAT; switch (dyn_box(v)) { case BOX_NIL: return FLAN_DYN_TAG_NIL; case BOX_BOOL: return FLAN_DYN_TAG_BOOL; case BOX_INT: return FLAN_DYN_TAG_INT; case BOX_KW: return FLAN_DYN_TAG_KEYWORD; default: { flan_obj *o = dyn_obj(v); if (o == NULL) return FLAN_DYN_TAG_NIL; switch (o->kind) { case OBJ_TEXT: return FLAN_DYN_TAG_TEXT; /* A view answers the same tag a heap vec does: from a dyn program's side there is nothing to tell them apart by, which is the point of a view being indistinguishable rather than a fourth kind of vec. */ case OBJ_VEC: return FLAN_DYN_TAG_VEC; case OBJ_VIEW: return FLAN_DYN_TAG_VEC; case OBJ_MAP: return FLAN_DYN_TAG_MAP; default: return FLAN_DYN_TAG_INT; } } } } const char *flan_dyn_tag_name(int32_t tag) { if (tag < 0 || tag > FLAN_DYN_TAG_MAP) return "?"; return tag_words[tag]; } static inline const char *tag_of(flan_dyn v) { return flan_dyn_tag_name(flan_dyn_tag(v)); } /* ── Rendering, for messages and for print ───────────────────────────── * * One walk, two callers. [flan_dyn_print] writes to stdout through * [flan_write_stdout], so a dyn print and a typed print interleave correctly * in the one buffer; a trap message renders into a small buffer and puts the * values in the sentence. * * What it renders, per tag, is what typed [print] renders for the * corresponding type — captured from a running program rather than read off * lib/render.ml, because that file is the REPL's inspector and not necessarily * println's expansion: * * int %lld 42 * float %g, and "nan" unsigned 3.5, 1, nan * bool the word true / false * text bare at the top level, hi / "a b" * quoted and escaped inside * vec a slice's spelling [ 1 2 3] * * The leading space before every element is not a slip: it is what * lib/render.ml's slice loop emits and what a Flan program prints today, and * an acceptance test comparing the two would notice a tidier answer. * * nil is the one tag with no typed counterpart, and it renders as `nil`. * * A typed Vec prints as `` rather than structurally, and a dyn vec does * not: it prints the way a *slice* does. That is deliberate and is argued in * the doc — the typed refusal is about borrowing storage the printer does not * own, and a dyn vec's storage is the collector's, so there is nothing to * borrow and nobody to ask. * * DEPTH is a cycle stop and nothing else. A typed value cannot contain itself, * so the typed printer needs no run-time cap; [flan_dyn_set_at] makes a dyn * vec that can, so this one does. Past the cap it prints render.ml's "...", * which is the same mark that file uses for the same idea. */ #define PRINT_DEPTH 16 static void emit(const char *s) { flan_write_stdout((const uint8_t *)s, (int64_t)strlen(s)); } static void emit_n(const uint8_t *p, int64_t n) { flan_write_stdout(p, n); } /* A text inside a structure, quoted and escaped. The same table as * flan_rt.c's [flan_escape_char], which is where the typed side's printers — * [flan_escape_bytes] and flan_dev.c's emitters — now share their one copy of * it: printers that disagree about what a string looks like are that many * wire formats. * * This copy is deliberate, and the argument for it is docs/SPIKE-DUPLICITY.md * §9's: the dyn printer lives inside the runtime that owns the storage it * walks, which is why it prints a dyn vec structurally where the typed * printer answers . The whole printer is this side's; the table it * shares with the other side is the part that must not drift. If that table * changes, change this one. Streamed rather than built, so there is no buffer * to overrun and no length to cap. */ static void emit_escaped(const uint8_t *p, int64_t n) { int64_t i; emit("\""); for (i = 0; i < n; i++) { unsigned char c = p[i]; switch (c) { case '"': emit("\\\""); break; case '\\': emit("\\\\"); break; case '\n': emit("\\n"); break; case '\t': emit("\\t"); break; case '\r': emit("\\r"); break; default: if (c < 0x20) { char b[5]; snprintf(b, sizeof b, "\\x%02x", c); emit(b); } else { emit_n(&c, 1); } } } emit("\""); } static int64_t dyn_int_value(flan_dyn v); /* forward: both int shapes */ static double dyn_num_value(flan_dyn v); /* forward: the view helpers, needed by [render] and [say_render] above where * they are defined, alongside the container operations below */ static int64_t view_len(const char *op, flan_obj *o); static void *view_base(flan_obj *o); static flan_dyn view_box(int32_t elem, const uint8_t *p); static int64_t view_elem_size(int32_t elem); /* forward: needed by [dyn_equal] below, defined alongside the view helpers * further down — a length and an element reader that answer correctly * whether [o] is an ordinary heap vec or a view over a typed container. */ static int64_t vecish_len(flan_obj *o); static flan_dyn vecish_at(flan_obj *o, int64_t i); static void render(flan_dyn v, int depth, int nested) { char buf[64]; int32_t t = flan_dyn_tag(v); if (depth > PRINT_DEPTH) { emit("..."); return; } switch (t) { case FLAN_DYN_TAG_NIL: emit("nil"); return; case FLAN_DYN_TAG_BOOL: emit(dyn_payload(v) ? "true" : "false"); return; case FLAN_DYN_TAG_INT: snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v)); emit(buf); return; case FLAN_DYN_TAG_FLOAT: { double d; memcpy(&d, &v, sizeof d); /* x != x rather than isnan, which keeps math.h out of this file and is * the comparison flan_rt.c and the prelude both use. */ if (d != d) snprintf(buf, sizeof buf, "nan"); else snprintf(buf, sizeof buf, "%g", d); emit(buf); return; } case FLAN_DYN_TAG_TEXT: { flan_obj *o = dyn_obj(v); if (nested) emit_escaped(obj_text_bytes(o), o->len); else emit_n(obj_text_bytes(o), o->len); return; } /* A keyword prints with its colon, bare, at every depth: :a is its own * spelling the way true is, and quoting it would make it a text. */ case FLAN_DYN_TAG_KEYWORD: { kw_entry *k = dyn_kw(v); emit(":"); emit_n(kw_bytes(k), k->len); return; } /* The map prints in edn's shape with the vec's spacing: a space before * every element, key and value alike, so { :a 1 :b 2} sits beside the vec's * [ 1 2 3] rather than inventing a fourth convention. Entries come out in * insertion order, which is the only order the representation has. */ case FLAN_DYN_TAG_MAP: { flan_obj *o = dyn_obj(v); int64_t i; /* A class instance prints its shape tag in front, Clojure's own spelling * for a record: #point{ :x 1 :y 2}. The tag is not an entry, so it is * written here or it is not written at all. */ if (o->u.v.klass != NULL) { emit("#"); emit_n(kw_bytes(o->u.v.klass), o->u.v.klass->len); } emit("{"); for (i = 0; i < o->len; i++) { emit(" "); render(o->u.v.items[i * 2], depth + 1, 1); emit(" "); render(o->u.v.items[i * 2 + 1], depth + 1, 1); } emit("}"); return; } default: { flan_obj *o = dyn_obj(v); int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len; emit("["); for (i = 0; i < n; i++) { emit(" "); if (o->kind == OBJ_VIEW) render(view_box(o->u.view.elem, (const uint8_t *)view_base(o) + i * view_elem_size(o->u.view.elem)), depth + 1, 1); else render(o->u.v.items[i], depth + 1, 1); } emit("]"); return; } } } void flan_dyn_print(flan_dyn v) { render(v, 0, 0); } /* The same walk into a buffer, for a trap's sentence. Bounded and truncated * rather than allocating: a trap is the one moment when allocating would be a * second thing to go wrong, and the message's job is to name the value, not to * reproduce it. The depth is 2 rather than PRINT_DEPTH for the same reason. */ #define SAY_MAX 96 typedef struct { char *p; int64_t n, cap; } sayer; static void say_puts(sayer *s, const char *t) { while (*t && s->n < s->cap - 1) s->p[s->n++] = *t++; s->p[s->n] = '\0'; } static void say_render(sayer *s, flan_dyn v, int depth) { char buf[64]; int32_t t = flan_dyn_tag(v); if (s->n >= s->cap - 4) return; switch (t) { case FLAN_DYN_TAG_NIL: say_puts(s, "nil"); return; case FLAN_DYN_TAG_BOOL: say_puts(s, dyn_payload(v) ? "true" : "false"); return; case FLAN_DYN_TAG_INT: snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v)); say_puts(s, buf); return; case FLAN_DYN_TAG_FLOAT: { double d; memcpy(&d, &v, sizeof d); if (d != d) snprintf(buf, sizeof buf, "nan"); else snprintf(buf, sizeof buf, "%g", d); say_puts(s, buf); return; } case FLAN_DYN_TAG_TEXT: { flan_obj *o = dyn_obj(v); int64_t i; say_puts(s, "\""); for (i = 0; i < o->len && s->n < s->cap - 6; i++) { char c[2]; uint8_t b = obj_text_bytes(o)[i]; c[0] = b >= 0x20 ? (char)b : '.'; c[1] = '\0'; say_puts(s, c); } say_puts(s, i < o->len ? "...\"" : "\""); return; } case FLAN_DYN_TAG_KEYWORD: { kw_entry *k = dyn_kw(v); int64_t i; say_puts(s, ":"); for (i = 0; i < k->len && s->n < s->cap - 6; i++) { char c[2]; c[0] = (char)kw_bytes(k)[i]; c[1] = '\0'; say_puts(s, c); } if (i < k->len) say_puts(s, "..."); return; } case FLAN_DYN_TAG_MAP: { flan_obj *o = dyn_obj(v); int64_t i; if (depth >= 2) { say_puts(s, "{...}"); return; } /* The same tag [render] writes, so a trap sentence naming an instance * says which class it was. Truncated with the rest when the buffer is * short: [say] is a 96-byte sentence, not a printer. */ if (o->u.v.klass != NULL && s->n < s->cap - 8) { int64_t j; say_puts(s, "#"); for (j = 0; j < o->u.v.klass->len && s->n < s->cap - 8; j++) { char c[2]; c[0] = (char)kw_bytes(o->u.v.klass)[j]; c[1] = '\0'; say_puts(s, c); } } say_puts(s, "{"); for (i = 0; i < o->len && s->n < s->cap - 8; i++) { say_puts(s, " "); say_render(s, o->u.v.items[i * 2], depth + 1); say_puts(s, " "); say_render(s, o->u.v.items[i * 2 + 1], depth + 1); } say_puts(s, i < o->len ? " ...}" : "}"); return; } default: { flan_obj *o = dyn_obj(v); int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len; if (depth >= 2) { say_puts(s, "[...]"); return; } say_puts(s, "["); for (i = 0; i < n && s->n < s->cap - 8; i++) { say_puts(s, " "); if (o->kind == OBJ_VIEW) say_render(s, view_box(o->u.view.elem, (const uint8_t *)view_base(o) + i * view_elem_size(o->u.view.elem)), depth + 1); else say_render(s, o->u.v.items[i], depth + 1); } say_puts(s, i < n ? " ...]" : "]"); return; } } } static void say(char *buf, int64_t cap, flan_dyn v) { sayer s; s.p = buf; s.n = 0; s.cap = cap; buf[0] = '\0'; say_render(&s, v, 0); } /* ── Traps ───────────────────────────────────────────────────────────── * * The shape of every message: the operation, then what was wrong in words, * then the call as it would have been written. So a program that adds a number * to a string stops with * * dyn +: int and text, and + wants two numbers — (+ 3 "hi") * * which names the operation, both tags, and both values, in that order, * because that is the order somebody reads it in. [flan_trap] then parks the * program in a dev session and ends it standing up in a standalone build; the * sentence is the same either way, which is the point of routing through the * hook rather than calling abort here. * * The trap *name* — what the break loop shows and what a `layout` op will say * it cannot place — is "DynType" for a tag that was not what the operation * wanted, "DynRange" for an index outside a vec or a text, "DynArith" for a * division by zero or the one quotient that overflows, and "DynHeap" for an * allocation the host refused. Four names rather than one because they are * four different mistakes and a person stopped in one of them wants to know * which without reading the sentence twice — and because the break loop lists * them by name. */ /* Where the operation was written, printed as flan_rt.c's traps print it: the * GNU "file:line:col: " prefix, so `next-error` walks to the dyn failure the * same way it walks to a bounds failure. The pair is what an emitted string * literal already is — a pointer and a length, not a C string — and the * emitter hands it over exactly as [flan_dyn_cast_kind]'s site does. * * A NULL [loc] prints nothing at all and the sentence after it is byte for * byte the one this file printed before: the entry points that have not been * given a site yet (every one but the five arithmetic and four ordering ones) * pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and * has no source position to offer. */ static void trap_where(const uint8_t *loc, int64_t loclen) { if (loc != NULL && loclen > 0) fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc); } static _Noreturn void trap2(const uint8_t *loc, int64_t loclen, const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a, flan_dyn b) { char sa[SAY_MAX], sb[SAY_MAX]; say(sa, SAY_MAX, a); say(sb, SAY_MAX, b); fflush(stdout); trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s and %s, and %s — (%s %s %s)\n", op, tag_of(a), tag_of(b), why, op, sa, sb); flan_trap((const uint8_t *)name, namelen); } static _Noreturn void trap1(const uint8_t *loc, int64_t loclen, const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a) { char sa[SAY_MAX]; say(sa, SAY_MAX, a); fflush(stdout); trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s, and %s — (%s %s)\n", op, tag_of(a), why, op, sa); flan_trap((const uint8_t *)name, namelen); } #define TYPE_TRAP "DynType", 7 #define ARITH_TRAP "DynArith", 8 /* No site reaches these two yet: [at], [set-at], [push] and the allocator * paths are not among the nine entry points this pass gave a location to. The * parameter is here so that giving them one later is a call-site change and * not another round of signature churn. */ static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn v, int64_t i, int64_t len) { char sv[SAY_MAX]; say(sv, SAY_MAX, v); fflush(stdout); trap_where(loc, loclen); fprintf(stderr, "dyn %s: index %lld is out of bounds for %s of length %lld — %s\n", op, (long long)i, tag_of(v), (long long)len, sv); flan_trap((const uint8_t *)"DynRange", 8); } /* ── Allocation and collection ───────────────────────────────────────── * * Collection happens here and nowhere else, which is the fact the roots * contract rests on: between two allocations nothing is swept, so a * temporary living only in a C local survives the operation it was made in. * A growing vec's element array is a [realloc] and not an allocation in this * sense — it cannot collect, because the value being pushed may not be rooted * yet. That means a program that only ever pushes can hold more than the * trigger says before the next real allocation catches up, which is fine: what * it is holding is the vec, and the vec is live. * * The trigger is the plainest one that works: collect when this allocation * would carry the heap past a limit, then set the limit to twice what survived * — with a floor, so a program with a tiny live set does not collect on every * other allocation. That gives amortised O(1) collections per byte allocated * and a heap bounded at twice the live set plus the floor, which is the * property the million-allocation test asserts. * * "The answer to 'I need more performance' will never be a faster GC, it will * be to type the whole program" — so there is no generation, no card table, no * incremental phase, and no free list. */ static void gc_mark_all(void); static void gc_sweep(void); void flan_gc_init(void) { if (gc_ready) return; gc_ready = 1; gc_all = NULL; gc_bytes = 0; gc_count = 0; gc_next = gc_floor; } /* The trigger is recomputed from the new floor by the same formula the sweep * uses, rather than only being raised to meet it. Raising alone left a heap * that had been given a *lower* floor still running to the old one — the first * collection then happened a megabyte in, and a test that had asked for 64K * measured a megabyte. */ void flan_gc_set_floor(int64_t bytes) { gc_floor = bytes > 0 ? bytes : (1 << 20); gc_next = gc_bytes * 2; if (gc_next < gc_floor) gc_next = gc_floor; } int64_t flan_gc_live_bytes(void) { return gc_bytes; } int64_t flan_gc_count(void) { return gc_count; } void flan_gc_collect(void) { gc_mark_all(); gc_sweep(); gc_next = gc_bytes * 2; if (gc_next < gc_floor) gc_next = gc_floor; } /* Out of memory is the one failure in here that is not the program's fault and * not recoverable by anything this file can do. It takes the trap path like * everything else, so a dev session parks on it and can be read, rather than * the allocation quietly answering NULL and every caller below growing a null * check for a case none of them can handle. */ static _Noreturn void trap_oom(int64_t want) { fflush(stdout); fprintf(stderr, "dyn heap: %lld bytes could not be allocated, with %lld live\n", (long long)want, (long long)gc_bytes); flan_trap((const uint8_t *)"DynHeap", 7); } static flan_obj *gc_alloc(uint8_t kind, int64_t extra) { int64_t need = (int64_t)sizeof(flan_obj) + extra; flan_obj *o; if (!gc_ready) flan_gc_init(); if (gc_bytes + need > gc_next) flan_gc_collect(); o = (flan_obj *)malloc((size_t)need); if (o == NULL) trap_oom(need); o->next = gc_all; o->kind = kind; o->mark = 0; o->len = 0; memset(&o->u, 0, sizeof o->u); gc_all = o; gc_bytes += need; gc_count++; /* Into the ring before anything else can allocate. See the ring's comment: * this is the one line that makes an expression with two constructors in it * safe without the other lane having agreed to anything. */ ring[ring_at] = o; ring_at = (ring_at + 1) % RING; return o; } /* The mark stack. Explicit rather than recursive, because a vec of a vec of a * vec is an ordinary dyn value and its depth is the program's, not this * file's: a recursive marker would put the heap's depth on the C stack and a * long enough chain would overflow it during a collection, which is the worst * possible moment. Grown on demand and kept between collections, so a steady * program stops paying for it after the first one. */ static flan_obj **mstack; static int64_t mstack_n, mstack_cap; static void mark_push(flan_obj *o) { if (o == NULL || o->mark) return; o->mark = 1; /* Only a vec and a map have anything to trace. A text and a boxed int are * leaves, and marking them is the whole of their visit. */ if (o->kind != OBJ_VEC && o->kind != OBJ_MAP) return; if (mstack_n == mstack_cap) { int64_t cap = mstack_cap ? mstack_cap * 2 : 64; flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m); if (m == NULL) trap_oom(cap * (int64_t)sizeof *m); mstack = m; mstack_cap = cap; } mstack[mstack_n++] = o; } static void mark_value(flan_dyn v) { if (dyn_boxed(v) && dyn_box(v) == BOX_OBJ) mark_push(dyn_obj(v)); } static void gc_mark_all(void) { int64_t i; unsigned k; for (i = 0; i < roots_n; i++) { const flan_desc *d = roots[i].desc; if (d == NULL) mark_value(*(flan_dyn *)roots[i].base); else { int64_t j; for (j = 0; j < d->n; j++) mark_value(*(flan_dyn *)((char *)roots[i].base + d->offs[j])); } } for (k = 0; k < RING; k++) mark_push(ring[k]); while (mstack_n > 0) { flan_obj *o = mstack[--mstack_n]; int64_t n = obj_words(o); for (i = 0; i < n; i++) mark_value(o->u.v.items[i]); } } static void gc_sweep(void) { flan_obj **link = &gc_all; flan_obj *o = gc_all; while (o != NULL) { flan_obj *next = o->next; if (o->mark) { o->mark = 0; link = &o->next; } else { int64_t held = (int64_t)sizeof(flan_obj); if (o->kind == OBJ_TEXT) held += o->len; if (o->kind == OBJ_VEC || o->kind == OBJ_MAP) { int64_t per = o->kind == OBJ_MAP ? 2 : 1; held += o->u.v.cap * per * (int64_t)sizeof(flan_dyn); free(o->u.v.items); } gc_bytes -= held; gc_count--; *link = next; free(o); } o = next; } } static void root_add(void *base, const flan_desc *d) { if (roots_n == roots_cap) { int64_t cap = roots_cap ? roots_cap * 2 : 64; flan_root *r = (flan_root *)realloc(roots, (size_t)cap * sizeof *r); if (r == NULL) trap_oom(cap * (int64_t)sizeof *r); roots = r; roots_cap = cap; } roots[roots_n].base = base; roots[roots_n].desc = d; roots_n++; } void flan_dyn_root_push(flan_dyn *slot) { root_add(slot, NULL); } /* The aggregate form. One entry on the same stack, so one [flan_dyn_root_pop] * takes off a mixture of the two and a function's pop count stays the number * of pushes it made. A NULL descriptor is not an error — it is a type the * compiler found no dyn in — but it still occupies an entry, because the count * is what the epilogue knows, and it is turned into an empty descriptor rather * than stored as NULL, which on this stack means something else. */ static const flan_desc desc_empty = { 0, 0, NULL }; void flan_dyn_root_push_desc(void *base, const flan_desc *d) { root_add(base, d == NULL ? &desc_empty : d); } /* Clamped at the globals rather than refused. A pop that outruns its pushes * means the frame machinery is already out of step, and the useful thing at * that point is a heap that still collects, not a second failure on top of the * first. flan_rt.c's [flan_handler_pop] takes the same line for the same * reason, by frame rather than by count. The floor is [roots_base] and not * zero because the globals under it were never any frame's to pop: an * over-popping frame taking them with it is the one way this clamp could turn * a miscount into a use-after-free. */ void flan_dyn_root_pop(int64_t n) { if (n <= 0) return; roots_n = roots_n - n > roots_base ? roots_n - n : roots_base; } /* The two halves of "the globals are the bottom of this stack". * * [begin] empties it outright, because a re-entered [main] is about to push * the same globals again and the entries the previous run left are the ones * that would be duplicated. [end] records how many of them there are. * * Nothing between the two may allocate: between them the globals hold whatever * the previous run left in them and are not rooted, so a collection there * would sweep values the slots still point at. The emitted [main] calls * [begin] immediately before the pushes and [end] immediately after, with only * the pushes in between, which is what makes that hold. */ void flan_dyn_root_globals_begin(void) { roots_n = 0; roots_base = 0; } void flan_dyn_root_globals_end(void) { roots_base = roots_n; } void flan_dyn_root_reset(void) { roots_n = roots_base; } /* ── Constructors ──────────────────────────────────────────────────────*/ flan_dyn flan_dyn_nil(void) { return dyn_make(BOX_NIL, 0); } flan_dyn flan_dyn_from_bool(uint8_t b) { return dyn_make(BOX_BOOL, b ? 1u : 0u); } flan_dyn flan_dyn_from_i64(int64_t x) { flan_obj *o; if (x >= DYN_INT_MIN && x <= DYN_INT_MAX) return dyn_make(BOX_INT, (uint64_t)x); /* Wider than the payload, so it goes on the heap. Rare by construction — * see the representation note — and it is the case that keeps i64 an i64 * rather than a 48-bit integer with a different name. */ o = gc_alloc(OBJ_INT, 0); o->u.i = x; return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } flan_dyn flan_dyn_from_f64(double x) { flan_dyn v; /* Every NaN becomes the one positive quiet NaN, which is what keeps a * negative quiet NaN from being read back as a box. The argument that this * loses nothing is in the representation note above and in flan_rt.c's * [flan_f64_to_bytes]. */ if (x != x) return 0x7FF8000000000000ULL; memcpy(&v, &x, sizeof v); return v; } flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) { flan_obj *o; if (n < 0) n = 0; o = gc_alloc(OBJ_TEXT, n); o->len = n; if (n > 0) memcpy(obj_text_bytes(o), p, (size_t)n); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } flan_dyn flan_dyn_vec_new(void) { flan_obj *o = gc_alloc(OBJ_VEC, 0); o->len = 0; o->u.v.items = NULL; o->u.v.cap = 0; /* Shared arm, and nothing reads this for a vec; written anyway so that the field's value is never whatever [gc_alloc] happened to leave. */ o->u.v.klass = NULL; return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } flan_dyn flan_dyn_map_new(void) { flan_obj *o = gc_alloc(OBJ_MAP, 0); o->len = 0; o->u.v.items = NULL; o->u.v.cap = 0; o->u.v.klass = NULL; return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } /* The same map with a shape tag on it: what a (defclass ...) constructor * calls. [k] is a keyword and anything else traps by name — the compiler * hands it the class's own name and nothing else can reach this. */ flan_dyn flan_dyn_map_new_class(flan_dyn k) { flan_obj *o; if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k); o = gc_alloc(OBJ_MAP, 0); o->len = 0; o->u.v.items = NULL; o->u.v.cap = 0; o->u.v.klass = dyn_kw(k); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } /* The shape tag, as a value: the class's name as a keyword, or nil. Never * traps. Absence is an answer here for the reason it is one in [map_get] — * asking what class a value is, is a question every value can be asked, and * an ordinary map, a number and nil all truthfully answer "none". */ flan_dyn flan_dyn_class_of(flan_dyn v) { flan_obj *o; if (flan_dyn_tag(v) != FLAN_DYN_TAG_MAP) return flan_dyn_nil(); o = dyn_obj(v); if (o->u.v.klass == NULL) return flan_dyn_nil(); return dyn_make(BOX_KW, (uint64_t)(uintptr_t)o->u.v.klass); } /* ── Keywords ────────────────────────────────────────────────────────── * * One global table, append-only, never freed: a keyword is a *name*, the set * of names a program uses is written in its source (plus whatever an edn file * contributes), and a name is not something the collector should be asked to * prove liveness of. Interning here rather than at each site is what makes * two spellings of :a one word — the constructor scans for the bytes and * answers the entry that already holds them, so keyword equality upstream is * the identity compare and never touches the bytes again. * * The scan is linear. A structural hash would repay itself on a program with * thousands of distinct keywords; a config file has dozens, every literal in * compiled code could be hoisted to one construction the day it matters, and * a table this simple has nothing in it to get wrong. */ static kw_entry **kws; static int64_t kws_n, kws_cap; flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n) { int64_t i; kw_entry *k; if (n < 0) n = 0; for (i = 0; i < kws_n; i++) { k = kws[i]; if (k->len == n && (n == 0 || memcmp(kw_bytes(k), p, (size_t)n) == 0)) return dyn_make(BOX_KW, (uint64_t)(uintptr_t)k); } if (kws_n == kws_cap) { int64_t cap = kws_cap ? kws_cap * 2 : 32; kw_entry **t = (kw_entry **)realloc(kws, (size_t)cap * sizeof *t); if (t == NULL) trap_oom(cap * (int64_t)sizeof *t); kws = t; kws_cap = cap; } k = (kw_entry *)malloc(sizeof(kw_entry) + (size_t)n); if (k == NULL) trap_oom((int64_t)sizeof(kw_entry) + n); k->len = n; if (n > 0) memcpy(kw_bytes(k), p, (size_t)n); kws[kws_n++] = k; return dyn_make(BOX_KW, (uint64_t)(uintptr_t)k); } /* ── Reading a value back ──────────────────────────────────────────────*/ static int64_t dyn_int_value(flan_dyn v) { if (dyn_box(v) == BOX_INT) { /* Sign-extend from 48 bits. The shift pair is the portable spelling; a * bitfield would be one line shorter and implementation-defined. */ uint64_t p = dyn_payload(v); return (int64_t)(p << 16) >> 16; } return dyn_obj(v)->u.i; } static double dyn_num_value(flan_dyn v) { double d; if (flan_dyn_tag(v) == FLAN_DYN_TAG_INT) return (double)dyn_int_value(v); memcpy(&d, &v, sizeof d); return d; } static inline int is_num(flan_dyn v) { int32_t t = flan_dyn_tag(v); return t == FLAN_DYN_TAG_INT || t == FLAN_DYN_TAG_FLOAT; } static inline int is_text(flan_dyn v) { return flan_dyn_tag(v) == FLAN_DYN_TAG_TEXT; } static inline int is_vec(flan_dyn v) { return flan_dyn_tag(v) == FLAN_DYN_TAG_VEC; } int64_t flan_dyn_need_i64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_INT) trap1(NULL, 0, TYPE_TRAP, "i64", "an int was wanted", v); return dyn_int_value(v); } /* A float, and an int is not one. Refusing the widening is the decision, not * an omission: typed Flan has no implicit widening anywhere — [(print-i64 x)] * used to force an explicit [(i64 x)] at every site — and a boundary that * quietly turned an int into a float would be the one place in the language * where a *value* changed type without anybody writing it down. The dyn * *operators* promote, because arithmetic between a 2 and a 2.5 has an obvious * answer and refusing it makes dynamic code worse; the boundary into a typed * f64 parameter does not, because there the annotation is somebody's stated * expectation and a mismatch is worth hearing about. * * Where this is sharper than the typed language is a *literal*. `(g 1)` * against `(defn g [x f64] ...)` compiles, because the checker gives the * literal the type the parameter asks for; a dyn value written as `1` has * already been through flan_dyn_from_i64 and cannot remember that it was a * literal. So the same source read as dyn traps where read as typed it does * not. That is a real divergence, it is the compiler's to close — by tagging * such a literal as a float where it can see the context — and it is written * down in the doc's boundary section so that closing it is a decision somebody * makes rather than a surprise somebody meets. Softening the check here is the * option not to take: this function sees a tag and nothing else, so it could * not tell (g 1) from (g (len xs)). */ double flan_dyn_need_f64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); return dyn_num_value(v); } uint8_t flan_dyn_need_bool(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); return (uint8_t)(dyn_payload(v) ? 1 : 0); } /* ── A numeric cast opening a box, FIX.org 2026-09-20 ─────────────────── * * [(f64 d)] on a dyn. The *conversion* is not done here: [check.ml] lowers * such a cast to a branch on this function's answer, and each arm is the * ordinary [flan_dyn_need_i64]/[flan_dyn_need_f64] followed by the cast the * emitter already emits for a typed argument of that type. So this function * decides one thing — which of the two numeric tags the box holds — and * everything about the arithmetic (the fptosi range check, NaN, the * narrowing rule) stays where it already was, identical in both backends and * identical to the typed spelling of the same cast. * * Answers 1 for a float box, 0 for an int box. Every other tag traps, with * the same [trap1] sentence the typed boundary's own refusals use — bool * included, which mirrors [flan_dyn_need_i64] refusing a bool today rather * than inventing a new rule for casts. * * [want_float] is what the *target* type is: 1 for f32/f64, 0 for the * integer widths. When it disagrees with the box, the cast still happens — * the author's call, "just coerce it with a warning" — and the warning below * is the whole of what the disagreement costs. A cast is already a * conversion operator, [(f64 5)] converts a typed integer, so converting * across the box is the cast doing its job; the warning exists because the * box's kind was not what the program apparently expected. * * Once per *site*, not per value. These casts sit in per-cell-per-frame * loops — sand.flan runs at 120fps — and a per-occurrence line would be a * flood rather than a diagnostic. The site is the [loc] text [check.ml] * passes in, and the table below is keyed on its *bytes* rather than its * address: the two backends emit their own constants for it and neither * promises that two mentions of one site share one pointer. * * The table is fixed and small because it is only ever as large as the * number of cross-kind cast sites a program has, which is a handful in the * programs this was written for. A program with more than [SITE_MAX] of them * stops deduplicating for the overflow — it still warns, every time, which * is the noisy failure rather than the silent one. * * What the table stores is the loc's pointer, never a copy — the same licence * the allocation registry takes for its type names (flan_dev.c:1073-1075). * The bytes are a string constant in the image of whatever module emitted the * cast, and a module that emitted a string constant is never unloaded: the * cell table forbids dlclose outright (flan_dev.c:27), and the one path that * does unload — an expression thunk — is gated on the module having emitted * no string literal at all ([nstr] in lib/emit.ml:383-391). A cast site's loc * IS a string literal, emitted through [string_const] like any other, so a * module holding one of these sites is on the never-unloaded side of that * test. If that ever stops being true the table has to copy. * * Not thread-safe, and that is a statement about who runs this rather than a * shrug: [flan_dyn_cast_kind] runs on the program's own thread and Flan has * no second one today. The dev agent's listener thread reads flan_dev.c's * tables — which is why *those* carry a seqlock — and never touches this one. * Were a second thread ever to reach a cast, the cost would not be a line * printed twice: {ptr, len} is a pair only meaningful together, and a reader * that took the new pointer with the old length would read off the end of a * string literal, exactly the hazard flan_dev.c:1126-1129 describes. The fix * then is the registry's, not a lock on a path that runs per cast in a frame * loop. */ #define SITE_MAX 64 static struct { const uint8_t *ptr; int64_t len; } warned_sites[SITE_MAX]; static int warned_count; static int site_first_time(const uint8_t *loc, int64_t loc_len) { for (int i = 0; i < warned_count; i++) if (warned_sites[i].len == loc_len && memcmp(warned_sites[i].ptr, loc, (size_t)loc_len) == 0) return 0; if (warned_count < SITE_MAX) { warned_sites[warned_count].ptr = loc; warned_sites[warned_count].len = loc_len; warned_count++; } return 1; } int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len, const uint8_t *target, int64_t target_len, int32_t want_float) { int32_t tag = flan_dyn_tag(v); if (tag != FLAN_DYN_TAG_INT && tag != FLAN_DYN_TAG_FLOAT) { /* [trap1] takes the operation as a C string and the target is a Flan * slice, so it is copied out. Every cast name is two or three bytes; the * clamp is for a caller this file cannot see. */ char name[8]; size_t n = (size_t)target_len < sizeof name - 1 ? (size_t)target_len : sizeof name - 1; memcpy(name, target, n); name[n] = '\0'; /* This one has a site: the cast's own, which the emitter already hands * over for the cross-kind warning below. It was the first entry point on * this side to take a location and it was not passing it on. */ trap1(loc, loc_len, TYPE_TRAP, name, "a number was wanted", v); } int32_t is_float = tag == FLAN_DYN_TAG_FLOAT ? 1 : 0; if (is_float != (want_float ? 1 : 0) && site_first_time(loc, loc_len)) { fflush(stdout); fprintf(stderr, "%.*s: (%.*s x) found a dyn holding %s, and converted it to " "%.*s — warned once for this site\n", (int)loc_len, (const char *)loc, (int)target_len, (const char *)target, is_float ? "a float" : "an int", (int)target_len, (const char *)target); } return is_float; } /* nil <-> None at an (Option T) boundary. Cannot trap — every dyn value * answers this one way or the other. */ int32_t flan_dyn_is_nil(flan_dyn v) { return flan_dyn_tag(v) == FLAN_DYN_TAG_NIL ? 1 : 0; } /* (Some nil)'s run-time half: a dyn value the checker could not see was nil * at compile time, reaching Some anyway. [op] is "some" rather than a Flan * spelling of the call, matching how every other dyn trap here names the * operation that refused. */ flan_dyn flan_dyn_need_not_nil(flan_dyn v) { if (flan_dyn_tag(v) == FLAN_DYN_TAG_NIL) trap1(NULL, 0, TYPE_TRAP, "some", "Some cannot hold nil -- nil and None would become the same case " "of an (Option dyn)", v); return v; } /* Clojure's truthiness, not C's or Python's: nil and false are the only * falsey values, and everything else — 0, 0.0, "", an empty vec, an empty * map, any keyword — is truthy. Never traps; every tag answers. */ uint8_t flan_dyn_truthy(flan_dyn v) { int32_t t = flan_dyn_tag(v); if (t == FLAN_DYN_TAG_NIL) return 0; if (t == FLAN_DYN_TAG_BOOL) return (uint8_t)(dyn_payload(v) ? 1 : 0); return 1; } /* ── Arithmetic ──────────────────────────────────────────────────────── * * Two ints answer an int; anything else numeric answers a float. The promotion * is the one place dyn is more permissive than the typed language, and the * case for it is that (+ 1 2.5) has exactly one sensible answer and a language * that refuses it is not dynamic in any useful sense. A program that wants the * refusal annotates, which is the whole bargain. * * Integer division and remainder by zero trap rather than answering. That * matches typed Flan, which signals ArithError and dies with "divide by zero" * if nothing handles it; the condition is not signalled here because a dyn * operation has no [loc] to report and no transfer channel in its hands, which * is the same reason the six traps in flan_rt.c park rather than signal. The * float case is left to IEEE — 1.0/0.0 is inf and that is an answer, not a * failure. * * The INT64_MIN / -1 pair overflows, and is the only pair that does. It gets * its own sentence for the reason flan_rt.c's gives it one: somebody meeting * it has probably never had to think about it. */ static void want_nums(const uint8_t *loc, int64_t loclen, const char *op, const char *why, flan_dyn a, flan_dyn b) { if (!is_num(a) || !is_num(b)) trap2(loc, loclen, TYPE_TRAP, op, why, a, b); } #define ARITH_NUM "it takes two numbers" static flan_dyn arith(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn a, flan_dyn b) { int64_t x, y; want_nums(loc, loclen, op, ARITH_NUM, a, b); if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { x = dyn_int_value(a); y = dyn_int_value(b); switch (op[0]) { case '+': return flan_dyn_from_i64((int64_t)((uint64_t)x + (uint64_t)y)); case '-': return flan_dyn_from_i64((int64_t)((uint64_t)x - (uint64_t)y)); case '*': return flan_dyn_from_i64((int64_t)((uint64_t)x * (uint64_t)y)); case '/': if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) trap2(loc, loclen, ARITH_TRAP, op, "the quotient is one past the largest i64, which is true of " "this pair of operands and no other", a, b); return flan_dyn_from_i64(x / y); default: if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) return flan_dyn_from_i64(0); return flan_dyn_from_i64(x % y); } } { double p = dyn_num_value(a), q = dyn_num_value(b); switch (op[0]) { case '+': return flan_dyn_from_f64(p + q); case '-': return flan_dyn_from_f64(p - q); case '*': return flan_dyn_from_f64(p * q); case '/': return flan_dyn_from_f64(p / q); default: /* No fmod, which would drag math.h in for one operator. The identity is * the definition of the remainder, and the trunc is what C's [%] does * for integers, so the two operators agree about sign. */ if (q == 0.0) return flan_dyn_from_f64(p - p); /* nan, by 0/0 */ { double t = p / q; double k; /* A quotient past 2^63 has no integer part this can name, and the * cast would be undefined rather than merely wrong. Every such * remainder is zero to the precision a double has left, so that is * what it answers — which is also fmod's answer. */ if (!(t > -9.2233720368547758e18 && t < 9.2233720368547758e18)) return flan_dyn_from_f64(t == t ? 0.0 : t); k = (t < 0) ? -(double)(int64_t)(-t) : (double)(int64_t)t; return flan_dyn_from_f64(p - k * q); } } } } flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "+", a, b); } flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "-", a, b); } flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "*", a, b); } flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "/", a, b); } flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return arith(loc, loclen, "%", a, b); } /* ── Ordering ────────────────────────────────────────────────────────── * * Numbers against numbers, text against text, and nothing else. Text orders * bytewise, which is [memcmp] with the shorter one first on a tie — the same * order a sort of a [(Vec string)] would want and the only order that needs no * locale, no collation table and no argument. * * A number against a text traps rather than answering. The temptation is to * order by tag so that every value is comparable and sorting never fails; the * reason not to is that the resulting order is an artefact of this file's tag * numbering, and a program that sorted a mixed vec would get a stable answer * that means nothing. */ static int order(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn a, flan_dyn b) { if (is_num(a) && is_num(b)) { if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { int64_t x = dyn_int_value(a), y = dyn_int_value(b); return x < y ? -1 : (x > y ? 1 : 0); } { double p = dyn_num_value(a), q = dyn_num_value(b); /* NaN is unordered, and the honest answer is that it is neither less * than nor greater than anything. Reported as "greater" would make a * sort loop; reported as 2 lets each operator below answer false, which * is what IEEE says every one of them answers. */ if (p != p || q != q) return 2; return p < q ? -1 : (p > q ? 1 : 0); } } if (is_text(a) && is_text(b)) { flan_obj *x = dyn_obj(a), *y = dyn_obj(b); int64_t n = x->len < y->len ? x->len : y->len; int c = n > 0 ? memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)n) : 0; if (c != 0) return c < 0 ? -1 : 1; return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0); } trap2(loc, loclen, TYPE_TRAP, op, "it compares two numbers or two texts, and these are neither", a, b); } flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return flan_dyn_from_bool(order(loc, loclen, "<", a, b) == -1); } flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { int c = order(loc, loclen, "<=", a, b); return flan_dyn_from_bool(c == -1 || c == 0); } flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { return flan_dyn_from_bool(order(loc, loclen, ">", a, b) == 1); } flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen) { int c = order(loc, loclen, ">=", a, b); return flan_dyn_from_bool(c == 1 || c == 0); } /* ── Equality ────────────────────────────────────────────────────────── * * Structural, and the only operation here that never traps: two values of * unrelated tags are unequal, which is an answer, and making it an error would * mean a dyn program could not ask "is this the string I expected" without * first checking that it is a string at all. * * A number equals a number by value across the two tags — (= 1 1.0) is true — * which is the same promotion the operators do and for the same reason. Text * is bytewise and not by identity: two separately built texts with the same * bytes are equal, and the doc's "string identity" section says why that is * the only defensible choice when a text is immutable. * * A vec is equal element by element, with an identity shortcut first. The * depth cap is the cycle stop: [set_at] lets a vec contain itself, and past * the cap two vecs are equal only if they are the same vec, which terminates * and answers correctly for the case that actually arises (a cycle compared * against itself). Two *distinct* cyclic vecs with the same shape answer * false, which is a wrong answer to a question nobody has asked yet; the * honest fix is a visited set and it can be added the day somebody needs it. */ #define EQ_DEPTH 64 static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { int32_t ta = flan_dyn_tag(a), tb = flan_dyn_tag(b); if (a == b && ta != FLAN_DYN_TAG_FLOAT) return 1; if (is_num(a) && is_num(b)) { if (ta == FLAN_DYN_TAG_INT && tb == FLAN_DYN_TAG_INT) return dyn_int_value(a) == dyn_int_value(b); return dyn_num_value(a) == dyn_num_value(b); } if (ta != tb) return 0; if (ta == FLAN_DYN_TAG_TEXT) { flan_obj *x = dyn_obj(a), *y = dyn_obj(b); if (x->len != y->len) return 0; return x->len == 0 || memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)x->len) == 0; } if (ta == FLAN_DYN_TAG_VEC) { flan_obj *x = dyn_obj(a), *y = dyn_obj(b); int64_t i, xn, yn; if (x == y) return 1; if (depth >= EQ_DEPTH) return 0; /* [x]/[y] may each be an ordinary heap vec or a view (M2 item 3) — the tag does not say which, so [vecish_len]/[vecish_at] below read either shape correctly. Reading raw through [x->u.v.items] the way this arm used to is wrong for a view: nothing sets [len] for OBJ_VIEW, so it reads back 0, and the elements alias [u.view.base] reinterpreted as dyn words — two views with different contents would compare equal, a view and an equal heap vec would compare unequal, and a map keyed by any view would collide with every other view, silently, with nothing to crash. */ xn = vecish_len(x); yn = vecish_len(y); if (xn != yn) return 0; for (i = 0; i < xn; i++) if (!dyn_equal(vecish_at(x, i), vecish_at(y, i), depth + 1)) return 0; return 1; } /* Two maps are equal when they hold the same keys and each key answers an * equal value — by lookup and never by position, because two maps built by * inserting the same pairs in different orders are the same map. Sizes are * compared first, so one lookup per entry of x is the whole walk: every key * of x found in y at equal size means every key of y was found. Quadratic, * like everything else about this map, and wrong to be clever about before * the linear scan itself is. */ if (ta == FLAN_DYN_TAG_MAP) { flan_obj *x = dyn_obj(a), *y = dyn_obj(b); int64_t i, j; if (x == y) return 1; if (depth >= EQ_DEPTH) return 0; /* The shape tag is part of the value. Two instances of one class compare * by their entries as any two maps do; an instance and a plain map with * the same entries do not, which is Clojure's answer for a record beside * a map and is the only answer a tag can have if it means anything. An * identity compare, because both sides are interned entries. */ if (x->u.v.klass != y->u.v.klass) return 0; if (x->len != y->len) return 0; for (i = 0; i < x->len; i++) { flan_dyn k = x->u.v.items[i * 2]; int found = 0; for (j = 0; j < y->len; j++) { if (dyn_equal(k, y->u.v.items[j * 2], depth + 1)) { if (!dyn_equal(x->u.v.items[i * 2 + 1], y->u.v.items[j * 2 + 1], depth + 1)) return 0; found = 1; break; } } if (!found) return 0; } return 1; } /* nil, bool and keyword, whose whole content the identity test above * already compared — a keyword's bytes were interned into exactly one * entry, so two keywords are equal iff they are the same word. Reached only * when that test said no. */ return 0; } flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool((uint8_t)dyn_equal(a, b, 0)); } /* ── Containers ────────────────────────────────────────────────────────*/ static inline int is_map(flan_dyn v) { return flan_dyn_tag(v) == FLAN_DYN_TAG_MAP; } /* ── Typed containers as views ───────────────────────────────────────── * * Every entry point below already dispatches on [flan_dyn_tag], which does * not distinguish a view from a heap vec — see [flan_dyn_tag]'s switch — so * [flan_dyn_len], [flan_dyn_at], [flan_dyn_set_at], [flan_dyn_push] and the * printer each add one branch for [OBJ_VIEW] beside the existing [OBJ_VEC] * one. What follows is that branch's machinery. */ static int64_t view_elem_size(int32_t elem) { return elem == FLAN_VIEW_BOOL ? 1 : 8; } /* The stale-container check flan_rt.c's [flan_vec_check] runs for a typed * Vec, restated for a view's own trap rather than reused: the duplicity * doctrine's dyn side gets its own spelling (docs/SPIKE-DUPLICITY.md), and a * dyn program that hits this wants the same park-and-inspect [flan_trap] * gives every other dyn mistake, not the typed side's [rt_die]. A Vec with * no allocator yet — one nobody has pushed to — has nothing to check. * * The message never renders the view it just declared unsafe to read — * review's second finding, and it was not a decoration this dropped for * safety's sake, it was a real infinite recursion: [say] on a view calls * [say_render]'s view branch, which calls [view_len], which calls back in * here, unconditionally, because the epoch is still stale. Every render of * this same view would hit the same check and take the same branch, so * nothing about depth or a visited set closes it — the fix is that a * stale-container check must never read the container it has just refused * to trust, not even to describe it in the sentence explaining why. */ static void view_vec_check(const char *op, flan_dyn_vec_hdr *h) { if (h->alloc) { flan_dyn_alloc_hdr *a = (flan_dyn_alloc_hdr *)h->alloc; if ((int64_t)a->epoch != h->epoch) { fflush(stdout); fprintf(stderr, "dyn %s: this view's container's allocator was released — the " "Vec was made at epoch %lld and the allocator is at %lld now\n", op, (long long)h->epoch, (long long)(int64_t)a->epoch); flan_trap((const uint8_t *)"DynRange", 8); } } } /* [len] and [base], read live for a Vec view (so a push that grows and * moves the underlying Vec is seen the very next operation) and read from * the snapshot for a flat one. */ static int64_t view_len(const char *op, flan_obj *o) { if (o->u.view.is_vec) { flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)o->u.view.base; view_vec_check(op, h); return h->len; } return o->u.view.len; } static void *view_base(flan_obj *o) { if (o->u.view.is_vec) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr; return o->u.view.base; } /* Reads box the element on the way out — the runtime already knows how to * box an i64, an f64 or a bool, so this is that, from raw bytes rather than * from a C value already in hand. */ static flan_dyn view_box(int32_t elem, const uint8_t *p) { switch (elem) { case FLAN_VIEW_I64: { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); } case FLAN_VIEW_F64: { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } default: { uint8_t b = *p; return flan_dyn_from_bool(b); } } } /* A length and an element reader that answer correctly whether [o] is an * ordinary heap vec (OBJ_VEC, elements are dyn words) or a view over a * typed container (OBJ_VIEW, elements are native bytes boxed on the way * out) — the pair [dyn_equal]'s VEC arm needs so that a view compares * correctly against another view and against an ordinary vec alike. Reading * [o->len]/[o->u.v.items] directly, the way that arm used to, answers 0 and * garbage for a view: nothing sets [len] for OBJ_VIEW, and its elements * alias [u.view.base] reinterpreted as dyn words rather than the native * bytes they are. */ static int64_t vecish_len(flan_obj *o) { return o->kind == OBJ_VIEW ? view_len("=", o) : o->len; } static flan_dyn vecish_at(flan_obj *o, int64_t i) { if (o->kind == OBJ_VIEW) return view_box(o->u.view.elem, (const uint8_t *)view_base(o) + i * view_elem_size(o->u.view.elem)); return o->u.v.items[i]; } /* Writes tag-check on the way in: the dyn value's tag must be the one this * view's element type wants, or this traps by name and never coerces or * truncates a mismatched value into the slot. [v] is the view, for the * sentence's container half; [x] is the value that was refused. */ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) { switch (elem) { case FLAN_VIEW_I64: { int64_t n; if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are int", v, x); n = dyn_int_value(x); memcpy(p, &n, 8); return; } case FLAN_VIEW_F64: { double d; if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are float", v, x); d = dyn_num_value(x); memcpy(p, &d, 8); return; } default: { uint8_t b; if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are bool", v, x); b = dyn_payload(x) ? 1 : 0; *p = b; return; } } } flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem) { flan_obj *o = gc_alloc(OBJ_VIEW, 0); o->u.view.base = hdr; o->u.view.len = 0; o->u.view.elem = elem; o->u.view.is_vec = 1; return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { flan_obj *o = gc_alloc(OBJ_VIEW, 0); o->u.view.base = data; o->u.view.len = len; o->u.view.elem = elem; o->u.view.is_vec = 0; return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } flan_dyn flan_dyn_len(flan_dyn v) { if (is_text(v) || is_map(v)) return flan_dyn_from_i64(dyn_obj(v)->len); if (is_vec(v)) { flan_obj *o = dyn_obj(v); if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("len", o)); return flan_dyn_from_i64(o->len); } trap1(NULL, 0, TYPE_TRAP, "len", "only a text, a vec or a map has one", v); } /* The index has to be an int, and that is a separate sentence from the * container being wrong: (at v "1") and (at 3 1) are two different mistakes * and telling somebody "these are the wrong types" names neither. */ static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) { if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT) trap2(NULL, 0, TYPE_TRAP, op, "an index must be an int", v, i); return dyn_int_value(i); } /* A text answers a byte, as an int. That is what [(at s i)] on a * [(Slice u8)] does in the typed language, and a text is a run of bytes in * both. Codepoints are utf8's job and stay there. */ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) { int64_t k; flan_obj *o; if (!is_text(v) && !is_vec(v)) trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); k = need_index("at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("at", o); if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len); return view_box(o->u.view.elem, (const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem)); } if (k < 0 || k >= o->len) trap_range(NULL, 0, "at", v, k, o->len); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); return o->u.v.items[k]; } void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) { int64_t k; flan_obj *o; if (is_text(v)) trap2(NULL, 0, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); if (!is_vec(v)) trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); k = need_index("set-at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("set-at", o); uint8_t *p; if (k < 0 || k >= len) trap_range(NULL, 0, "set-at", v, k, len); p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem); view_unbox("set-at", v, o->u.view.elem, x, p); return; } if (k < 0 || k >= o->len) trap_range(NULL, 0, "set-at", v, k, o->len); o->u.v.items[k] = x; } void flan_dyn_push(flan_dyn v, flan_dyn x) { flan_obj *o; if (!is_vec(v)) { /* The value is in the sentence rather than the vec, because the vec is the * thing that is wrong and the value is what says which push it was. */ trap2(NULL, 0, TYPE_TRAP, "push", "only a vec is pushed to", v, x); } o = dyn_obj(v); if (o->kind == OBJ_VIEW) { uint8_t buf[8]; static const uint8_t push_loc[] = "(dyn push)"; int64_t size; if (!o->u.view.is_vec) trap2(NULL, 0, TYPE_TRAP, "push", "this view is a slice or an array and cannot grow", v, x); size = view_elem_size(o->u.view.elem); view_unbox("push", v, o->u.view.elem, x, buf); if (!flan_vec_push(o->u.view.base, buf, size, size, push_loc, (int64_t)sizeof(push_loc) - 1)) trap_oom(size); return; } if (o->len == o->u.v.cap) { int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; flan_dyn *items = (flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *items); if (items == NULL) trap_oom(cap * (int64_t)sizeof *items); /* The growth is charged to the heap so the trigger sees it, and it is * charged *here* rather than at the next collection because a vec that * doubles a dozen times between allocations would otherwise be invisible * to the trigger until it was already large. */ gc_bytes += (cap - o->u.v.cap) * (int64_t)sizeof *items; o->u.v.items = items; o->u.v.cap = cap; } o->u.v.items[o->len++] = x; } /* ── Maps ────────────────────────────────────────────────────────────── * * Association pairs in one block, scanned linearly with the structural * equality above. Not a hash table, and that is a decision rather than a * shortcut deferred: hashing dyn values structurally means a hash function * over every tag kept in step with [dyn_equal] forever — the exact same-side * duplication the duplicity audit warns the typed side's printers into — and * the maps this exists for are documents read from files, tens of entries. * "The answer to 'I need more performance' will never be a faster GC"; nor * will it be a faster dyn map. Type the program. * * A key occurs once: [set] replaces the value of an equal key in place, which * is what makes a map keyed by anything — including another map — a set with * dedup for free. Insertion order is preserved and is the print order. * * Absence answers nil rather than trapping. A key that is not in a map is an * answer to a question the caller was allowed to ask — the same line [eq] * takes about unrelated tags — and nil is the value FIX.org's queue says * arrives with maps. [contains] is the question to ask when nil might also be * *stored*, and both are here so neither has to be guessed from the other. */ static int64_t map_find(flan_obj *o, flan_dyn k) { int64_t i; for (i = 0; i < o->len; i++) if (dyn_equal(o->u.v.items[i * 2], k, 0)) return i; return -1; } static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) { if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, op, "only a map answers it", m, k); return dyn_obj(m); } flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("get", m, k); int64_t i = map_find(o, k); return i < 0 ? flan_dyn_nil() : o->u.v.items[i * 2 + 1]; } flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("has-key?", m, k); return flan_dyn_from_bool(map_find(o, k) >= 0); } void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) { flan_obj *o = want_map("put", m, k); int64_t i = map_find(o, k); if (i >= 0) { o->u.v.items[i * 2 + 1] = v; return; } if (o->len == o->u.v.cap) { int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; flan_dyn *items = (flan_dyn *)realloc(o->u.v.items, (size_t)cap * 2 * sizeof *items); if (items == NULL) trap_oom(cap * 2 * (int64_t)sizeof *items); /* Charged now for the reason push's growth is: the trigger has to see * the block while it is growing, not after. */ gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items; o->u.v.items = items; o->u.v.cap = cap; } o->u.v.items[o->len * 2] = k; o->u.v.items[o->len * 2 + 1] = v; o->len++; }