defedn: the struct a data file implies, and a reader for it
(edn/defedn Tileset "assets/tileset.edn") reads the file while the program is
being compiled, derives the struct its shape implies, and emits that struct
with a reader over the tokenizer next door. From there (.texture-path data) is
a field load: no Value, no match, no runtime tag, nothing looked up by name.
The real game file is the case it was built against, and its set of [x y] pairs
is why a vector inside a set becomes a fixed array rather than a Vec — a set is
this repo's (Map T bool), so its elements are map keys, and [2 i64] is one
where (Vec i64) is not.
Two things found while writing it. A quasiquote inside a package's ordinary
function was not qualified — only a defmacro's body goes through
qualify_macro — so a (defn ... [c (Ptr Cursor)] ...) emitted from a derivation
helper reached the importer naming a type it had never heard of. The name
survives into a string, which is the property the expander depends on and
exactly what puts it out of a rename's reach; load.ml now qualifies a literal
(Form.Sym {.s "..."}) naming something the package owns. Until a package's
macros could call the package's functions there was no helper that built code,
so this could not have shown before.
And (vec-new) and (map-new) have to be told what they build by naming a type,
which (Vec i64) and [2 i64] have no way to be. Both fall back to what the
context wants and a signature is a type position, so each collection gets a
one-line constructor stating its type. The reader reads better for it.
This commit is contained in:
parent
a2004ae7a6
commit
1422d4faf3
25
lib/load.ml
25
lib/load.ml
@ -238,6 +238,31 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
|
||||
in
|
||||
{ a with Ast.body = List.map (rename_expr owned alias bound)
|
||||
a.Ast.body }) arms)
|
||||
(* A quoted symbol naming something the package declares.
|
||||
[(Form.Sym {.s "Cursor"})] is what a quasiquote desugars to, and it is
|
||||
the one place a package's name survives into a *string* — which is
|
||||
exactly the property [Macro]'s walk depends on and exactly what puts the
|
||||
name out of an ordinary rename's reach.
|
||||
|
||||
[qualify_macro] handles that for a [defmacro] by renaming the body
|
||||
before the desugaring, over the text its author wrote. An ordinary
|
||||
[defn] never went through it, and until a package's macros could call
|
||||
the package's functions that was never visible: a helper that *builds*
|
||||
code was not a thing a package could have. It is now — the derivation a
|
||||
type provider does is far too large for one macro body — and a
|
||||
[(defn ... [c (Ptr Cursor)] ...)] emitted from one arrived at the
|
||||
importer naming a type the importer has never heard of.
|
||||
|
||||
Only a literal string, and only a name the package owns. A [.s] computed
|
||||
at run time is a name the macro made up (a generated struct, a field
|
||||
read out of the data file) and is nobody's to qualify; a literal naming
|
||||
[i64] or [let] is not the package's either. The case order matters: this
|
||||
has to be tried before the general [Struct] arm below, which would
|
||||
rewrite the constructor and walk past the field. *)
|
||||
| Ast.Struct (("Form.Sym" as n), [ ("s", ({ Ast.e = Ast.Str s; _ } as v)) ])
|
||||
when qualify_name owned alias bound s <> s ->
|
||||
Ast.Struct (name n,
|
||||
[ ("s", { v with Ast.e = Ast.Str (qualify_name owned alias bound s) }) ])
|
||||
| Ast.Struct (n, kvs) ->
|
||||
Ast.Struct (name n, List.map (fun (k, v) -> (k, go v)) kvs)
|
||||
| Ast.Arr items -> Ast.Arr (gos items)
|
||||
|
||||
546
vendor/edn/provide.flan
vendored
Normal file
546
vendor/edn/provide.flan
vendored
Normal file
@ -0,0 +1,546 @@
|
||||
;;;; 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)))
|
||||
|
||||
(defn i64->string [n i64] string
|
||||
(string (i64->bytes n)))
|
||||
|
||||
;; 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}))))
|
||||
Loading…
x
Reference in New Issue
Block a user