Joseph Ferano
3c1fb1b31e
Both directions of the boundary go through expect, the way every other dyn crossing does. A dyn's tag decides which case an (Option T) becomes on the way in; an Option's own tag decides nil or a boxed payload on the way out. box_option/unbox_option build the same If-over-a-tag shape get and map-remove already build for the same reason, reading an Option's tag and payload with the raw Field access Render's structural printer already uses — nothing new for either backend to lower. A literal Some/None skips the runtime check entirely, since the checker already knows which case it is. A bare T has no None to become. The literal nil the checker can see is refused right there, at compile time, in expect itself — the author's decision to do both halves rather than settle for the runtime trap alone. Everything one step removed from the syntax — a dyn that only turns out to be nil once the program runs — reaches flan_dyn_need_i64's existing DynType trap, unchanged; there is no dataflow in this checker for it to be otherwise (see "Ownership tracking repealed"). (Some nil) is refused the same way: the literal at compile time, with a message saying why nil and None would collide; a dyn that turns out to be nil only at run time through the new flan_dyn_need_not_nil, which traps by the same route flan_dyn_need_i64 does. (Option (Option T)) does not cross either direction — boxing Some of an inner None would box it as nil, indistinguishable from the outer None, the same ambiguity (Some nil) is refused for. The type itself stays legal on the typed side; only the crossing does not exist for it. (Option dyn) needs no case of its own in the boundary code — the payload is already dyn, so box_option/unbox_option treat it as the identity — but it is not yet a value a program can hold anywhere. The per-type-descriptor pass (M2 item 2) refuses it at every storage site today, the same way it refuses (Vec dyn), because a struct's dyn fields are marked by byte offsets and (Option dyn)'s payload has none. Item 4 does not lift that gate; it only makes the boundary already correct for the day items 2/3 do. expect grew a ctx parameter to build the fresh slot the two new crossings need — every call site threaded through, one context mismatch caught and fixed in check_fn's tail-expression case along the way. var's None case grew a direct Dyn arm: None at a dyn want is nil outright, with nothing to build. nil-option.flan carries the crossings that succeed and ends on the bare-T trap; some-nil.flan is (Some nil)'s run-time half, kept in its own file the way dyn-boundary.flan is one trap per program. Both are in no_fallback_slots and test_sanitize.ml: the new dyn temporary unbox_option's tag test mints is rooted, and reads its Option's tag and payload through ASan clean, --sanitize matching the unsanitized run byte for byte.
1392 lines
56 KiB
C
1392 lines
56 KiB
C
/* 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 <stdint.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
|
|
/* ── 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);
|
|
|
|
/* ── 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
|
|
|
|
/* 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 ... */
|
|
|
|
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; } 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_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. */
|
|
static inline int64_t obj_words(flan_obj *o) {
|
|
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;
|
|
|
|
/* ── 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;
|
|
case OBJ_VEC: 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 `<vec>` 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_bytes] and flan_dev.c's [flan_dev_emit_str], and
|
|
* for the same reason those two are the same as each other: three printers
|
|
* that disagree about what a string looks like is three wire formats. 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);
|
|
|
|
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;
|
|
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;
|
|
emit("[");
|
|
for (i = 0; i < o->len; i++) {
|
|
emit(" ");
|
|
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; }
|
|
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;
|
|
if (depth >= 2) { say_puts(s, "[...]"); return; }
|
|
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], depth + 1);
|
|
}
|
|
say_puts(s, i < o->len ? " ...]" : "]");
|
|
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. */
|
|
|
|
static _Noreturn void trap2(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);
|
|
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 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);
|
|
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
|
|
|
|
static _Noreturn void trap_range(const char *op, flan_dyn v, int64_t i,
|
|
int64_t len) {
|
|
char sv[SAY_MAX];
|
|
say(sv, SAY_MAX, v);
|
|
fflush(stdout);
|
|
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 empty 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. */
|
|
void flan_dyn_root_pop(int64_t n) {
|
|
if (n <= 0) return;
|
|
roots_n = n < roots_n ? roots_n - n : 0;
|
|
}
|
|
|
|
void flan_dyn_root_reset(void) { roots_n = 0; }
|
|
|
|
/* ── 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;
|
|
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;
|
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
|
}
|
|
|
|
/* ── 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(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(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(TYPE_TRAP, "bool", "a bool was wanted", v);
|
|
return (uint8_t)(dyn_payload(v) ? 1 : 0);
|
|
}
|
|
|
|
/* 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(TYPE_TRAP, "some",
|
|
"Some cannot hold nil -- nil and None would become the same case "
|
|
"of an (Option dyn)", v);
|
|
return v;
|
|
}
|
|
|
|
/* ── 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 char *op, const char *why, flan_dyn a, flan_dyn b) {
|
|
if (!is_num(a) || !is_num(b)) trap2(TYPE_TRAP, op, why, a, b);
|
|
}
|
|
|
|
#define ARITH_NUM "it takes two numbers"
|
|
|
|
static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) {
|
|
int64_t x, y;
|
|
want_nums(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(ARITH_TRAP, op, "it does not divide by zero", a, b);
|
|
if (x == INT64_MIN && y == -1)
|
|
trap2(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(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) { return arith("+", a, b); }
|
|
flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith("-", a, b); }
|
|
flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith("*", a, b); }
|
|
flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith("/", a, b); }
|
|
flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", 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 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(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) {
|
|
return flan_dyn_from_bool(order("<", a, b) == -1);
|
|
}
|
|
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) {
|
|
int c = order("<=", a, b);
|
|
return flan_dyn_from_bool(c == -1 || c == 0);
|
|
}
|
|
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) {
|
|
return flan_dyn_from_bool(order(">", a, b) == 1);
|
|
}
|
|
flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) {
|
|
int c = order(">=", 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;
|
|
if (x == y) return 1;
|
|
if (depth >= EQ_DEPTH) return 0;
|
|
if (x->len != y->len) return 0;
|
|
for (i = 0; i < x->len; i++)
|
|
if (!dyn_equal(x->u.v.items[i], y->u.v.items[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;
|
|
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;
|
|
}
|
|
|
|
flan_dyn flan_dyn_len(flan_dyn v) {
|
|
if (is_text(v) || is_vec(v) || is_map(v))
|
|
return flan_dyn_from_i64(dyn_obj(v)->len);
|
|
trap1(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(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(TYPE_TRAP, "at", "only a text or a vec is indexed", v, i);
|
|
k = need_index("at", v, i);
|
|
o = dyn_obj(v);
|
|
if (k < 0 || k >= o->len) trap_range("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;
|
|
(void)x;
|
|
if (is_text(v))
|
|
trap2(TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i);
|
|
if (!is_vec(v))
|
|
trap2(TYPE_TRAP, "set-at", "only a vec is assigned into", v, i);
|
|
k = need_index("set-at", v, i);
|
|
o = dyn_obj(v);
|
|
if (k < 0 || k >= o->len) trap_range("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(TYPE_TRAP, "push", "only a vec is pushed to", v, x);
|
|
}
|
|
o = dyn_obj(v);
|
|
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(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++;
|
|
}
|