flan/vendor/json/provide.flan
Joseph Ferano 889fdc30d9 A file that does not parse says so, and the provider is written down
The louder failure had the quieter answer. A generated reader accumulates
errors on the cursor — which is what lets it be a straight line of
assignments — and the cursor is made and dropped inside the entry point, so a
stray brace in a file read at run time handed the program a zeroed struct and
said nothing at all. That is the one thing the rest of vendor:edn refuses to
do: read-file answers an Option precisely so a malformed document is
distinguishable from one that is literally nil, and the hand-written reader in
test/programs/edn.flan tests ok? and prints the reason. ReadFailed is the
derived reader being as honest, in both packages, and it sits beside
SchemaDrift because both are "the file is not what this program was built for".

Then the writing-down. docs/BUILT.md gets the section: the four things the
macro system did not have and now does, each general and none of them
mentioning EDN — a macro reading a file at the call site's path, a package
macro calling its package, one call answering several declarations, and
compile-error, which is the one piece that had to go in the compiler and the
reason it had to. The set rule the real game file decided is there too, and
what defjson shares, which is the design and not the code.

NEXT.md item 9 and PORTING.md §3.9 both close. Not as (read-edn T bytes): the
struct comes from the *file* rather than from a type declared by hand, so the
~80 lines PORTING prices for two schemas are not written at all. The competing
answer PORTING names — compile-time embedding — turned out to be the other half
rather than a competitor: the shape comes from the file at compile time and the
bytes may come from an embed beside it, which is exactly what
test/programs/edn-provide.flan does.
2026-09-19 06:59:22 +07:00

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}))))