;;;; 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.flan 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.flan'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 ─────────────── (defn joined [a string b string] string (let [v (vec-new u8)] (append (addr v) (bytes a)) (append (addr v) (bytes b)) (string (as-slice v)))) (defn joined3 [a string b string c string] string (joined a (joined b c))) ;; Copied out, and not `(string (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. (defn i64->string [n i64] string (let [v (vec-new u8)] (append-i64 (addr v) n) (string (as-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. (defn where [src [u8] pos i32] string (let [line (i64 1) col (i64 1) i (i32 0)] (while (< i pos) (if (= (at src i) \newline) (do (set line (+ line 1)) (set col 1)) (set col (+ col 1))) (set i (+ 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. (defstruct Derived [ty Form decls [Form] reader Form bad string]) (defn derived-bad [msg string] Derived (Derived {.ty `i64 .decls (form-nil) .reader `0 .bad msg})) (defn ok-derived [ty Form decls [Form] reader Form] Derived (Derived {.ty ty .decls decls .reader reader .bad ""})) (defn bad? [d Derived] bool (> (len (bytes (.bad d))) 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 ok?, so a whole struct is a straight line of ;; assignments with one test at the end. (defn 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. (defn need-float [c (Ptr Cursor)] f64 (let [t (next c)] (match (float-of t) (Some x) x None (do (fail c err-unexpected-token (.pos t)) 0.0)))) (defn 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.flan 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. (defn need-string [c (Ptr Cursor) a Allocator] string (let [t (expect c tok-string) b (vec-new u8 a)] (append (addr b) (.text t)) (string (as-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. (defn at-byte? [c (Ptr Cursor) b u8] bool (skip-trivia c) (and (not (at-end? c)) (= (at (.src c) (.pos c)) 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. (defstruct SchemaDrift [field string struct string extra? bool 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. (defn derive [c (Ptr Cursor) name string src [u8]] Derived (let [t (next c)] (when (not (ok? c)) (return (derived-bad (joined3 "the data file could not be read at " (where src (error-pos c)) (joined ": " (error-message (.err c))))))) (cond (= (.kind t) tok-int) (ok-derived `i64 (form-nil) `(need-int c)) (= (.kind t) tok-float) (ok-derived `f64 (form-nil) `(need-float c)) (= (.kind t) tok-bool) (ok-derived `bool (form-nil) `(need-bool c)) (= (.kind t) tok-string) (ok-derived `string (form-nil) `(need-string c a)) (= (.kind t) tok-map-open) (derive-map c name (.pos t) src) (= (.kind t) tok-vec-open) (derive-vec c name (.pos t) src) (= (.kind t) tok-set-open) (derive-set c name (.pos t) src) (= (.kind t) tok-nil) (derived-bad (joined3 "the nil at " (where src (.pos t)) " 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 (.pos t)) " 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. (defn derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (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)] (when (bad? head) (return head)) (let [n (i64 1)] (while (and (ok? c) (not (at-byte? c \]))) (let [item (derive c (joined name "-item") src)] (when (bad? item) (return item)) (when (not (same-type? (.ty head) (.ty item))) (return (derived-bad (disagreement "vector" src at-pos n (.ty head) (.ty item))))) (set n (+ n 1)))) (expect c tok-vec-close) (let [elem (.ty head) read1 (.reader head) ty `(Vec ~elem) cn (Form.Sym {.s (joined name "-new")})] (ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty (vec-new a))) `(let [xs (~cn a)] (expect c tok-vec-open) (while (and (ok? c) (not (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. (defn 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. (defn derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (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)] (when (bad? head) (return head)) (let [n (i64 1)] (while (and (ok? c) (not (at-byte? c \}))) (let [item (derive-key c (joined name "-key") src)] (when (bad? item) (return item)) (when (not (same-type? (.ty head) (.ty item))) (return (derived-bad (disagreement "set" src at-pos n (.ty head) (.ty item))))) (set n (+ n 1)))) (expect c tok-map-close) (let [elem (.ty head) read1 (.reader head) ty `(Map ~elem bool) cn (Form.Sym {.s (joined name "-new")})] (ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty (map-new a))) `(let [tbl (~cn a)] (expect c tok-set-open) (while (and (ok? c) (not (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. (defn derive-key [c (Ptr Cursor) name string src [u8]] Derived (when (at-byte? c \[) (return (derive-array c name src))) (let [d (derive c name src)] (when (bad? d) (return d)) (when (not (key-type? (.ty d))) (return (derived-bad (joined3 "a set of " (render (.ty d)) " 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. (defn derive-array [c (Ptr Cursor) name string src [u8]] Derived (let [open (next c)] (when (at-byte? c \]) (return (derived-bad (joined3 "the empty vector at " (where src (.pos open)) " is inside a set, and an empty fixed array has no element type and no length")))) (let [head (derive c (joined name "-item") src)] (when (bad? head) (return head)) (let [n (i64 1)] (while (and (ok? c) (not (at-byte? c \]))) (let [item (derive c (joined name "-item") src)] (when (bad? item) (return item)) (when (not (same-type? (.ty head) (.ty item))) (return (derived-bad (disagreement "vector inside a set" src (.pos open) n (.ty head) (.ty item))))) (set n (+ n 1)))) (expect c tok-vec-close) (when (not (key-type? (.ty head))) (return (derived-bad (joined3 "a set of vectors of " (render (.ty head)) " 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 (.ty head) read1 (.reader head) count (Form.Int {.i n})] (ok-derived `[~count ~elem] (.decls head) `(let [arr (array ~count ~elem) i 0] (expect c tok-vec-open) (while (and (ok? c) (not (at-byte? c \])) (< i ~count)) (set (at arr i) ~read1) (set i (+ i 1))) (expect c tok-vec-close) arr))))))) (defn disagreement [what string src [u8] at-pos i32 n i64 first Form second Form] string (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. (defn derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (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 (and (ok? c) (not (at-byte? c \}))) (let [k (next c)] (when (not (ok? c)) (return (derived-bad (joined3 "the data file could not be read at " (where src (error-pos c)) (joined ": " (error-message (.err c))))))) (when (!= (.kind k) tok-keyword) (return (derived-bad (joined3 (joined3 "the map at " (where src at-pos) " has a key at ") (where src (.pos k)) " 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 (.text k)) d (derive c (joined3 name "-" fname) src)] (when (bad? d) (return d)) (dotimes [i (len (.decls d))] (push decls (at (.decls d) i))) (push fields (Form.Sym {.s fname})) (push fields (.ty d)) (let [dot (Form.Sym {.s (joined "." fname)}) lit (Form.Str {.s fname}) bit (Form.Int {.i (<< (i64 1) idx)}) read1 (.reader d)] (push clauses `(keyword=? k ~lit)) (push clauses `(do (set (~dot out) ~read1) (set seen (bit-or 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 `(when (= (bit-and seen ~bit) 0) (signal (SchemaDrift {.field ~lit .struct ~(Form.Str {.s name}) .extra? false .pos (.pos k)}))))) (set idx (+ 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 `:else) (push clauses `(do (signal (SchemaDrift {.field (copy-text (.text k)) .struct ~(Form.Str {.s name}) .extra? true .pos (.pos k)})) (when (not (skip-value c)) (return out)))) (let [sname (Form.Sym {.s name}) rname (Form.Sym {.s (joined "read-" name)}) struct `(defstruct ~sname ~(Form.Vec {.xs (as-slice fields)})) reader `(defn ~rname [c (Ptr Cursor) a Allocator] ~sname (let [out (~sname {}) seen 0] (expect c tok-map-open) (while (ok? c) (let [k (next c)] (when (or (not (ok? c)) (= (.kind k) tok-map-close)) ~@(as-slice missing) (return out)) (when (!= (.kind k) tok-keyword) (fail c err-unexpected-token (.pos k)) (return out)) (cond ~@(as-slice clauses)))) out))] (push decls struct) (push decls reader) (ok-derived sname (as-slice decls) `(~rname c a))))) ;; ── Comparing and rendering a type form ───────────────────────────── (defn same-type? [a Form b Form] bool (bytes=? (bytes (render a)) (bytes (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. (defn render [f Form] string (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) "]") _ "?")) (defn render-items [xs [Form]] string (let [out ""] (dotimes [i (len xs)] (set out (if (= i 0) (render (at xs i)) (joined3 out " " (render (at 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. (defn key-type? [t Form] bool (let [s (bytes (render t))] (or (bytes=? s (bytes "i64")) (or (bytes=? s (bytes "bool")) (bytes=? s (bytes "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. (defmacro defedn [args] (if (!= (len 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") (match (at args 1) (Form.Str path) (match (at 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")))) (defn provide [name string path string src [u8]] Form (let [cur (cursor src) d (derive (addr cur) name src)] (if (bad? d) (refuse (.bad d)) (if (not (= (.kind (next (addr cur))) tok-eof)) (refuse (joined3 path " holds more than one value, and a defedn derives one struct from one" "")) (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")})] `(do ~@(.decls d) ;; 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 [u8] a Allocator] ~sname (let [c (cursor b)] (~rname (addr c) a))) (defn ~fname [p string a Allocator] ~sname (let [b (slurp p a)] (~bname (as-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. (defn refuse [msg string] Form `(defn ~(gensym) [] () (compile-error ~(Form.Str {.s msg}))))