Joseph Ferano
69646e534e
(defmacro do-grid [[r rows c cols] & body] ...) — positional names, a [ ] pattern wherever an argument is a vector, and & for the tail. The reading of the list lives in Expand, below both sides that need it: Parse turns it into the bindings a macro body opens with, and Macro checks a call against the same reading before expanding it, so arity and shape are refused with the call's own location rather than with the Loc.from_macro stamp every node of an expansion carries. The breaking half: [args] used to bind the whole argument list and now binds the first argument. The whole list is [& args], and every defmacro in the tree — prelude, vendor, tests, the elisp fixtures — was migrated to it. One grammar, not a legacy mode.
465 lines
22 KiB
Plaintext
465 lines
22 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. `(.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])
|
|
|
|
;; 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.
|
|
(defstruct ReadFailed
|
|
[struct string
|
|
code i32
|
|
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)
|
|
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.
|
|
(when (not (ok? (addr c)))
|
|
(signal (ReadFailed {.struct ~(Form.Str {.s name})
|
|
.code (.err c)
|
|
.pos (.err-pos c)})))
|
|
out))
|
|
(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}))))
|