Joseph Ferano
a5a77867f9
edn-provide.flan reads assets/edn/tileset.edn through a struct derived from it, and its first five lines are edn-read.flan's first five character for character. Two readers over one file agreeing is what says the derived one is right; either alone could be self-consistently wrong. The pair memberships are the derivation deciding in public: the set became a (Map [2 i64] bool), so [3 4] is a key and [9 9] is not, where a version that made it 108 loose integers would have compiled and answered differently on all four. A tuning file beside it covers the rest of the matrix — a string, an integer, a float, a boolean, a vector summed rather than counted, and a map inside a map read two field loads deep — and then drift: the struct was derived from a file with :speed and without :level, and the bytes read carry the opposite. Both are named, and the read carries on. The refusals write their own data file, because the data file is the test. Each is asserted on the position it names, not on the fact of failing, and one of them checks a line and column into a file the compiler is not reading — which is the whole of what compile-error was added for. Two things the tests caught. Load extends the ambient macro set rather than replacing it, so a package reached twice handed its declarations over twice and the module refused them as a redefinition; Macro.compile dedupes by name, which is the rule macro_union already applies a level up. And `where` held a line and a column at once, which the prelude's note over append-i64 says cannot be done: i64->bytes renders into one shared static buffer, and both numbers read as the second one.
554 lines
27 KiB
Plaintext
554 lines
27 KiB
Plaintext
;;;; defedn: a struct derived from a data file, at compile time.
|
|
;;;;
|
|
;;;; F#'s type providers, with the part that makes them worth having and none
|
|
;;;; of the part that needs a plugin protocol. `(edn/defedn Tileset "t.edn")`
|
|
;;;; reads t.edn while the program is being compiled, works out what shape it
|
|
;;;; is, and emits the struct that shape implies together with a reader for it.
|
|
;;;; From then on `(.texture-path data)` is a field load off a struct: no Value,
|
|
;;;; no match, no runtime tag, nothing to look up by name.
|
|
;;;;
|
|
;;;; read.flan is the other half of the same choice, and both belong here. A
|
|
;;;; dynamic Value is what you want when the shape is the program's *input* —
|
|
;;;; an editor opening a file it has never seen. A provider is what you want
|
|
;;;; when the shape is part of the program and only the numbers change, which
|
|
;;;; is what a game's tuning file is. The typed world is not an afterthought:
|
|
;;;; it is the same tokenizer, read by a macro instead of by a loop.
|
|
;;;;
|
|
;;;; ── What it needs, and what was built for it ─────────────────────────
|
|
;;;;
|
|
;;;; A macro is compiled and dlopened into the compiler, so it has always been
|
|
;;;; able to run arbitrary code at expansion time. Three things it could not do
|
|
;;;; are what this file rests on, and all three are general:
|
|
;;;;
|
|
;;;; - `(macro-slurp "t.edn")` reads a file at expansion time, resolved the
|
|
;;;; way `(embed "t.edn")` resolves a path — against the directory of the
|
|
;;;; source file the form is written in.
|
|
;;;; - a package's macro may call the package's own functions, which is why
|
|
;;;; the derivation below is ordinary Flan over the tokenizer next door
|
|
;;;; rather than a second scanner inlined into a macro body.
|
|
;;;; - a macro may answer several declarations, as a top-level `(do ...)`,
|
|
;;;; and may refuse with a sentence through `(compile-error "...")`.
|
|
;;;;
|
|
;;;; ── The rules ────────────────────────────────────────────────────────
|
|
;;;;
|
|
;;;; A map with keyword keys is a struct, one field per key, named for the
|
|
;;;; keyword. An integer is an i64, a float an f64, a boolean a bool, a string
|
|
;;;; a `string` — copied, which is read.flan's contract and not the tokenizer's:
|
|
;;;; a Token's text points into the buffer, and a struct that outlives the
|
|
;;;; buffer cannot hold one.
|
|
;;;;
|
|
;;;; A vector of one repeated shape is a `(Vec T)`. A set is this repo's own
|
|
;;;; spelling of one, `(Map T bool)` — check.ml says exactly that where it
|
|
;;;; refuses a map with a `()` value — and its elements are therefore read as
|
|
;;;; map *keys*. That is why a vector inside a set derives to a fixed array
|
|
;;;; `[n T]` rather than to a Vec: a Vec is not a map key and `[2 i64]` is.
|
|
;;;; The file this was built for is a set of pairs, so that is the case rather
|
|
;;;; than a corner of it.
|
|
;;;;
|
|
;;;; A nested map is a struct of its own, named for the path that reaches it —
|
|
;;;; `Tileset-selected-cells`. A hyphen because `/` is package qualification
|
|
;;;; and cannot appear in a name a program declares, and because every name in
|
|
;;;; this language is already hyphenated, so no case conversion has to be
|
|
;;;; written to produce one. The path is unique, so the name is.
|
|
;;;;
|
|
;;;; Everything else is refused while expanding, with the line and column in
|
|
;;;; the *data* file. A refusal is the point: a file the compiler could not
|
|
;;;; make sense of is one the program would have read wrongly.
|
|
|
|
;; ── Small string work, for the refusals and the names ───────────────
|
|
|
|
(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`
|
|
;; below holds a line and a column at the same time, which read as the same
|
|
;; number until this copied.
|
|
(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, because that is what a slice into the
|
|
;; buffer costs nothing to produce. 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 at once, which is why they travel together:
|
|
;; the *type* the value implies, the struct declarations that type needs (a
|
|
;; nested map contributes one, and everything nested inside it contributes
|
|
;; more), and the *expression* that reads one — written against a cursor named
|
|
;; `c` and an allocator named `a`, which is the shape every generated reader
|
|
;; binds.
|
|
;;
|
|
;; `bad` is the refusal, carried rather than raised: there is no exception to
|
|
;; throw out of a recursive walk, and a partial answer with a reason attached
|
|
;; propagates to the top where the one `compile-error` is written. Empty means
|
|
;; the walk succeeded.
|
|
(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))
|
|
|
|
;; ── The scalars a generated reader calls ────────────────────────────
|
|
;;
|
|
;; Functions and not inlined expansions, so that `C-c C-m` over a defedn shows
|
|
;; a reader somebody can read. Each is `expect` plus the conversion, with the
|
|
;; same "the cursor carries the error" contract the hand-written reader in
|
|
;; test/programs/edn.flan is written against: a failure leaves the value at
|
|
;; zero and 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))
|
|
|
|
;; Two kinds are acceptable, because 2 and 2.0 are the same number and a tuning
|
|
;; 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))
|
|
|
|
;; Copied into the allocator, which is the whole difference between a field of
|
|
;; a struct and a Token's text. The lifetime contract at the top of edn.flan is
|
|
;; the reason: `text` is a slice of the buffer, and a struct read out of a
|
|
;; buffer that is later freed would hold a dangling one.
|
|
(defn need-string [c (Ptr Cursor) a Allocator] string
|
|
(let [t (expect c tok-string)
|
|
b (vec-new u8 a)]
|
|
(append (addr b) (.text t))
|
|
(string (as-slice b))))
|
|
|
|
;; Whether the next thing, past trivia, is this byte. Enough of a peek for
|
|
;; every loop below — "is the collection over" is the only lookahead a reader
|
|
;; of a known shape ever needs — and it consumes nothing, so the closer is
|
|
;; still there for `expect` to take.
|
|
(defn at-byte? [c (Ptr Cursor) b u8] bool
|
|
(skip-trivia c)
|
|
(and (not (at-end? c)) (= (at (.src c) (.pos c)) b)))
|
|
|
|
;; ── The condition a reader signals when the file moved ──────────────
|
|
;;
|
|
;; The case the whole feature exists to catch. The struct was derived from the
|
|
;; file as it was when the program was compiled; the file read at run time may
|
|
;; be a later one, and a field that has gone or arrived 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 texture path of "" and a count of 0, and the
|
|
;; program draws nothing for a reason nothing reports. So it is a condition,
|
|
;; with the field named. Nothing here is fatal — signalling a condition no
|
|
;; handler takes carries on — so a program that would rather not care does not
|
|
;; have to write anything, and one that would rather know binds a handler.
|
|
;;
|
|
;; `pos` is the byte offset in the buffer being read: of the offending key for
|
|
;; an unknown one, and of the token that ended the map for a missing one, which
|
|
;; is where a person would look to add it.
|
|
(defstruct SchemaDrift
|
|
[field string
|
|
struct string
|
|
extra? bool
|
|
pos i32])
|
|
|
|
;; ── Deriving ────────────────────────────────────────────────────────
|
|
;;
|
|
;; One value, from the cursor's current position, consumed. `name` is what a
|
|
;; struct here would be called; `src` is the whole buffer, for the positions a
|
|
;; refusal names.
|
|
(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 a))
|
|
|
|
(= (.kind t) tok-map-open) (derive-map c name (.pos t) src)
|
|
(= (.kind t) tok-vec-open) (derive-vec c name (.pos t) src)
|
|
(= (.kind t) tok-set-open) (derive-set c name (.pos t) src)
|
|
|
|
(= (.kind t) tok-nil)
|
|
(derived-bad
|
|
(joined3 "the nil 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 defedn derives a type from — a map, a vector, a set, an integer, a float, a boolean or a string")))))
|
|
|
|
;; A vector, whose elements must all come to the same type. The first element
|
|
;; decides; every one after it is compared against that decision and both
|
|
;; positions are named when they disagree, because "heterogeneous" without
|
|
;; saying where sends someone to read the whole file.
|
|
(defn derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
|
|
(when (at-byte? c \])
|
|
(return (derived-bad
|
|
(joined3 "the empty vector at " (where src at-pos)
|
|
" has no element to derive an element type from — defedn 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))
|
|
(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 (disagreement "vector" src at-pos n
|
|
(.ty head) (.ty item)))))
|
|
(set n (+ n 1))))
|
|
(expect c tok-vec-close)
|
|
(let [elem (.ty head)
|
|
read1 (.reader head)
|
|
ty `(Vec ~elem)
|
|
cn (Form.Sym {.s (joined name "-new")})]
|
|
(ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty
|
|
(vec-new a)))
|
|
`(let [xs (~cn a)]
|
|
(expect c tok-vec-open)
|
|
(while (and (ok? c) (not (at-byte? c \])))
|
|
(push xs ~read1))
|
|
(expect c tok-vec-close)
|
|
xs))))))
|
|
|
|
;; Why every collection gets a one-line constructor of its own.
|
|
;;
|
|
;; `(vec-new)` and `(map-new)` each need to be told what they build, and the
|
|
;; way to tell them in argument position is to *name* a type: check.ml's
|
|
;; vec_new_elem and map_new_types take an `Ast.Var` and nothing else. A type
|
|
;; this derives may have no name — `(Vec i64)` has none, and `[2 i64]`, which
|
|
;; is the key of the set in the file this was built for, has none either.
|
|
;;
|
|
;; Both fall back to what the context wants, and a function's return type is a
|
|
;; type position where anything can be written. So the type is stated once, in
|
|
;; a signature, and the bare call in the body gets it from `want`. It is also
|
|
;; the more readable expansion: the reader says `(cells-new a)` where it would
|
|
;; otherwise carry a type nobody wrote.
|
|
(defn with-decl [decls [Form] d Form] [Form]
|
|
(form-append decls (form-cons d (form-nil))))
|
|
|
|
;; A set becomes `(Map T bool)`, so its elements are map keys. `derive-key` is
|
|
;; where that constraint is enforced and said.
|
|
(defn derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
|
|
(when (at-byte? c \})
|
|
(return (derived-bad
|
|
(joined3 "the empty set at " (where src at-pos)
|
|
" has no element to derive an element type from"))))
|
|
(let [head (derive-key c (joined name "-key") src)]
|
|
(when (bad? head)
|
|
(return head))
|
|
(let [n (i64 1)]
|
|
(while (and (ok? c) (not (at-byte? c \})))
|
|
(let [item (derive-key c (joined name "-key") src)]
|
|
(when (bad? item)
|
|
(return item))
|
|
(when (not (same-type? (.ty head) (.ty item)))
|
|
(return (derived-bad (disagreement "set" src at-pos n
|
|
(.ty head) (.ty item)))))
|
|
(set n (+ n 1))))
|
|
(expect c tok-map-close)
|
|
(let [elem (.ty head)
|
|
read1 (.reader head)
|
|
ty `(Map ~elem bool)
|
|
cn (Form.Sym {.s (joined name "-new")})]
|
|
(ok-derived ty (with-decl (.decls head) `(defn ~cn [a Allocator] ~ty
|
|
(map-new a)))
|
|
`(let [tbl (~cn a)]
|
|
(expect c tok-set-open)
|
|
(while (and (ok? c) (not (at-byte? c \})))
|
|
(put tbl ~read1 true))
|
|
(expect c tok-map-close)
|
|
tbl))))))
|
|
|
|
;; One element of a set. The scalars that are map keys pass; a vector becomes a
|
|
;; fixed array, which is one where a Vec is not; anything else is refused here
|
|
;; rather than at the `(Map ...)` the caller would build out of it, because a
|
|
;; map-key refusal names a type nobody wrote.
|
|
(defn derive-key [c (Ptr Cursor) name string src [u8]] Derived
|
|
(when (at-byte? c \[)
|
|
(return (derive-array c name src)))
|
|
(let [d (derive c name src)]
|
|
(when (bad? d)
|
|
(return d))
|
|
(when (not (key-type? (.ty d)))
|
|
(return (derived-bad
|
|
(joined3 "a set of " (render (.ty d))
|
|
" is not something this builds: a set becomes a (Map T bool), so its elements are map keys. Integers, booleans, strings and vectors of those are"))))
|
|
d))
|
|
|
|
;; A vector in key position. Its length is part of its type, so every element
|
|
;; of the set has to be the same length as well as the same shape — which falls
|
|
;; out of the type comparison the caller already makes, since the length is in
|
|
;; the type it compares.
|
|
(defn derive-array [c (Ptr Cursor) name string src [u8]] Derived
|
|
(let [open (next c)]
|
|
(when (at-byte? c \])
|
|
(return (derived-bad
|
|
(joined3 "the empty vector at " (where src (.pos open))
|
|
" is inside a set, and an empty fixed array has no element type and no length"))))
|
|
(let [head (derive c (joined name "-item") src)]
|
|
(when (bad? head)
|
|
(return head))
|
|
(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 (disagreement "vector inside a set" src
|
|
(.pos open) n
|
|
(.ty head) (.ty item)))))
|
|
(set n (+ n 1))))
|
|
(expect c tok-vec-close)
|
|
(when (not (key-type? (.ty head)))
|
|
(return (derived-bad
|
|
(joined3 "a set of vectors of " (render (.ty head))
|
|
" is not something this builds: the vector becomes a fixed array, which is a map key only when its elements are compared bytewise"))))
|
|
(let [elem (.ty head)
|
|
read1 (.reader head)
|
|
count (Form.Int {.i n})]
|
|
(ok-derived `[~count ~elem] (.decls head)
|
|
`(let [arr (array ~count ~elem)
|
|
i 0]
|
|
(expect c tok-vec-open)
|
|
(while (and (ok? c) (not (at-byte? c \])) (< i ~count))
|
|
(set (at arr i) ~read1)
|
|
(set i (+ i 1)))
|
|
(expect c tok-vec-close)
|
|
arr)))))))
|
|
|
|
(defn disagreement [what string src [u8] at-pos i32 n i64
|
|
first Form second Form] string
|
|
(joined3 (joined3 "the " what " at ")
|
|
(where src at-pos)
|
|
(joined3 (joined3 " holds more than one shape: its first element is "
|
|
(render first) " and element ")
|
|
(i64->string n)
|
|
(joined3 " is " (render second)
|
|
". Every element has to be the same shape, because the type this becomes has one element type"))))
|
|
|
|
;; ── A map, which is a struct ────────────────────────────────────────
|
|
;;
|
|
;; The declaration and the reader together, because the fields decide both and
|
|
;; walking twice would mean tokenizing twice.
|
|
;;
|
|
;; The reader's shape is the hand-written one in test/programs/edn.flan, which
|
|
;; was written to show what a generated one would look like: open the map, loop
|
|
;; on the keys, dispatch each onto its field, and finish. What it does
|
|
;; differently is the two arms a hand-written reader had no reason to have — a
|
|
;; key that is not a field of the struct, and a field the file did not have.
|
|
;; Both signal SchemaDrift. See the note over that type.
|
|
(defn derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived
|
|
(when (at-byte? c \})
|
|
(return (derived-bad
|
|
(joined3 "the empty map at " (where src at-pos)
|
|
" has no keys 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 map 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-keyword)
|
|
(return (derived-bad
|
|
(joined3 (joined3 "the map at " (where src at-pos) " has a key at ")
|
|
(where src (.pos k))
|
|
" that is not a keyword. A struct's fields are named, so every key of a map defedn reads has to be one — :name, not \"name\" and not 1"))))
|
|
(let [fname (copy-text (.text k))
|
|
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 `(keyword=? k ~lit))
|
|
(push clauses `(do (set (~dot out) ~read1)
|
|
(set seen (bit-or seen ~bit))))
|
|
;; Checked at the closing brace rather than tracked by name: the
|
|
;; bit is decided here, where the field is, 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 k)})))))
|
|
(set idx (+ idx 1)))))
|
|
(expect c tok-map-close)
|
|
;; An unknown key. The hand-written reader skips one, which is right when a
|
|
;; person wrote the reader and knows what else is in the file. Here the
|
|
;; struct *is* the file, so a key that is not a field is the file having
|
|
;; moved: it is 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 (copy-text (.text k))
|
|
.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-map-open)
|
|
(while (ok? c)
|
|
(let [k (next c)]
|
|
(when (or (not (ok? c)) (= (.kind k) tok-map-close))
|
|
~@(as-slice missing)
|
|
(return out))
|
|
(when (!= (.kind k) tok-keyword)
|
|
(fail c err-unexpected-token (.pos k))
|
|
(return out))
|
|
(cond ~@(as-slice clauses))))
|
|
out))]
|
|
(push decls struct)
|
|
(push decls reader)
|
|
(ok-derived sname (as-slice decls) `(~rname c a)))))
|
|
|
|
;; ── 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, a number, `(Vec T)`, `(Map K V)` and `[n 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))
|
|
|
|
;; What check.ml takes as a map key, narrowed to what this file can produce.
|
|
;; A float is deliberately absent and the checker says why: NaN is not equal to
|
|
;; itself, so there is no equality for a map to hash.
|
|
(defn key-type? [t Form] bool
|
|
(let [s (bytes (render t))]
|
|
(or (bytes=? s (bytes "i64"))
|
|
(or (bytes=? s (bytes "bool"))
|
|
(bytes=? s (bytes "string"))))))
|
|
|
|
;; ── The macro ───────────────────────────────────────────────────────
|
|
;;
|
|
;; `(edn/defedn Tileset "assets/tileset.edn")`. The path is relative to the
|
|
;; file this is written in, exactly as `(embed "assets/tileset.edn")` 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. `C-c C-m` over the call shows all of it, which
|
|
;; is the point of generating readable code rather than the smallest code — a
|
|
;; provider whose output nobody can look at is a plugin.
|
|
(defmacro defedn [args]
|
|
(if (!= (len args) 2)
|
|
(refuse "defedn is (defedn Name \"path.edn\") — 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 defedn is written in — the same place (embed \"...\") would look")))
|
|
_ (refuse "defedn's first argument is the name of the struct to declare, written as a name"))
|
|
_ (refuse "defedn'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 (joined3 path " holds more than one value, and a defedn 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)
|
|
;; The two entry points. Both take the allocator the struct's own
|
|
;; fields are built in, because a string field is a copy and a Vec
|
|
;; field is an allocation — spec-memory's rule, and the reason 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 `defedn` 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}))))
|