452 lines
21 KiB
Plaintext
452 lines
21 KiB
Plaintext
;;;; 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})))
|