;;;; defedn: a struct derived from a data file, at compile time. ;;;; ;;;; F#'s type providers, with the part that makes them worth having and none ;;;; of the part that needs a plugin protocol. `edn/defedn(Tileset, "t.edn")` ;;;; reads t.edn while the program is being compiled, works out what shape it ;;;; is, and emits the struct that shape implies together with a reader for it. ;;;; From then on `(.texture-path data)` is a field load off a struct: no Value, ;;;; no match, no runtime tag, nothing to look up by name. ;;;; ;;;; read.fln is the other half of the same choice, and both belong here. A ;;;; dynamic Value is what you want when the shape is the program's *input* — ;;;; an editor opening a file it has never seen. A provider is what you want ;;;; when the shape is part of the program and only the numbers change, which ;;;; is what a game's tuning file is. The typed world is not an afterthought: ;;;; it is the same tokenizer, read by a macro instead of by a loop. ;;;; ;;;; ── What it needs, and what was built for it ───────────────────────── ;;;; ;;;; A macro is compiled and dlopened into the compiler, so it has always been ;;;; able to run arbitrary code at expansion time. Three things it could not do ;;;; are what this file rests on, and all three are general: ;;;; ;;;; - `macro-slurp("t.edn")` reads a file at expansion time, resolved the ;;;; way `embed("t.edn")` resolves a path — against the directory of the ;;;; source file the form is written in. ;;;; - a package's macro may call the package's own functions, which is why ;;;; the derivation below is ordinary Flan over the tokenizer next door ;;;; rather than a second scanner inlined into a macro body. ;;;; - a macro may answer several declarations, as a top-level `do:`, ;;;; and may refuse with a sentence through `compile-error("...")`. ;;;; ;;;; ── The rules ──────────────────────────────────────────────────────── ;;;; ;;;; A map with keyword keys is a struct, one field per key, named for the ;;;; keyword. An integer is an i64, a float an f64, a boolean a bool, a string ;;;; a `string` — copied, which is read.fln's contract and not the tokenizer's: ;;;; a Token's text points into the buffer, and a struct that outlives the ;;;; buffer cannot hold one. ;;;; ;;;; A vector of one repeated shape is a `Vec(T)`. A set is this repo's own ;;;; spelling of one, `Map(T, bool)` — check.ml says exactly that where it ;;;; refuses a map with a `()` value — and its elements are therefore read as ;;;; map *keys*. That is why a vector inside a set derives to a fixed array ;;;; `[n T]` rather than to a Vec: a Vec is not a map key and `[2 i64]` is. ;;;; The file this was built for is a set of pairs, so that is the case rather ;;;; than a corner of it. ;;;; ;;;; A nested map is a struct of its own, named for the path that reaches it — ;;;; `Tileset-selected-cells`. A hyphen because `/` is package qualification ;;;; and cannot appear in a name a program declares, and because every name in ;;;; this language is already hyphenated, so no case conversion has to be ;;;; written to produce one. The path is unique, so the name is. ;;;; ;;;; Everything else is refused while expanding, with the line and column in ;;;; the *data* file. A refusal is the point: a file the compiler could not ;;;; make sense of is one the program would have read wrongly. ;; ── Small string work, for the refusals and the names ─────────────── fn- joined(a: str, b: str) -> str let v = vec-new(u8) append(addr(v), bytes-view(a)) append(addr(v), bytes-view(b)) str(slice(v)) fn- joined3(a: str, b: str, c: str) -> str = joined(a, joined(b, c)) ;; Copied out, and not `str(i64->bytes(n))`. The prelude's note over ;; append-i64 is the reason: i64->bytes renders into one shared static buffer ;; in the runtime, so two of its results cannot be held at once — and `where` ;; below holds a line and a column at the same time, which read as the same ;; number until this copied. fn- i64->string(n: i64) -> str let v = vec-new(u8) append-i64(addr(v), n) str(slice(v)) ;; The tokenizer answers byte offsets, because that is what a slice into the ;; buffer costs nothing to produce. A person reading a refusal wants a line and ;; a column, so the newlines before the offset are counted here — once per ;; refusal, which is as often as this is ever called. fn- where(src: [const u8], pos: i32) -> str let line = i64(1) col = i64(1) i = i32(0) while i < pos if src[i] == \newline line += 1 col = 1 else col += 1 i += 1 joined3("line ", i64->string(line), joined(" column ", i64->string(col))) ;; ── What a value came to ──────────────────────────────────────────── ;; ;; One walk answers three things at once, which is why they travel together: ;; the *type* the value implies, the struct declarations that type needs (a ;; nested map contributes one, and everything nested inside it contributes ;; more), and the *expression* that reads one — written against a cursor named ;; `c` and an allocator named `a`, which is the shape every generated reader ;; binds. ;; ;; `bad` is the refusal, carried rather than raised: there is no exception to ;; throw out of a recursive walk, and a partial answer with a reason attached ;; propagates to the top where the one `compile-error` is written. Empty means ;; the walk succeeded. struct Derived(ty: Form, decls: [Form], reader: Form, bad: str) fn- derived-bad(msg: str) -> Derived Derived{.ty quasiquote(i64) .decls form-nil() .reader quasiquote(0) .bad msg} fn- ok-derived(ty: Form, decls: [Form], reader: Form) -> Derived Derived{.ty ty .decls decls .reader reader .bad ""} fn- is-bad(d: Derived) -> bool = length(bytes-view(d.bad)) > 0 ;; ── The scalars a generated reader calls ──────────────────────────── ;; ;; Functions and not inlined expansions, so that `C-c C-m` over a defedn shows ;; a reader somebody can read. Each is `expect` plus the conversion, with the ;; same "the cursor carries the error" contract the hand-written reader in ;; test/programs/edn.flan is written against: a failure leaves the value at ;; zero and the cursor not is-ok, so a whole struct is a straight line of ;; assignments with one test at the end. fn need-int(c: Ptr(Cursor)) -> i64 match int-of(expect(c, tok-int)) Some(v) -> v None -> 0 ;; Two kinds are acceptable, because 2 and 2.0 are the same number and a tuning ;; file written by hand has both. `float-of` answers Some for either. fn need-float(c: Ptr(Cursor)) -> f64 let t = next(c) match float-of(t) Some(x) -> x None -> fail(c, err-unexpected-token, t.pos) 0.0 fn need-bool(c: Ptr(Cursor)) -> bool match bool-of(expect(c, tok-bool)) Some(v) -> v None -> false ;; Copied into the allocator, which is the whole difference between a field of ;; a struct and a Token's text. The lifetime contract at the top of edn.fln is ;; the reason: `text` is a slice of the buffer, and a struct read out of a ;; buffer that is later freed would hold a dangling one. fn need-string(c: Ptr(Cursor), a: Allocator) -> str let t = expect(c, tok-string) b = vec-new(u8, a) append(addr(b), t.text) str(slice(b)) ;; Whether the next thing, past trivia, is this byte. Enough of a peek for ;; every loop below — "is the collection over" is the only lookahead a reader ;; of a known shape ever needs — and it consumes nothing, so the closer is ;; still there for `expect` to take. fn is-at-byte(c: Ptr(Cursor), b: u8) -> bool skip-trivia(c) not is-at-end(c) and c.src[c.pos] == b ;; ── The condition a reader signals when the file moved ────────────── ;; ;; The case the whole feature exists to catch. The struct was derived from the ;; file as it was when the program was compiled; the file read at run time may ;; be a later one, and a field that has gone or arrived is a program reading ;; something other than what it was built for. ;; ;; Silence is the alternative and it is the bad one: a missing key leaves a ;; field at zero, which is a texture path of "" and a count of 0, and the ;; program draws nothing for a reason nothing reports. So it is a condition, ;; with the field named. Nothing here is fatal — signalling a condition no ;; handler takes carries on — so a program that would rather not care does not ;; have to write anything, and one that would rather know binds a handler. ;; ;; `pos` is the byte offset in the buffer being read: of the offending key for ;; an unknown one, and of the token that ended the map for a missing one, which ;; is where a person would look to add it. struct SchemaDrift(field: str, struct: str, is-extra: bool, pos: i32) ;; ── And the one a file that does not parse signals ────────────────── ;; ;; The louder failure had the quieter answer until this existed. A generated ;; reader accumulates errors on the cursor rather than returning them — which ;; is what lets it be a straight line of assignments — and the cursor is made ;; and dropped inside the entry point, so a stray brace in a file read at run ;; time gave the program a zeroed struct and said nothing at all. ;; ;; That is the one thing the rest of this package refuses to do. `read-file` ;; answers an Option precisely so that a malformed document is distinguishable ;; from a document that is literally nil, and the hand-written reader in ;; test/programs/edn.flan tests is-ok and prints the reason. A derived reader has ;; to be at least as honest. ;; ;; A condition and not an Option, to match SchemaDrift beside it: both are "the ;; file is not what this program was built for", and a handler that wants to ;; carry on with a half-read struct may, while one that wants to stop has ;; something to stop on. `code` is an err-* constant, which `error-message` ;; turns into a sentence. struct ReadFailed(struct: str, code: i32, pos: i32) ;; ── Deriving ──────────────────────────────────────────────────────── ;; ;; One value, from the cursor's current position, consumed. `name` is what a ;; struct here would be called; `src` is the whole buffer, for the positions a ;; refusal names. fn- derive(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived let t = next(c) if not is-ok(c) return derived-bad(joined3("the data file could not be read at ", where(src, error-pos(c)), joined(": ", error-message(c.err)))) if t.kind == tok-int ok-derived(quasiquote(i64), form-nil(), quasiquote(need-int(c))) elif t.kind == tok-float ok-derived(quasiquote(f64), form-nil(), quasiquote(need-float(c))) elif t.kind == tok-bool ok-derived(quasiquote(bool), form-nil(), quasiquote(need-bool(c))) elif t.kind == tok-string ok-derived(quasiquote(str), form-nil(), quasiquote(need-string(c, a))) elif t.kind == tok-map-open derive-map(c, name, t.pos, src) elif t.kind == tok-vec-open derive-vec(c, name, t.pos, src) elif t.kind == tok-set-open derive-set(c, name, t.pos, src) elif t.kind == tok-nil derived-bad(joined3("the nil at ", where(src, t.pos), " has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out")) else derived-bad(joined3("the value at ", where(src, t.pos), " is not one defedn derives a type from — a map, a vector, a set, an integer, a float, a boolean or a string")) ;; A vector, whose elements must all come to the same type. The first element ;; decides; every one after it is compared against that decision and both ;; positions are named when they disagree, because "heterogeneous" without ;; saying where sends someone to read the whole file. fn- derive-vec(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived if is-at-byte(c, \]) return derived-bad(joined3("the empty vector at ", where(src, at-pos), " has no element to derive an element type from — defedn reads the shape out of the data, and an empty collection carries none")) let head = derive(c, joined(name, "-item"), src) if is-bad(head) return head let n = i64(1) while is-ok(c) and not is-at-byte(c, \]) let item = derive(c, joined(name, "-item"), src) if is-bad(item) return item if not is-same-type(head.ty, item.ty) return derived-bad(disagreement("vector", src, at-pos, n, head.ty, item.ty)) n += 1 expect(c, tok-vec-close) let elem = head.ty read1 = head.reader ty = quasiquote(Vec(~elem)) cn = Form.Sym{.s joined(name, "-new")} ok-derived(ty, with-decl(head.decls, quasiquote(defn(~cn, [a Allocator], ~ty, vec-new(a)))), quasiquote(let([xs ~cn(a)], expect(c, tok-vec-open), while(is-ok(c) and not is-at-byte(c, \]), push(xs, ~read1)), expect(c, tok-vec-close), xs))) ;; Why every collection gets a one-line constructor of its own. ;; ;; `vec-new()` and `map-new()` each need to be told what they build, and the ;; way to tell them in argument position is to *name* a type: check.ml's ;; vec_new_elem and map_new_types take an `Ast.Var` and nothing else. A type ;; this derives may have no name — `Vec(i64)` has none, and `[2 i64]`, which ;; is the key of the set in the file this was built for, has none either. ;; ;; Both fall back to what the context wants, and a function's return type is a ;; type position where anything can be written. So the type is stated once, in ;; a signature, and the bare call in the body gets it from `want`. It is also ;; the more readable expansion: the reader says `cells-new(a)` where it would ;; otherwise carry a type nobody wrote. fn- with-decl(decls: [Form], d: Form) -> [Form] form-append(decls, form-cons(d, form-nil())) ;; A set becomes `Map(T, bool)`, so its elements are map keys. `derive-key` is ;; where that constraint is enforced and said. fn- derive-set(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived if is-at-byte(c, \}) return derived-bad(joined3("the empty set at ", where(src, at-pos), " has no element to derive an element type from")) let head = derive-key(c, joined(name, "-key"), src) if is-bad(head) return head let n = i64(1) while is-ok(c) and not is-at-byte(c, \}) let item = derive-key(c, joined(name, "-key"), src) if is-bad(item) return item if not is-same-type(head.ty, item.ty) return derived-bad(disagreement("set", src, at-pos, n, head.ty, item.ty)) n += 1 expect(c, tok-map-close) let elem = head.ty read1 = head.reader ty = quasiquote(Map(~elem, bool)) cn = Form.Sym{.s joined(name, "-new")} ok-derived(ty, with-decl(head.decls, quasiquote(defn(~cn, [a Allocator], ~ty, map-new(a)))), quasiquote(let([tbl ~cn(a)], expect(c, tok-set-open), while(is-ok(c) and not is-at-byte(c, \}), put(tbl, ~read1, true)), expect(c, tok-map-close), tbl))) ;; One element of a set. The scalars that are map keys pass; a vector becomes a ;; fixed array, which is one where a Vec is not; anything else is refused here ;; rather than at the `Map(...)` the caller would build out of it, because a ;; map-key refusal names a type nobody wrote. fn- derive-key(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived if is-at-byte(c, \[) return derive-array(c, name, src) let d = derive(c, name, src) if is-bad(d) return d if not is-key-type(d.ty) return derived-bad(joined3("a set of ", render(d.ty), " is not something this builds: a set becomes a (Map T bool), so its elements are map keys. Integers, booleans, strings and vectors of those are")) d ;; A vector in key position. Its length is part of its type, so every element ;; of the set has to be the same length as well as the same shape — which falls ;; out of the type comparison the caller already makes, since the length is in ;; the type it compares. fn- derive-array(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived let open = next(c) if is-at-byte(c, \]) return derived-bad(joined3("the empty vector at ", where(src, open.pos), " is inside a set, and an empty fixed array has no element type and no length")) let head = derive(c, joined(name, "-item"), src) if is-bad(head) return head let n = i64(1) while is-ok(c) and not is-at-byte(c, \]) let item = derive(c, joined(name, "-item"), src) if is-bad(item) return item if not is-same-type(head.ty, item.ty) return derived-bad(disagreement("vector inside a set", src, open.pos, n, head.ty, item.ty)) n += 1 expect(c, tok-vec-close) if not is-key-type(head.ty) return derived-bad(joined3("a set of vectors of ", render(head.ty), " is not something this builds: the vector becomes a fixed array, which is a map key only when its elements are compared bytewise")) let elem = head.ty read1 = head.reader count = Form.Int{.i n} ok-derived(quasiquote([~count ~elem]), head.decls, quasiquote(let([arr array(~count, ~elem) i 0], expect(c, tok-vec-open), while(is-ok(c) and not is-at-byte(c, \]) and i < ~count, set(arr[i], ~read1), set(i, i + 1)), expect(c, tok-vec-close), arr))) fn- disagreement(what: str, src: [const u8], at-pos: i32, n: i64, first: Form, second: Form) -> str joined3(joined3("the ", what, " at "), where(src, at-pos), joined3(joined3(" holds more than one shape: its first element is ", render(first), " and element "), i64->string(n), joined3(" is ", render(second), ". Every element has to be the same shape, because the type this becomes has one element type"))) ;; ── A map, which is a struct ──────────────────────────────────────── ;; ;; The declaration and the reader together, because the fields decide both and ;; walking twice would mean tokenizing twice. ;; ;; The reader's shape is the hand-written one in test/programs/edn.flan, which ;; was written to show what a generated one would look like: open the map, loop ;; on the keys, dispatch each onto its field, and finish. What it does ;; differently is the two arms a hand-written reader had no reason to have — a ;; key that is not a field of the struct, and a field the file did not have. ;; Both signal SchemaDrift. See the note over that type. fn- derive-map(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived if is-at-byte(c, \}) return derived-bad(joined3("the empty map at ", where(src, at-pos), " has no keys to derive fields from — a struct with no fields is not a shape anything can be read into")) let fields = vec-new(Form) ; the defstruct's [name type ...] vector clauses = vec-new(Form) ; the reader's cond: test, body, test, body missing = vec-new(Form) ; one per field, checked when the map closes decls = vec-new(Form) ; nested structs, innermost first idx = i64(0) while is-ok(c) and not is-at-byte(c, \}) let k = next(c) if not is-ok(c) return derived-bad(joined3("the data file could not be read at ", where(src, error-pos(c)), joined(": ", error-message(c.err)))) if k.kind != tok-keyword return derived-bad(joined3(joined3("the map at ", where(src, at-pos), " has a key at "), where(src, k.pos), " that is not a keyword. A struct's fields are named, so every key of a map defedn reads has to be one — :name, not \"name\" and not 1")) let fname = copy-text(k.text) let d = derive(c, joined3(name, "-", fname), src) if is-bad(d) return d for i in range(length(d.decls)) push(decls, d.decls[i]) push(fields, Form.Sym{.s fname}) push(fields, d.ty) let dot = Form.Sym{.s joined(".", fname)} lit = Form.Str{.s fname} bit = Form.Int{.i i64(1) << idx} read1 = d.reader push(clauses, quasiquote(is-keyword-equal(k, ~lit))) push(clauses, quasiquote(do(set(~dot(out), ~read1), set(seen, seen || ~bit)))) ;; Checked at the closing brace rather than tracked by name: the ;; bit is decided here, where the field is, so the two cannot fall ;; out of step the way a parallel list of names would. push(missing, quasiquote(when seen && ~bit == 0 then signal(SchemaDrift{.field ~lit .struct ~(Form.Str{.s name}) .is-extra false .pos k.pos}))) idx += 1 expect(c, tok-map-close) ;; An unknown key. The hand-written reader skips one, which is right when a ;; person wrote the reader and knows what else is in the file. Here the ;; struct *is* the file, so a key that is not a field is the file having ;; moved: it is reported and then skipped, so a program that declines to ;; handle the condition still reads the rest. push(clauses, quasiquote(:else)) push(clauses, quasiquote(do(signal(SchemaDrift{.field copy-text(k.text) .struct ~(Form.Str{.s name}) .is-extra true .pos k.pos}), when not skip-value(c) then return out))) let sname = Form.Sym{.s name} rname = Form.Sym{.s joined("read-", name)} let (struct) = quasiquote(defstruct(~sname, ~(Form.Vec{.xs slice(fields)}))) let reader = quote defn(~rname, [c Ptr(Cursor) a Allocator], ~sname): let out = ~sname({}) seen = 0 expect(c, tok-map-open) while is-ok(c) let k = next(c) if not is-ok(c) or k.kind == tok-map-close ~@(slice(missing)) return out if k.kind != tok-keyword fail(c, err-unexpected-token, k.pos) return out cond(~@(slice(clauses))) out push(decls, struct) push(decls, reader) ok-derived(sname, slice(decls), quasiquote(~rname(c, a))) ;; ── Comparing and rendering a type form ───────────────────────────── fn- is-same-type(a: Form, b: Form) -> bool is-bytes-equal(bytes-view(render(a)), bytes-view(render(b))) ;; A type form as text, for the refusals. Only the shapes this file builds — a ;; name, a number, `Vec(T)`, `Map(K, V)` and `[n T]` — because nothing else ;; ever reaches it. fn render(f: Form) -> str match f Form.Sym(s) -> s Form.Int(i) -> i64->string(i) Form.List(xs) -> joined3("(", render-items(xs), ")") Form.Vec(xs) -> joined3("[", render-items(xs), "]") _ -> "?" fn- render-items(xs: [Form]) -> str let out = "" for i in range(length(xs)) out = (if i == 0 then render(xs[i]) else joined3(out, " ", render(xs[i]))) out ;; What check.ml takes as a map key, narrowed to what this file can produce. ;; A float is deliberately absent and the checker says why: NaN is not equal to ;; itself, so there is no equality for a map to hash. fn- is-key-type(t: Form) -> bool let s = bytes-view(render(t)) is-bytes-equal(s, bytes-view("i64")) or (is-bytes-equal(s, bytes-view("bool")) or is-bytes-equal(s, bytes-view("string"))) ;; ── The macro ─────────────────────────────────────────────────────── ;; ;; `edn/defedn(Tileset, "assets/tileset.edn")`. The path is relative to the ;; file this is written in, exactly as `embed("assets/tileset.edn")` is — see ;; `macro-slurp` in the prelude, and check.ml's `embed_path`, which is the rule ;; it copies. ;; ;; It answers a `do`, which the top level splices: the nested structs innermost ;; first, then the struct named here, a reader per struct, and the two entry ;; points over the whole thing. `C-c C-m` over the call shows all of it, which ;; is the point of generating readable code rather than the smallest code — a ;; provider whose output nobody can look at is a plugin. macro defedn(& args) if length(args) != 2 refuse("defedn is (defedn Name \"path.edn\") — a name for the struct, and a path to the file its shape is read out of") else match args[1] Form.Str(path) -> match args[0] Form.Sym(name) -> match macro-slurp(path) Some(src) -> provide(name, path, src) None -> refuse(joined3("there is no file at ", path, ", read relative to the file this defedn is written in — the same place (embed \"...\") would look")) _ -> refuse("defedn's first argument is the name of the struct to declare, written as a name") _ -> refuse("defedn's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from") fn- provide(name: str, path: str, src: [const u8]) -> Form let cur = cursor(src) d = derive(addr(cur), name, src) if is-bad(d) refuse(d.bad) else if not next(addr(cur)).kind == tok-eof refuse(joined3(path, " holds more than one value, and a defedn derives one struct from one", "")) else let sname = Form.Sym{.s name} rname = Form.Sym{.s joined("read-", name)} bname = Form.Sym{.s joined(name, "-of-bytes")} fname = Form.Sym{.s joined(name, "-read-file")} quote ~@(d.decls) ;; The two entry points. Both take the allocator the struct's own ;; fields are built in, because a string field is a copy and a Vec ;; field is an allocation — spec-memory's rule, and the reason the ;; destination is never implicit. defn(~bname, [b [const u8] a Allocator], ~sname): let c = cursor(b) out = ~rname(addr(c), a) ;; The cursor is made and dropped here, so this is the only ;; place that can ask whether the read worked. See ReadFailed. if not is-ok(addr(c)) signal(ReadFailed{.struct ~(Form.Str{.s name}) .code c.err .pos c.err-pos}) out defn(~fname, [p str a Allocator], ~sname): let b = slurp(p, a) ~bname(slice(b), a) ;; A refusal, as a declaration. `compile-error` is an expression and a ;; top-level position takes a declaration, so it goes in the body of a function ;; nothing calls: the checker walks it, the arm fires, and `Loc.from_macro` has ;; already put the report on the `defedn` the author wrote. The name is a ;; gensym, so two refusals in one file are two reports rather than a name ;; defined twice. fn- refuse(msg: str) -> Form quote defn(~(gensym()), [], (), compile-error(~(Form.Str{.s msg})))