diff --git a/lib/ast.ml b/lib/ast.ml index 76e941b..63e6fa1 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -66,6 +66,10 @@ and expr_kind = | Call of expr * expr list | Match of expr * arm list | Struct of string * (string * expr) list (* (Cursor {.src s}) *) + (* {:a 1 :b s} — a dyn map literal. Braces whose first form is not a + [.field] symbol are this; the struct spelling keeps the dot. Keys are + ordinary expressions, keywords being the common case. *) + | MapLit of (expr * expr) list | Arr of expr list (* [0xE6B800FF ...] — a fixed array value *) (* (array 4 rl/Vector2) — a zeroed fixed array, given its count and its element type. [n T] is the ordinary *type* syntax and already works @@ -260,6 +264,7 @@ let map_children f (e : expr) : expr = | Call (fn, args) -> Call (ex fn, List.map ex args) | Match (s, arms) -> Match (ex s, List.map arm arms) | Struct (n, fs) -> Struct (n, List.map (fun (n, v) -> (n, ex v)) fs) + | MapLit kvs -> MapLit (List.map (fun (k, v) -> (ex k, ex v)) kvs) | Arr es -> Arr (List.map ex es) | Fn (ps, es) -> Fn (ps, List.map ex es) | Dotimes (l, n, c, es) -> Dotimes (l, n, ex c, List.map ex es) diff --git a/lib/check.ml b/lib/check.ml index 5b91e41..ab93b9d 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1429,14 +1429,14 @@ let box loc (e : Tast.expr) : Tast.expr = write. *) | Types.String -> dyn "flan_dyn_from_bytes" [ e ] (* Unit does not box. A value of the zero-sized type carries nothing for a - dyn word to hold, and [nil] -- which is what an [if] with no else answers - in dyn context -- is a different thing with a different constructor. The + dyn word to hold, and [nil] -- the absent dyn value, writable as the + literal [nil] -- is a different thing with a different constructor. The two get confused if unit is allowed to become one. *) | Types.Unit -> Loc.failk "check/dyn-unit" loc "() does not box into dyn — a value of the zero-sized type carries \ - nothing a dyn could hold. The absent dyn value is nil, which is what an \ - if with no else branch answers here" + nothing a dyn could hold. The absent dyn value is nil, which is a \ + literal here: write nil" | Types.Never -> e | Types.Vec _ | Types.Map _ | Types.Slice _ | Types.Array _ -> no_dyn_yet loc ~into:true e.Tast.ty @@ -1837,10 +1837,15 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = mk loc (Types.Float k) (Tast.Float (x, k)) | Ast.Str s -> expect loc ~want (mk loc Types.String (Tast.Str s)) | Ast.Kw k -> - (* A keyword resolves at compile time against the enum the site expects, - and a typo is an error here rather than a wrong number at run time - (plan.org, settled: keywords at typed call sites). It has no meaning - without that expectation — there is no keyword type to fall back on. *) + (* Two keywords in one spelling, told apart by the expectation. Where an + enum type is expected, :space resolves at compile time against its + members and a typo is an error here rather than a wrong number at run + time (plan.org, settled: keywords at typed call sites) — no runtime + value exists at all. Everywhere else :foo is a first-class dyn value, + interned by the runtime so two spellings of one name are one word and + equality is an identity compare. The enum reading keeps priority + because it existed first and costs nothing; nothing is lost, since a + site that wants the dyn keyword against an enum expectation has none. *) (match want with | Some (Types.Enum name) -> let members = Hashtbl.find ctx.env.enums name in @@ -1850,13 +1855,35 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = fail loc "%s has no member :%s — it has %s" name k (String.concat " " (List.map (fun (m, _) -> ":" ^ m) members))) + | Some Types.Dyn | None -> + expect loc ~want + (rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str k) ]) | Some other -> - fail loc ":%s is an enum member, but %s is expected here" k - (Types.to_string other) - | None -> fail loc - ":%s only means something where an enum type is expected — there is \ - no keyword type" k) + ":%s is an enum member where an enum is expected and a dyn keyword \ + elsewhere, but %s is expected here" k + (Types.to_string other)) + (* {:a 1 :b s} — a dyn map, built where it stands. Always dyn: the + runtime owns the storage the way (vec-new dyn) does, keys and values are + both dyn words, and a typed want other than dyn refuses through [expect] + like any other dyn value would. The literal lowers to a fresh slot — a + rooted one, because a slot of type dyn is what [dyn_roots] counts — so + the map stays reachable across the allocations its own entries make. *) + | Ast.MapLit kvs -> + let m = fresh_slot ctx Types.Dyn in + let mval = mk loc Types.Dyn (Tast.Local m) in + let sets = + List.map + (fun (k, v) -> + rt loc Types.Unit "flan_dyn_map_set" + [ mval; check ctx ~want:Types.Dyn k; + check ctx ~want:Types.Dyn v ]) + kvs + in + expect loc ~want + (mk loc Types.Dyn + (Tast.Let ([ (m, rt loc Types.Dyn "flan_dyn_map_new" []) ], + sets @ [ mval ]))) | Ast.Quote _ -> unimplemented loc "a quoted symbol (restart names)" 6 | Ast.Var name -> var ctx loc ~want name @@ -1934,6 +1961,23 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = let fty = (List.nth s.Tast.fields i).Tast.fty in expect loc ~want (mk loc fty (Tast.Field (target, i)))) | Ast.Struct (name, kvs) -> check_struct ctx ~want loc name kvs + (* A bracket literal where a dyn is wanted is the runtime's own vec, built + where it stands — the same lowering the map literal gets, and what makes + {:xs [1 2]} mean what it reads as. Everywhere else brackets stay the + fixed-array literal they always were. *) + | Ast.Arr items when want = Some Types.Dyn -> + let v = fresh_slot ctx Types.Dyn in + let vval = mk loc Types.Dyn (Tast.Local v) in + let pushes = + List.map + (fun x -> + rt loc Types.Unit "flan_dyn_push" + [ vval; check ctx ~want:Types.Dyn x ]) + items + in + mk loc Types.Dyn + (Tast.Let ([ (v, rt loc Types.Dyn "flan_dyn_vec_new" []) ], + pushes @ [ vval ])) | Ast.Arr items -> check_arr ctx ~want loc items (* (array 4 rl/Vector2). Parse already assembled the whole array type, so there is nothing to infer: resolve it and hand back its all-bytes-zero @@ -2135,6 +2179,13 @@ and var ctx loc ~want name = match name with | "true" | "false" -> expect loc ~want (mk loc Types.Bool (Tast.Bool (name = "true"))) + (* The dyn absence value, written down. It arrived with maps — (get m k) on + a key the map does not hold answers it — and this is its producer, so a + program can store one, compare against one, and put one in a map. It is + always dyn: at a typed want it refuses through [expect], and what a nil + does at an (Option T) boundary is the queue's own later item. *) + | "nil" -> + expect loc ~want (rt loc Types.Dyn "flan_dyn_nil" []) | "None" -> (match want with | Some (Types.Option t) -> mk loc (Types.Option t) Tast.None_ @@ -4437,6 +4488,15 @@ and named_call ctx ~want loc name args = (match args with | [ target; k; v ] -> let target = check ctx target in + (* A put into a dyn map is a call and nothing else, the way a push into + a dyn vec is: the runtime owns the storage, so there is no guard, no + restart and no region check. An equal key's value is replaced. *) + if target.Tast.ty = Types.Dyn then + expect loc ~want + (rt loc Types.Unit "flan_dyn_map_set" + [ target; check ctx ~want:Types.Dyn k; + check ctx ~want:Types.Dyn v ]) + else begin let kt, vt = map_kv loc "put" target.Tast.ty in let k = check ctx ~want:kt k in let v = check ctx ~want:vt v in @@ -4465,6 +4525,7 @@ and named_call ctx ~want loc name args = (reg_note loc "flan_dev_reg_note_map" target [ size_of loc kt; size_of loc vt ] target.Tast.ty)) ]))) + end | _ -> assert false) (* (get m k) -> (Option V). Absence is None, not an untyped nil, and the @@ -4477,6 +4538,16 @@ and named_call ctx ~want loc name args = (match args with | [ target; k ] -> let target = check ctx target in + (* A dyn map's absence is nil, not None: the typed map can promise an + (Option V) because V was written down, and a dyn map has nothing to + write. nil is an ordinary dyn value the caller compares against — + and (contains? m k) is the question to ask when nil might also be + stored under the key. *) + if target.Tast.ty = Types.Dyn then + expect loc ~want + (rt loc Types.Dyn "flan_dyn_map_get" + [ target; check ctx ~want:Types.Dyn k ]) + else begin let kt, vt = map_kv loc "get" target.Tast.ty in let k = check ctx ~want:kt k in (* Deferred, and the placeholder is [None] rather than [Unit]: this @@ -4512,6 +4583,23 @@ and named_call ctx ~want loc name args = (Tast.Let ([ (ks, k); (out, mk loc vt (Tast.Zero vt)) ], [ mk loc oty (Tast.If (cond, some, none)) ]))) + end + | _ -> assert false) + + (* (keyword s) -> the interned dyn keyword named by the bytes, for a name + that only exists at run time — a reader building :texture-path out of a + token's text. A literal :foo never comes through here. *) + | "keyword" -> + arity loc name 1 args; + (match args with + | [ s ] -> + let s = check ctx s in + (match s.Tast.ty with + | Types.String | Types.Slice (Types.Int Types.U8) -> + expect loc ~want (rt loc Types.Dyn "flan_dyn_kw" [ s ]) + | other -> + fail loc "keyword takes a string or a [u8], found %s" + (Types.to_string other)) | _ -> assert false) (* (map-remove m k) -> (Option V): the value that was there, or None when @@ -4617,6 +4705,18 @@ and named_call ctx ~want loc name args = (match args with | [ target; k ] -> let target = check ctx target in + (* The dyn map's question, one word with the typed one. It exists on + the dyn side because absence there is nil, and a map can also store + nil under a key — (get m k) answering nil cannot tell the two + apart, and this can. The bool comes back unboxed the way a dyn + comparison does, because a presence test is overwhelmingly an if's + condition. *) + if target.Tast.ty = Types.Dyn then + expect loc ~want + (unbox loc Types.Bool + (rt loc Types.Dyn "flan_dyn_map_contains" + [ target; check ctx ~want:Types.Dyn k ])) + else begin let kt, vt = map_kv loc "has-key?" target.Tast.ty in let k = check ctx ~want:kt k in (* Deferred, and the placeholder is a [bool] — the form a condition @@ -4640,6 +4740,7 @@ and named_call ctx ~want loc name args = [ found; mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])) ]))) + end | _ -> assert false) (* ── Assets, decision 1: embedded at compile time ────────────── @@ -5828,7 +5929,13 @@ let builtins : (string * string * string) list = (addr v)) ...)."); ("has-key?", "has-key? [(Map K V) K] bool", "Whether the key is present, copying no value — the form a condition \ - wants, where get would hand back an Option to match on."); + wants, where get would hand back an Option to match on. Over a dyn map \ + it is the question that stays askable when nil might also be stored \ + under the key."); + ("keyword", "keyword [string|[u8]] dyn", + "The interned dyn keyword named by the bytes, for a name that only \ + exists at run time — a reader building :texture-path out of a token's \ + text. A literal :foo is already one."); (* assets, embedded at compile time *) ("embed", "embed [\"path\" string?] [u8]", @@ -5924,11 +6031,15 @@ let builtins : (string * string * string) list = after it runs."); ("argv", "argv [] [string]", "The command line, as a slice of strings."); - (* the five that are names rather than calls — [var]'s arms. Their + (* the names rather than calls — [var]'s arms. Their signature is the [name type] shape [Dev.defs] gives a global, because that is what they are at the site: a value, not a call. *) ("true", "true bool", "The true boolean literal."); ("false", "false bool", "The false boolean literal."); + ("nil", "nil dyn", + "The absent dyn value: what (get m k) answers for a key a dyn map does \ + not hold, and always dyn — what a nil does at an (Option T) boundary \ + is a later milestone's question."); ("None", "None (Option T)", "The absent Option. It takes its type from its context — a return type \ or an annotated binding — because nothing about the word says what it \ diff --git a/lib/emit.ml b/lib/emit.ml index a59cf2c..b9a40f1 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3015,6 +3015,11 @@ declare i64 @flan_dyn_from_f64(double) declare i64 @flan_dyn_from_bool(i32) declare i64 @flan_dyn_from_bytes(ptr, i64) declare i64 @flan_dyn_vec_new() +declare i64 @flan_dyn_map_new() +declare i64 @flan_dyn_kw(ptr, i64) +declare i64 @flan_dyn_map_get(i64, i64) +declare void @flan_dyn_map_set(i64, i64, i64) +declare i64 @flan_dyn_map_contains(i64, i64) declare i64 @flan_dyn_add(i64, i64) declare i64 @flan_dyn_sub(i64, i64) declare i64 @flan_dyn_mul(i64, i64) diff --git a/lib/load.ml b/lib/load.ml index 68797f1..c6c88ce 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -265,6 +265,10 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = [ ("s", { v with Ast.e = Ast.Str (qualify_name owned alias bound s) }) ]) | Ast.Struct (n, kvs) -> Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs) + (* A dyn map literal has no name of its own to qualify; its keys and + values are ordinary expressions and are walked like anything else. *) + | Ast.MapLit kvs -> + Ast.MapLit (List.map (fun (k, v) -> (go k, go v)) kvs) | Ast.Arr items -> Ast.Arr (gos items) | Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t) | Ast.Fn (ps, body) -> @@ -656,6 +660,7 @@ let rec expr_uses acc (e : Ast.expr) = | Ast.Struct (n, kvs) -> acc := (n, e.Ast.loc) :: !acc; List.iter (fun (_, v) -> go v) kvs + | Ast.MapLit kvs -> List.iter (fun (k, v) -> go k; go v) kvs | Ast.Arr items -> gos items | Ast.ArrayOf t -> texpr_uses acc t | Ast.Fn (_, body) -> gos body diff --git a/lib/parse.ml b/lib/parse.ml index a75c1b5..5ab0133 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -154,7 +154,10 @@ and pitems (items : Form.t list) : Ast.pitem list = is what braces mean in the position a body starts in. *) let constraints (body : Form.t list) : Ast.pred list * Form.t list = match body with - | ({ Form.v = Form.Map (({ Form.v = Form.Kw _; _ } :: _ as kvs)); _ } as m) + (* Only when the first key is [:where] — the one key the map takes. Braces + opening on any other keyword are a dyn map literal standing as the body's + first form, and belong to the body. *) + | ({ Form.v = Form.Map (({ Form.v = Form.Kw "where"; _ } :: _ as kvs)); _ } as m) :: rest -> let pred (p : Form.t) = match p.Form.v with @@ -215,7 +218,15 @@ let rec expr (f : Form.t) : Ast.expr = (* In value position brackets are a fixed-array literal; in type position they are a slice or array type. Position disambiguates, as with {}. *) | Vec items -> mk (Ast.Arr (List.map expr items)) - | Map _ -> fail f "a bare map is not an expression; write (Type {.field v})" + (* Braces in value position are two literals told apart by their first form. + A [.field] symbol says struct, and a bare struct field list still needs + its type written — (Type {.field v}) — because the fields alone do not + name one. Anything else, the empty braces included, is a dyn map literal: + {:a 1 :b s}, keys and values alternating, each an ordinary expression. *) + | Map ({ v = Sym s; _ } :: _) + when String.length s > 1 && s.[0] = '.' -> + fail f "a bare map is not an expression; write (Type {.field v})" + | Map items -> mk (Ast.MapLit (map_pairs f items)) | List [] -> fail f "() is not an expression" | List (head :: args) -> form f mk head args @@ -506,7 +517,10 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = | _ -> fail f "field access is (.%s value)" field) (* ── struct literal: (Cursor {.src s .pos 0}) ───────────────────── *) - | Sym name when args <> [] && is_map (List.hd args) -> + (* Only braces whose first form is a [.field] symbol — or the empty braces, + which have always meant the zero-initialised struct here. A map literal + as an argument, (f {:a 1}), keeps its head as an ordinary call. *) + | Sym name when args <> [] && is_struct_map (List.hd args) -> (match args with | [ { v = Map kvs; _ } ] -> mk (Ast.Struct (name, struct_fields f kvs)) | _ -> fail f "a struct literal is (%s {.field value ...})" name) @@ -514,7 +528,24 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr = (* ── anything else is a call ────────────────────────────────────── *) | _ -> mk (Ast.Call (expr head, List.map expr args)) -and is_map (f : Form.t) = match f.v with Map _ -> true | _ -> false +and is_struct_map (f : Form.t) = + match f.v with + | Map [] -> true + | Map ({ v = Sym s; _ } :: _) -> String.length s > 1 && s.[0] = '.' + | _ -> false + +(* A map literal's braces hold key/value pairs, each an expression. *) +and map_pairs f (items : Form.t list) : (Ast.expr * Ast.expr) list = + let rec go = function + | [] -> [] + | k :: v :: rest -> (expr k, expr v) :: go rest + | [ odd ] -> + Loc.fail odd.Form.loc + "a map literal is key/value pairs, and this one has an odd number of \ + forms — found %s with no value" (Form.to_string odd) + in + ignore f; + go items and body_of (items : Form.t list) : Ast.expr list = List.map expr items diff --git a/lib/prelude.ml b/lib/prelude.ml index 4bef62e..847109c 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -354,8 +354,8 @@ let source = {flan| ;; that makes the empty case unforgettable — and it is the wrong thing to write ;; when the empty case is one word: ;; -;; (match (edn/read src) (Some v) v None edn/Value.Nil) -;; (or-else (edn/read src) edn/Value.Nil) +;; (match (parse-i64 s) (Some v) v None (i64 0)) +;; (or-else (parse-i64 s) (i64 0)) ;; ;; **Neither takes a {:where}, and that is a decision rather than an ;; oversight.** A predicate buys an *operation* on the variable — [ordered?] diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index a3001a9..b0a7a3a 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -105,6 +105,14 @@ typedef uint64_t flan_dyn; #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. */ @@ -143,19 +151,32 @@ static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) { #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 */ + 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 */ + 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 */ @@ -221,31 +242,49 @@ static unsigned ring_at; * 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" }; + "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_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; } } @@ -253,7 +292,7 @@ int32_t flan_dyn_tag(flan_dyn v) { } const char *flan_dyn_tag_name(int32_t tag) { - if (tag < 0 || tag > FLAN_DYN_TAG_VEC) return "?"; + if (tag < 0 || tag > FLAN_DYN_TAG_MAP) return "?"; return tag_words[tag]; } @@ -369,6 +408,31 @@ static void render(flan_dyn v, int depth, int nested) { 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; @@ -432,6 +496,33 @@ static void say_render(sayer *s, flan_dyn v, int depth) { 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; @@ -616,9 +707,9 @@ 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 has 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) return; + /* 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); @@ -640,7 +731,8 @@ static void gc_mark_all(void) { for (k = 0; k < RING; k++) mark_push(ring[k]); while (mstack_n > 0) { flan_obj *o = mstack[--mstack_n]; - for (i = 0; i < o->len; i++) mark_value(o->u.v.items[i]); + int64_t n = obj_words(o); + for (i = 0; i < n; i++) mark_value(o->u.v.items[i]); } } @@ -655,8 +747,9 @@ static void gc_sweep(void) { } else { int64_t held = (int64_t)sizeof(flan_obj); if (o->kind == OBJ_TEXT) held += o->len; - if (o->kind == OBJ_VEC) { - held += o->u.v.cap * (int64_t)sizeof(flan_dyn); + 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; @@ -739,6 +832,56 @@ flan_dyn flan_dyn_vec_new(void) { 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) { @@ -998,8 +1141,39 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { if (!dyn_equal(x->u.v.items[i], y->u.v.items[i], depth + 1)) return 0; return 1; } - /* nil and bool, whose whole content is the payload the identity test above - * already compared. Reached only when that test said no. */ + /* 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; } @@ -1009,9 +1183,14 @@ flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) { /* ── 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)) return flan_dyn_from_i64(dyn_obj(v)->len); - trap1(TYPE_TRAP, "len", "only a text or a vec has one", 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 @@ -1075,3 +1254,70 @@ void flan_dyn_push(flan_dyn v, flan_dyn x) { } 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++; +} diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index ec4ad4f..fe1f2ab 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -44,6 +44,15 @@ flan_dyn flan_dyn_from_bool(uint8_t b); flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n); flan_dyn flan_dyn_vec_new(void); +flan_dyn flan_dyn_map_new(void); + +/* A keyword: :foo as a run-time value. Interned — the runtime keeps one entry + * per distinct name forever, so two keywords with the same bytes are the same + * word and equality is an identity compare, never a memcmp. The entries are + * immortal by construction and the collector never traces or frees one. + * [p] may point anywhere; the bytes are copied on the first interning. The + * name is the bytes after the colon: flan_dyn_kw("a", 1) is :a. */ +flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n); /* ── Operations ──────────────────────────────────────────────────────── * @@ -80,6 +89,16 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i); void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x); void flan_dyn_push(flan_dyn v, flan_dyn x); +/* Map only; anything else traps by name. Keys and values are both dyn and a + * key is compared structurally, so a keyword, a text, an int, or a whole map + * may key one. [get] on an absent key answers nil — absence is an answer, the + * same line [eq] takes about unrelated tags — and [contains] is the question + * to ask when nil might also be stored. [set] replaces the value of an equal + * key in place, so a key occurs once and insertion order is print order. */ +flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k); +void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v); +flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k); + /* Structural, and per type it renders what typed [print] renders. Never * traps: every tag has a rendering, including nil. */ void flan_dyn_print(flan_dyn v); @@ -158,12 +177,14 @@ void flan_dyn_root_reset(void); * both — a value's tag is the first thing anyone asks a stopped dyn program — * and the trap messages in flan_dyn.c are written from the same table, so a * message and an inspector cannot disagree about what to call a value. */ -#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_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 int32_t flan_dyn_tag(flan_dyn v); const char *flan_dyn_tag_name(int32_t tag); diff --git a/test/dune b/test/dune index cd2ced3..dd80114 100644 --- a/test/dune +++ b/test/dune @@ -25,7 +25,7 @@ ; The dev agent package: its Flan declarations and the C that implements them. (glob_files %{workspace_root}/vendor/agent/*) ; The EDN package — the tokenizer and the dynamic reader over it — which - ; programs/edn.flan, arena-edn.flan and edn-read.flan import; and the JSON + ; programs/edn.flan and edn-read.flan import; and the JSON ; tokenizer, which programs/json.flan does. (glob_files %{workspace_root}/vendor/edn/*) (glob_files %{workspace_root}/vendor/json/*) diff --git a/test/programs/arena-edn.flan b/test/programs/arena-edn.flan deleted file mode 100644 index 7da47d0..0000000 --- a/test/programs/arena-edn.flan +++ /dev/null @@ -1,127 +0,0 @@ -;;;; An EDN document read into a dynamic value, against an arena. -;;;; -;;;; This is the other half of programs/edn.flan. That one reads a document -;;;; whose shape is known into a struct, by hand, which is what the compiler's -;;;; (read-edn Enemy bytes) will emit. This one is what a reader handed *no* -;;;; target type has to answer with: a data type naming itself through a -;;;; (Vec Value) and a (Map string Value), holding whatever was in the file. -;;;; -;;;; ── The allocator story, which is the point of the program ─────────── -;;;; -;;;; edn/read takes no allocator and names none. It does not need to: -;;;; spec-memory.md puts the allocator in the calling convention, so every -;;;; (vec-new) and (map-new) inside it takes the *context*, and the caller -;;;; chooses the tier with (with-allocator ...) around the call. An explicit -;;;; allocator at a construction site overrides that, which is how a reader -;;;; would take one as a parameter if it wanted to — but the existing idiom -;;;; already does the job, so there is no new machinery here and none needed. -;;;; -;;;; The tier has to be a region and not the heap, and that is enforced rather -;;;; than documented: a (Vec Value) whose elements own storage traps at its -;;;; construction against any allocator that can free one block. See -;;;; programs/arena-region.flan. -;;;; -;;;; ── What the region buys, said plainly ─────────────────────────────── -;;;; -;;;; The document below is four levels deep and every level allocates. There is -;;;; no teardown anywhere in this file: no drop, no destructor, no recursive -;;;; free, not even a (free) call. One (free-all frame) at the bottom of main -;;;; releases every Vec block, every Map block and every entry in them, because -;;;; they all came out of the same region. -;;;; -;;;; Odin's core:encoding/json ships a hand-written recursive destroy_value in -;;;; the *library* for the heap case, and names parsing against temp_allocator -;;;; and calling free_all as the idiomatic alternative. This is that -;;;; alternative, and it needs nothing from the language that was not already -;;;; there. -;;;; -;;;; ── The reader moved, and what is left here ────────────────────────── -;;;; -;;;; read-value used to be written out in this file. It is vendor/edn's now, as -;;;; (edn/read bytes), and what this program keeps is the half that was always -;;;; the demonstration: the walk back over a document nobody declared a type -;;;; for, and the one free-all that ends it. The strings are the package's own -;;;; copies in the region now rather than views into `doc`, which is why there -;;;; is nothing left here saying which parts of the value outlive the release. - -(import edn "vendor:edn") - -(defvar frame Allocator) - -(defn count-leaves [v edn/Value] i32 - (match v - (List items) - (let [n 0] - (dotimes [i (len items)] - (set n (+ n (count-leaves (at items i))))) - n) - (Set items) - (let [n 0] - (dotimes [i (len items)] - (set n (+ n (count-leaves (at items i))))) - n) - ;; map-next fills an out-parameter with a copy of the value's bytes, - ;; which for a Value holding a container is a second header over the same - ;; block. In a region that is an alias and not a second owner — nothing - ;; here owns anything, the arena does — so walking a map is the ordinary - ;; iteration and needs no accessor of its own. - (Table entries) - (let [n 0 - cur (i64 0) - k "" - v edn/Value.Nil] - (while (map-next entries (addr cur) (addr k) (addr v)) - (set n (+ n (count-leaves v)))) - n) - _ 1)) - -(defn sum-ints [v edn/Value] i64 - (match v - (Int n) n - (List items) - (let [t (i64 0)] - (dotimes [i (len items)] - (set t (+ t (sum-ints (at items i))))) - t) - (Table entries) - (match (get entries "xs") (Some x) (sum-ints x) None (i64 0)) - _ (i64 0))) - -(defn describe [v edn/Value] string - (match v - Nil "nil" (Bool _b) "bool" (Int _n) "int" (Float _x) "float" - (Text _s) "string" (Key _s) "keyword" (List _i) "vector" - (Set _i) "set" (Table _e) "map")) - -(defconst doc - "{:name \"level-1\" - :xs [1 2 3] - :spawns [{:kind :grunt :at [10 20]} - {:kind :boss :at [30 40]}] - :gravity 9.8 - :looping true}") - -(defn main [] i32 - (set frame (arena-new 65536)) - (with-allocator frame - ;; None is the malformed document, and it cannot happen for a literal that - ;; is right here — but reading it back out of the Option is what makes the - ;; refusal visible at the call site instead of arriving as a Nil that looks - ;; like data. - (match (edn/read (bytes doc)) - (Some v) - (do - (println (describe v)) - (println (count-leaves v)) - (println (sum-ints v)) - (match v - (Table entries) - (match (get entries "name") - (Some n) (println (describe n)) - None (println "missing")) - _ (println "not a map"))) - None (println "malformed"))) - ;; The whole document, in one operation and with no per-element teardown. - (free-all frame) - (arena-destroy frame) - 0) diff --git a/test/programs/dyn-map.flan b/test/programs/dyn-map.flan new file mode 100644 index 0000000..e41b920 --- /dev/null +++ b/test/programs/dyn-map.flan @@ -0,0 +1,70 @@ +;;;; Dyn maps and keywords: the literal, the operations, the printing, and a +;;;; collection loop that outruns the GC floor. +;;;; +;;;; Every value here is dyn. {:a 1} is a heap map the collector traces; :a is +;;;; an interned keyword, so two spellings of one name are the same word and +;;;; equality never reads the bytes; [1 2] where a dyn is wanted is the +;;;; runtime's own vec. The printed forms are the dyn renderer's — a space +;;;; before every element, strings quoted when nested — pinned here across +;;;; both backends the way test/dyn_ops.c pins them from C. + +;; A dyn global: rooted once at startup, so what main stores in it survives +;; every collection the churn loop below causes. +(defvar config dyn) + +(defn main [] i32 + ;; The literal, and what it prints as. + (let [m {:a 1 :b "two" :xs [1 2 3] :inner {:c 2.5}}] + (println m) + (println (len m)) + (println (get m :a)) + (println (get m :b)) + (println (get m :xs)) + (println (get (get m :inner) :c)) + + ;; Absence is nil — an answer, not a trap — and has-key? is the question + ;; that stays askable when nil might also be stored. + (println (get m :missing)) + (println (= (get m :missing) nil)) + (println (has-key? m :a)) + (println (has-key? m :missing)) + (put m :flag nil) + (println (get m :flag)) + (println (has-key? m :flag)) + + ;; put replaces an equal key's value in place; the length holds still. + (put m :a 99) + (println (get m :a)) + (println (len m)) + + ;; Keywords: identity equality, printing, and the runtime constructor — + ;; (keyword "a") has to be the same word as the literal :a. + (println (= :a :a)) + (println (= :a :b)) + (println (= :a "a")) + (println (= (keyword "a") :a)) + (println :standalone) + + ;; Keys are whole values compared structurally: a text and a keyword are + ;; two keys, and a vec of numbers can key a map. + (put m "a" "text key") + (println (len m)) + (println (get m "a")) + (put m [1 2] "vec key") + (println (get m [1 2])) + + ;; Maps compare structurally, by lookup and not by insertion order. + (println (= {:x 1 :y 2} {:y 2 :x 1})) + (println (= {:x 1} {:x 2})) + (println (= {:x 1} {:x 1 :y 2}))) + + ;; The churn: enough map, vec and text allocation to pass the 1 MiB floor + ;; many times over, against one live map held in a rooted global. A marker + ;; that lost track of a map's keys or values frees something live, and the + ;; sum at the end comes out wrong — or ASan speaks, in the sanitize sweep. + (set config {:total 0}) + (dotimes [i 200000] + (let [row {:i 1 :s "forty-seven bytes of text to fatten each row" :v [1 2 3]}] + (put config :total (+ (get config :total) (len row))))) + (println (get config :total)) + 0) diff --git a/test/programs/edn-read.flan b/test/programs/edn-read.flan index d6b18e3..39da26f 100644 --- a/test/programs/edn-read.flan +++ b/test/programs/edn-read.flan @@ -1,5 +1,5 @@ -;;;; (edn/read bytes) over the file it was built for, plus the two properties -;;;; that are only claims until something runs them. +;;;; (edn/read bytes) over the file it was built for, plus the properties that +;;;; are only claims until something runs them. ;;;; ;;;; assets/edn/tileset.edn is the real thing, copied out of the editor that ;;;; writes it: a map of :texture-path to a string and :selected-cells to a set @@ -10,79 +10,60 @@ ;;;; beside the other three is a type error in a program that has nothing to do ;;;; with this one. embed-dir does not descend, which is what makes a ;;;; subdirectory the answer rather than a second assets directory. -;;;; The hand-written struct reader in programs/edn.flan is the other route and -;;;; needs a defstruct per file; this one needs nothing and reads a file whose -;;;; keys it has never heard of. ;;;; -;;;; The two properties: +;;;; The document is plain dyn now — maps, vecs, keywords, texts — where it +;;;; used to be the edn/Value tagged union. What the union's hand-written +;;;; equality bought, the runtime's structural equality answers: ;;;; ;;;; * a set holds each value once, by *structure*. #{[0 0] [0 0]} is one -;;;; element, and a dedup written with `=` would make it two — two Vec -;;;; headers over two blocks are never the same header. +;;;; element. A set reads as a dyn map from element to true, and the dedup +;;;; is put's own key-replace, so a set with a duplicate never exists. ;;;; -;;;; * (edn/read-file path) is the same read with the buffer owned and freed -;;;; inside the call, which is only safe because of the property below it. -;;;; Two cases: the real file by path, whose answer has to equal the embed -;;;; above byte for byte, and a missing one, where slurp's FileError has to -;;;; arrive at a handler *outside* read-file with `use-value` still armed — -;;;; the pass-through decision, run rather than asserted. +;;;; * the document owns its strings. The buffer a document was read from is +;;;; overwritten byte by byte afterwards, and the string read out of the +;;;; document still prints what was in the file — the box copied. ;;;; -;;;; * a Value owns its strings. The last case reads a document out of a -;;;; buffer and then overwrites every byte of that buffer in place. A -;;;; reader holding views prints the overwriting bytes; one holding copies -;;;; prints what was in the file. The buffer is written rather than freed -;;;; because a freed buffer is a read of released memory, which can pass by -;;;; luck; overwriting it cannot. +;;;; * (edn/read-file path) frees its buffer inside the call, safe because +;;;; of the property above, and passes a FileError through untouched with +;;;; both restarts still armed. +;;;; +;;;; What dyn cannot say and the old (Option Value) could: `read` answers nil +;;;; both for malformed input and for the document `nil`. The distinction did +;;;; not vanish — it moved to the cursor, where the error position has always +;;;; lived, and `malformed?` below is the three lines it costs. (import edn "vendor:edn") -(defvar frame Allocator) - ;; The document, read at compile time. An embed is bytes in the binary, so ;; there is no file open here and no path to get wrong at run time. (defconst tileset (embed "assets/edn/tileset.edn")) -;; [a b] as a Value, so a membership test can be written against a pair this -;; program made rather than one it found. Building a Value from outside the -;; package is the same two forms as building one inside it. -(defn pair [a i64 b i64] edn/Value - (let [items (vec-new edn/Value)] - (push items (edn/Value.Int {.n a})) - (push items (edn/Value.Int {.n b})) - (edn/Value.List {.items items}))) - -(defn field [v edn/Value k string] edn/Value - (match v - (Table entries) (match (get entries k) (Some x) x None edn/Value.Nil) - _ edn/Value.Nil)) - (defn show-tileset [] () - (match (edn/read tileset) - (Some doc) - (do - (match (field doc "texture-path") - (Text s) (println s) - _ (println "no texture path")) - (match (field doc "selected-cells") - (Set cells) - (do - (println (len cells)) - ;; Two cells that are in the file and one that is not. A reader - ;; that flattened the pairs into 108 integers would still have - ;; the right count of *something*, and would miss both of these. - (println (edn/member? cells (pair (i64 4) (i64 3)))) - (println (edn/member? cells (pair (i64 0) (i64 0)))) - (println (edn/member? cells (pair (i64 3) (i64 4)))) - (println (edn/member? cells (pair (i64 9) (i64 9))))) - _ (println "no cells"))) - None (println "malformed"))) + (let [doc (edn/read tileset) + cells (get doc :selected-cells)] + (println (get doc :texture-path)) + (println (len cells)) + ;; Two cells that are in the file and one that is not. A reader that + ;; flattened the pairs into 108 integers would still have the right count + ;; of *something*, and would miss all of these; [3 4] answering yes where + ;; [9 9] answers no is what says the pair compare is positional. + (println (has-key? cells [4 3])) + (println (has-key? cells [0 0])) + (println (has-key? cells [3 4])) + (println (has-key? cells [9 9])))) ;; The size of a set after the dedup, which is the whole of what the dedup can ;; be asked for. (defn set-size [src string] () - (match (edn/read (bytes src)) - (Some v) (match v (Set items) (println (len items)) _ (println "not a set")) - None (println "malformed"))) + (println (len (edn/read (bytes src))))) + +;; Malformed input, told apart from the document `nil` by the cursor — the +;; return value alone cannot say it, and this is the spelling that can. +(defn malformed? [src string] bool + (let [c (edn/cursor (bytes src)) + t (edn/next (addr c)) + v (edn/read-value (addr c) t)] ; the value is not the question here + (not (edn/ok? (addr c))))) ;; A document in a buffer this program owns and can write to. (bytes "literal") ;; is not that — a literal is constant data behind a writable-looking slice — @@ -94,41 +75,19 @@ v (edn/read src)] (dotimes [i (len src)] (set (at src i) \x)) - (match v - (Some doc) - (match (field doc "name") - (Text s) (println s) - _ (println "no name")) - None (println "malformed"))))) + (println (get v :name))))) -;; The path-taking entry point over the same file the embed above holds, and -;; the whole reason both of this session's additions exist. What a program -;; wants to write is one form: -;; -;; (defvar game-data edn/Value -;; (with-allocator frame -;; (or-else (edn/read-file "game-data.edn") edn/Value.Nil))) -;; -;; and it is written as a defn here because the *initialiser* is still refused -;; — "a global's value must be a compile-time constant — this one is computed" -;; — which is a separate piece of work on globals and nothing to do with -;; read-file or or-else. Everything inside the with-allocator is verbatim, so -;; the day a computed initialiser is allowed, load-game-data and the `set` -;; below it collapse back into the defvar above and this comment goes with -;; them. -;; -;; The texture path printed here has to be the one show-tileset printed, which -;; is what says read-file read the file and not merely something. -(defvar game-data edn/Value) - -(defn load-game-data [] edn/Value - (or-else (edn/read-file "programs/assets/edn/tileset.edn") edn/Value.Nil)) +;; The path-taking entry point over the same file the embed above holds. The +;; texture path printed here has to be the one show-tileset printed, which is +;; what says read-file read the file and not merely something — and that +;; freeing the buffer inside the call took none of the document with it. The +;; defvar is a dyn global, rooted once at startup, so the document lives past +;; the frame that read it. +(defvar game-data dyn) (defn by-path [] () - (set game-data (load-game-data)) - (match (field game-data "texture-path") - (Text s) (println s) - _ (println "no texture path"))) + (set game-data (edn/read-file "programs/assets/edn/tileset.edn")) + (println (get game-data :texture-path))) ;; A missing file, answered from outside read-file. Nothing in the package ;; handles FileError, so the condition walks past it to here with both restarts @@ -136,10 +95,8 @@ ;; resumes as if that file had been asked for all along, which is exactly what ;; slurp.flan asserts for slurp alone. ;; -;; `some?` is the assertion: the answer is a real document, so the restart was -;; taken rather than the read quietly answering None. Distinguishing the two is -;; the reason read-file passes the condition through instead of folding a -;; missing file into the None that means "malformed". +;; The map check is the assertion: the answer is a real document rather than +;; the nil a swallowed error would have to become, so the restart was taken. (defvar saw-file-error i64) (defn by-missing-path [] () @@ -147,46 +104,47 @@ [(FileError [c] (set saw-file-error (+ saw-file-error 1)) (invoke-restart 'use-value "programs/assets/edn/tileset.edn"))] - (println (some? (edn/read-file "programs/assets/edn/not-here.edn")))) + (println (has-key? (edn/read-file "programs/assets/edn/not-here.edn") + :texture-path))) (println saw-file-error)) (defn main [] i32 - (set frame (arena-new 262144)) - (with-allocator frame - (do - (show-tileset) - (println "") + (show-tileset) + (println "") - ;; Dedup, on each kind of element a set can hold. The nested pair is the - ;; one a structural compare is needed for; the nested *set* is the one - ;; that also needs the compare to ignore order, or #{1 2} and #{2 1} - ;; would be two elements. - (set-size "#{}") - (set-size "#{1 1 2}") - (set-size "#{[0 0] [0 0] [0 1]}") - (set-size "#{\"a\" \"a\" :a :a}") - (set-size "#{#{1 2} #{2 1}}") - ;; Three map cases and not one, because #{{:a 1} {:a 1} {:a 2}} answers 2 - ;; whether tables=? works or does nothing at all — two merge and one does - ;; not, or none merge and there were only ever three. The pair below - ;; isolates it: the first must be 1, and the second must be 2 on the - ;; *keys*, which a size compare alone would get wrong. - (set-size "#{{:a 1} {:a 1}}") - (set-size "#{{:a 1} {:b 1}}") - (set-size "#{{:a 1} {:a 1} {:a 2}}") - (set-size "#{1 1.0}") ; an int and a float are two values - (set-size "#{true false true}") - (println "") + ;; Dedup, on each kind of element a set can hold. The nested pair is the + ;; one a structural compare is needed for; the nested *set* is the one + ;; that also needs the compare to ignore order, or #{1 2} and #{2 1} + ;; would be two elements — as maps-to-true they are one map, compared by + ;; lookup and not by position. + (set-size "#{}") + (set-size "#{1 1 2}") + (set-size "#{[0 0] [0 0] [0 1]}") + (set-size "#{\"a\" \"a\" :a :a}") + (set-size "#{#{1 2} #{2 1}}") + ;; Three map cases and not one, because #{{:a 1} {:a 1} {:a 2}} answers 2 + ;; whether the map compare works or does nothing at all — two merge and one + ;; does not, or none merge and there were only ever three. The pair below + ;; isolates it: the first must be 1, and the second must be 2 on the + ;; *keys*, which a size compare alone would get wrong. + (set-size "#{{:a 1} {:a 1}}") + (set-size "#{{:a 1} {:b 1}}") + (set-size "#{{:a 1} {:a 1} {:a 2}}") + ;; One, and the old Value answered two. Dyn equality is the language's own, + ;; and it says (= 1 1.0) the way the operators promote — so under a + ;; maps-to-true set, 1 and 1.0 are one key. A narrowing against EDN's + ;; letter, taken with open eyes: the alternative was a second equality kept + ;; beside the runtime's, which is the duplication this rewrite retired. + (set-size "#{1 1.0}") + (set-size "#{true false true}") + (println "") - (survives-its-buffer) - ;; And the refusal, which has to be distinguishable from the document - ;; that is literally nil. - (match (edn/read (bytes "#{1 2")) (Some _v) (println "read") None (println "malformed")) - (match (edn/read (bytes "nil")) (Some _v) (println "read") None (println "malformed")) - (println "") + (survives-its-buffer) + ;; And the refusal, told apart from the document that is literally nil. + (println (malformed? "#{1 2")) + (println (malformed? "nil")) + (println "") - (by-path) - (by-missing-path))) - (free-all frame) - (arena-destroy frame) + (by-path) + (by-missing-path) 0) diff --git a/test/programs/json.flan b/test/programs/json.flan index b171568..a3e2d6e 100644 --- a/test/programs/json.flan +++ b/test/programs/json.flan @@ -1,9 +1,9 @@ ;;;; The JSON tokenizer, and a document read into a dynamic value in an arena. ;;;; -;;;; This is programs/edn.flan and programs/arena-edn.flan in one file, because -;;;; for JSON they are one claim. edn needed two programs: the tokenizer there -;;;; allocates nothing and hands back views, so the struct reader and the arena -;;;; reader are separate lanes over the same cursor. vendor/json copies its +;;;; This is the tokenizer walk and the arena-held document in one file, +;;;; because for JSON they are one claim. EDN's tokenizer +;;;; allocates nothing and hands back views, so a reader over it is a separate +;;;; lane over the same cursor. vendor/json copies its ;;;; strings into the allocator, so the cursor and the allocator cannot be ;;;; demonstrated apart — the interesting thing about a token is what ;;;; (json/string-of t) makes of it. @@ -14,17 +14,17 @@ ;;;; has to answer with: a Value naming itself through a (Vec Value) and a ;;;; (Map string Value). ;;;; -;;;; ── The one thing this proves that arena-edn.flan cannot ───────────── +;;;; ── The one thing this proves that a view-holding reader cannot ────── ;;;; -;;;; arena-edn's header has a section admitting that its strings are views into -;;;; the source buffer and outlive the region rather than dying with it. This +;;;; A reader whose strings are views into the source buffer has them outlive +;;;; the region rather than dying with it. This ;;;; document does not have that hole, and the proof is at the bottom of main: ;;;; the source buffer is overwritten with `?` bytes while the Value is still ;;;; live, and the strings read back afterwards are still the strings. An ;;;; implementation that aliased the buffer — which is free, and which edn does ;;;; on purpose — prints question marks there. ;;;; -;;;; Everything else is the shape arena-edn already argued for: no teardown +;;;; Everything else is the arena shape arena-value.flan argues for: no teardown ;;;; anywhere, one (free-all frame) at the bottom, and read-value taking no ;;;; allocator because with-allocator around the call is what binds one. ;;;; @@ -103,7 +103,7 @@ ;; One token in hand, and the cursor for whatever the token opens. An array and ;; an object recurse; everything else is a leaf. ;; -;; The two collection arms are longer than arena-edn's because JSON's commas +;; The two collection arms are longer than edn/read-value's because JSON's commas ;; are grammar and EDN's are whitespace: after every element there has to be a ;; separator or a closer, and nothing else. A reader that skipped that check ;; would accept [1 2] and a trailing comma, which are the two things a file diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 642516a..b7a396c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -570,49 +570,27 @@ let () = outputs ~dev:true "a dynamic value in an arena, dev" "programs/arena-value.flan" arena_value_out; - (* And the same thing over a real document, which is what the arena route - was taken for: the EDN tokenizer is a non-allocating cursor over a - [u8], and the reader above it builds a (Vec Value) and a - (Map string Value) against whichever allocator the *caller* bound. It - takes no allocator parameter and names none — spec-memory.md puts the - allocator in the calling convention, so (with-allocator a (edn/read s)) - is the whole of "read-edn taking an allocator", and there is no new - machinery to add for it. - - The reader is the package's now rather than the program's, and the - expected output did not move when it went there, which is the useful - thing about running this unchanged: the promotion was a move and not a - rewrite. What the program keeps is the walk back over a document nobody - declared a type for. - - The numbers are structural: "map" is the document's shape, 12 is every - leaf in it, 6 is [1 2 3] summed, and "string" is :name's value read back - through the map. A reader that flattened a level or dropped a nested - map would miss on the leaf count. *) - let arena_edn_out = "map\n12\n6\nstring\n" in - outputs "an EDN document in an arena" "programs/arena-edn.flan" - arena_edn_out; - outputs ~opt:"-O0" "an EDN document in an arena, -O0" - "programs/arena-edn.flan" arena_edn_out; - (* The package's entry point over the file it exists for. assets/tileset.edn is the editor's real output: a map of :texture-path to a string and :selected-cells to a set of 54 integer pairs, and nothing in the program - declares a type for any of it. + declares a type for any of it. The document is plain dyn now — the + edn/Value union this program used to walk is retired, and what its + hand-written equality bought, flan_dyn_eq answers. Three claims, and each line is one a plausible wrong version misses. 54 with three memberships and a miss: a reader that flattened the pairs into 108 integers would have a count of something and would answer no to every pair, and [3 4] answering yes where [9 9] answers no is what says the pair compare is positional. The dedup sizes are next: 1 for - #{#{1 2} #{2 1}} needs set equality to ignore order, 2 for #{1 1.0} - needs an int and a float to stay two values, and 2 for #{[0 0] [0 0] - [0 1]} is the one a dedup written with `=` gets wrong, because two Vec - headers over two blocks are never equal. The three map sizes are three + #{#{1 2} #{2 1}} needs set equality to ignore order — sets are dyn maps + to true, compared by lookup — and 2 for #{[0 0] [0 0] [0 1]} is the one + a dedup by header identity gets wrong. The three map sizes are three and not one because #{{:a 1} {:a 1} {:a 2}} answers 2 whether the map compare works or does nothing: 1 for #{{:a 1} {:a 1}} is the one that says it works, and 2 for #{{:a 1} {:b 1}} is the one that says a size - compare alone is not it. + compare alone is not it. #{1 1.0} answers 1 where the old union said 2: + dyn equality promotes across the number tags, and the program states + that narrowing beside the case. Then "level-1", which is the whole of the copy contract: the document is read out of a (Vec u8) and every byte of that buffer is then overwritten @@ -620,31 +598,34 @@ let () = is written and not freed on purpose — a read of released memory can pass by luck, and this cannot. - Last, that a malformed document is distinguishable from the document - that is literally nil, which is why the entry point answers an Option - and not a Value. + Then true/false from malformed?, which is the distinction the old + (Option Value) return carried, moved to the cursor now that read + answers nil for malformed input: the truncated set #{1 2 leaves the + cursor not-ok and the document nil leaves it clean. - Then the path-taking entry point, whose two lines are the two halves of + Then the path-taking entry point, whose lines are the two halves of what it decided. The texture path repeats the first line of the run, from a file read at run time rather than embedded, which says read-file read *that* file and that freeing its buffer inside the call took none of the document with it. `true` then `1` is the pass-through: slurp's FileError for a missing path walked past read-file to a handler here with `use-value` still armed, the read resumed against the path the - handler named, and the answer is a document — not the None that means - malformed, which is the collapse read-file refuses to make. *) + handler named, and the answer is a document with the key in it — not + the nil a swallowed error would have to become. *) let edn_read_out = "./source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, \ Stones.png\n\ 54\ntrue\ntrue\ntrue\nfalse\n\n\ - 0\n2\n2\n2\n1\n1\n2\n2\n2\n2\n\n\ - level-1\nmalformed\nread\n\n\ + 0\n2\n2\n2\n1\n1\n2\n2\n1\n2\n\n\ + level-1\ntrue\nfalse\n\n\ ./source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, \ Stones.png\ntrue\n1\n" in outputs "edn/read over the tileset" "programs/edn-read.flan" edn_read_out; outputs ~opt:"-O0" "edn/read over the tileset, -O0" "programs/edn-read.flan" edn_read_out; + outputs ~x86:true "edn/read over the tileset, x86" + "programs/edn-read.flan" edn_read_out; (* The same file again, through a struct derived from it at compile time. The first five lines are the first five above, character for character, @@ -2510,8 +2491,8 @@ ERR@7 unexpected token: not the kind the caller was reading quotes, and escaping them here would put a second reader between the test and what the program printed. - This is edn.flan and arena-edn.flan in one case because for JSON they - are one claim. vendor/edn never allocates and refuses escaped strings + This is the tokenizer and the arena-held document in one case because + for JSON they are one claim. vendor/edn never allocates and refuses escaped strings for want of anywhere to put the unescaped copy; vendor/json has an allocator, so it unescapes, and to unescape it copies - which means the cursor cannot be exercised without the allocator behind it. @@ -2528,9 +2509,9 @@ ERR@7 unexpected token: not the kind the caller was reading about - raised through json/fail on the cursor, so a caller's grammar errors carry a position the same way the tokenizer's do. - The last block is the one that could not be written against vendor/edn - at all. arena-edn.flan's header admits its Values are views into the - source buffer and outlive the region; here the source buffer is + The last block is the one that could not be written against the EDN + tokenizer alone, whose token text is views into the + source buffer; here the source buffer is overwritten with `?` while the document is live, and `level "1"` prints again afterwards. An implementation that aliased the buffer - which is free, and which edn does on purpose - prints question marks there. 15 @@ -3203,6 +3184,30 @@ level "1" "programs/dyn-vec.flan" dyn_vec_out; outputs ~x86:true "dyn: a heterogeneous vector, --x86" "programs/dyn-vec.flan" dyn_vec_out; + (* Maps and keywords, the M2 additions, over all three rows like the dyn + cases above them. The expectations were captured from the running + program, not composed: the map line pins the renderer's edn shape with + the space-per-element convention and nested strings quoted; nil is what + an absent key answers and (= ... nil) is how a program asks; keyword + equality is identity — keyword called on the one-byte name a at run + time answers the same word as the literal :a — and a text, a keyword + and a vec are three + different keys. The 600000 at the end is a 200k-iteration allocation + loop against one live map in a rooted dyn global, which passes the + collector's 1 MiB floor many times over on every backend: a marker + that lost a map's keys or values frees something live and the sum + comes out wrong. *) + let dyn_map_out = + "{ :a 1 :b \"two\" :xs [ 1 2 3] :inner { :c 2.5}}\n4\n1\ntwo\n\ + [ 1 2 3]\n2.5\nnil\ntrue\ntrue\nfalse\nnil\ntrue\n99\n5\n\ + true\nfalse\nfalse\ntrue\n:standalone\n6\ntext key\nvec key\n\ + true\nfalse\nfalse\n600000\n" + in + outputs "dyn: maps and keywords" "programs/dyn-map.flan" dyn_map_out; + outputs ~opt:"-O0" "dyn: maps and keywords, -O0" + "programs/dyn-map.flan" dyn_map_out; + outputs ~x86:true "dyn: maps and keywords, --x86" + "programs/dyn-map.flan" dyn_map_out; let dyn_global_out = "0 start\n2 done\n" in outputs "dyn: a global" "programs/dyn-global.flan" dyn_global_out; outputs ~opt:"-O0" "dyn: a global, -O0" diff --git a/test/test_flan.ml b/test/test_flan.ml index 70e4460..aa4f7a0 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -881,8 +881,15 @@ let () = the runtime's own from [(vec-new dyn)]. *) rejects_check "a typed container boxed into dyn" "(defn take [d dyn] i32 1)\n\ - (defn main [] i32 (take [1 2 3]))" + (defn main [] i32 (let [v (vec-new i64)] (take v)))" ~needle:"does not cross into dyn yet"; + (* A bracket *literal* is not a typed container yet, and where a dyn is + wanted it builds the runtime's own vec instead — the lowering the map + literal's values ride on, and what makes {:xs [1 2]} mean what it + reads as. *) + accepts "a bracket literal where a dyn is wanted is a dyn vec" + "(defn take [d dyn] i32 1)\n\ + (defn main [] i32 (take [1 2 3]))"; (* A condition crosses a handler boundary as a pointer to a live frame, and a dyn payload has to stay rooted across that transfer — the collector's question, and milestone 2's. *) @@ -905,6 +912,76 @@ let () = "(declare c-take [d dyn] () \"c_take\")" ~needle:"does not cross to C"; + (* ── dyn maps, keywords and nil — M2 item 1 ────────────────────── *) + + (* The literal parses and checks: braces whose first form is not a .field + symbol are a dyn map, in binding position and as a call argument alike — + the argument spelling used to be swallowed by the struct-literal rule. *) + accepts "a map literal in a binding" + "(defn main [] i32 (let [m {:a 1 :b \"two\"}] (len m)))"; + accepts "a map literal as an argument" + "(defn take [d dyn] i32 1)\n(defn main [] i32 (take {:a 1}))"; + accepts "the empty braces are an empty map" + "(defn main [] i32 (let [m {}] (len m)))"; + accepts "map literals nest, and brackets inside are dyn vecs" + "(defn main [] i32 (let [m {:xs [1 2] :inner {:c 2.5}}] (len m)))"; + rejects_check "a map literal with an odd number of forms" + "(defn main [] i32 (let [m {:a 1 :b}] (len m)))" + ~needle:"odd number of forms"; + (* The struct spelling is untouched on both of its sides: bare braces + opening on a .field are still a struct literal that wants its type + written, and (Type {.field v}) still builds one. *) + rejects_check "bare struct-shaped braces still refuse" + "(defn main [] i32 (let [m {.x 1}] 0))" + ~needle:"write (Type {.field v})"; + accepts "a struct literal still builds" + "(defstruct P [x i32])\n\ + (defn main [] i32 (let [p (P {.x 1})] (.x p)))"; + (* And the {:where ...} constraint map is still peeled off a defn body — + it opens on :where, which is what now tells it from a map literal + standing as the body's first form. *) + accepts "a where clause is still a constraint map" + "(defn biggest [a $t b $t] $t {:where (ordered? $t)} (if (> a b) a b))\n\ + (defn main [] i32 (biggest 1 2))"; + + (* Keywords: dyn where nothing else is asked, still an enum member where an + enum is, and refused where a concrete non-dyn type is wanted. *) + accepts "a keyword is a dyn value" + "(defn main [] i32 (let [k :foo] (if (= k :foo) 0 1)))"; + accepts "a keyword where an enum is expected still resolves" + "(defenum Axis [x y])\n\ + (defn pick [a Axis] i32 1)\n\ + (defn main [] i32 (pick :x))"; + rejects_check "a keyword where an i32 is expected" + "(defn take [n i32] i32 n)\n(defn main [] i32 (take :foo))" + ~needle:"but i32 is expected here"; + accepts "keyword takes a string" + "(defn main [] i32 (let [k (keyword \"foo\")] (if (= k :foo) 0 1)))"; + rejects_check "keyword takes bytes, not a number" + "(defn main [] i32 (let [k (keyword 3)] 0))" + ~needle:"keyword takes a string"; + + (* nil is a literal now — the dyn absence value, and what (get m k) answers + for a key a map does not hold. It is always dyn. *) + accepts "nil is a dyn literal" + "(defn main [] i32 (let [n nil] (if (= n nil) 0 1)))"; + rejects_check "nil at a typed want" + "(defn take [n i32] i32 n)\n(defn main [] i32 (take nil))" + ~needle:"does not cross into a written type"; + + (* The map operations ride the words the typed map already owns: get, put, + len, has-key? — one question, one word, on both sides. has-key? on a + typed map still checks against its K. *) + accepts "get, put, len and has-key? over a dyn map" + "(defn main [] i32\n\ + \ (let [m {:a 1}]\n\ + \ (put m :b 2)\n\ + \ (if (has-key? m :b) (len m) 0)))"; + accepts "has-key? still serves the typed map" + "(defn main [] i32\n\ + \ (let [m (map-new string i32 (heap-allocator))]\n\ + \ (if (has-key? m \"a\") 1 0)))"; + (* The x86 backend used to refuse dyn by name, and what was pinned here was the sentence it refused with. It compiles it now, which is the thing this row is for: that backend is the dev daemon's default and dyn is the @@ -1008,12 +1085,14 @@ let () = rejects_check "field given twice" (cursor ^ "(defn f [s [u8]] Cursor (Cursor {.pos 0 .pos 1}))") ~needle:"given twice"; - (* The old spelling is refused rather than quietly accepted, and the refusal - names the new one. Two accepted spellings is how two spellings become - permanent, and the colon is wanted for keys. *) - rejects_check "a field label written with a colon" + (* {:src s} is a dyn map literal now, not a struct field list with the + wrong punctuation — the colon is wanted for keys, and this is one. What + used to be caught as a mispunctuated struct is caught one level up + instead: (Cursor {:src s}) is a call whose head names a struct type, and + that refusal still points at the struct spelling. *) + rejects_check "a struct type called with a colon-keyed map" (cursor ^ "(defn f [s [u8]] Cursor (Cursor {:src s}))") - ~needle:"a field label is written .src, not :src"; + ~needle:"a struct value is written (Cursor {.field value ...})"; accepts "field through a pointer auto-derefs" (cursor ^ "(defn f [c (Ptr Cursor)] i32 (.pos c))"); accepts "set through a pointer" @@ -1336,11 +1415,15 @@ let () = reaches [Check] means a driver skipped that step. *) rejects_check "an unresolved import is a driver bug" "(import rl \"vendor:raylib\")" ~needle:"not resolved"; - (* Keywords resolve against an enum and against nothing else. *) + (* Keywords resolve against an enum where one is expected, and everywhere + else are the dyn value from M2 — there is no third reading left to + refuse, so a call that wants a concrete non-dyn type still refuses, just + through the ordinary found-dyn sentence of that boundary rather than a + keyword-specific one. *) rejects_check "a keyword needs an enum" "(defn g [x i32] ()) (defn f [] () (g :space))" ~needle:"is expected here"; - rejects_check "a keyword with no expectation" - "(defn f [] () (print (i64 :space)))" ~needle:"no keyword type"; + rejects_check "a keyword with no expectation converts as dyn" + "(defn f [] () (print (i64 :space)))" ~needle:"found dyn"; rejects_check "a keyword that is not a member" "(defenum Key [space 32]) (defn g [k Key] ()) (defn f [] () (g :spcae))" ~needle:"has no member :spcae"; diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index aa8ff79..8fbdca5 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -124,7 +124,6 @@ let corpus = would be a stack-use-after-scope — which is exactly what ASan sees and an output comparison does not. *) "programs/two-numbers.flan", []; - "programs/arena-edn.flan", []; "programs/bytes2.flan", []; "programs/cleanup.flan", []; "programs/conditions.flan", []; @@ -168,12 +167,15 @@ let corpus = [dyn-vec] is the one that builds objects of three kinds; [dyn-defer] is the one whose roots come off on a transfer's path out rather than a return's, which is where a pop written on one path only would show. - [p13] is the only program anywhere that allocates past flan_dyn.c's - one-megabyte floor, so it is the only one where a mark and a sweep + [p13] and [dyn-map] are the programs that allocate past flan_dyn.c's + one-megabyte floor, so they are where a mark and a sweep actually run — everything else in this list agrees with ASan by never - collecting at all. *) + collecting at all. [dyn-map] is also the one whose live set is a map, + so its keys and values are what the marker has to trace to be right, + and the interned keywords are what the sweep has to leave alone. *) "programs/dyn-vec.flan", []; "programs/dyn-defer.flan", []; + "programs/dyn-map.flan", []; "../spike/x86/p13-dyn-collect.flan", []; "programs/sand-headless.flan", []; "programs/signedness.flan", []; diff --git a/vendor/edn/read.flan b/vendor/edn/read.flan index 5acfcf8..55c530d 100644 --- a/vendor/edn/read.flan +++ b/vendor/edn/read.flan @@ -2,85 +2,65 @@ ;;;; ;;;; `edn.flan` answers "what is the next token". This answers "what is in the ;;;; file", for a caller that has no struct to hand — a config file whose keys -;;;; are not known until it is read, a tileset, a save. `(read-edn Enemy bytes)` -;;;; is the other direction and is not here: it wants a compile-time walk over -;;;; a struct's fields, there is no run-time type information in this language, -;;;; and it is its own project (NEXT.md item 9). +;;;; are not known until it is read, a tileset, a save. `(edn/defedn T path)` +;;;; in provide.flan is the other direction: the shape known at compile time, +;;;; read into a struct, at no run-time cost. Together they are the two sides +;;;; of one capability, and this is the dynamic one. +;;;; +;;;; ── What a document reads as ───────────────────────────────────────── +;;;; +;;;; Plain dyn values, the runtime's own: +;;;; +;;;; nil true 42 1.5 nil, bool, int, float +;;;; "text" a dyn text — a copy, owned by the collector +;;;; :key symbol a keyword, interned, so equality is identity +;;;; [1 2] a dyn vec +;;;; {:a 1} a dyn map — keys are whole values, so :a and "a" +;;;; stay two keys the way EDN says they are +;;;; #{1 2} a dyn map from each element to true. There is no +;;;; set kind; a map's put already replaces an equal +;;;; key, so the dedup is the representation's own, and +;;;; (has-key? s x) is the membership test. +;;;; +;;;; This file used to define edn/Value — a tagged union with its own +;;;; structural equality, its own set dedup and its own table compare, written +;;;; before the dyn runtime existed. That was one capability implemented twice +;;;; on the same side, and the duplicity audit (docs/SPIKE-DUPLICITY.md §5) +;;;; retired it: everything value=? and its four helpers did is what +;;;; flan_dyn_eq does, and the (Map Value Value) the typed side refused — +;;;; keyable says no — is exactly what the dyn map serves without being asked. ;;;; ;;;; ── Where the storage comes from ───────────────────────────────────── ;;;; -;;;; `read` takes no allocator and names none. It does not need to: -;;;; spec-memory.md puts the allocator in the calling convention, so every -;;;; (vec-new) and (map-new) below takes the *context*, and the caller chooses -;;;; the tier by writing (with-allocator frame (edn/read bytes)). An explicit -;;;; allocator at a construction site overrides that, which is how this would -;;;; take one as a parameter if the idiom could not say it — and the idiom -;;;; says it, so there is no allocator parameter here and nothing lost. +;;;; The collector's heap, all of it. A dyn value's storage is the dyn +;;;; runtime's — that is what lets the collector find the values inside it — +;;;; so `read` neither takes an allocator nor consults the ambient one, and +;;;; there is no free-all to call and nothing to tear down. The strings are +;;;; copies: boxing a string is flan_dyn_from_bytes, which copies into the +;;;; heap, so the document does not point at the source buffer at all once +;;;; `read` has returned. Overwrite the buffer, free it, read the next file +;;;; into it — the document stands. ;;;; -;;;; `read-file` is the one exception and states its own reason at the bottom -;;;; of this file: the buffer it slurps is named against the heap because its -;;;; life is strictly inside the call and the caller cannot observe it, so it -;;;; is not the caller's tier to choose. The document it answers still lands -;;;; wherever the context says. +;;;; ── Malformed input is nil, and the narrowing is stated ────────────── ;;;; -;;;; The tier has to be a region, and that is enforced rather than documented: -;;;; a (Vec Value) whose elements own storage traps at its construction against -;;;; any allocator that can free one block. Calling `read` with the heap in the -;;;; context dies at the first collection in the document, naming the line. -;;;; See test/programs/arena-region.flan. +;;;; `read` answers nil for a document that failed to tokenize — and nil is +;;;; also what the document `nil` reads as. The old (Option Value) return kept +;;;; those apart; a dyn nil cannot, and wrapping dyn in an Option today would +;;;; put the document where the collector cannot see it (a dyn inside a typed +;;;; container is unrooted until the per-type descriptors land — the queue's +;;;; item 2). A caller who needs the distinction drives its own cursor and +;;;; asks it afterwards, which is also how the error *position* has always +;;;; been got: ;;;; -;;;; There is no teardown in this file — no drop, no destructor, no recursive -;;;; free. One (free-all frame) releases the whole document, because every part -;;;; of it came out of the one region. -;;;; -;;;; ── A Value owns its strings, and a Token does not ─────────────────── -;;;; -;;;; This is the one place the two layers of this package disagree, and it is -;;;; deliberate. A Token's text is a slice INTO the source buffer; a Value's -;;;; strings are copies, in the allocator, and the document does not point at -;;;; the source at all once `read` has returned. -;;;; -;;;; A view would be cheaper and would be a trap. `read` hands its answer back -;;;; out of the function that owns the buffer, which is exactly the case -;;;; edn.flan's lifetime contract says a view cannot survive: the caller frees -;;;; the bytes it slurped, or reads the next file into them, and every string -;;;; in the document is garbage with nothing to say so. A free-all on the arena -;;;; would not even take them, because they were never in it. -;;;; -;;;; Odin settles the same question the same way: core/encoding/json's parser -;;;; clones a string even when it holds no escapes (parser.odin:388), clones -;;;; keys (:254), and its destroy_value frees them (types.odin:96). A reader -;;;; whose result is self-contained is the only kind that can be a library. -;;;; -;;;; ── Sets are a Vec, and why they are not a Map ─────────────────────── -;;;; -;;;; `Value.Set` holds a (Vec Value), deduplicated on insert by a structural -;;;; `value=?`. The obvious shape — a (Map Value bool) — does not typecheck and -;;;; cannot be made to: lib/types.ml `keyable` refuses a key type holding a Vec -;;;; or a Map, and Value holds both. Restricting set elements to the Values -;;;; that *are* keyable was the other way out and is worse: `#{[0 0] [1 0]}` is -;;;; legal EDN and is the exact shape this was built for, so the restriction -;;;; would refuse the motivating file to buy a faster insert. -;;;; -;;;; The cost is stated rather than hidden: insert is O(n) and building a set -;;;; of n elements is O(n²). For the file this was written for — 54 integer -;;;; pairs — that is 1458 comparisons, once, at load. A set large enough for -;;;; the quadratic to matter is one this shape is wrong for, and the reader -;;;; will know before this comment does. - -(defdata Value - [(Nil []) - (Bool [b bool]) - (Int [n i64]) - (Float [x f64]) - (Text [s string]) - (Key [s string]) - (List [items (Vec Value)]) - (Set [items (Vec Value)]) - (Table [entries (Map string Value)])]) +;;;; (let [c (edn/cursor src) +;;;; v (edn/read-value (addr c) (edn/next (addr c)))] +;;;; (if (edn/ok? (addr c)) ... (edn/error-pos (addr c)) ...)) ;; ── Copying a token's text ────────────────────────────────────────── +;; Not the dyn reader's own — everything below boxes through the runtime, +;; which copies for itself — but provide.flan's generated readers build typed +;; strings out of token text and this is where that copy has always lived. ;; The (Vec u8) is the copy; the string is a view of it, and the Vec header is ;; dropped here on purpose. Nothing individually owns a block in a region — ;; free-all owns all of them — so keeping the header around to free through @@ -90,197 +70,92 @@ (append (addr b) s) (string (as-slice b)))) -;; ── Structural equality ───────────────────────────────────────────── - -;; What the set's dedup is written against. Recursive, because a set element -;; may be a vector or a map or another set, and `=` on a Value would compare a -;; Vec header against a Vec header — two copies of one document would never be -;; equal and two aliases of one block always would. -(defn value=? [a Value b Value] bool - (match a - Nil (match b Nil true _ false) - ;; `=` on two bools is refused by the language (plan.org, Types), so the - ;; comparison is written as the thing it means. - (Bool x) (match b (Bool y) (if x y (not y)) _ false) - (Int x) (match b (Int y) (= x y) _ false) - (Float x) (match b (Float y) (= x y) _ false) - ;; Text and Key are compared by their bytes and never to each other: - ;; "a" and :a are two values in EDN and stay two here. - (Text x) (match b (Text y) (bytes=? (bytes x) (bytes y)) _ false) - (Key x) (match b (Key y) (bytes=? (bytes x) (bytes y)) _ false) - (List xs) (match b (List ys) (items=? xs ys) _ false) - (Set xs) (match b (Set ys) (sets=? xs ys) _ false) - (Table e) (match b (Table f) (tables=? e f) _ false))) - -;; A vector is equal element by element, in order. -(defn items=? [xs (Vec Value) ys (Vec Value)] bool - (when (!= (len xs) (len ys)) - (return false)) - (dotimes [i (len xs)] - (when (not (value=? (at xs i) (at ys i))) - (return false))) - true) - -;; A set is not. #{1 2} and #{2 1} are one value written two ways, and a -;; positional compare would make `#{#{1 2} #{2 1}}` a two-element set — which -;; is the case that decides whether this function is worth having separately -;; from items=?. -(defn sets=? [xs (Vec Value) ys (Vec Value)] bool - (when (!= (len xs) (len ys)) - (return false)) - (dotimes [i (len xs)] - (when (not (member? ys (at xs i))) - (return false))) - true) - -(defn member? [xs (Vec Value) v Value] bool - (dotimes [i (len xs)] - (when (value=? (at xs i) v) - (return true))) - false) - -;; Maps compare by size and then by lookup, which is what makes the walk -;; order-independent — two maps built by inserting the same pairs in different -;; orders iterate differently and are the same map. -(defn tables=? [a (Map string Value) b (Map string Value)] bool - (when (!= (len a) (len b)) - (return false)) - (let [cur (i64 0) - k "" - v Value.Nil] - (while (map-next a (addr cur) (addr k) (addr v)) - (match (get b k) - (Some w) (when (not (value=? v w)) (return false)) - None (return false)))) - true) - ;; ── Reading ───────────────────────────────────────────────────────── ;; One token in hand, and the cursor for whatever that token opens. Public -;; because it is the entry point for a caller who wants the error *position*: -;; a caller driving its own Cursor can ask (edn/error-pos c) afterwards, and -;; `read` below cannot, because the cursor it made is gone. -(defn read-value [c (Ptr Cursor) t Token] Value +;; because it is the entry point for a caller who wants the error position — +;; see the header. +(defn read-value [c (Ptr Cursor) t Token] dyn (cond - (= (.kind t) tok-bool) - (Value.Bool {.b (match (bool-of t) (Some v) v None false)}) - (= (.kind t) tok-int) - (Value.Int {.n (match (int-of t) (Some v) v None (i64 0))}) - (= (.kind t) tok-float) - (Value.Float {.x (match (float-of t) (Some v) v None 0.0)}) - (= (.kind t) tok-string) (Value.Text {.s (copy-text (.text t))}) - (= (.kind t) tok-keyword) (Value.Key {.s (copy-text (.text t))}) - ;; A symbol becomes a Key. There is no Symbol case, because nothing that - ;; reads a document this way tells the two apart — and a case nobody can - ;; act on differently is a case that only makes matches longer. - (= (.kind t) tok-symbol) (Value.Key {.s (copy-text (.text t))}) + (= (.kind t) tok-nil) nil + (= (.kind t) tok-bool) (match (bool-of t) (Some v) v None false) + (= (.kind t) tok-int) (match (int-of t) (Some v) v None (i64 0)) + (= (.kind t) tok-float) (match (float-of t) (Some v) v None 0.0) + ;; The box copies the bytes into the collector's heap, which is the "a + ;; document owns its strings" rule this file has always had: a view into + ;; the source buffer would be garbage with nothing to say so the moment + ;; the caller reads the next file into it. + (= (.kind t) tok-string) (string (.text t)) + (= (.kind t) tok-keyword) (keyword (.text t)) + ;; A symbol becomes a keyword. Nothing that reads a document this way + ;; tells the two apart, and a case nobody can act on differently is a + ;; case that only makes matches longer. + (= (.kind t) tok-symbol) (keyword (.text t)) (= (.kind t) tok-vec-open) - (let [items (vec-new Value) + (let [items (vec-new dyn) u (next c)] (while (and (ok? c) (!= (.kind u) tok-vec-close) (!= (.kind u) tok-eof)) (push items (read-value c u)) (set u (next c))) - (Value.List {.items items})) + items) ;; A set ends on tok-map-close, because `}` is the byte that ends it. The - ;; dedup is here and not at the end: a set with a duplicate in it never - ;; exists, so nothing downstream has to know that one might. + ;; dedup is the map's own: put replaces the value of an equal key, so a + ;; set with a duplicate in it never exists and #{[0 0] [0 0]} is one + ;; element by structure, not by header identity. (= (.kind t) tok-set-open) - (let [items (vec-new Value) + (let [s {} u (next c)] (while (and (ok? c) (!= (.kind u) tok-map-close) (!= (.kind u) tok-eof)) - (let [v (read-value c u)] - (when (not (member? items v)) - (push items v))) + (put s (read-value c u) true) (set u (next c))) - (Value.Set {.items items})) + s) - ;; A map's key is whatever token is there, and its text is the key — - ;; copied, so :a and "a" collide as keys here where EDN keeps them apart. - ;; That is a real narrowing and it is the price of a (Map string Value): - ;; the alternative is a (Map Value Value), which `keyable` refuses for the - ;; reason the set's comment above gives. + ;; A map's key is a whole value, read by the same recursion as anything + ;; else — :a and "a" are two keys, [0 0] can key a map, and the old + ;; (Map string Value) narrowing that collapsed them is gone with the type + ;; that forced it. (= (.kind t) tok-map-open) - (let [entries (map-new string Value) + (let [m {} k (next c)] (while (and (ok? c) (!= (.kind k) tok-map-close) (!= (.kind k) tok-eof)) - (let [v (next c)] - (put entries (copy-text (.text k)) (read-value c v))) + (let [key (read-value c k) + u (next c)] + (put m key (read-value c u))) (set k (next c))) - (Value.Table {.entries entries})) + m) - :else Value.Nil)) + :else nil)) -;; The whole document, from a byte slice, in the calling convention's -;; allocator. -;; -;; (Option Value) and not Value, which is the one place this departs from -;; edn.flan's "errors live on the cursor, not in the return type". The cursor -;; is made inside this function and dies with it, so there is nothing left for -;; a caller to ask — and a Value.Nil answer would be indistinguishable from the -;; document that is literally `nil`, which is the class of quiet wrongness the -;; package's refusals exist to avoid. A caller who needs the byte offset builds -;; the Cursor itself and calls read-value; that is the three lines below. -;; -;; One collision the Option does NOT resolve, said here rather than discovered: -;; empty input answers (Some Value.Nil), the same as the document `nil`. Empty -;; is not malformed — a tokenizer over no bytes reports no error, correctly — -;; and the alternative is this function deciding that an empty file is a -;; failure, which is the caller's question and not the reader's. -(defn read [src [u8]] (Option Value) +;; The whole document, from a byte slice. nil when the input was malformed — +;; the header says what that conflates and what to do when it matters. +(defn read [src [u8]] dyn (let [c (cursor src) t (next (addr c)) v (read-value (addr c) t)] - (if (ok? (addr c)) (Some v) None))) + (if (ok? (addr c)) v nil))) -;; The same, from a path, and the reason it is worth having is the line above -;; it: **the source buffer is dead the moment `read` returns.** Every string in -;; the document is a copy in the allocator — that is this file's "A Value owns -;; its strings" section, and test_acceptance.ml's edn-read case proves it by -;; overwriting every byte of the buffer after the read and still printing the -;; string it found. So the buffer has no reader once this returns, which means -;; it does not have to be the caller's to hold, and a caller writing +;; The same, from a path. The buffer is slurped against the heap, read, and +;; freed on the way out — it can be, because the document copies every byte it +;; keeps. The heap is named rather than left to the context because the caller +;; can never observe this buffer, so its tier was never the caller's to +;; choose; the document itself lands in the collector's heap wherever this is +;; called from. ;; -;; (defconst raw (embed "game-data.edn")) -;; (edn/read raw) -;; -;; or a slurp-and-free pair around `read` is keeping a name alive for a value -;; whose whole life fits inside one call. -;; -;; **The heap is named, and this is the one place in the package that names an -;; allocator.** The file header argues that `read` takes none because the tier -;; is the caller's choice; that argument does not reach this buffer, because -;; the caller can never observe it. Left to the context, (with-allocator frame -;; (edn/read-file p)) would grow the region by the file's size for bytes that -;; die immediately, and the `free` below would buy nothing back — a bump -;; allocator has no FLAN_CAN_FREE, so freeing into one is a no-op. Against the -;; heap the free is real, and the document still lands in whatever tier the -;; caller chose, because that is where `read`'s own (vec-new) and (map-new) go. -;; -;; The `defer` rather than a trailing (free src) is for the transfer path: -;; `read` allocates, so it can signal StorageExhausted, and a handler that -;; answers by transferring out would otherwise leave the buffer behind. -;; -;; **A FileError passes straight through, and that is the decision, not an -;; omission.** The return type here is already saying something: `None` means -;; the document was malformed, which the header above argues at length has to -;; stay distinguishable from the document that is literally `nil`. Folding "the -;; file was not there" into that same `None` would collapse the distinction the -;; Option exists for. And this function has nothing to answer a FileError -;; *with* — `use-value` wants a path only the caller knows, and whether a -;; missing file is fatal or is a cue to write a default is the caller's policy -;; in every program. Nothing here establishes a handler, so slurp's condition -;; reaches the caller's with both restarts still armed; edn-read.flan runs the -;; `use-value` half, where the handler names another path, the read happens -;; against that file, and this function never learns that anything went wrong. -(defn read-file [path string] (Option Value) +;; A FileError passes straight through, and that is the decision, not an +;; omission: this function has nothing to answer one with — `use-value` wants +;; a path only the caller knows, and whether a missing file is fatal or a cue +;; to write a default is the caller's policy in every program. Nothing here +;; establishes a handler, so slurp's condition reaches the caller's with both +;; restarts still armed. +(defn read-file [path string] dyn (let [src (slurp path (heap-allocator))] (defer (free src)) (read (as-slice src))))