;;;; 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. `cfg.port` 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.fln'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 ─────────────────────────────────────────────── 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` ;; holds a line and a column at the same time. fn- i64->string(n: i64) -> str let v = vec-new(u8) append-i64(addr(v), n) str(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. 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: 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. 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 fn- 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 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 ;; 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. 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 ;; `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. fn need-string(c: Ptr(Cursor)) -> str 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. 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 comma between two members, taken when there is one. A trailing comma is ;; json.fln'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. fn comma(c: Ptr(Cursor)) -> () if is-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. struct SchemaDrift(field: str, struct: str, is-extra: bool, pos: i32) ;; And the one a file that does not parse signals. 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 without this a stray brace in a file read ;; at run time would give the program a zeroed struct and say nothing. The ;; louder failure would have had the quieter answer. `code` is an err-* ;; constant, which `error-message` turns into a sentence. struct ReadFailed(struct: str, code: i32, pos: i32) ;; ── Deriving ──────────────────────────────────────────────────────── 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))) elif t.kind == tok-object-open derive-object(c, name, t.pos, src) elif t.kind == tok-array-open derive-array(c, name, t.pos, src) elif t.kind == tok-null derived-bad(joined3("the null 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 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. fn- derive-array(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived if is-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) if is-bad(head) return head comma(c) 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(joined3(joined3("the array at ", where(src, at-pos), " holds more than one shape: element 0 is "), render(head.ty), joined3(joined3(" and element ", i64->string(n), " is "), render(item.ty), ". Every element of an array has to be the same shape, because the (Vec T) it becomes has one element type"))) comma(c) n += 1 expect(c, tok-array-close) let elem = head.ty read1 = head.reader ty = quasiquote(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(head.decls, quasiquote(defn(~cn, [a Allocator], ~ty, vec-new(a)))), quasiquote(let([xs ~cn(a)], expect(c, tok-array-open), while(is-ok(c) and not is-at-byte(c, \]), push(xs, ~read1), comma(c)), expect(c, tok-array-close), xs))) ;; ── An object, which is a struct ──────────────────────────────────── fn- derive-object(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived if is-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 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-string return derived-bad(joined3("the object at ", joined3(where(src, at-pos), " has a member at ", where(src, k.pos)), " 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 = k.text if has-escape(raw) return derived-bad(joined3("the member name at ", where(src, k.pos), " 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")) if not is-name-like(raw) return derived-bad(joined3("the member name at ", where(src, k.pos), " 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) 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-key-equal(k, ~lit))) push(clauses, quasiquote(do(set(~dot(out), ~read1), set(seen, 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, quasiquote(when seen && ~bit == 0 then signal(SchemaDrift{.field ~lit .struct ~(Form.Str{.s name}) .is-extra false .pos close.pos}))) comma(c) 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, quasiquote(:else)) push(clauses, quasiquote(do(signal(SchemaDrift{.field match(string-of(k), Some(s), s, None, "") .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-object-open) while is-ok(c) and not is-at-byte(c, \}) let k = expect(c, tok-string) expect(c, tok-colon) cond(~@(slice(clauses))) comma(c) do: let close = expect(c, tok-object-close) ~@(slice(missing)) out push(decls, struct) push(decls, reader) ok-derived(sname, slice(decls), quasiquote(~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. fn is-key-equal(t: Token, s: str) -> bool is-bytes-equal(t.text, bytes-view(s)) fn- has-escape(s: [const u8]) -> bool for i in range(length(s)) if 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. fn- is-name-like(s: [const u8]) -> bool if length(s) == 0 return false for i in range(length(s)) let b = s[i] if not (is-alpha(b) or (is-digit(b) or (b == \- or (b == \? or (b == \_ or 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. fn- copy-of(s: [const u8]) -> str let b = vec-new(u8) append(addr(b), s) str(slice(b)) ;; ── 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 and `Vec(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 ;; ── 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. macro defjson(& args) if length(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") 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 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") 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(joined(path, " holds more than one value, and a defjson 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) ;; 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 [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 `defjson` 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})))