JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge: a macro reads the file, and the struct is the file's shape

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-19 09:58:25 +07:00
commit 1d74a4f694
19 changed files with 2131 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
NEXT.md
View File

@ -1073,8 +1073,15 @@ rather than cumulative, which is a deliberate divergence from `watch.clj` argued
five numbers, and the window is the editor's". **Item 6 landed the same day**:
`test/programs/frame-rollback.flan` is the worked example — `snapshot` at the top of the frame, `restore` in the
`continue` clause — and `bounds-condition.flan`'s half-written abandoned frame is the thought it finishes. That was
the last Tier 1 item anyone was going to move. Items 7 (`drop`), 8 (generics) and 9 (`(read-edn T bytes)`) are still
on that list and still deferred with reasons written beside each; none is a blocker for this game.
the last Tier 1 item anyone was going to move. **Item 9 (`(read-edn T bytes)`) landed 2026-09-19**, and not as
`read-edn`: `(edn/defedn Tileset "assets/tileset.edn")` derives the struct from the *file* at compile time and
emits a reader with it, so the ~80 lines `docs/PORTING.md` prices for two schemas are not written by hand and not
written by the compiler either. It is a macro in `vendor:edn`, and `defjson` is the same over `vendor:json`. The
competing answer PORTING names — compile-time embedding — is not a competitor after all but the other half: the
shape comes from the file at compile time and the bytes may come from an `embed` beside it. See
[`docs/BUILT.md`](docs/BUILT.md), "A type provider: the struct a data file implies". Items 7 (`drop`) and 8
(generics) are still on that list and still deferred with reasons written beside each; neither is a blocker for
this game.
**What `docs/PORTING.md` says NOT to build, with evidence:** escaping closures (one capture site, fixed by one parameter),
`Handle`/pools, `Result`/`try`, `handler-case`, `loop`/`recur` and tail calls, user allocators, structural typing —

175
docs/BUILT.md
View File

@ -5804,3 +5804,178 @@ the same comparison the prelude uses. An infinity still prints signed: there the
the value, and the backends were always agreed about it. Pinned in
`test/programs/format.flan`, which is in the x86 survey corpus, so one program holds both
the printed form under `dune test` and the agreement under the survey.
## A type provider: the struct a data file implies, derived while the program is compiled
`(edn/defedn Tileset "assets/tileset.edn")` reads the file at expansion time, works out
what shape it is, and answers the struct that shape implies together with a reader over
the tokenizer next door. `(.texture-path data)` is then a field load off a struct nobody
declared: no `Value`, no `match`, no runtime tag, nothing looked up by name. F#'s type
providers with the useful half and none of the plugin protocol, and `vendor/json`'s
`defjson` is the same thing over a different grammar.
Both are macros in their packages, not compiler builtins. That was the requirement and it
held, but only after four things the macro system did not have. Each is general and none
of them mentions EDN.
### A macro may read a file, at the path the call site is written at
`(embed "assets/x.edn")` resolves against the directory of the *source file the form is
written in* — check.ml's `embed_path`, and Odin's rule before it — because anything else
makes a package's assets depend on where `flan` happened to be invoked from. A macro had
no way to honour that rule: it runs inside the compiler and could always have called
`slurp`, but a `Form` carries no location, deliberately, so a macro handed
`(defedn T "assets/x.edn")` knows the path and not what it is relative to.
So the compiler tells it. `lib/macro.ml`'s `dir_of` pokes the call site's directory into
two C symbols in the macro module's own `flan_rt.c` before every expansion, and the
prelude's `(macro-slurp "...")` joins the two. C data and not a Flan global because
`Build.macro_module` emits with hidden visibility and only the `flan.macro.*` thunks stay
exported — the other half of that same comment is that the C goes on resolving the way it
always did, which is what makes these findable.
It answers `None` rather than signalling, and that is why it is not `slurp`. A condition
raised inside an expansion is raised in the compiler, through the module's own copy of the
runtime, which is the failure `Build.macro_module`'s hidden-visibility note measured: it
takes the process down instead of parking it. Absence arriving as an answer is what lets
a provider refuse *about* a missing file, with a location, which is the sentence its
author wanted anyway.
Re-expansion re-reads, and nothing had to be built for that: the cached macro module holds
the macro's code, not the data, and `expand_form` calls the macro fresh. Editing the
`.edn` and building again produces the struct that file now implies — measured by adding
a key and finding it in the emitted IR.
### A package's macro may call the package's functions
`Load.qualify_macro` already renamed a package macro's body so a call to the package's own
`next` reads `edn/next`; the intent was written down. The module was then compiled from
the prelude and the `defmacro`s alone, so the call arrived at the checker as *the call
edn/next into an imported package*. That was the machinery missing a piece, not a rule —
and it is why a derivation this size can be ordinary Flan over the tokenizer next door
instead of a second scanner inlined into a macro body.
`Parse.imported_decls` carries the package's declarations beside its macros, already
qualified, and `Macro.compile` trims them to what the macro bodies reach. raylib's five
`with-*` are pure quasiquote, so nothing of raylib is reachable and its module is the one
it always was — which matters, because raylib's declarations are `declare`s against a
library a macro module has no linker argument for. The trim is over names and happens
before `Check`, since a surviving `Declare` would be emitted whether or not the checker
was asked about it.
One thing this exposed. A quasiquote inside a package's *ordinary function* was never
qualified — only a `defmacro` 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 exactly
the property the expander's walk depends on and exactly what puts it out of a rename's
reach. `rename_expr` now qualifies a literal `(Form.Sym {.s "..."})` naming something the
package owns. Until a package's macros could call its functions there was no helper that
built code, so this could not have shown before.
### One call, several declarations
Expansion is form-for-form, and every macro written until now expanded to an *expression*.
A provider produces the struct *and* the reader over it, and a struct per nesting level in
the data: three declarations and more from one form, which no arrangement of one-for-one
reaches. A top-level `(do ...)` is now its items, spliced in place, after expansion and
before the declaration walk. Nobody writes one in a file, and the single-declaration entry
point says so by name for anyone who tries.
### `compile-error`, because a name carries a name and not a sentence
This is the one piece that had to go in the compiler, and the prelude's `unless` had
already written down why: *a macro has no error facility, so a malformed call answers a
name nothing defines and the report is the right place with the wrong sentence.* A
provider's refusals are all sentence — *the third element of this vector is a string where
the first two were integers*, at line 3 column 9 of a file the compiler is not reading —
and no symbol an expansion could invent holds that.
So a macro that has to refuse expands to `(compile-error "...")`, one arm in check.ml's
builtin match. A builtin because it has to fail *while checking*: a declared function
would compile, link and run, and the compile it was meant to stop would have succeeded.
`Loc.from_macro` already stamps the call site onto every node of an expansion, so the
location is the form the author wrote and the sentence is the macro's — the two halves the
prelude's note says are never both right at once. It is wrapped in a `defn` with a
gensym'd name, because a top-level position takes a declaration and the body is where an
expression the checker walks can live.
### The rules it derives, and the one the game file decided
A map with keyword keys is a struct, one field per key. An integer is `i64`, a float
`f64`, a boolean `bool`, a string `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 `(Vec T)`. A nested map is a
struct named for the path that reaches it, `Tileset-selected-cells`, with a hyphen because
`/` is package qualification and because every name in this language is hyphenated
already, so no case conversion has to be written at macro time.
The set rule is the one the real file decided. A set is this repo's `(Map T bool)` —
check.ml says exactly that where it refuses a `()` value — so its elements are map *keys*,
and a vector inside a set is therefore a fixed array `[n T]` and not a `(Vec T)`: a Vec is
not a map key and `[2 i64]` is. `game-data.edn` is a set of `[x y]` pairs, so that is the
case rather than a corner of it. Every element must then be the same *length* as well as
the same shape, which falls out of the type comparison already being made, since the
length is in the type.
Everything else is refused while expanding, with the line and column in the **data** file:
a heterogeneous collection names both positions, an empty one has no element to derive
from, a `nil` has no type, and a map with a key that is not a keyword is not a struct. A
file the compiler could not make sense of is one the program would have read wrongly.
`(vec-new)` and `(map-new)` have to be *told* what they build by naming a type, and
`(Vec i64)` and `[2 i64]` have no name to be. Both fall back to what the context wants and
a signature is a type position where anything can be written, so each collection gets a
one-line constructor stating its type. The reader reads better for it: it says
`(cells-new a)` where it would otherwise carry a type nobody wrote.
### Two conditions at read time, for the two ways a file stops matching
The struct was derived from the file as it was when the program was compiled.
`SchemaDrift` names a key that has arrived or a field that has gone, once each, because a
missing key otherwise leaves a field at zero — a texture path of `""` and a count of `0` —
and the program draws nothing for a reason nothing reports. `ReadFailed` is the louder
one: a generated reader accumulates errors on the cursor, and the cursor is made and
dropped inside the entry point, so a file that does not parse would have handed back a
zeroed struct with nothing said. `read-file` answers an `Option` precisely so a malformed
document is distinguishable from one that is literally nil, and a derived reader is held
to the same honesty. Neither is fatal: signalling a condition no handler takes carries on,
so a program that would rather not care writes nothing.
### What `defjson` shares, which is the design and not the code
`vendor/json` imports `vendor/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 shape
of the answer — one walk giving a type, the declarations it needs and the expression that
reads one; a refusal carried in a field rather than raised; the typed constructor per
collection; the gensym'd `compile-error` wrapper.
Four things are genuinely different. Strings go through `string-of` and never through
`.text`, because `.text` is the raw interior with escapes undecoded and a field read off
it would hold a backslash and an `n` where the file meant a newline. Commas and colons are
tokens rather than whitespace. An object's keys are strings, so a key is refused when it
is not a name a program could write, and refused again when it carries an escape — the
generated reader compares against the bytes as written, which costs no allocation per key
and is only the same question when the name is written plainly. And there are no sets, so
there is no map-key path and no fixed array: every collection is a `(Vec T)`, and
`defjson` is the smaller of the two by half. JSON has no integer type either; the
tokenizer draws the line at whether a number has a fraction or an exponent, which is the
only line there is, so `1` derives `i64` and `1.0` derives `f64`.
### What is checked
`test/programs/edn-provide.flan` reads the real `assets/edn/tileset.edn` through a derived
struct, 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 — `[3 4]` is a key and `[9 9]` is not, where a version that made the set 108 loose
integers would have compiled and answered differently on all four.
The refusals write their own data file, because the data file *is* the test, and each is
asserted on the position it names rather than on the fact of failing. One checks a line
and column into a file the compiler is not reading, which is the whole of what
`compile-error` was added for. `test_session.ml` expands a `defedn` through a session at
an origin the editor would have sent, which is the `C-c C-m` path and the live-tuning
loop: it asserts both that the data file resolved against the buffer's directory and that
what comes back is code a person can read. The generated readers survey under `@x86` — the
fixed-array map key is a hash and equality pair nothing generated had asked the backend
for before — and `@sanitize` is clean over both programs.

22
docs/PORTING.md
View File

@ -214,10 +214,11 @@ tileset file itself.
So this is writable today, and the tileset needs no hand-written reader at all: it reads
as a `Value.Table` whose `:selected-cells` is a `Value.Set` of pairs, against an arena,
released by one `free-all`. A hand-written reader is still what a *struct* costs, because
`(read-edn T bytes)` is not built — call it ~80 lines for the bitmask table if it wants
to land in a struct rather than a `Value`. See §3 for whether it should be written at
all.
released by one `free-all`. A hand-written reader is no longer what a *struct* costs:
`(edn/defedn Tileset "assets/tileset.edn")` derives the struct from the file while the
program is compiled and emits the reader with it, so the ~80 lines this used to price are
not written at all. See §3 item 9, and `docs/BUILT.md`, "A type provider: the struct a
data file implies".
---
@ -629,10 +630,15 @@ not compete for the same slot.
game rather than in the engine. **Do not sequence it ahead of items 4–6 on this game's
account.**
9. **`(read-edn T bytes)`.** `vendor:edn` already makes the asset readers writable; this
removes ~80 lines of hand-written cursor walking for two schemas. Convenience, and it
competes with compile-time embedding, which may be the better answer for both files
anyway.
9. ~~**`(read-edn T bytes)`.**~~ **Built**, and not under that name: `(edn/defedn Tileset
"assets/tileset.edn")` reads the *file* while the program is compiled, derives the
struct its shape implies, and emits a reader with it — so the ~80 lines are neither
hand-written nor written by the compiler from a type that was declared by hand. It is a
macro in `vendor:edn`, not a builtin, and `defjson` is the same over `vendor:json`.
The competition with compile-time embedding was the wrong reading of it: they are the
two halves of one answer, the shape from the file at compile time and the bytes from an
`embed` beside it. See `docs/BUILT.md`, "A type provider: the struct a data file
implies".
**Not ranked, because this game does not need them:** escaping closures and capture (one
site, fixed by one parameter), `Handle` and pools (nothing to pool), `Result`/`try`

39
lib/check.ml
View File

@ -4683,6 +4683,41 @@ and named_call ctx ~want loc name args =
| _ ->
fail loc
"embed is (embed \"path\") for a [u8], or (embed \"path\" string)")
(* ── What a macro says when it has to refuse ───────────────────
The one thing a macro could not do, written down in the prelude where
[unless] settles for it: "a macro has no error facility: it runs inside
the compiler and anything it signals aborts the compile with no location.
So a malformed (unless) answers a name nothing defines, and the report is
'unknown name unless-takes-a-test-and-a-body' at the call site, which is
the right place and the wrong sentence."
A name nothing defines carries a name. It cannot carry a sentence, and a
type provider's refusals are all sentence: the third element of this
vector is a string where the first two were integers; there is no file at
assets/x.edn; :size is a map with keys of two kinds. Those name a position
in a *data* file, which no symbol the expansion could invent will hold.
So a macro that has to refuse expands to a call to this, and the string is
the report. [Loc.from_macro] has already stamped the call site onto every
node of the expansion, so the location is the [defedn] the author wrote
and the sentence is the macro's — which is the two halves the prelude's
note says are never both right at once.
A builtin and not a declaration, because it has to fail *here*: a declared
function would compile, link and run, and the compile it was meant to stop
would have succeeded. The whole of it is one arm, and the argument is a
literal for the same reason [embed]'s path is one — there is nothing at
this point in a compile to compute a string from. *)
| "compile-error" ->
arity loc name 1 args;
(match (List.hd args).Ast.e with
| Ast.Str s -> fail loc "%s" s
| _ ->
fail (List.hd args).Ast.loc
"compile-error takes a literal string — it is reported while the \
program is being checked, so there is nothing here to build one \
from. A macro that has to refuse builds the sentence as it expands \
and puts it in the form")
| "embed-dir" ->
arity loc name 1 args;
let arg = List.hd args in
@ -5780,6 +5815,10 @@ let builtins : (string * string * string) list =
("embed-dir", "embed-dir [\"path\"] [n EmbedFile]",
"Every file in the directory, read at compile time, as a fixed array of \
EmbedFile. It does not descend.");
("compile-error", "compile-error [\"message\"] ()",
"Refuses the compile with that message, at the form it is written in. \
What a macro expands to when it has to say why: a name nothing defines \
carries a name, and this carries a sentence.");
(* files *)
("slurp", "slurp [string Allocator?] (Vec u8)",

35
lib/load.ml
View File

@ -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)
@ -965,12 +990,17 @@ let rec import ~seen ~open_ ~loc alias dir =
let nested_macros =
List.fold_left (fun acc r -> macro_union acc r.macros) [] nested
in
(* Beside the macros, what those macros may call — see the note over
[Parse.imported_decls]. The same set the package's own files are checked
against, so a macro of a package this one imports is compiled against
exactly what its author could see. *)
let nested_decls = List.concat_map (fun r -> r.decls) nested in
(* The package's own files, parsed with what it imported in front of them
and nothing else. A parent's macros are deliberately not here: this
package did not import that parent, and a name it never asked for is not
one it should be able to call. *)
let ds =
Parse.with_imported nested_macros
Parse.with_imported ~decls:nested_decls nested_macros
(fun () -> List.concat_map (fun (_, forms) -> Parse.program forms) sources)
in
(* [main] is the importer's, always. A package that called its own would
@ -1319,7 +1349,8 @@ let program ?(parse = Parse.program) ~file (forms : Form.t list) : t =
(imports_of forms)
in
let decls =
Parse.with_imported (macro_union imported.macros !Parse.imported_macros)
Parse.with_imported ~decls:(imported.decls @ !Parse.imported_decls)
(macro_union imported.macros !Parse.imported_macros)
(fun () -> parse forms)
in
let t =

165
lib/macro.ml
View File

@ -82,11 +82,23 @@ let self =
| Some s when s <> "" -> s
| _ -> Build.stamp_of Sys.executable_name)
let key (extra : Form.t list) =
(* [support] is in the key for the same reason the prelude's text is: it is
compiled into the module, so a package whose functions changed while its
macros did not is a stale [.so] that the extras alone would not notice.
[Marshal] and not a printer, because [Ast] has no printer and one written
for a cache key would be a second rendering of the tree to keep in step with
the first. The declarations are plain data — variants, strings, floats and
locations, no closures and no abstract blocks — so the image is structural,
and it moves when a location does. That direction is the safe one: a
cosmetic edit above a package's functions costs a rebuild of the module, and
nothing costs a stale one. *)
let key ?(support = []) (extra : Form.t list) =
Digest.to_hex
(Digest.string
(Lazy.force self ^ "\000" ^ Prelude.source ^ "\000"
^ String.concat "\000" (List.map Form.to_string extra)))
^ String.concat "\000" (List.map Form.to_string extra)
^ "\000"
^ (if support = [] then "" else Marshal.to_string support [])))
(* True while a macro module is being built. [Build.macro_module] goes through
[Check.program], which parses the prelude, which calls back into
@ -163,9 +175,99 @@ let reduce (forms : Form.t list) : Form.t list =
| _ -> true)
forms
(* ── What a package's macro may call ────────────────────────────────
The header above says a macro body may call prelude functions and other
macros and nothing else, and for a macro written in a *package* that was the
machinery missing a piece rather than a rule. [Load.qualify_macro] renames
the body so a call to the package's own [next] reads [edn/next] — it says
the intent plainly — and the module was then compiled without anything of
that name in it, so the call arrived at the checker as "the call edn/next
into an imported package".
So [Parse.imported_decls] carries the package's declarations beside its
macros, already qualified, and they go into the module. Trimmed to what the
macros actually reach, for two reasons that are both about programs whose
macros want none of this: raylib's five [with-*] are pure quasiquote, so
nothing of raylib is reachable and the module is the one it always was — and
raylib's declarations are [declare]s against a library this link has no
argument for, so a module that took the whole package would fail to link
for every program that draws anything.
Reachability over names and not over [Reach]'s checked program, because the
trim has to happen *before* [Check]: an [Ast.Declare] that survived into the
module would be emitted whether or not the checker was ever asked about it.
A type is reached the same way a function is — [Load.uses] walks signatures
and bodies alike — which is what keeps [edn/Cursor] in when [edn/next] is. *)
let support (roots : string list) (ds : Ast.decl list) : Ast.decl list =
if ds = [] then []
else begin
let want = Hashtbl.create 64 in
List.iter (fun n -> Hashtbl.replace want n ()) roots;
(* Fixpoint over the declarations, since a kept one names more. Bounded by
their number: the set only grows and a pass that adds nothing stops. *)
let changed = ref true in
while !changed do
changed := false;
List.iter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n when Hashtbl.mem want n ->
List.iter
(fun (u, _) ->
if not (Hashtbl.mem want u) then begin
Hashtbl.replace want u ();
changed := true
end)
(Load.uses [ d ])
| _ -> ())
ds
done;
List.filter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n -> Hashtbl.mem want n
| None -> false)
ds
end
(* The names a macro's text mentions, which is the root set above. Every symbol
in the body, because a macro body reaches a package's names as calls, as
types in a [let]'s initialiser and as data-type cases — and over-rooting only
ever keeps a declaration that would have compiled anyway. *)
let roots_of (extra : Form.t list) =
List.fold_left (fun acc f -> Load.form_syms f acc) [] extra
let compile (names : string list) (extra : Form.t list) : loaded =
(* The macros themselves are in [imported_decls] too — a [defmacro] is an
[Ast.Defn] by the time [Parse] is finished with it, and [Load] qualifies
and carries it like any other declaration. They arrive here a second time
in [extra], which is where their *current* text is, so the copy in the
support set is dropped rather than reaching the checker as a name defined
twice. Current matters: a session that has just re-evaluated a macro holds
the new body in [macros] and the old one in [decls]. *)
(* Deduped by name as well as filtered, and the dedupe is not belt and
braces. [Load.program] extends the ambient set rather than replacing it —
a session has already set its own when it calls — so a package reached
along two routes, or a file reloaded inside a session that already knows
it, arrives twice. Two declarations of one name reach [Check.program] as a
redefinition, refused with a sentence nobody would connect to this. It is
the rule [Load.macro_union] already applies a level up, applied to the
declarations that now travel with those macros. *)
let support =
let seen = Hashtbl.create 64 in
List.filter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n when List.mem n names -> false
| Some n -> if Hashtbl.mem seen n then false
else (Hashtbl.add seen n (); true)
| None -> true)
(support (roots_of extra) !Parse.imported_decls)
in
let out =
Filename.concat (Build.cachedir ()) ("flan-macros-" ^ key extra ^ ".so")
Filename.concat (Build.cachedir ())
("flan-macros-" ^ key ~support extra ^ ".so")
in
if not (Sys.file_exists out) then begin
building := true;
@ -177,8 +279,13 @@ let compile (names : string list) (extra : Form.t list) : loaded =
(fun () ->
(* [Check.program] prepends the prelude itself — reduced, for the one
build that cannot have all of it — so only the file's own defmacros
go in here. *)
let p = Check.program (Parse.program extra) in
and the package declarations they reach go in here.
The support comes first: it holds the types a macro's signature
names, and a declaration order that mentioned [edn/Cursor] before
declaring it would be refused for a reason that is this line's and
not the author's. *)
let p = Check.program (support @ Parse.program extra) in
(* Written beside the final name and renamed, so a second process
reading the cache never sees a half-written object. *)
let tmp = out ^ "." ^ string_of_int (Unix.getpid ()) in
@ -189,6 +296,48 @@ let compile (names : string list) (extra : Form.t list) : loaded =
{ handle;
fns = List.map (fun n -> (n, Dynload.dl_sym handle ("flan.macro." ^ n))) names }
(* ── Where the call site is ────────────────────────────────────────
The one thing a macro cannot find out for itself and the one it needs to
read a data file: a Form carries no location — deliberately, see
[Expand.unmarshal] — so a macro handed [(defedn T "assets/x.edn")] knows the
path and not what it is relative to. [(embed "assets/x.edn")] resolves
against the directory of the source file the form is written in, and a macro
reading a file has to resolve it the same way or a package's data would
depend on where flan was invoked from.
So it is poked in before the call, into the two C symbols the module's own
[flan_rt.c] declares for it. C data and not a Flan global because
[Build.macro_module] emits with hidden visibility and only the
[flan.macro.*] thunks stay exported — the same comment's other half is that
the C goes on resolving the way it always did, which is what makes these two
findable.
Set per call rather than once per module: one expansion walks the prelude's
forms, the file's own and a package's, and a macro called from a package's
source resolves against *that* file's directory. [Filename.dirname] is
[embed_path]'s own move, and an empty answer — a bare filename with no
directory in it — leaves the length at zero, which the runtime reads as "no
better idea than the process's own directory". *)
let dir_of (l : loaded) (loc : Loc.t) =
let dir = Filename.dirname loc.Loc.file in
let dir = if String.equal dir "." then "" else dir in
(* Not guarded. The symbol is in the module this just built, so its absence
means [runtime/flan_rt.c] and this file have come apart — and the shape
that failure would take if it were swallowed is a relative path resolving
against the compiler's working directory, which reads some *other* file
and says nothing. A missing symbol raises out of [dl_sym] instead. *)
let buf = Dynload.dl_sym l.handle "flan_macro_dir" in
let n = Dynload.dl_sym l.handle "flan_macro_dir_n" in
(* 4096 is FLAN_PATH_MAX, and a path at or over it is left unset rather than
truncated: half a directory is a path that resolves to the wrong file,
where none at all resolves to none. *)
if String.length dir > 0 && String.length dir < 4096 then begin
Dynload.poke_bytes buf 0 dir;
Dynload.poke_i64 n 0 (Int64.of_int (String.length dir))
end
else Dynload.poke_i64 n 0 0L
(* ── The walk ──────────────────────────────────────────────────────
Bottom up: a macro's arguments are expanded before it is called, so nothing
a macro is handed contains a call to another macro. Then what it answers is
@ -212,6 +361,7 @@ let rec expand_form (l : loaded) (f : Form.t) : Form.t =
every form it produced knows where it came from and an error on one of
them can say so. *)
let from = Loc.from_macro n loc in
dir_of l loc;
settle l n loc (Expand.call ~loc:from (List.assoc n l.fns) args) fuel
| Form.List xs -> Form.make (Form.List (List.map (expand_form l) xs)) loc
| Form.Vec xs -> Form.make (Form.Vec (List.map (expand_form l) xs)) loc
@ -230,6 +380,7 @@ and settle l first loc (f : Form.t) left =
else begin
let args = List.map (expand_form l) args in
let from = Loc.from_macro m loc in
dir_of l loc;
settle l first loc (Expand.call ~loc:from (List.assoc m l.fns) args)
(left - 1)
end
@ -416,6 +567,10 @@ let expand_step (f : Form.t) : Form.t * string option =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym n; _ } :: args)
when List.mem_assoc n l.fns ->
(* [C-c C-m] over a type provider reads the data file, which is the
whole of what makes the live loop live: edit the .edn, expand
again, see the struct that file now implies. *)
dir_of l f.Form.loc;
( Expand.call ~loc:(Loc.from_macro n f.Form.loc) (List.assoc n l.fns)
args,
Some n )

72
lib/parse.ml
View File

@ -1219,6 +1219,15 @@ let rec decl (f : Form.t) : Ast.decl =
| _ ->
fail f "defmacro is (defmacro name [param ...] body ...)")
(* Only reachable from the single-declaration entry point below: a file's
forms go through [splice] first, and a [do] there is its items. Said by
name because the two paths differ and the difference is not the author's
fault to guess at. *)
| List ({ v = Sym "do"; _ } :: _) ->
fail f
"a top-level (do ...) is several declarations spliced in place, and this \
is a position that takes exactly one — a macro answering several is a \
file's form, not an expression's"
| List ({ v = Sym s; _ } :: _) -> fail f "unknown top-level form (%s ...)" s
| _ -> fail f "expected a top-level declaration, found %s" (Form.to_string f)
@ -1255,10 +1264,40 @@ let expander : (Form.t list -> Form.t list) ref = ref (fun fs -> fs)
whole of an evaluation. Empty is the ordinary case and costs nothing. *)
let imported_macros : Form.t list ref = ref []
let with_imported (ms : Form.t list) (f : unit -> 'a) : 'a =
(* What those macros are allowed to *call*, and it is the same list the
importing program gets: the package's declarations, qualified under the
alias, as [Load] already built them.
A macro module is compiled from the prelude plus the [defmacro]s, so until
now the header's rule held without anything enforcing it — a macro body
could call prelude functions and other macros and nothing else. A package
macro that called one of its own package's functions was renamed to
[alias/fn] by [Load.rename_form], reached the checker with nothing of that
name declared, and was refused as a call into an imported package.
That refusal was the machinery missing a piece rather than a rule. The
rename says the intent plainly: what a package's macro answers with, and
what its body calls, is spelled the way the importer spells it. So the
declarations travel beside the macros and go into the module with them.
[Macro.compile] prunes them to what the macros actually reach, so a package
whose macros are pure quasiquote — raylib's five [with-*] — pays nothing and
links nothing new.
An [Ast.decl list] and not forms, because [Load] has already done the
qualifying over the Ast and a second renamer over [Form] would be that work
written twice, in the file where the two copies could disagree silently. *)
let imported_decls : Ast.decl list ref = ref []
let with_imported ?(decls = []) (ms : Form.t list) (f : unit -> 'a) : 'a =
let saved = !imported_macros in
let saved_decls = !imported_decls in
imported_macros := ms;
Fun.protect ~finally:(fun () -> imported_macros := saved) f
imported_decls := decls;
Fun.protect
~finally:(fun () ->
imported_macros := saved;
imported_decls := saved_decls)
f
(* Two entry points and not one function with a flag, and the reason is the
daemon. [Loc.Errors] is a second exception, and the handlers in the session
@ -1273,12 +1312,41 @@ let with_imported (ms : Form.t list) (f : unit -> 'a) : 'a =
here: the reader already found where each declaration ends, so skipping a
bad one costs nothing and cannot lose its place. Inside a declaration there
is no such landmark, so one bad [defn] is one error. *)
(* ── One call, several declarations ────────────────────────────────
Expansion is form-for-form: [Macro.expand_form] answers one [Form.t] per
input and the loop below turns each into one [Ast.decl]. Every macro written
until now expands to an *expression* — [unless], [into], raylib's [with-*] —
so one-for-one was the whole of what was needed.
A type provider is the first thing that is not. [(defedn Tileset "t.edn")]
has to produce the struct *and* the reader over it, and a nested map in the
data means a struct per nesting level: three declarations and more from one
form. There is no arrangement of one-for-one that reaches that.
So a [do] at the top level is its items, in place. It is the sequencing
spelling the language already has, it is Clojure's answer to exactly this,
and it is only ever reachable by a macro: nobody writes [(do (defn ...))] in
a file, and the message below still says so for anyone who tries and wrote
it wrong. Recursive, because a macro that splices what another macro
answered has a [do] inside a [do] and the nesting is not the author's to
flatten by hand.
It is spliced *after* expansion and before the declaration walk, so what is
spliced is already fully expanded — a [do] holding a call to another macro
settled before it got here. *)
let rec splice (f : Form.t) : Form.t list =
match f.Form.v with
| Form.List ({ Form.v = Form.Sym "do"; _ } :: items) ->
List.concat_map splice items
| _ -> [ f ]
let parse_forms ~keep_going (forms : Form.t list) : Ast.decl list =
(* Quasiquote first and always, because it is pure and needs nothing loaded:
it is what turns a macro body into ordinary code, and the prelude's own
macros have to parse in a process that has not built a macro module yet.
Then expansion, which may need one. *)
let forms = !expander (List.map Expand.quasiquote forms) in
let forms = List.concat_map splice forms in
temps := 0;
let s = Loc.sink ~on:keep_going in
let decls = List.filter_map (fun f -> Loc.caught s (fun () -> decl f)) forms in

35
lib/prelude.ml
View File

@ -1794,6 +1794,41 @@ let source = {flan|
(let [n (i64 0)]
(if (= (file-stat-raw path (addr n)) 1) (Some n) None)))
;; ── Reading a file while a macro runs ─────────────────────────────────
;;
;; The one thing a macro needed that it could not write for itself. A macro is
;; compiled and dlopened into the compiler, so `slurp` was always callable from
;; one; what was missing is that a macro has no idea where its call site is,
;; and so no way to resolve a path the way `(embed "assets/x.edn")` resolves
;; one — relative to the directory of the source file the form is written in.
;;
;; This is that rule, and it is the *same* rule: the compiler pokes the call
;; site's directory into the runtime before every expansion (runtime/flan_rt.c,
;; "Reading a file while a macro runs", and lib/macro.ml's expand_form), and a
;; relative path is joined to it. An absolute path is taken as written.
;;
;; **None rather than a condition**, which is the whole reason this is not
;; `slurp`. A condition signalled inside an expansion is signalled *in the
;; compiler*, through the macro module's own copy of the runtime, and that is
;; the failure `Build.macro_module`'s hidden-visibility note measured: it takes
;; the process down instead of parking it. Absence arriving as an answer is
;; what lets a type provider say "there is no file at that path" as a refusal
;; with a location, which is the sentence its author wanted anyway.
;;
;; **Outside a macro it is still a read**, with the path relative to the
;; process rather than to any source file — nothing else knows better, and
;; every program links this runtime. It is not a file API and `slurp` is; this
;; exists so a macro can look at data at compile time.
(declare macro-slurp-raw [path string out-len (Ptr i64)] (Ptr u8)
"flan_macro_slurp")
(defn macro-slurp [path string] (Option [u8])
(let [n (i64 0)
p (macro-slurp-raw path (addr n))]
(if (< n 0)
None
(Some (slice-from-ptr p (i32 n))))))
;; ── Form: what a macro takes and what it answers ──────────────────────
;;
;; The reader's output, mirrored on the Flan side, because a macro is a

32
lib/session.ml
View File

@ -122,6 +122,32 @@ let create ?(debug = false) ?(x86 = false) ~file () =
macros = Load.macro_union (own_macros forms) l.Load.macros;
thunks = 0; debug; x86 }, l)
(* What a macro may call, for the same reason [macros] is held: an evaluation
parses one form with no import in sight, and a package macro whose body
calls its own package's functions has to find them. [Load.program] hands
this to [Parse.with_imported] from the import it just read; a session has to
answer it from what it already holds.
Filtered out of [decls] by ownership rather than kept as a second list,
because [decls] is the one thing every redefinition already maintains and a
parallel copy would be a second thing to remember to update. A package's
names are qualified in there — that is what "post-Load: flat, one namespace"
means — so the prefix is the whole test.
The buffer's own declarations are deliberately not here. A macro module is
built from the prelude with no part of the file in it (see [Macro.reduce]'s
header, and the cycle it is about), and a session's [decls] is the file. *)
let package_decls t =
List.filter
(fun (d : Ast.decl) ->
match Ast.declared_name d with
| Some n ->
List.exists
(fun (p : Load.pkg) -> String.starts_with ~prefix:(p.Load.alias ^ "/") n)
t.pkgs
| None -> false)
t.decls
(* Which package a file being edited belongs to, if any.
A form typed into vendor/agent/agent.flan declares [poll], but the running
@ -480,7 +506,7 @@ let restore t h =
let eval ?(origin = "<eval>") ?pause t src : change =
let forms = Reader.read_all ~file:origin src in
Parse.with_imported t.macros @@ fun () ->
Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () ->
(* Through [Load] like any other source, so an evaluated (import ...) means
what it means in a file. Its expansion is what gets spliced, which is also
why the accumulated list is the post-Load one: re-evaluating a file that
@ -1296,7 +1322,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
untouched: a cold macro module costs its ~300ms before that clock starts,
and the non-termination refusals raise [Loc.Error] out of this call, which
the daemon already answers as an error rather than a silence. *)
let parsed = Parse.with_imported t.macros (fun () -> Parse.expr form) in
let parsed = Parse.with_imported ~decls:(package_decls t) t.macros (fun () -> Parse.expr form) in
(* Wrapped before the checker, so the call is checked like any other and a
prelude that stopped offering [pause] would be an ordinary unknown name
rather than a thunk that silently did not stop. The [Do] takes the
@ -1440,7 +1466,7 @@ let macroexpand ?(origin = "<eval>") ~(all : bool) t (src : string) : expansion
let before = Expand.quasiquote form in
(* And the session's macros in front of it, as [eval] and [eval_expr] both
put them: [Macro.program] reads [Parse.imported_macros] directly. *)
Parse.with_imported t.macros @@ fun () ->
Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () ->
let after, name =
if all then Macro.expand_all before else Macro.expand_step before
in

82
runtime/flan_rt.c
View File

@ -2975,6 +2975,88 @@ const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) {
return (const uint8_t *)v;
}
/* ── Reading a file while a macro runs ─────────────────────────────────
*
* A macro is compiled and dlopened into the compiler, so it is ordinary native
* code and could always have called `slurp`. What it could not do is resolve a
* path the way the rest of the language resolves one. (embed "assets/x.edn")
* is relative to the directory of the *source file the form is written in* —
* lib/check.ml's embed_path, and Odin's rule before it — because anything else
* makes a package's assets depend on where flan happened to be invoked from.
* A macro has no idea where its call site is: a Form carries no location, on
* purpose (see the prelude's Form, and Expand.unmarshal).
*
* So the compiler tells it, here. lib/macro.ml dlsym's the two symbols below
* and pokes the call site's directory into them before every expansion; a
* macro-time read joins that to a relative path and opens the result. The
* channel is C data and not a Flan global because Build.macro_module emits the
* module with hidden visibility — only the flan.macro.* thunks stay exported —
* and "the C goes on resolving the way it always did" is the other half of
* that same comment.
*
* It is empty in a process that is not expanding anything, which is every
* process but the compiler: the module links this file, so a *program* holding
* these symbols simply has a relative path mean what it means to the shell.
*
* `slurp` is deliberately not what the prelude wraps around this. slurp
* signals a FileError, and a condition raised inside an expansion is raised in
* the compiler, through the macro module's own copy of the runtime — which is
* the failure Build.macro_module's ~hidden comment measured. Absence answers
* here as a length of -1, on getenv's pattern, so a data file that is not
* there becomes something the macro can refuse *about* rather than a trap. */
char flan_macro_dir[FLAN_PATH_MAX] = { 0 };
int64_t flan_macro_dir_n = 0;
/* The bytes are the caller's to read and nobody's to free: an expansion is
* bounded by the size of the program being compiled, which is exactly the
* budget lib/dynload.ml's `owned` note already spends on a macro's own
* allocations. Leaking is the same decision as there, for the same reason —
* the returned slice is read after the call returns, and there is no `drop`. */
const uint8_t *flan_macro_slurp(const uint8_t *path, int64_t n, int64_t *len) {
static const char empty[1] = { 0 };
char rel[FLAN_PATH_MAX];
char full[FLAN_PATH_MAX];
FILE *f;
long size;
uint8_t *buf;
size_t got;
*len = -1;
if (!flan_path_cstr(path, n, rel)) return (const uint8_t *)empty;
/* An absolute path is taken as written, and a relative one is joined to the
* call site's directory — embed_path's two cases, in the same order. A dir
* that was never poked leaves a relative path relative to the process, which
* is the only thing it can mean when nothing knows better. */
if (rel[0] == '/' || flan_macro_dir_n <= 0) {
memcpy(full, rel, (size_t)n + 1);
} else {
if (flan_macro_dir_n + 1 + n >= FLAN_PATH_MAX) return (const uint8_t *)empty;
memcpy(full, flan_macro_dir, (size_t)flan_macro_dir_n);
full[flan_macro_dir_n] = '/';
memcpy(full + flan_macro_dir_n + 1, rel, (size_t)n + 1);
}
f = fopen(full, "rb");
if (!f) return (const uint8_t *)empty;
/* A directory opens on Linux and fails at the read, which is the trap
* check.ml's read_embed_file records: guarding only the open turns
* (macro-slurp "somedir") into a crash rather than an answer. Both ends are
* guarded here and both answer absent. */
if (fseek(f, 0, SEEK_END) != 0) { fclose(f); return (const uint8_t *)empty; }
size = ftell(f);
if (size < 0 || fseek(f, 0, SEEK_SET) != 0) {
fclose(f);
return (const uint8_t *)empty;
}
buf = (uint8_t *)malloc((size_t)size + 1);
if (!buf) { fclose(f); return (const uint8_t *)empty; }
got = fread(buf, 1, (size_t)size, f);
fclose(f);
if (got != (size_t)size) { free(buf); return (const uint8_t *)empty; }
buf[size] = 0;
*len = (int64_t)size;
return buf;
}
/* ── The rest of the file surface ──────────────────────────────────────
*
* Four more POSIX-shaped calls under the same rules as flan_file_size,

10
test/dune
View File

@ -65,6 +65,9 @@
; fourth file beside those three is a type error in an unrelated program.
; embed-dir does not descend and neither does a glob, so this is its own line.
(glob_files programs/assets/edn/*)
; And the config programs/json-provide.flan derives a struct from, under
; assets/ for the same reason and needing its own line for the same one.
(glob_files programs/assets/json/*)
; The reload primitive's host: a C main that dlopens what Build.shared made.
(file reload_host.c)
; A shared object that is not a redefinition module, for the agent's refusal
@ -103,6 +106,7 @@
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; The raylib bindings and the ported example the raylib case builds. The
; example imports examples/digits.flan, so the directory comes whole.
(glob_files %{workspace_root}/vendor/raylib/*)
@ -149,7 +153,8 @@
; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one
; translation unit here that frees anything, which is what makes it worth a
; sanitized run at all. See [dyn_sweep].
(file dyn_ops.c))
(file dyn_ops.c)
(glob_files programs/assets/json/*))
(action (run ./test_sanitize.exe)))
; The corpus a third time, under Valgrind's memcheck. Its own alias for the
@ -186,6 +191,7 @@
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; The package tree the multi-level cases import, as in the test stanza
; above: a glob per directory, because dune's glob does not descend.
(glob_files programs/pkgs/shape/*)
@ -244,6 +250,7 @@
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
; A glob per package directory, because dune's glob does not descend.
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
@ -407,6 +414,7 @@
(glob_files programs/*.flan)
(glob_files programs/assets/*)
(glob_files programs/assets/edn/*)
(glob_files programs/assets/json/*)
(glob_files programs/pkgs/shape/*)
(glob_files programs/pkgs/area/*)
(glob_files programs/pkgs/draw/*)

11
test/programs/assets/edn/tuning.edn Normal file
View File

@ -0,0 +1,11 @@
;; A tuning file with one of each shape defedn derives, so that the struct it
;; produces exercises every arm: a string, an integer, a float, a boolean, a
;; homogeneous vector, a nested map, and a nested map inside that one.
{:name "goblin"
:hp 12
:speed 1.5
:boss? false
:drops [3 1 4 1 5]
:hitbox {:w 16
:h 24
:offset {:x -2 :y 0}}}

12
test/programs/assets/json/config.json Normal file
View File

@ -0,0 +1,12 @@
{
"name": "tileset\nrunner",
"port": 8080,
"scale": 1.5,
"debug": true,
"layers": [3, 1, 4, 1, 5],
"window": {
"w": 1280,
"h": 720,
"origin": { "x": -2, "y": 0 }
}
}

120
test/programs/edn-provide.flan Normal file
View File

@ -0,0 +1,120 @@
;;;; defedn over two real files, and the condition a drifted one signals.
;;;;
;;;; The first half is the claim the feature is for: `(.texture-path t)` here
;;;; is a field load off a struct nobody declared, and the same numbers
;;;; edn-read.flan prints through the dynamic reader come out of it. Two
;;;; readers over one file agreeing is what says the derived one is right —
;;;; either alone could be self-consistently wrong.
;;;;
;;;; The second half is the shape matrix: a string, an integer, a float, a
;;;; boolean, a vector, and a map inside a map, each read back.
;;;;
;;;; The third is drift. The struct was derived from the file as it was when
;;;; this was compiled; the bytes read at run time are a later version of it,
;;;; with one key gone and one arrived. Both are named by SchemaDrift, which is
;;;; the whole reason the reader carries one: a missing key otherwise leaves a
;;;; field at zero and the program draws nothing for a reason nothing reports.
(import edn "vendor:edn")
;; Both derived at compile time, from the files as they sit beside this one.
;; The path is the (embed "...") path — relative to this file — and not the
;; path the run-time reads below use, which is relative to the process.
(edn/defedn Tileset "assets/edn/tileset.edn")
(edn/defedn Tuning "assets/edn/tuning.edn")
;; The same file the dynamic reader in edn-read.flan walks. Embedded rather
;; than read, so this half asserts the reader and not the filesystem.
(defconst tileset (embed "assets/edn/tileset.edn"))
(defconst tuning (embed "assets/edn/tuning.edn"))
(defn show-tileset [a Allocator] ()
(let [t (Tileset-of-bytes tileset a)]
;; The line edn-read.flan prints first, off a struct field this time.
(println (.texture-path t))
;; 54 pairs, and the same three memberships and one miss. A derivation
;; that flattened the pairs into 108 integers would have a different count
;; and would answer no to every one of these.
(println (len (.selected-cells t)))
(println (has-key? (.selected-cells t) [3 4]))
(println (has-key? (.selected-cells t) [0 0]))
(println (has-key? (.selected-cells t) [4 11]))
(println (has-key? (.selected-cells t) [9 9]))))
(defn show-tuning [a Allocator] ()
(let [t (Tuning-of-bytes tuning a)]
(println (.name t))
(println (.hp t))
(println (.speed t))
(println (if (.boss? t) "yes" "no"))
(println (len (.drops t)))
;; 3 + 1 + 4 + 1 + 5. A vector read that stopped at the first element would
;; still have a plausible length from a zeroed Vec, so the sum is the claim.
(let [total (i64 0)]
(dotimes [i (len (.drops t))]
(set total (+ total (at (.drops t) i))))
(println total))
;; The nested structs, by the names the paths give them: Tuning-hitbox and
;; Tuning-hitbox-offset. Both are ordinary field loads, two deep.
(println (.w (.hitbox t)))
(println (.h (.hitbox t)))
(println (.x (.offset (.hitbox t))))
(println (.y (.offset (.hitbox t))))))
;; ── Drift ───────────────────────────────────────────────────────────
;;
;; The struct says :name :hp :speed :boss? :drops :hitbox. These bytes have no
;; :speed and have a :level the struct has never heard of, which is what a
;; tuning file looks like a month after the program was built.
(defconst drifted string
"{:name \"imp\" :hp 3 :level 7 :boss? true :drops [1] :hitbox {:w 1 :h 1 :offset {:x 0 :y 0}}}")
(defn show-drift [a Allocator] ()
(handler-bind
[(edn/SchemaDrift [d]
(do (print (if (.extra? d) "extra " "missing "))
(print (.field d))
(print " in ")
(println (.struct d))))]
(let [t (Tuning-of-bytes (bytes drifted) a)]
;; The fields that were there are read, which is the other half of the
;; contract: a drifted file is reported, not refused. :speed is the one
;; that was missing and is zero.
(println (.name t))
(println (.hp t))
(println (.speed t)))))
;; ── A file that does not parse ──────────────────────────────────────
;;
;; The louder failure, and the one that had the quieter answer until ReadFailed
;; existed: a generated reader accumulates errors on the cursor, and the cursor
;; is made and dropped inside the entry point, so a stray brace gave back a
;; zeroed struct with nothing said. The rest of this package refuses to do
;; that — read-file answers an Option so that a malformed document is
;; distinguishable from one that is literally nil — and a derived reader has to
;; be at least as honest.
(defconst broken string "{:name \"orc\" :hp }")
(defn show-broken [a Allocator] ()
(handler-bind
[(edn/ReadFailed [e]
(do (print "unreadable ")
(print (.struct e))
(print ": ")
(println (edn/error-message (.code e)))))]
(let [t (Tuning-of-bytes (bytes broken) a)]
;; Read anyway, and zeroed, which is the half a handler that carries on
;; is choosing. Printed so that "it signalled" and "it gave back nothing
;; usable" are two claims rather than one.
(println (.hp t)))))
(defn main [] i32
(let [a (heap-allocator)]
(show-tileset a)
(println "")
(show-tuning a)
(println "")
(show-drift a)
(println "")
(show-broken a))
0)

53
test/programs/json-provide.flan Normal file
View File

@ -0,0 +1,53 @@
;;;; defjson over a config file, and the escape that says it is not defedn.
;;;;
;;;; The same idea as edn-provide.flan and a different package: json depends on
;;;; edn for nothing and this program imports only json.
;;;;
;;;; "name" is the line that matters. Its value in the file is written
;;;; "tileset\nrunner", and JSON's `.text` is the RAW interior — escapes
;;;; undecoded — so a reader built on `.text` prints one line with a backslash
;;;; and an n in it. This prints two lines, which is `string-of` having been
;;;; used where a field is filled.
(import json "vendor:json")
(json/defjson Config "assets/json/config.json")
(defconst config (embed "assets/json/config.json"))
(defn main [] i32
(let [a (heap-allocator)
cfg (Config-of-bytes config a)]
;; Two lines, not one with a backslash in it.
(println (.name cfg))
(println (.port cfg))
(println (.scale cfg))
(println (if (.debug cfg) "yes" "no"))
(println (len (.layers cfg)))
;; 3 + 1 + 4 + 1 + 5. A length alone would pass on a Vec that was allocated
;; and never filled, so the sum is the claim.
(let [total (i64 0)]
(dotimes [i (len (.layers cfg))]
(set total (+ total (at (.layers cfg) i))))
(println total))
;; The nested structs, by the names the paths give them: Config-window and
;; Config-window-origin. Ordinary field loads, two deep.
(println (.w (.window cfg)))
(println (.h (.window cfg)))
(println (.x (.origin (.window cfg))))
(println (.y (.origin (.window cfg))))
(println "")
;; Drift, the same contract defedn's reader carries: the struct says "port"
;; and these bytes do not, and they carry a "host" it has never heard of.
(handler-bind
[(json/SchemaDrift [d]
(do (print (if (.extra? d) "extra " "missing "))
(print (.field d))
(print " in ")
(println (.struct d))))]
(let [c2 (Config-of-bytes
(bytes "{\"name\":\"x\",\"host\":\"h\",\"scale\":2.0,\"debug\":false,\"layers\":[1],\"window\":{\"w\":1,\"h\":1,\"origin\":{\"x\":0,\"y\":0}}}")
a)]
(println (.name c2))
(println (.port c2)))))
0)

187
test/test_acceptance.ml
View File

@ -643,6 +643,184 @@ let () =
outputs ~opt:"-O0" "edn/read over the tileset, -O0"
"programs/edn-read.flan" edn_read_out;
(* The same file again, through a struct derived from it at compile time.
The first five lines are the first five above, character for character,
and that is the claim: two readers over one file agreeing is what says
the derived one is right, where either alone could be self-consistently
wrong. Nothing in the program declares a type and nothing in it matches
on a tag — (.texture-path t) is a field load.
The pair memberships are the derivation's own decision showing: the set
became a (Map [2 i64] bool), so [3 4] is a key and [9 9] is not. A
version that made it a (Vec i64) of 108 numbers would have compiled and
would answer differently on every one of these four lines.
Then the shape matrix — a string, an integer, a float, a boolean, a
vector summed, and a map inside a map read two field loads deep, by the
names the paths give them. 14 is 3+1+4+1+5, and it is there because a
length alone would pass on a Vec that was allocated and never filled.
Last, drift: the struct was derived from a file with :speed and without
:level, and the bytes read carry the opposite. Both conditions are
named, in the order the reader meets them — the unknown key as it
arrives, the missing field when the map closes — and the read carries
on, which is the other half of the contract. :speed reads 0.
Then the louder failure, which had the quieter answer until ReadFailed
existed: a generated reader accumulates errors on the cursor, and the
cursor is made and dropped inside the entry point, so a file that does
not parse handed back a zeroed struct with nothing said. The rest of the
package refuses to do that — read-file answers an Option so a malformed
document is distinguishable from one that is literally nil — and this is
the derived reader being as honest. Two lines and not one: it signalled,
and what it gave back is nothing usable. *)
let edn_provide_out =
"./source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, \
Stones.png\n\
54\ntrue\ntrue\ntrue\nfalse\n\n\
goblin\n12\n1.5\nno\n5\n14\n16\n24\n-2\n0\n\n\
extra level in Tuning\nmissing speed in Tuning\nimp\n3\n0\n\n\
unreadable Tuning: unexpected token: not the kind the caller was \
reading\n0\n"
in
outputs "defedn over the tileset and a tuning file"
"programs/edn-provide.flan" edn_provide_out;
outputs ~opt:"-O0" "defedn over the tileset and a tuning file, -O0"
"programs/edn-provide.flan" edn_provide_out;
(* The same idea in the other package, over a config file. json depends on
edn for nothing and this program imports only json: what the two share
is the design, not a line of code.
The first two lines are the claim that separates them. "name" is written
"tileset\nrunner" in the file, and json.flan's .text is the RAW interior
with escapes undecoded — so a reader built on it prints one line with a
backslash and an n in it. Two lines is string-of having been used where
a field is filled, which is the one call in that package that allocates
and the one that is correct.
Then the shape matrix — a number that is an integer because the file
wrote it as one, a number that is a float because the file wrote a
point, a boolean, an array summed rather than counted, and an object
inside an object read two field loads deep — and drift, where the bytes
have a "host" the struct never heard of and no "port" it expects. *)
let json_provide_out =
"tileset\nrunner\n8080\n1.5\nyes\n5\n14\n1280\n720\n-2\n0\n\n\
extra host in Config\nmissing port in Config\nx\n0\n"
in
outputs "defjson over a config file" "programs/json-provide.flan"
json_provide_out;
outputs ~opt:"-O0" "defjson over a config file, -O0"
"programs/json-provide.flan" json_provide_out;
(* What a provider refuses, and where it says the trouble is.
A data file the compiler could not make sense of is one the program
would have read wrongly, so each of these is a compile that stops rather
than a struct with a field of some guessed type.
Both halves of the pair are written here rather than committed, because
the data file *is* the test: a fixture .edn sitting in the corpus would
be read by nothing else and would look like an asset. They go beside the
other programs so that the two things a provider resolves — the vendor:
collection, and the data path relative to the source file — resolve the
way they do for a real one.
Each is asserted on the position it names and not only on the fact of
failing. A version that refused everything with one sentence would pass
a test that checked the refusal alone, and a line and column into a file
the compiler is not reading is the whole of what the refusal had to be
given a facility for. *)
let refusal ~pkg ~mac ~ext name data needle =
let base = "programs/refuse-" ^ name in
let datap = base ^ "." ^ ext and flanp = base ^ ".flan" in
Out_channel.with_open_bin datap (fun ch -> Out_channel.output_string ch data);
Out_channel.with_open_bin flanp (fun ch ->
Out_channel.output_string ch
(Printf.sprintf
"(import p \"vendor:%s\")\n(p/%s T \"refuse-%s.%s\")\n\
(defn main [] i32 0)\n" pkg mac name ext));
(match
let l = Load.program ~file:flanp (Reader.read_file flanp) in
Check.program l.Load.decls
with
| _ ->
incr failures;
Printf.printf "FAIL %s\n it was accepted\n" name
| exception Loc.Error { Loc.dmsg = m; _ } ->
if not (contains m needle) then begin
incr failures;
Printf.printf "FAIL %s\n said: %S\n wanted: %S in it\n"
name m needle
end);
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ datap; flanp ]
in
let provider_refusal = refusal ~pkg:"edn" ~mac:"defedn" ~ext:"edn" in
let json_refusal = refusal ~pkg:"json" ~mac:"defjson" ~ext:"json" in
(* The element positions are named, both of them, because "heterogeneous"
on its own sends someone to read the whole file. *)
provider_refusal "mixed-vector" "{:xs [1 2 \"three\"]}" "element 2 is string";
(* A map whose keys are not all keywords is not a struct: a field is named,
and "name" in quotes is a value. *)
provider_refusal "mixed-keys" "{:a 1 \"b\" 2}" "that is not a keyword";
(* An empty collection carries no element to derive an element type from,
which is the one thing a shape read out of data cannot guess. *)
provider_refusal "empty-vector" "{:xs []}"
"has no element to derive an element type from";
(* nil has no type. A field that is sometimes absent is not something a
struct holds, and guessing would put a zero where a decision belongs. *)
provider_refusal "nil-value" "{:a nil}" "has no type to derive";
(* The line and column are into the *data* file and are the point of the
whole error facility: this one is on the third line. *)
provider_refusal "position" "{:a 1\n :b 2\n :c [1 \"x\"]}" "line 3 column";
(* A set becomes a (Map T bool), so its elements are map keys. A set of
maps is refused by name here rather than at the (Map ...) it would build,
whose message names a type nobody wrote. *)
provider_refusal "set-of-maps" "{:s #{{:a 1}}}"
"is not something this builds";
(* And the file that is not there, which is the case the path rule is for:
it says where it looked. *)
(let flanp = "programs/refuse-missing.flan" in
Out_channel.with_open_bin flanp (fun ch ->
Out_channel.output_string ch
"(import edn \"vendor:edn\")\n\
(edn/defedn T \"no-such-file.edn\")\n(defn main [] i32 0)\n");
(match
let l = Load.program ~file:flanp (Reader.read_file flanp) in
Check.program l.Load.decls
with
| _ ->
incr failures;
Printf.printf "FAIL a defedn over a file that is not there\n\
\ it was accepted\n"
| exception Loc.Error { Loc.dmsg = m; _ } ->
if not (contains m "there is no file at no-such-file.edn") then begin
incr failures;
Printf.printf "FAIL a defedn over a file that is not there\n\
\ said: %S\n" m
end);
(try Sys.remove flanp with Sys_error _ -> ()));
(* And what defjson refuses, which is the same walk over a different
grammar. The first three are the ones it shares; the last two are its
own, and both are about a member name.
A struct's fields are names, and JSON's are arbitrary strings — so
"a b" has no field it could become, and an escaped one is refused
because the generated reader compares against the bytes as written. The
comparison costs no allocation per key, which is the whole reason it is
written that way, and it is only the same question as "is this the
field" when the name has no escape in it. Refusing is what keeps those
two facts from quietly disagreeing. *)
json_refusal "json-mixed-array" "{\"xs\": [1, 2, \"three\"]}"
"element 2 is string";
json_refusal "json-null" "{\"a\": null}" "has no type to derive";
json_refusal "json-empty-array" "{\"xs\": []}"
"has no element to derive an element type from";
json_refusal "json-spaced-key" "{\"a b\": 1}"
"is not a name a program could write";
json_refusal "json-escaped-key" "{\"a\\nb\": 1}"
"has an escape in it";
(* And the branch that makes it safe, which needs a program that dies to
say anything — the shape bounds.flan uses, and for the same reason.
Run 0 is the control and must not trap: a (Vec (Vec i32)) in the region
@ -2999,10 +3177,11 @@ level "1"
outputs ~opt:"-O0" "dyn: an unannotated defn at two types, -O0"
"programs/dyn-basic.flan" dyn_basic_out;
(* The rendering is the typed printer's: a leading space after the open
bracket and strings quoted inside a collection but bare alone —
(println [\"a\"]) and (println \"a\") already disagree exactly this way,
so the dyn printer disagreeing would have been the bug. The stub this
expectation was first written against printed neither. *)
bracket, and a string quoted inside a collection but bare alone —
println of a one-string array and of the string itself already
disagree exactly this way, so the dyn printer disagreeing would have
been the bug. The stub this expectation was first written against
printed neither. *)
let dyn_vec_out = "4\n[ 1 2.5 \"three\" true]\n1 2.5 three true \n" in
outputs "dyn: a heterogeneous vector"
"programs/dyn-vec.flan" dyn_vec_out;

49
test/test_session.ml
View File

@ -737,6 +737,55 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a session that refused an expansion could not expand afterwards: %s" m);
(* ── A type provider, expanded ─────────────────────────────────────
Two claims, and they are the two halves of the live-tuning loop.
The first is the path. A macro that reads a data file resolves it the way
(embed "...") does — against the directory of the source file the *form*
is written in — and a macro cannot know where that is, because a Form
carries no location. The compiler pokes the call site's directory in
before every expansion, and the call site here is an origin the editor
sent, not a file on a command line. "assets/edn/tuning.edn" is beside
programs/edn-provide.flan and nowhere near this process's directory, so an
expansion that answered anything at all read the right file.
The second is that the answer is readable. `C-c C-m` over a provider is
the only way to see what it decided, and a provider whose output nobody
can look at is a plugin. So this asserts on text a person would recognise:
the struct with its fields and derived types, the nested struct named for
its path, and the reader's dispatch on a key. Asserted as substrings
rather than in full — the expansion is some hundreds of characters and a
golden copy of it would fail on every comment reflowed in the derivation.
It also re-reads on every expansion, which is what makes editing the .edn
and hitting C-c C-m a loop: nothing is cached but the macro module, and
that holds the macro's code, not the data. *)
(let pt, _ = Session.create ~file:"programs/edn-provide.flan" () in
match
Session.macroexpand ~origin:"programs/edn-provide.flan" ~all:false pt
"(edn/defedn Tuning \"assets/edn/tuning.edn\")"
with
| x ->
let got = Form.to_source x.Session.xafter in
List.iter
(fun want ->
if not (has got want) then
fail "expanding a defedn: %S is not in\n%s" want got)
[ (* The struct, with a type per field derived from the value. *)
"(defstruct Tuning [name string hp i64 speed f64 boss? bool";
(* The vector, and the constructor that states its type so that
(vec-new) has something to take it from. *)
"drops (Vec i64)";
(* The nested map, named for the path that reaches it, and the one
nested inside that. *)
"(defstruct Tuning-hitbox-offset [x i64 y i64])";
"hitbox Tuning-hitbox";
(* And the reader, dispatching on a key onto a field. *)
"(edn/keyword=? k \"speed\")";
"(set (.speed out) (edn/need-float c))" ]
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "expanding a defedn through a session: %s" m);
(* A form typed into a file that is *imported as a package* has to be
qualified the way the import qualified it, or it splices as a brand-new
unrelated name: the evaluation reports success and the running program

584
vendor/edn/provide.flan vendored Normal file
View File

@ -0,0 +1,584 @@
;;;; 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])
;; ── 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 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.
(defstruct ReadFailed
[struct string
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.
(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)
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 `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}))))

464
vendor/json/provide.flan vendored Normal file
View File

@ -0,0 +1,464 @@
;;;; 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}))))