From 1422d4faf3a45bf45509e0cc3064974ebec24991 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 05:55:00 +0700 Subject: [PATCH] defedn: the struct a data file implies, and a reader for it MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (edn/defedn Tileset "assets/tileset.edn") reads the file while the program is being compiled, derives the struct its shape implies, and emits that struct with a reader over the tokenizer next door. From there (.texture-path data) is a field load: no Value, no match, no runtime tag, nothing looked up by name. The real game file is the case it was built against, and its set of [x y] pairs is why a vector inside a set becomes a fixed array rather than a Vec — a set is this repo's (Map T bool), so its elements are map keys, and [2 i64] is one where (Vec i64) is not. Two things found while writing it. A quasiquote inside a package's ordinary function was not qualified — only a defmacro's body goes through qualify_macro — so a (defn ... [c (Ptr Cursor)] ...) emitted from a derivation helper reached the importer naming a type it had never heard of. The name survives into a string, which is the property the expander depends on and exactly what puts it out of a rename's reach; load.ml now qualifies a literal (Form.Sym {.s "..."}) naming something the package owns. Until a package's macros could call the package's functions there was no helper that built code, so this could not have shown before. And (vec-new) and (map-new) have to be told what they build by naming a type, which (Vec i64) and [2 i64] have no way to be. Both fall back to what the context wants and a signature is a type position, so each collection gets a one-line constructor stating its type. The reader reads better for it. --- lib/load.ml | 25 ++ vendor/edn/provide.flan | 546 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 571 insertions(+) create mode 100644 vendor/edn/provide.flan diff --git a/lib/load.ml b/lib/load.ml index 44a6357..44c5e8f 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -238,6 +238,31 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = in { a with Ast.body = List.map (rename_expr owned alias bound) a.Ast.body }) arms) + (* A quoted symbol naming something the package declares. + [(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is + the one place a package's name survives into a *string* — which is + exactly the property [Macro]'s walk depends on and exactly what puts the + name out of an ordinary rename's reach. + + [qualify_macro] handles that for a [defmacro] by renaming the body + before the desugaring, over the text its author wrote. An ordinary + [defn] never went through it, and until a package's macros could call + the package's functions that was never visible: a helper that *builds* + code was not a thing a package could have. It is now — the derivation a + type provider does is far too large for one macro body — and a + [(defn ... [c (Ptr Cursor)] ...)] emitted from one arrived at the + importer naming a type the importer has never heard of. + + Only a literal string, and only a name the package owns. A [.s] computed + at run time is a name the macro made up (a generated struct, a field + read out of the data file) and is nobody's to qualify; a literal naming + [i64] or [let] is not the package's either. The case order matters: this + has to be tried before the general [Struct] arm below, which would + rewrite the constructor and walk past the field. *) + | Ast.Struct (("Form.Sym" as n), [ ("s", ({ Ast.e = Ast.Str s; _ } as v)) ]) + when qualify_name owned alias bound s <> s -> + Ast.Struct (name n, + [ ("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) | Ast.Arr items -> Ast.Arr (gos items) diff --git a/vendor/edn/provide.flan b/vendor/edn/provide.flan new file mode 100644 index 0000000..e85debe --- /dev/null +++ b/vendor/edn/provide.flan @@ -0,0 +1,546 @@ +;;;; 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))) + +(defn i64->string [n i64] string + (string (i64->bytes n))) + +;; 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}))))