;;;; defjson: a struct derived from a JSON file, at compile time. ;;;; ;;;; `(json/defjson Config "config.json")` reads config.json while the program ;;;; is being compiled, derives the struct its shape implies, and emits that ;;;; struct with a reader over the tokenizer next door. `(.port cfg)` is then a ;;;; field load: no Value, no match, no runtime tag, nothing looked up by name. ;;;; ;;;; It is the same idea as vendor/edn's defedn and deliberately not the same ;;;; code. Neither package imports the other: json depends on edn for nothing, ;;;; and borrowing a shape walk across that line would be a dependency for the ;;;; sake of a resemblance. What carries over is the design — one walk that ;;;; answers a type, the declarations that type needs and the expression that ;;;; reads one; a refusal carried in a field rather than raised; a typed ;;;; one-line constructor per collection; and a `compile-error` wrapped in a ;;;; defn nothing calls. ;;;; ;;;; ── What is different, and why ─────────────────────────────────────── ;;;; ;;;; **Strings go through `string-of` and never through `.text`.** json.flan's ;;;; `.text` is the RAW interior of a string token, escapes undecoded, so a ;;;; field read off it would hold a literal backslash-n where the file meant a ;;;; newline. `string-of` is the one call in that package that allocates, and ;;;; it is the one that is correct. ;;;; ;;;; **Commas and colons are tokens.** In EDN a comma is whitespace; here a ;;;; member is a string, a colon, a value, and a comma if another follows. ;;;; ;;;; **An object's keys are strings, not keywords**, so the refusal a map of ;;;; the wrong shape gets is about a string, and a key has to look like a name ;;;; a program could write — `{"a b": 1}` is a legal object and `a b` is not a ;;;; field. ;;;; ;;;; **There are no sets**, so there is no map-key path and no fixed array: ;;;; every collection here is a `(Vec T)`. defjson is strictly the smaller of ;;;; the two. ;;;; ;;;; JSON has no integer type of its own — the tokenizer draws the line at ;;;; whether a number has a fraction or an exponent, which is the only line ;;;; there is — so a number written 1 is an i64 here and one written 1.0 is an ;;;; f64. That is the file's own distinction and the honest one to derive from; ;;;; a tuning value that will sometimes be fractional should be written 1.0. ;; ── Small string work ─────────────────────────────────────────────── (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` ;; holds a line and a column at the same time. (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. 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: the type the value implies, the struct ;; declarations that type needs, and the expression that reads one — written ;; against a cursor named `c` and an allocator named `a`, which is what every ;; generated reader binds. `bad` is the refusal, carried rather than raised, ;; because there is no exception to throw out of a recursive walk. (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)) (defn with-decl [decls [Form] d Form] [Form] (form-append decls (form-cons d (form-nil)))) ;; ── The scalars a generated reader calls ──────────────────────────── ;; ;; Functions and not inlined expansions, so that `C-c C-m` over a defjson shows ;; a reader somebody can read. Each is `expect` plus the conversion, and a ;; failure leaves the value at zero with 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)) ;; Both number kinds are acceptable, because 2 and 2.0 are the same number and ;; a 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)) ;; `string-of` and not `.text`. The header says why: `.text` is the raw ;; interior and an escape in it has not been decoded, so a field read off it ;; would hold a backslash and an n where the file meant a newline. (defn need-string [c (Ptr Cursor)] string (match (string-of (expect c tok-string)) (Some s) s None "")) ;; Whether the next thing, past whitespace, is this byte. Enough of a peek for ;; every loop below — "is this over" and "is there another member" are the only ;; lookaheads a reader of a known shape needs — and it consumes nothing. (defn at-byte? [c (Ptr Cursor) b u8] bool (skip-trivia c) (and (not (at-end? c)) (= (at (.src c) (.pos c)) b))) ;; The comma between two members, taken when there is one. A trailing comma is ;; json.flan's err-trailing-comma and is the tokenizer's to refuse, not this ;; loop's: taking it here and then meeting the closer is exactly the shape that ;; refusal is written against. (defn comma [c (Ptr Cursor)] () (when (at-byte? c \,) (next c))) ;; ── The condition a reader signals when the file moved ────────────── ;; ;; The case the whole feature exists to catch, and the same one defedn carries: ;; the struct was derived from the file as it was when the program was ;; compiled, and a key that has gone or arrived since 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 port of ;; 0 and a path of "", and the program fails for a reason nothing reports. ;; ;; Its own type and not edn's, because these two packages do not depend on each ;; other. A program reading both files binds two clauses, which is the honest ;; shape: the two conditions carry different provenance. (defstruct SchemaDrift [field string struct string extra? bool pos i32]) ;; ── Deriving ──────────────────────────────────────────────────────── (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)) (= (.kind t) tok-object-open) (derive-object c name (.pos t) src) (= (.kind t) tok-array-open) (derive-array c name (.pos t) src) (= (.kind t) tok-null) (derived-bad (joined3 "the null 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 defjson derives a type from — an object, an array, a number, a boolean or a string"))))) ;; An array, whose elements must all come to the same type. The first decides; ;; every one after it is compared against that, and both positions are named ;; when they disagree — "heterogeneous" on its own sends someone to read the ;; whole file. (defn derive-array [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \]) (return (derived-bad (joined3 "the empty array at " (where src at-pos) " has no element to derive an element type from — defjson 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)) (comma c) (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 (joined3 (joined3 "the array at " (where src at-pos) " holds more than one shape: element 0 is ") (render (.ty head)) (joined3 (joined3 " and element " (i64->string n) " is ") (render (.ty item)) ". Every element of an array has to be the same shape, because the (Vec T) it becomes has one element type"))))) (comma c) (set n (+ n 1)))) (expect c tok-array-close) (let [elem (.ty head) read1 (.reader head) ty `(Vec ~elem) cn (Form.Sym {.s (joined name "-new")})] ;; The constructor states the type so the bare (vec-new a) in its body ;; can take it from `want`. (vec-new) has to be *told* what it builds by ;; naming a type, and `(Vec i64)` has no name to be — but a signature is ;; a type position where anything can be written. The reader reads ;; better for it too. (ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty (vec-new a))) `(let [xs (~cn a)] (expect c tok-array-open) (while (and (ok? c) (not (at-byte? c \]))) (push xs ~read1) (comma c)) (expect c tok-array-close) xs)))))) ;; ── An object, which is a struct ──────────────────────────────────── (defn derive-object [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (when (at-byte? c \}) (return (derived-bad (joined3 "the empty object at " (where src at-pos) " has no members 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 object 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-string) (return (derived-bad (joined3 "the object at " (joined3 (where src at-pos) " has a member at " (where src (.pos k))) " whose name is not a string, which JSON requires")))) ;; The comparison in the generated reader is against the token's RAW ;; text, which costs no allocation per key. That is only the same ;; question as "is this the field" when the name has no escape in it — ;; so a name that has one is refused here rather than silently compared ;; wrongly. Nothing writes "port" for "port"; what this catches is ;; the file where it would have mattered. (let [raw (.text k)] (when (has-escape? raw) (return (derived-bad (joined3 "the member name at " (where src (.pos k)) " has an escape in it. A generated reader compares a key against the bytes as written, which costs nothing per key and is only the same question when the name is written plainly — so this one is refused rather than matched wrongly")))) (when (not (name-like? raw)) (return (derived-bad (joined3 "the member name at " (where src (.pos k)) " is not a name a program could write, so there is no field it can become. A struct's fields are named; letters, digits, - and ? are what a name is made of")))) (expect c tok-colon) (let [fname (copy-of raw) 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 `(key=? k ~lit)) (push clauses `(do (set (~dot out) ~read1) (set seen (bit-or seen ~bit)))) ;; Checked where the object closes. The bit is decided here, ;; beside the field, 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 close)}))))) (comma c) (set idx (+ idx 1)))))) (expect c tok-object-close) ;; A member the struct has no field for: the struct *is* the file, so an ;; unknown name is the file having moved. 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 (match (string-of k) (Some s) s None "") .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-object-open) (while (and (ok? c) (not (at-byte? c \}))) (let [k (expect c tok-string)] (expect c tok-colon) (cond ~@(as-slice clauses)) (comma c))) (let [close (expect c tok-object-close)] ~@(as-slice missing)) out))] (push decls struct) (push decls reader) (ok-derived sname (as-slice decls) `(~rname c a))))) ;; ── The small predicates the refusals are written against ─────────── ;; The generated reader's key test. Against the raw interior, which is the ;; whole of why a name with an escape in it is refused above. (defn key=? [t Token s string] bool (bytes=? (.text t) (bytes s))) (defn has-escape? [s [u8]] bool (dotimes [i (len s)] (when (= (at s i) \\) (return true))) false) ;; What a field name may be made of. Deliberately narrower than what the reader ;; would accept: this is the set a *person* would recognise as a name, and a ;; member called "a b" or "x.y" has no field it could become. (defn name-like? [s [u8]] bool (when (= (len s) 0) (return false)) (dotimes [i (len s)] (let [b (at s i)] (when (not (or (alpha? b) (or (digit? b) (or (= b \-) (or (= b \?) (or (= b \_) (= b \!))))))) (return false)))) true) ;; A copy of a token's raw text as a string. The Vec header is dropped here on ;; purpose: this runs inside the compiler, where an expansion is bounded by the ;; size of the program being compiled. (defn copy-of [s [u8]] string (let [b (vec-new u8)] (append (addr b) s) (string (as-slice b)))) ;; ── 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 and `(Vec 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)) ;; ── The macro ─────────────────────────────────────────────────────── ;; ;; `(json/defjson Config "config.json")`. The path is relative to the file this ;; is written in, exactly as `(embed "config.json")` 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. (defmacro defjson [args] (if (!= (len args) 2) (refuse "defjson is (defjson Name \"path.json\") — 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 defjson is written in — the same place (embed \"...\") would look"))) _ (refuse "defjson's first argument is the name of the struct to declare, written as a name")) _ (refuse "defjson'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 (joined path " holds more than one value, and a defjson 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) ;; Both entry points take the allocator the struct's own fields are ;; built in: a string field is a copy and a Vec field is an ;; allocation, and spec-memory's rule is that 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 `defjson` 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}))))