flan/vendor/edn/provide.fln

;;;; 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 ───────────────

fn- joined(a: str, b: str) -> str
  let v = vec-new(u8)
  append(addr(v), bytes-view(a))
  append(addr(v), bytes-view(b))
  str(slice(v))

fn- joined3(a: str, b: str, c: str) -> str = joined(a, joined(b, c))

;; Copied out, and not `(str (i64->bytes n))`. The prelude's note over
;; append-i64 is the reason: i64->bytes renders into one shared static buffer
;; in the runtime, so two of its results cannot be held at once — and `where`
;; below holds a line and a column at the same time, which read as the same
;; number until this copied.
fn- i64->string(n: i64) -> str
  let v = vec-new(u8)
  append-i64(addr(v), n)
  str(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.
fn- where(src: [const u8], pos: i32) -> str
  let line = i64(1)
      col = i64(1)
      i = i32(0)
  while i < pos
    if src[i] == \newline
      line += 1
      col = 1
    else
      col += 1
    i += 1
  joined3("line ", i64->string(line), joined(" column ", i64->string(col)))

;; ── What a value came to ────────────────────────────────────────────
;;
;; One walk answers three things 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.
struct Derived(ty: Form, decls: [Form], reader: Form, bad: str)

fn- derived-bad(msg: str) -> Derived
  Derived{.ty quasiquote(i64) .decls form-nil() .reader quasiquote(0) .bad msg}

fn- ok-derived(ty: Form, decls: [Form], reader: Form) -> Derived
  Derived{.ty ty .decls decls .reader reader .bad ""}

fn- is-bad(d: Derived) -> bool = length(bytes-view(d.bad)) > 0

;; ── 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 is-ok, so a whole struct is a straight line of
;; assignments with one test at the end.

fn need-int(c: Ptr(Cursor)) -> i64
  match int-of(expect(c, tok-int))
    Some(v) -> v
    None -> 0

;; 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.
fn need-float(c: Ptr(Cursor)) -> f64
  let t = next(c)
  match float-of(t)
    Some(x) -> x
    None ->
      fail(c, err-unexpected-token, t.pos)
      0.0

fn need-bool(c: Ptr(Cursor)) -> bool
  match bool-of(expect(c, tok-bool))
    Some(v) -> v
    None -> false

;; 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.
fn need-string(c: Ptr(Cursor), a: Allocator) -> str
  let t = expect(c, tok-string)
      b = vec-new(u8, a)
  append(addr(b), t.text)
  str(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.
fn is-at-byte(c: Ptr(Cursor), b: u8) -> bool
  skip-trivia(c)
  not is-at-end(c) and c.src[c.pos] == b

;; ── The 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.
struct SchemaDrift(field: str, struct: str, is-extra: bool, pos: i32)

;; ── And the one a file that does not parse signals ──────────────────
;;
;; The louder failure had the quieter answer until this existed. 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 a stray brace in a file read at run
;; time gave the program a zeroed struct and said nothing at all.
;;
;; That is the one thing the rest of this package refuses to do. `read-file`
;; answers an Option precisely so that a malformed document is distinguishable
;; from a document that is literally nil, and the hand-written reader in
;; test/programs/edn.flan tests is-ok and prints the reason. A derived reader has
;; to be at least as honest.
;;
;; A condition and not an Option, to match SchemaDrift beside it: both are "the
;; file is not what this program was built for", and a handler that wants to
;; carry on with a half-read struct may, while one that wants to stop has
;; something to stop on. `code` is an err-* constant, which `error-message`
;; turns into a sentence.
struct ReadFailed(struct: str, code: i32, 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.
fn- derive(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived
  let t = next(c)
  if not is-ok(c)
    return derived-bad(joined3("the data file could not be read at ", where(src, error-pos(c)), joined(": ", error-message(c.err))))
  if t.kind == tok-int
    ok-derived(quasiquote(i64), form-nil(), quasiquote(need-int(c)))
  elif t.kind == tok-float
    ok-derived(quasiquote(f64), form-nil(), quasiquote(need-float(c)))
  elif t.kind == tok-bool
    ok-derived(quasiquote(bool), form-nil(), quasiquote(need-bool(c)))
  elif t.kind == tok-string
    ok-derived(quasiquote(str), form-nil(), quasiquote(need-string(c, a)))
  elif t.kind == tok-map-open
    derive-map(c, name, t.pos, src)
  elif t.kind == tok-vec-open
    derive-vec(c, name, t.pos, src)
  elif t.kind == tok-set-open
    derive-set(c, name, t.pos, src)
  elif t.kind == tok-nil
    derived-bad(joined3("the nil at ", where(src, t.pos), " has no type to derive — a field that is sometimes absent is not something a struct can hold, so give it a value in the file or take the key out"))
  else
    derived-bad(joined3("the value at ", where(src, t.pos), " is not one 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.
fn- derive-vec(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived
  if is-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)
  if is-bad(head)
    return head
  let n = i64(1)
  while is-ok(c) and not is-at-byte(c, \])
    let item = derive(c, joined(name, "-item"), src)
    if is-bad(item)
      return item
    if not is-same-type(head.ty, item.ty)
      return derived-bad(disagreement("vector", src, at-pos, n, head.ty, item.ty))
    n += 1
  expect(c, tok-vec-close)
  let elem = head.ty
      read1 = head.reader
      ty = quasiquote(Vec(~elem))
      cn = Form.Sym{.s joined(name, "-new")}
  ok-derived(ty,
             with-decl(head.decls, quasiquote(defn(~cn, [a Allocator], ~ty, vec-new(a)))),
             quasiquote(let([xs ~cn(a)], expect(c, tok-vec-open), while(is-ok(c) and not is-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.
fn- 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.
fn- derive-set(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived
  if is-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)
  if is-bad(head)
    return head
  let n = i64(1)
  while is-ok(c) and not is-at-byte(c, \})
    let item = derive-key(c, joined(name, "-key"), src)
    if is-bad(item)
      return item
    if not is-same-type(head.ty, item.ty)
      return derived-bad(disagreement("set", src, at-pos, n, head.ty, item.ty))
    n += 1
  expect(c, tok-map-close)
  let elem = head.ty
      read1 = head.reader
      ty = quasiquote(Map(~elem, bool))
      cn = Form.Sym{.s joined(name, "-new")}
  ok-derived(ty,
             with-decl(head.decls, quasiquote(defn(~cn, [a Allocator], ~ty, map-new(a)))),
             quasiquote(let([tbl ~cn(a)], expect(c, tok-set-open), while(is-ok(c) and not is-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.
fn- derive-key(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived
  if is-at-byte(c, \[)
    return derive-array(c, name, src)
  let d = derive(c, name, src)
  if is-bad(d)
    return d
  if not is-key-type(d.ty)
    return derived-bad(joined3("a set of ", render(d.ty), " 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.
fn- derive-array(c: Ptr(Cursor), name: str, src: [const u8]) -> Derived
  let open = next(c)
  if is-at-byte(c, \])
    return derived-bad(joined3("the empty vector at ", where(src, open.pos), " is inside a set, and an empty fixed array has no element type and no length"))
  let head = derive(c, joined(name, "-item"), src)
  if is-bad(head)
    return head
  let n = i64(1)
  while is-ok(c) and not is-at-byte(c, \])
    let item = derive(c, joined(name, "-item"), src)
    if is-bad(item)
      return item
    if not is-same-type(head.ty, item.ty)
      return derived-bad(disagreement("vector inside a set", src, open.pos, n, head.ty, item.ty))
    n += 1
  expect(c, tok-vec-close)
  if not is-key-type(head.ty)
    return derived-bad(joined3("a set of vectors of ", render(head.ty), " 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 = head.ty
      read1 = head.reader
      count = Form.Int{.i n}
  ok-derived(quasiquote([~count ~elem]), head.decls,
             quasiquote(let([arr array(~count, ~elem) i 0], expect(c, tok-vec-open), while(is-ok(c) and not is-at-byte(c, \]) and i < ~count, set(arr[i], ~read1), set(i, i + 1)), expect(c, tok-vec-close), arr)))

fn- disagreement(what: str, src: [const u8], at-pos: i32, n: i64, first: Form, second: Form) -> str
  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.
fn- derive-map(c: Ptr(Cursor), name: str, at-pos: i32, src: [const u8]) -> Derived
  if is-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 is-ok(c) and not is-at-byte(c, \})
    let k = next(c)
    if not is-ok(c)
      return derived-bad(joined3("the data file could not be read at ", where(src, error-pos(c)), joined(": ", error-message(c.err))))
    if k.kind != tok-keyword
      return derived-bad(joined3(joined3("the map at ", where(src, at-pos), " has a key at "), where(src, k.pos), " 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(k.text)
    let d = derive(c, joined3(name, "-", fname), src)
    if is-bad(d)
      return d
    for i in range(length(d.decls))
      push(decls, d.decls[i])
    push(fields, Form.Sym{.s fname})
    push(fields, d.ty)
    let dot = Form.Sym{.s joined(".", fname)}
        lit = Form.Str{.s fname}
        bit = Form.Int{.i i64(1) << idx}
        read1 = d.reader
    push(clauses, quasiquote(is-keyword-equal(k, ~lit)))
    push(clauses,
         quasiquote(do(set(~dot(out), ~read1), set(seen, 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,
         quasiquote(when seen && ~bit == 0 then signal(SchemaDrift{.field ~lit .struct ~(Form.Str{.s name}) .is-extra false .pos k.pos})))
    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, quasiquote(:else))
  push(clauses,
       quasiquote(do(signal(SchemaDrift{.field copy-text(k.text) .struct ~(Form.Str{.s name}) .is-extra true .pos k.pos}), when not skip-value(c) then return out)))
  let sname = Form.Sym{.s name}
      rname = Form.Sym{.s joined("read-", name)}
  let (struct) = quasiquote(defstruct(~sname, ~(Form.Vec{.xs slice(fields)})))
  let reader =
    quote
      defn(~rname, [c Ptr(Cursor) a Allocator], ~sname):
        let out = ~sname({})
            seen = 0
        expect(c, tok-map-open)
        while is-ok(c)
          let k = next(c)
          if not is-ok(c) or k.kind == tok-map-close
            ~@(slice(missing))
            return out
          if k.kind != tok-keyword
            fail(c, err-unexpected-token, k.pos)
            return out
          cond(~@(slice(clauses)))
        out
  push(decls, struct)
  push(decls, reader)
  ok-derived(sname, slice(decls), quasiquote(~rname(c, a)))

;; ── Comparing and rendering a type form ─────────────────────────────

fn- is-same-type(a: Form, b: Form) -> bool
  is-bytes-equal(bytes-view(render(a)), bytes-view(render(b)))

;; A type form as text, for the refusals. Only the shapes this file builds — a
;; name, a number, `(Vec T)`, `(Map K V)` and `[n T]` — because nothing else
;; ever reaches it.
fn render(f: Form) -> str
  match f
    Form.Sym(s) -> s
    Form.Int(i) -> i64->string(i)
    Form.List(xs) -> joined3("(", render-items(xs), ")")
    Form.Vec(xs) -> joined3("[", render-items(xs), "]")
    _ -> "?"

fn- render-items(xs: [Form]) -> str
  let out = ""
  for i in range(length(xs))
    out = (if i == 0 then render(xs[i]) else joined3(out, " ", render(xs[i])))
  out

;; 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.
fn- is-key-type(t: Form) -> bool
  let s = bytes-view(render(t))
  is-bytes-equal(s, bytes-view("i64")) or (is-bytes-equal(s, bytes-view("bool")) or is-bytes-equal(s, bytes-view("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.
macro defedn(& args)
  if length(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")
  else
    match args[1]
      Form.Str(path) ->
        match args[0]
          Form.Sym(name) ->
            match macro-slurp(path)
              Some(src) -> provide(name, path, src)
              None ->
                refuse(joined3("there is no file at ", path, ", read relative to the file this 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")

fn- provide(name: str, path: str, src: [const u8]) -> Form
  let cur = cursor(src)
      d = derive(addr(cur), name, src)
  if is-bad(d)
    refuse(d.bad)
  else
    if not next(addr(cur)).kind == tok-eof
      refuse(joined3(path, " holds more than one value, and a defedn derives one struct from one", ""))
    else
      let sname = Form.Sym{.s name}
          rname = Form.Sym{.s joined("read-", name)}
          bname = Form.Sym{.s joined(name, "-of-bytes")}
          fname = Form.Sym{.s joined(name, "-read-file")}
      quote
        ~@(d.decls)
        ;; 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 [const u8] a Allocator], ~sname):
          let c = cursor(b)
              out = ~rname(addr(c), a)
          ;; The cursor is made and dropped here, so this is the only
          ;; place that can ask whether the read worked. See ReadFailed.
          if not is-ok(addr(c))
            signal(ReadFailed{.struct ~(Form.Str{.s name}) .code c.err .pos c.err-pos})
          out
        defn(~fname, [p str a Allocator], ~sname):
          let b = slurp(p, a)
          ~bname(slice(b), a)

;; A refusal, as a declaration. `compile-error` is an expression and a
;; top-level position takes a declaration, so it goes in the body of a function
;; nothing calls: the checker walks it, the arm fires, and `Loc.from_macro` has
;; already put the report on the `defedn` the author wrote. The name is a
;; gensym, so two refusals in one file are two reports rather than a name
;; defined twice.
fn- refuse(msg: str) -> Form
  quote
    defn(~(gensym()), [], (), compile-error(~(Form.Str{.s msg})))