Read raylib's header instead of trusting the transcription
This commit is contained in:
commit
b239d2ae59
158
BUILT.md
158
BUILT.md
@ -132,6 +132,164 @@ No raylib headers are needed: the generated C declares the prototypes it uses, s
|
||||
library being linkable and not on `raylib-devel`. `vendor/raylib/link` carries `-l:libraylib.so.550` because Fedora
|
||||
ships the runtime library without the `.so` symlink.
|
||||
|
||||
### The header is read now — `headers`, `lib/cimport.ml`
|
||||
|
||||
The section above ends by naming what the generator *trusts*: that the
|
||||
`defstruct` matches the library's real struct, and that the `declare-c`
|
||||
signature is the function's real signature. "No header is read, deliberately,
|
||||
so nothing can check either." A header is read now, and both are checked.
|
||||
|
||||
**The dependency, which is the crux, and which this project already answered
|
||||
once.** Zig's old `@cImport` ran clang as a *library*. That is exactly the
|
||||
dependency plan.org rejected in "Why LLVM IR as text": a version-pinned C++
|
||||
library breaks routinely on upgrade, a binary on PATH does not. So this shells
|
||||
out for `clang -Xclang -ast-dump=json -fsyntax-only`, which is the same binary
|
||||
every build already runs and adds nothing that is not already being paid for.
|
||||
`lib/cjson.ml` is enough JSON to read that dump and no more, so it adds no opam
|
||||
package either.
|
||||
|
||||
A note worth recording, because it strengthens the argument rather than
|
||||
weakening it: **Zig has since abandoned clang here too.** `translate_c.zig` is
|
||||
gone; `lib/compiler/translate-c/` is built on Aro, a C frontend written in Zig.
|
||||
Their reason was to ship a compiler containing no clang at all — the opposite
|
||||
premise to this one, where `clang` on PATH *is* the toolchain assumption. Both
|
||||
projects walked away from linking libclang; only the destination differs.
|
||||
|
||||
**What is imported: functions, and only functions.** Not structs, not enums,
|
||||
not macros. The bound on how much is not a curated list but the package's own
|
||||
`defstruct`s — a function whose signature mentions a struct the package has not
|
||||
described is refused with that reason, so `vendor/raylib` describing thirteen
|
||||
structs is what makes the import thirteen structs wide, and describing a
|
||||
fourteenth widens it. Of raylib 5.5's 581 functions, 256 import, 153 are
|
||||
refused, and 172 are left alone because the package already binds them by hand.
|
||||
|
||||
Not generating `defstruct`s is what makes the check possible at all. Generate
|
||||
them and the header becomes the authority on layout, and comparing the
|
||||
package's layouts against the header's would be comparing the header with
|
||||
itself. A `_Static_assert` on `sizeof`/`offsetof` was rejected in the section
|
||||
above as circular for exactly that reason; **this is not circular, because the
|
||||
two sides have different authors.** It is the cheapest real closure of the
|
||||
trusted-not-guaranteed gap.
|
||||
|
||||
**Refusing by demotion, which is the one thing taken wholesale from Zig.** Zig's
|
||||
translator never drops a declaration it cannot handle: `failDecl` binds the name
|
||||
to a `@compileError` carrying the reason, so the name still exists, the program
|
||||
still compiles, and asking for *that one name* fails at the use site with the
|
||||
reason. A wholesale import has a hundred and fifty refusals and a caller cares
|
||||
about the one they typed. Flan already had that mechanism — `Load.refuse_hidden`,
|
||||
built for `main` — so `rl/get-gamepad-name` is not a name, and a program that
|
||||
writes it is told *the return type is a string, and a string only crosses as a
|
||||
parameter* rather than "unknown name".
|
||||
|
||||
That is also the split `shim.ml` needed and did not have. It refuses through
|
||||
`Loc.fail`, which is right when a human named one function and wrong for a
|
||||
wholesale import, where one returned `const char *` would kill the header. Same
|
||||
judgement, different disposition; a hand-written `declare-c` still hard-fails
|
||||
and `shim.ml` is untouched.
|
||||
|
||||
**Two C spellings mean something in a parameter that they mean nowhere else.**
|
||||
`const char *` is a string going in, and the generator already knows how to hand
|
||||
one over. `char *` without the const is very often a buffer the callee *writes*,
|
||||
and handing it a NUL-terminated temporary would lose the writes with no
|
||||
diagnostic anywhere — const is the only thing in the header that separates the
|
||||
two, so it is what decides, and an out-buffer keeps a hand-written binding
|
||||
saying `(Ptr u8)`. `long`, `size_t` and the rest are refused rather than
|
||||
guessed, and for a reason specific to this project: it builds for x86-64, for
|
||||
wasm32-wasi and for the browser, and `long` is 64 bits on the first and 32 on
|
||||
the others, so a guess would be right for the target that gets tested and
|
||||
silently wrong for two that do not.
|
||||
|
||||
**Naming.** `rl/InitWindow` is `rl/init-window`. Reversibility is not a property
|
||||
of the rule — the C symbol is stored verbatim in the declaration, so the wrapper
|
||||
reads the library's spelling rather than reconstructing it. What the rule must
|
||||
be is *injective over one header*, since two C functions arriving under one Flan
|
||||
name would surface as a duplicate declaration about a name nobody wrote. A
|
||||
boundary goes before an uppercase letter after a lowercase one, before an
|
||||
uppercase letter between an uppercase and a lowercase, and before a digit after
|
||||
a lowercase; nowhere else. So `SetTargetFPS` is `set-target-fps` and not
|
||||
`set-target-f-p-s`, `BeginMode2D` is `begin-mode-2d`, `UnloadUTF8` is
|
||||
`unload-utf8`. raylib's 581 names are injective under it. **When two do collide,
|
||||
neither takes the name** — resolving by order would mean that moving two lines
|
||||
in somebody else's header silently rebinds a name a program is already calling.
|
||||
Both are refused, both say why, and the author binds the one they want with a
|
||||
`declare-c`.
|
||||
|
||||
**Where it runs.** `headers` beside `link` in the package directory, read the
|
||||
same way: a path, any clang flags it needs, `${NAME}` expanded from the
|
||||
environment. What comes back is ordinary `declare-c` declarations, generated
|
||||
before the package's names are qualified, so they arrive as `rl/…` exactly like
|
||||
the hand-written ones and nothing downstream can tell which is which. No new
|
||||
form, no new `decl_kind`, no reader or parser change. A C symbol the package
|
||||
already binds by hand is left alone, so `declare-c` stays the escape hatch and
|
||||
stays the thing that wins.
|
||||
|
||||
A leading `?` makes a line optional, and `vendor/raylib` uses it. "No raylib
|
||||
headers are needed" is a real property — a build needs libraylib linkable, not
|
||||
raylib-devel installed — and requiring a header would take it from everyone in
|
||||
order to give the check to whoever has one. Unset `FLAN_RAYLIB_H` and the build
|
||||
is exactly what it was; set it and every signature is checked. A path that is
|
||||
*set and wrong* is an error naming it, because silently behaving as though
|
||||
nobody had opted in is the difference between an opt-in and a trap.
|
||||
|
||||
#### What the diff found
|
||||
|
||||
The evidence the whole lane exists for. Against raylib **5.5** — the version
|
||||
whose `.so` `link` names — **all 16 `defstruct`s and all 172 hand-written
|
||||
`declare-c` agree exactly.** The half BUILT.md called trusted is now checked,
|
||||
and it was right.
|
||||
|
||||
That is only worth stating because the check has teeth. Against the **5.1-dev**
|
||||
header installed in `/usr/local` it reports ten differences: nine functions that
|
||||
version does not have (`CheckCollisionCircleLine`, the six `Is*Valid` renames,
|
||||
`DrawRectangleRoundedLinesEx`) and `DrawRectangleRoundedLines`, which gained a
|
||||
parameter. Picking the wrong header is therefore loud, which matters, because
|
||||
the two headers are on the same machine and only one matches the linked library.
|
||||
|
||||
Both comparisons run **at build time** and stop the build, not just in the tool.
|
||||
Verified by breaking them: a permuted `Texture2D` fails naming the field that
|
||||
moved, and `f64` where raylib says `float` fails naming the parameter — which is
|
||||
the hazard the section above calls out by name and says only a test can catch.
|
||||
The message points at the line in `raylib.flan`, not at the header.
|
||||
|
||||
`flan import-c <header> [package.flan…]` prints what it would produce, what it
|
||||
refused and why, and both comparisons, without building anything. That also
|
||||
makes "generate once and commit the result" available for the cost of a
|
||||
printer — explicit in the source, checked against reality, no header read at
|
||||
build time.
|
||||
|
||||
#### What it costs, measured
|
||||
|
||||
The number that decides how much to import, because `reach.ml` was the reason to
|
||||
think a wholesale import could be free.
|
||||
|
||||
| | today (172 by hand) | + 256 imported |
|
||||
|---|---|---|
|
||||
| release build, cold | 0.298s | 0.312s |
|
||||
| release build, warm | 0.078s | 0.082s |
|
||||
| redefinition (`flan reload`) | 31.0ms | 46.5ms |
|
||||
| dev build, cold | 0.649s | 0.982s |
|
||||
|
||||
**`Reach.link` already drops a generated wrapper whose declaration nothing
|
||||
reachable calls, and that is what makes the release column nearly flat.**
|
||||
Confirmed on the case it exists for: a wasm32-wasi build of a program that
|
||||
imports raylib and calls none of it still links without libraylib, with 256
|
||||
extra declarations in play. Dev builds are not pruned, on purpose, so one
|
||||
compiles all 428 wrappers — once, at session start, since `Build.shared` is
|
||||
llc + `ld -shared` and compiles no C.
|
||||
|
||||
Reading the header is cached, and the cache earned itself against a measurement
|
||||
rather than a guess: 64ms of a 72ms check, against 8ms for the whole program
|
||||
without it. What is cached is the *extracted* signatures and not clang's JSON,
|
||||
because the parse is half the cost — 30ms is clang writing 1.8 MB and the rest
|
||||
is reading it. Keyed the way the object cache is keyed, on everything that could
|
||||
change the answer: the header's path, size and mtime, the full flag list, and a
|
||||
format version, since the value is marshalled. That takes the delta to 17ms.
|
||||
|
||||
**The 15.5ms on redefinition is the real cost and it is the argument against
|
||||
importing at build time**, on the branch where the dev loop is the priority. It
|
||||
is the strongest case for the third option — generate from the header, commit
|
||||
the result, regenerate when the library moves — and that decision is open.
|
||||
|
||||
### What a headless FFI test can and cannot pin
|
||||
|
||||
Worth knowing before writing another one, because two plausible tests in a row turned out to check nothing.
|
||||
|
||||
71
DISCUSS.md
71
DISCUSS.md
@ -196,33 +196,62 @@ happens.
|
||||
**One dependency:** hiccup is a macro, and the macro expander is blocked on `Form` being a Flan union, which is union
|
||||
values. The backend can start before that; the DSL cannot.
|
||||
|
||||
## 6. C interop as seamless as Zig's
|
||||
## 6. C interop as seamless as Zig's — built, with two decisions left
|
||||
|
||||
Today: `declare-c` names one C function per line and the compiler generates the wrapper, the typedefs and the flattened
|
||||
declaration — 175 lines for raylib. **No header is ever read, deliberately**, which means nothing verifies that a
|
||||
declaration matches the real signature. That is written down as trusted rather than guaranteed.
|
||||
**The mechanism is in** (`lib/cimport.ml`, `lib/cjson.ml`, `vendor/raylib/headers`; BUILT.md, "The header
|
||||
is read now"). Settled and not worth reopening: clang's JSON AST dump over a shelled-out `clang`, never
|
||||
libclang — and Zig has since abandoned linking clang too, for Aro, which strengthens the argument rather
|
||||
than weakening it. The import is bounded by the package's own `defstruct`s rather than by a curated list.
|
||||
Refusals are demotions in Zig's sense: the name exists, cannot be had, and says why at the use site, which
|
||||
`Load.refuse_hidden` already did for `main`. Names kebab by a rule that is injective over raylib's 581, and
|
||||
reversibility is by storage — the C symbol is kept verbatim — so the rule never needs an inverse. Where two
|
||||
names do collide, neither takes it.
|
||||
|
||||
The proposal: read the header, prefix a namespace, get `rl/InitWindow` for free, possibly kebab-cased to
|
||||
`rl/init-window`.
|
||||
**The evidence:** against raylib 5.5, all 16 `defstruct`s and all 172 hand-written `declare-c` agree
|
||||
exactly. Against the 5.1-dev header also on this machine, ten real differences. Both comparisons stop the
|
||||
build, and a permuted `Texture2D` or an `f64` for a `float` is caught by name.
|
||||
|
||||
**The dependency is the crux, and this project already answered the same question once.** Zig's `@cImport` runs clang as
|
||||
a *library*. That is exactly the dependency rejected in plan.org's "Why LLVM IR as text": a version-pinned C++ library
|
||||
breaks routinely on upgrade, while a binary on `PATH` does not. Linking libclang walks back into it.
|
||||
What is left is two decisions, and both are the author's.
|
||||
|
||||
**The middle path that keeps the property:** clang will dump a parsed header as JSON from the command line
|
||||
(`-Xclang -ast-dump=json`). Still only `clang` on `PATH`, still no library linkage, and it yields *real* signatures
|
||||
instead of hand-transcribed ones — which closes the "trusted, not guaranteed" gap that is the strongest argument for
|
||||
doing this at all.
|
||||
### 6a. Does reading the header stay a build-time step, or become a code generator?
|
||||
|
||||
**The design question is how much to import.** Zig imports everything a header declares. For raylib that is several
|
||||
hundred functions plus every struct and macro, nearly all unused. The current 175 lines are deliberate, and the
|
||||
declaration site is also the checkpoint where the compiler *refuses* a signature it cannot safely flatten — an
|
||||
aggregate return, a variadic, a `string` coming back. A wholesale import removes that checkpoint, or has to reproduce
|
||||
it as a filter. Generating the list from the header while keeping it explicit in the source is a third option: generate
|
||||
once, commit the result, regenerate when the library moves.
|
||||
The cost, measured, with the wrappers pruned by `Reach` as they already were:
|
||||
|
||||
**Kebab-casing is separable and small**, with one constraint: it must be reversible, because the generated C wrapper
|
||||
needs the library's own spelling.
|
||||
| | today | + 256 imported |
|
||||
|---|---|---|
|
||||
| release build, warm | 0.078s | 0.082s |
|
||||
| **redefinition** | **31.0ms** | **46.5ms** |
|
||||
| dev build, cold | 0.649s | 0.982s |
|
||||
|
||||
Release is nearly free and that question is answered. **The 15.5ms on redefinition is not nothing on the
|
||||
branch where the dev loop is the priority** — it is a 50% increase on the number that lane exists to keep
|
||||
small, and it buys a check of signatures that have not changed since the last build.
|
||||
|
||||
So the third option from the original discussion is now the live one: `flan import-c` already prints
|
||||
`declare-c` lines, so **generate from the header, commit the result, regenerate when raylib moves** costs
|
||||
nothing more to build. Explicit in the source, checked against reality, no header read at build time, and
|
||||
the check becomes a thing you run rather than a thing you pay for. Against it: a committed file goes stale
|
||||
silently, which is the failure the whole lane exists to prevent, and "regenerate when the library moves"
|
||||
is a discipline rather than a mechanism.
|
||||
|
||||
A middle reading worth considering: keep the build-time check but run it only when *not* `--dev`, on the
|
||||
grounds that a release build is where a wrong signature must not get through and a dev build is where
|
||||
15.5ms is felt. That is the same shape as `Reach` not pruning dev builds, for a symmetric reason.
|
||||
|
||||
### 6b. Do the 172 hand-written lines get migrated?
|
||||
|
||||
The diff is clean, so nothing blocks it on correctness. What blocks it is that migration needs the header
|
||||
present at *every* build, which means vendoring raylib.h into the repo or requiring `raylib-devel` — and
|
||||
BUILT.md records "a build needs libraylib linkable and not raylib-devel installed" as a property that was
|
||||
chosen on purpose. That is why `vendor/raylib/headers` is opt-in (`?${FLAN_RAYLIB_H}`) today and the
|
||||
hand-written lines are untouched.
|
||||
|
||||
Worth noting what migration would actually lose, since it is small but real: the hand-written names are
|
||||
better than the rule's. `IsKeyPressed` is `key-pressed?` by hand and `is-key-pressed` by rule;
|
||||
`CheckCollisionRecs` is `collision-recs?`. And an enum parameter imports as `i32`, because the header says
|
||||
`KeyboardKey` and nothing tells the importer the package calls that `Key` — so `(rl/key-down? :space)`
|
||||
would become an integer at the call site. A migration is therefore not a deletion; it is a deletion plus a
|
||||
kept list of the lines whose face is deliberately nicer than the header's.
|
||||
|
||||
## 7. Watching variables
|
||||
|
||||
|
||||
52
NEXT.md
52
NEXT.md
@ -40,6 +40,58 @@ read. It belongs with item 2, where the listing is being changed anyway.
|
||||
Read SBCL for what restarts should *mean* and ignore how it moves control: it transfers with `block`/`return-from`,
|
||||
which §6 rules out.
|
||||
|
||||
### Landed — a C header is read, so a binding is checked instead of trusted
|
||||
|
||||
`lib/cimport.ml`, `lib/cjson.ml`, a `headers` file beside `link`. Full reasoning in `BUILT.md`, "The header is read
|
||||
now"; DISCUSS.md item 6 is rewritten down to the two decisions left, both the author's.
|
||||
|
||||
The gap closed is the one `BUILT.md` recorded as *trusted*: `declare-c` generates the wrapper, the typedefs and the
|
||||
prototype from one declaration, so they agree with each other by construction and only the library could disagree —
|
||||
and nothing had a second opinion to disagree with. Now clang is asked for a JSON AST dump of the header (shelled out,
|
||||
never libclang — the dependency plan.org rejected; Zig has since left it too, for Aro) and both halves are compared
|
||||
against it.
|
||||
|
||||
**The evidence.** Against raylib 5.5, the version whose `.so` `vendor/raylib/link` names: **all 16 `defstruct`s and
|
||||
all 172 hand-written `declare-c` agree exactly.** Against the 5.1-dev header also installed on this machine, ten real
|
||||
differences — nine functions that version lacks and one that gained a parameter — so picking the wrong header is
|
||||
loud. Both comparisons run at build time and stop the build; verified by permuting `Texture2D` and by putting `f64`
|
||||
where raylib says `float`, which is the hazard `BUILT.md` names and says only a test can catch.
|
||||
|
||||
**Costs, measured, because they decide the remaining question.** Release build +4ms warm — `Reach.link` already drops
|
||||
a wrapper nothing reachable calls, confirmed on the wasm32 case it exists for with 256 extra declarations in play.
|
||||
Redefinition 31.0ms → 46.5ms. Dev build +333ms cold, once per session, since `Build.shared` compiles no C. Reading the
|
||||
header is cached (64ms → 17ms), keyed like the object cache; the cache was built against a measurement, not a guess.
|
||||
|
||||
**Opt-in on purpose.** `vendor/raylib/headers` is `?${FLAN_RAYLIB_H}`. "A build needs libraylib linkable and not
|
||||
raylib-devel installed" is a property chosen deliberately, and requiring a header would take it from everyone to give
|
||||
the check to whoever has one. Unset means off; set-and-wrong is an error naming the path.
|
||||
|
||||
Worth knowing before touching it:
|
||||
|
||||
- **The import is bounded by the package's own `defstruct`s**, not by a curated list. A function mentioning a struct
|
||||
the package has not described is refused with that reason. Of raylib's 581 functions, 256 import, 153 are refused,
|
||||
172 are already bound by hand and left alone. Widening the binding is a `defstruct`, not a list edit.
|
||||
- **No `defstruct` is generated, and that is load-bearing.** Generate them and the header becomes the authority on
|
||||
layout, and checking the package's layouts against it would be comparing the header with itself — which is exactly
|
||||
why `BUILT.md` rejected a `_Static_assert` as circular. Keeping them hand-written is what makes the check a second
|
||||
source.
|
||||
- **A refusal is a demotion, not a drop** — Zig's `failDecl`, which `Load.refuse_hidden` already implemented for
|
||||
`main`. `rl/get-gamepad-name` is a name that exists, cannot be had, and says why at the use site.
|
||||
- **`declare-c` and `declare` are untouched and still win.** A C symbol the package binds by hand is not imported, so
|
||||
the escape hatch is the override.
|
||||
- **`test/headers/sample.h`** is the importer's table — one function per decision, committed, no raylib needed. The
|
||||
raylib acceptance case skips without `FLAN_RAYLIB_H`; that one does not.
|
||||
|
||||
Two things that are *not* done, and are 6a and 6b in DISCUSS.md: whether the header stays a build-time read or becomes
|
||||
a committed generator (`flan import-c` already prints the lines, so it costs nothing more to switch), and whether the
|
||||
172 hand-written lines migrate. Neither is blocked on correctness. The 15.5ms on redefinition is the argument for the
|
||||
first; needing the header at every build — vendoring raylib.h or requiring raylib-devel — is the argument on the
|
||||
second.
|
||||
|
||||
One smaller thing found and worth not re-deriving: an enum parameter imports as `i32`, because the header says
|
||||
`KeyboardKey` and nothing tells the importer the package calls that `Key`. The ABI is identical, the face is worse,
|
||||
and it is why `(rl/key-down? :space)` keeps its hand-written line.
|
||||
|
||||
### Landed 2026-09-12 — six tracks, one session
|
||||
|
||||
Six agents in parallel worktrees. Kept short on purpose; the reasoning that outlives the change is in `BUILT.md` or in
|
||||
|
||||
98
bin/main.ml
98
bin/main.ml
@ -148,6 +148,103 @@ let () =
|
||||
| [] -> Printf.printf "%s: no declare-c, so no generated C\n" path
|
||||
| parts -> List.iter (fun (_, src) -> print_string src) parts))
|
||||
files
|
||||
(* A header, read. The importer is a pure function of the header and the
|
||||
package beside it, so it can be looked at without building anything —
|
||||
which is what makes the diff against a hand-written binding possible, and
|
||||
what makes "generate once and commit the result" a usable option rather
|
||||
than a description of one. Prints the declarations it would produce, then
|
||||
what it refused and why, then how the package's defstructs compare with
|
||||
the header's records. *)
|
||||
| _ :: "import-c" :: header :: rest ->
|
||||
with_errors header (fun () ->
|
||||
let pkg = List.filter (fun a -> Filename.check_suffix a ".flan") rest in
|
||||
let flags =
|
||||
List.filter (fun a -> not (Filename.check_suffix a ".flan")) rest
|
||||
in
|
||||
let ds =
|
||||
List.concat_map
|
||||
(fun f -> Flan.Parse.program (Flan.Reader.read_file f)) pkg
|
||||
in
|
||||
let structs =
|
||||
List.filter_map
|
||||
(fun (d : Flan.Ast.decl) ->
|
||||
match d.Flan.Ast.d with
|
||||
| Flan.Ast.Defstruct (n, fs) -> Some (n, fs)
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
let known_enums =
|
||||
List.filter_map
|
||||
(fun (d : Flan.Ast.decl) ->
|
||||
match d.Flan.Ast.d with
|
||||
| Flan.Ast.Defenum (n, _) -> Some n
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
let taken = Hashtbl.create 64 in
|
||||
List.iter
|
||||
(fun d ->
|
||||
match Flan.Ast.declared_name d with
|
||||
| Some n -> Hashtbl.replace taken n ()
|
||||
| None -> ())
|
||||
ds;
|
||||
let bound_syms =
|
||||
List.filter_map
|
||||
(fun (d : Flan.Ast.decl) ->
|
||||
match d.Flan.Ast.d with
|
||||
| Flan.Ast.Declare (_, s) | Flan.Ast.DeclareC (_, s) -> Some s
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
let imported, dump, env =
|
||||
Flan.Cimport.header ~loc:(Flan.Loc.make header 0 0) ~header ~flags
|
||||
~known_structs:(List.map fst structs) ~known_enums ~taken ~bound_syms
|
||||
in
|
||||
List.iter
|
||||
(fun d -> print_endline (Flan.Cimport.decl_source d))
|
||||
imported.Flan.Cimport.decls;
|
||||
Printf.printf "\n;; %d imported, %d refused, of %d functions in %s\n"
|
||||
(List.length imported.Flan.Cimport.decls)
|
||||
(List.length imported.Flan.Cimport.hidden)
|
||||
(List.length dump.Flan.Cimport.fns) header;
|
||||
List.iter
|
||||
(fun (n, why) -> Printf.printf ";; refused %s: %s\n" n why)
|
||||
imported.Flan.Cimport.hidden;
|
||||
(match Flan.Cimport.check_structs ~env ~structs dump with
|
||||
| [] ->
|
||||
if structs <> [] then
|
||||
Printf.printf ";; every defstruct agrees with the header\n"
|
||||
| bad ->
|
||||
List.iter
|
||||
(fun (n, why) -> Printf.printf ";; DISAGREES %s: %s\n" n why)
|
||||
bad);
|
||||
(* And the bindings the package already wrote by hand, against the
|
||||
header's own signatures. Nothing else in the build can do this: a
|
||||
wrong declare-c is wrong in the generated prototype too, so the two
|
||||
agree with each other and only the library disagrees. *)
|
||||
let bound =
|
||||
List.filter_map
|
||||
(fun (d : Flan.Ast.decl) ->
|
||||
match d.Flan.Ast.d with
|
||||
| Flan.Ast.DeclareC (fn, sym) -> Some (fn, sym)
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
if bound <> [] then
|
||||
match Flan.Cimport.diff_bound ~env ~bound dump with
|
||||
| [] ->
|
||||
Printf.printf
|
||||
";; all %d hand-written declare-c agree with the header\n"
|
||||
(List.length bound)
|
||||
| ds ->
|
||||
Printf.printf ";; %d of %d hand-written declare-c disagree\n"
|
||||
(List.length ds) (List.length bound);
|
||||
List.iter
|
||||
(fun (x : Flan.Cimport.sig_diff) ->
|
||||
Printf.printf ";; DIFFERS %s (%s): %s\n"
|
||||
x.Flan.Cimport.dflan x.Flan.Cimport.dsym x.Flan.Cimport.dwhy)
|
||||
ds)
|
||||
|
||||
(* The IR is target-independent — [Emit] writes no triple and no datalayout,
|
||||
which is what lets one .ll serve both targets — so there is nothing for a
|
||||
target to change here. Refused rather than accepted and ignored: silently
|
||||
@ -289,6 +386,7 @@ let () =
|
||||
| _ ->
|
||||
prerr_endline
|
||||
"usage: flan (read|parse|check|emit|shim) <file.flan>...\n\
|
||||
\ flan import-c <header.h> [package.flan...] [clang flags...]\n\
|
||||
\ flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
|
||||
[--debug] [--sanitize] [--target=wasm32-wasi|web]\n\
|
||||
\ flan run <file.flan> [args...]\n\
|
||||
|
||||
884
lib/cimport.ml
Normal file
884
lib/cimport.ml
Normal file
@ -0,0 +1,884 @@
|
||||
(** Reading a C header, so a binding is checked against the library instead of
|
||||
transcribed from it.
|
||||
|
||||
[declare-c] closed half the gap: the wrapper, the typedefs and the
|
||||
prototype are generated, so they cannot disagree with each other. The half
|
||||
it left open is the one BUILT.md records as *trusted* — that the signature
|
||||
somebody typed is the function's real signature. Nothing checked it,
|
||||
because no header was ever read. This reads one.
|
||||
|
||||
{2 Why clang, and why not linked to it}
|
||||
|
||||
Zig's old [@cImport] ran clang as a *library*. That is precisely the
|
||||
dependency plan.org rejected when it chose text IR over libLLVM bindings: a
|
||||
version-pinned C++ library breaks routinely on upgrade, a binary on PATH
|
||||
does not. So this shells out for [clang -Xclang -ast-dump=json
|
||||
-fsyntax-only], which is the same binary the build already runs for every
|
||||
other purpose and adds no dependency that is not already being paid for.
|
||||
|
||||
(Zig has since replaced clang here altogether with Aro, a C frontend
|
||||
written in Zig. Their reason was to ship a compiler containing no clang at
|
||||
all, self-contained and cross-compiling anywhere. This project has the
|
||||
opposite premise — [clang] on PATH is the whole toolchain assumption — so
|
||||
that move is explained by a constraint that does not apply here.)
|
||||
|
||||
{2 What is imported, and what bounds it}
|
||||
|
||||
Functions, and only functions. Not structs, not enums, not macros.
|
||||
|
||||
The bound on how much gets imported is not a curated list — it is the
|
||||
package's own [defstruct]s. A C function is imported when every type in its
|
||||
signature maps to something the package already declares or to a machine
|
||||
scalar; a function mentioning a struct the package has not described is
|
||||
refused, by name, with that reason. So [vendor/raylib] describing thirteen
|
||||
structs is what makes the import thirteen structs wide, and describing a
|
||||
fourteenth is what widens it. The layouts stay hand-written and stay the
|
||||
single statement about what raylib's structs are, which is the thing the
|
||||
acceptance tests pin; only the *signatures* come from the header.
|
||||
|
||||
This is also why no [defstruct] is generated. Generating one would make the
|
||||
header the authority on layout, and then the check below — comparing the
|
||||
package's [defstruct]s against the header's records — would be comparing
|
||||
the header with itself. Keeping the layouts hand-written is what makes
|
||||
[check_structs] an independent second source, and that check is the
|
||||
cheapest real closure of BUILT.md's trusted-not-guaranteed gap: a
|
||||
[_Static_assert] was rejected there as circular for exactly this reason,
|
||||
and this is not circular, because the two sides have different authors.
|
||||
|
||||
{2 Refusing by demotion}
|
||||
|
||||
Taken from Zig, and the one decision here most worth keeping. Zig's
|
||||
translator never drops a declaration it cannot handle: [failDecl] emits the
|
||||
name bound to a [@compileError] carrying the reason, so the name still
|
||||
exists, the program still compiles, and asking for that one name fails —
|
||||
at the use site, with the reason. A wholesale import has hundreds of
|
||||
refusals and a caller cares about the one they typed.
|
||||
|
||||
Flan has that mechanism already: [Load.refuse_hidden] is the same idea,
|
||||
built for [main]. So a refused import becomes a hidden name.
|
||||
[rl/get-gamepad-name] is not a name, and a program that writes it is told
|
||||
*why* — "returns const char *, and a string only crosses as a parameter" —
|
||||
rather than "unknown name".
|
||||
|
||||
This is also the split the existing generator needs and does not have.
|
||||
[Shim] refuses through [Loc.fail], which is right when a human named one
|
||||
function and wrong for a wholesale import: one returned [const char *]
|
||||
would otherwise kill the whole header. Same judgement, different
|
||||
disposition — a hand-written [declare-c] still hard-fails, and [Shim] is
|
||||
untouched. *)
|
||||
|
||||
let fail = Loc.fail
|
||||
|
||||
(* ── Names ─────────────────────────────────────────────────────────
|
||||
|
||||
The C symbol is kept verbatim in [Ast.DeclareC], so the kebab rule never
|
||||
needs an inverse: the generated wrapper reads the spelling out of the
|
||||
declaration rather than reconstructing it. What the rule does have to be is
|
||||
*injective over one header*, since two C functions arriving under one Flan
|
||||
name is a collision the checker would report as a duplicate declaration
|
||||
about a name nobody wrote. That is asserted below, by name.
|
||||
|
||||
The rule, in full. A boundary goes before a character that is
|
||||
|
||||
- an uppercase letter after a lowercase one — [InitWindow] → init-window
|
||||
- an uppercase letter between an uppercase and
|
||||
a lowercase one — [ColorToHSV] → color-to-hsv
|
||||
- a digit after a lowercase letter — [BeginMode2D] → begin-mode-2d
|
||||
|
||||
and nowhere else; an underscore is a boundary and disappears. The third
|
||||
clause is what keeps [2D] together as one word, and the second is what keeps
|
||||
an acronym together: [SetTargetFPS] is set-target-fps and not
|
||||
set-target-f-p-s, [UnloadUTF8] is unload-utf8. *)
|
||||
|
||||
let kebab (s : string) : string =
|
||||
let n = String.length s in
|
||||
let b = Buffer.create (n + 8) in
|
||||
String.iteri
|
||||
(fun i c ->
|
||||
let prev = if i > 0 then s.[i - 1] else '\000' in
|
||||
let next = if i + 1 < n then s.[i + 1] else '\000' in
|
||||
let upper c = c >= 'A' && c <= 'Z' in
|
||||
let lower c = c >= 'a' && c <= 'z' in
|
||||
let digit c = c >= '0' && c <= '9' in
|
||||
if
|
||||
i > 0 && prev <> '_'
|
||||
&& ((upper c && lower prev)
|
||||
|| (upper c && upper prev && lower next)
|
||||
|| (digit c && lower prev))
|
||||
then Buffer.add_char b '-';
|
||||
if c = '_' then (if Buffer.length b > 0 then Buffer.add_char b '-')
|
||||
else Buffer.add_char b (Char.lowercase_ascii c))
|
||||
s;
|
||||
Buffer.contents b
|
||||
|
||||
(* ── What clang was asked, and what it said ────────────────────────── *)
|
||||
|
||||
(* One C function, as the dump describes it and before anything is decided
|
||||
about whether Flan can hold it. *)
|
||||
type cfn = {
|
||||
csym : string;
|
||||
cret : string; (* the return type, as clang spells it *)
|
||||
cparams : (string * string) list; (* name (possibly ""), type *)
|
||||
cvariadic : bool;
|
||||
cloc : Loc.t; (* the line of the header it is on *)
|
||||
}
|
||||
|
||||
(* One C struct, for checking a [defstruct] against. *)
|
||||
type crecord = { rname : string; rfields : (string * string) list }
|
||||
|
||||
type dump = {
|
||||
fns : cfn list;
|
||||
records : crecord list;
|
||||
(* A typedef's underlying spelling: [Texture2D] → [struct Texture], and
|
||||
[Camera] → [Camera3D]. Followed when the spelled name is not one the
|
||||
package declares, which is what lets a Flan [defstruct Texture2D] serve a
|
||||
C parameter typed [Texture]. *)
|
||||
typedefs : (string * string) list;
|
||||
(* The typedef names that are enums rather than records. A C enum is an int
|
||||
on every target this compiles for, which is also what [Shim] lowers a Flan
|
||||
[defenum] to, so the two agree by construction. *)
|
||||
enums : string list;
|
||||
}
|
||||
|
||||
let clang_argv ~header ~flags =
|
||||
[ "clang"; "-Xclang"; "-ast-dump=json"; "-fsyntax-only" ] @ flags @ [ header ]
|
||||
|
||||
(* clang's stdout, or its stderr if it failed. Run through [Unix.create_process]
|
||||
rather than a shell so a path with a space in it needs no quoting and no
|
||||
[Filename.quote] round trip. *)
|
||||
let run_clang ~loc ~header ~flags =
|
||||
if not (Sys.file_exists header) then
|
||||
fail loc "no such header: %s" header;
|
||||
let argv = clang_argv ~header ~flags in
|
||||
let out_r, out_w = Unix.pipe ~cloexec:false () in
|
||||
let err_r, err_w = Unix.pipe ~cloexec:false () in
|
||||
let pid =
|
||||
try
|
||||
Unix.create_process "clang" (Array.of_list argv) Unix.stdin out_w err_w
|
||||
with Unix.Unix_error _ ->
|
||||
List.iter Unix.close [ out_r; out_w; err_r; err_w ];
|
||||
fail loc
|
||||
"clang is not on PATH, and reading a C header is done by running it \
|
||||
(%s)"
|
||||
(String.concat " " argv)
|
||||
in
|
||||
Unix.close out_w;
|
||||
Unix.close err_w;
|
||||
(* Both pipes have to be drained as they fill: the dump is megabytes and a
|
||||
process blocked writing stdout while this waits on its exit is a deadlock
|
||||
that only shows up on a big header. *)
|
||||
let read_all fd =
|
||||
let b = Buffer.create 65536 in
|
||||
let chunk = Bytes.create 65536 in
|
||||
let rec go () =
|
||||
match Unix.read fd chunk 0 65536 with
|
||||
| 0 -> ()
|
||||
| k -> Buffer.add_subbytes b chunk 0 k; go ()
|
||||
| exception Unix.Unix_error (Unix.EINTR, _, _) -> go ()
|
||||
in
|
||||
go (); Buffer.contents b
|
||||
in
|
||||
let out_buf = Buffer.create (1 lsl 21) in
|
||||
let err_buf = Buffer.create 4096 in
|
||||
(* Read stdout first but keep stderr drained too. clang writes very little to
|
||||
stderr for a header that parses, and a header that does not parse writes
|
||||
little enough to fit a pipe, so alternating is not needed — but stdout is
|
||||
the one that is megabytes, so it is the one read in the loop. *)
|
||||
Buffer.add_string out_buf (read_all out_r);
|
||||
Buffer.add_string err_buf (read_all err_r);
|
||||
Unix.close out_r;
|
||||
Unix.close err_r;
|
||||
let status = snd (Unix.waitpid [] pid) in
|
||||
(match status with
|
||||
| Unix.WEXITED 0 -> ()
|
||||
| _ ->
|
||||
fail loc "clang could not parse %s:\n%s" header
|
||||
(String.trim (Buffer.contents err_buf)));
|
||||
Buffer.contents out_buf
|
||||
|
||||
(* ── Reading the dump ──────────────────────────────────────────────── *)
|
||||
|
||||
(* clang omits [loc.file] when it is the same as the previous node's, so file
|
||||
attribution is a fold over the children in order and not a lookup. Getting
|
||||
this wrong is not loud: it silently imports everything the header includes,
|
||||
or nothing at all. *)
|
||||
let qual j = match Cjson.mem "type" j with Some t -> Cjson.str "qualType" t | None -> None
|
||||
|
||||
let read_dump ~header (root : Cjson.t) : dump =
|
||||
let want = try Unix.realpath header with Unix.Unix_error _ -> header in
|
||||
let same f = try Unix.realpath f = want with Unix.Unix_error _ -> f = want in
|
||||
let cur = ref "" in
|
||||
let fns = ref [] and records = ref [] and typedefs = ref [] and enums = ref [] in
|
||||
List.iter
|
||||
(fun d ->
|
||||
(match Cjson.mem "loc" d with
|
||||
| Some l -> (match Cjson.str "file" l with Some f -> cur := f | None -> ())
|
||||
| None -> ());
|
||||
let mine = same !cur in
|
||||
let name = Cjson.str "name" d in
|
||||
match (Cjson.str "kind" d, name) with
|
||||
| Some "FunctionDecl", Some nm when mine ->
|
||||
(* A [static] or [inline] definition in a header has no symbol to
|
||||
link against from outside the translation unit that has the body.
|
||||
Left out rather than imported and met at the linker. *)
|
||||
let sc = Cjson.str "storageClass" d in
|
||||
if sc <> Some "static" then begin
|
||||
let q = match qual d with Some q -> q | None -> "" in
|
||||
let cret =
|
||||
match String.index_opt q '(' with
|
||||
| Some k -> String.trim (String.sub q 0 k)
|
||||
| None -> q
|
||||
in
|
||||
let cparams =
|
||||
List.filter_map
|
||||
(fun p ->
|
||||
if Cjson.str "kind" p = Some "ParmVarDecl" then
|
||||
Some (Option.value ~default:"" (Cjson.str "name" p),
|
||||
Option.value ~default:"" (qual p))
|
||||
else None)
|
||||
(Cjson.arr "inner" d)
|
||||
in
|
||||
let line =
|
||||
match Cjson.mem "loc" d with
|
||||
| Some l ->
|
||||
(match Cjson.mem "line" l with
|
||||
| Some (Cjson.Num f) -> int_of_float f
|
||||
| _ -> 0)
|
||||
| None -> 0
|
||||
in
|
||||
fns := { csym = nm; cret; cparams; cvariadic = Cjson.bool "variadic" d;
|
||||
cloc = Loc.make !cur line 1 }
|
||||
:: !fns
|
||||
end
|
||||
| Some "RecordDecl", Some nm when mine && Cjson.bool "completeDefinition" d ->
|
||||
let rfields =
|
||||
List.filter_map
|
||||
(fun f ->
|
||||
if Cjson.str "kind" f = Some "FieldDecl" then
|
||||
Some (Option.value ~default:"" (Cjson.str "name" f),
|
||||
Option.value ~default:"" (qual f))
|
||||
else None)
|
||||
(Cjson.arr "inner" d)
|
||||
in
|
||||
(* A bitfield has no address and no Flan spelling; a record holding
|
||||
one is not one this can check, so it is not recorded and the
|
||||
[defstruct] beside it is left unchecked rather than checked
|
||||
wrongly. Same for an unnamed field, which is an anonymous union or
|
||||
struct. *)
|
||||
let ok =
|
||||
List.for_all
|
||||
(fun f ->
|
||||
Cjson.str "kind" f <> Some "FieldDecl"
|
||||
|| (not (Cjson.bool "isBitfield" f)
|
||||
&& Cjson.str "name" f <> None))
|
||||
(Cjson.arr "inner" d)
|
||||
in
|
||||
if ok then records := { rname = nm; rfields } :: !records
|
||||
| Some "TypedefDecl", Some nm when mine ->
|
||||
(match qual d with
|
||||
| Some u ->
|
||||
typedefs := (nm, u) :: !typedefs;
|
||||
if String.length u > 5 && String.sub u 0 5 = "enum " then
|
||||
enums := nm :: !enums
|
||||
| None -> ())
|
||||
| _ -> ())
|
||||
(Cjson.arr "inner" root);
|
||||
{ fns = List.rev !fns; records = List.rev !records;
|
||||
typedefs = List.rev !typedefs; enums = List.rev !enums }
|
||||
|
||||
(* ── C types into Flan types ───────────────────────────────────────── *)
|
||||
|
||||
(* What the package already says exists. The importer adds no type of its own:
|
||||
it either finds a Flan name for a C type here or refuses the function. *)
|
||||
type env = {
|
||||
known_structs : string list; (* the package's defstruct names *)
|
||||
known_enums : string list; (* its defenum names *)
|
||||
d : dump;
|
||||
}
|
||||
|
||||
exception Refused of string
|
||||
|
||||
let refuse fmt = Printf.ksprintf (fun m -> raise (Refused m)) fmt
|
||||
|
||||
let strip_prefix p s =
|
||||
let lp = String.length p in
|
||||
if String.length s >= lp && String.sub s 0 lp = p then
|
||||
Some (String.trim (String.sub s lp (String.length s - lp)))
|
||||
else None
|
||||
|
||||
(* [const struct Foo] → [Foo]. Qualifiers carry no Flan meaning — Flan has no
|
||||
const — but they have to come off before the name is recognised, and
|
||||
const-ness is read *before* this, where it still means something (see
|
||||
[param_ty]). *)
|
||||
let rec bare s =
|
||||
let s = String.trim s in
|
||||
match
|
||||
List.find_map (fun p -> strip_prefix p s)
|
||||
[ "const "; "volatile "; "restrict "; "struct "; "union "; "enum " ]
|
||||
with
|
||||
| Some s' -> bare s'
|
||||
| None -> s
|
||||
|
||||
(* A generated type expression carries no location of its own: the thing a
|
||||
message about it wants to point at is the declaration's line in the header,
|
||||
which is what the field and the declaration below carry. *)
|
||||
let ty t = { Ast.t; tloc = Loc.unknown }
|
||||
|
||||
let rec ty_source (t : Ast.texpr) =
|
||||
match t.Ast.t with
|
||||
| Ast.Tname n -> n
|
||||
| Ast.Tapp (n, args) ->
|
||||
Printf.sprintf "(%s %s)" n (String.concat " " (List.map ty_source args))
|
||||
| Ast.Tslice e -> Printf.sprintf "[%s]" (ty_source e)
|
||||
| Ast.Tarray (Ast.Lint n, e) -> Printf.sprintf "[%Ld %s]" n (ty_source e)
|
||||
| Ast.Tarray (Ast.Lname n, e) -> Printf.sprintf "[%s %s]" n (ty_source e)
|
||||
| Ast.Tmap (k, v) -> Printf.sprintf "{%s %s}" (ty_source k) (ty_source v)
|
||||
| Ast.Tfn (ps, r) ->
|
||||
Printf.sprintf "(Fn [%s] %s)"
|
||||
(String.concat " " (List.map ty_source ps)) (ty_source r)
|
||||
|
||||
let tname n = ty (Ast.Tname n)
|
||||
|
||||
(* The machine scalars, and the ones deliberately left out.
|
||||
|
||||
[long], [size_t] and the rest are refused rather than guessed, and the
|
||||
reason is specific to this project rather than general fussiness: it builds
|
||||
for x86-64, for wasm32-wasi and for the browser, and [long] is 64 bits on
|
||||
the first and 32 on the others. A guess would be right for the target that
|
||||
gets tested and silently wrong for the two that do not. A header that wants
|
||||
one says so in [declare-c], where a human takes responsibility for it. *)
|
||||
let scalar = function
|
||||
| "void" -> Some "Unit"
|
||||
| "_Bool" | "bool" -> Some "bool"
|
||||
| "char" | "signed char" | "int8_t" -> Some "i8"
|
||||
| "unsigned char" | "uint8_t" -> Some "u8"
|
||||
| "short" | "short int" | "int16_t" -> Some "i16"
|
||||
| "unsigned short" | "unsigned short int" | "uint16_t" -> Some "u16"
|
||||
| "int" | "signed int" | "int32_t" -> Some "i32"
|
||||
| "unsigned" | "unsigned int" | "uint32_t" -> Some "u32"
|
||||
| "int64_t" | "long long" | "long long int" -> Some "i64"
|
||||
| "uint64_t" | "unsigned long long" | "unsigned long long int" -> Some "u64"
|
||||
| "float" -> Some "f32"
|
||||
| "double" -> Some "f64"
|
||||
| _ -> None
|
||||
|
||||
let width_varies =
|
||||
[ "long"; "long int"; "unsigned long"; "unsigned long int"; "size_t";
|
||||
"ssize_t"; "ptrdiff_t"; "intptr_t"; "uintptr_t"; "time_t"; "wchar_t" ]
|
||||
|
||||
(* A named type, after qualifiers and pointers are gone: a struct the package
|
||||
describes, an enum, or nothing this can hold. *)
|
||||
let rec named env (n : string) : Ast.texpr =
|
||||
if List.mem n env.known_structs then tname n
|
||||
else if List.mem n env.known_enums then tname n
|
||||
else if List.mem n env.d.enums then
|
||||
(* A C enum is an int, which is what [Shim] lowers a Flan [defenum] to, so
|
||||
this is the same ABI and not a widening. What it loses is the nice face:
|
||||
a parameter typed [Key] takes [:space] at the call site and an [i32]
|
||||
does not. That is a reason to keep a hand-written [declare-c] for the
|
||||
few calls where it matters, not a reason to refuse the other five
|
||||
hundred. *)
|
||||
tname "i32"
|
||||
else if List.exists (fun r -> r.rname = n) env.d.records then
|
||||
(* Checked before the typedef table, because C's usual idiom
|
||||
[typedef struct Vector3 { ... } Vector3;] puts the same name in both and
|
||||
following it would arrive straight back here.
|
||||
|
||||
One step first, in the other direction: the package may already describe
|
||||
this record under one of its *other* typedef names. raylib's record is
|
||||
[struct Texture] and [Texture2D], [TextureCubemap] and the package's own
|
||||
[defstruct Texture2D] are all names for it, so [LoadTextureCubemap]
|
||||
returns the same struct the package has described and refusing it would
|
||||
be wrong. Any known struct whose typedef bottoms out at this record
|
||||
will do; they denote the same layout by construction. *)
|
||||
match
|
||||
List.find_opt
|
||||
(fun k ->
|
||||
match List.assoc_opt k env.d.typedefs with
|
||||
| Some u -> String.equal (bare u) n
|
||||
| None -> false)
|
||||
env.known_structs
|
||||
with
|
||||
| Some k -> tname k
|
||||
| None ->
|
||||
refuse
|
||||
"%s is a struct the package does not describe — add a defstruct for \
|
||||
it, or keep a hand-written declare-c"
|
||||
n
|
||||
else if List.mem_assoc n env.d.typedefs then begin
|
||||
let u = List.assoc n env.d.typedefs in
|
||||
if bare u = n then
|
||||
refuse "%s is a typedef of itself, which is not a type" n
|
||||
else
|
||||
(* Back through [value_ty] and not straight to [named]: a typedef may
|
||||
name a pointer or a function pointer — raylib's [AudioCallback] is
|
||||
one — and only [value_ty] knows what to say about either. Going
|
||||
straight to [named] reported a callback as an unknown type rather
|
||||
than as the callback it is. *)
|
||||
value_ty env u
|
||||
end
|
||||
else if List.mem n width_varies then
|
||||
refuse
|
||||
"%s has a width that differs between this project's own targets (64 \
|
||||
bits on x86-64, 32 on wasm32), so no single Flan type is right for it"
|
||||
n
|
||||
else refuse "%s is not a type the header importer knows" n
|
||||
|
||||
(* A type in any position but an outermost parameter. Pointers are where C says
|
||||
least and Flan has to say something: a [T *] is one T, or an array of them,
|
||||
or null, and the header does not distinguish. Flan's [(Ptr T)] claims only
|
||||
"the address of a T", which is the weakest of those and therefore the only
|
||||
honest one — the same judgement Zig makes when it translates [T *] to
|
||||
[[*c]T] rather than to a single-item pointer. *)
|
||||
and value_ty env (s : string) : Ast.texpr =
|
||||
let s = String.trim s in
|
||||
if String.length s > 0 && s.[String.length s - 1] = '*' then begin
|
||||
let inner = String.trim (String.sub s 0 (String.length s - 1)) in
|
||||
let b = bare inner in
|
||||
(* [void *] is an address of unknown element type; [(Ptr u8)] is what the
|
||||
package already spells that as ([Image.data]). *)
|
||||
if b = "void" then ty (Ast.Tapp ("Ptr", [ tname "u8" ]))
|
||||
else ty (Ast.Tapp ("Ptr", [ value_ty env inner ]))
|
||||
end
|
||||
else if String.contains s '[' then
|
||||
refuse "%s is an array, which C passes as a pointer and Flan as a value" s
|
||||
else if String.contains s '(' then
|
||||
refuse "%s is a function pointer, and a C callback is not implemented" s
|
||||
else
|
||||
let b = bare s in
|
||||
match scalar b with
|
||||
| Some "Unit" -> refuse "void is not a value"
|
||||
| Some p -> tname p
|
||||
| None -> named env b
|
||||
|
||||
(* A parameter, where two C spellings mean things no other position does.
|
||||
|
||||
[const char *] is a string going in, and [Shim] already knows how to hand
|
||||
one over: Flan's ptr+len, NUL-terminated into a copy for the duration of the
|
||||
call. [char *] without the const is not that. It is very often a buffer the
|
||||
callee *writes*, and handing it a temporary copy would lose the writes with
|
||||
no diagnostic anywhere. const is the only thing in the header that separates
|
||||
the two, so it is what decides, and a genuine out-buffer keeps a
|
||||
hand-written binding that says [(Ptr u8)] and means it. *)
|
||||
let param_ty env (s : string) : Ast.texpr =
|
||||
let s = String.trim s in
|
||||
if String.length s > 0 && s.[String.length s - 1] = '*' then begin
|
||||
let inner = String.trim (String.sub s 0 (String.length s - 1)) in
|
||||
let is_const = strip_prefix "const " inner <> None in
|
||||
match bare inner with
|
||||
| "char" when is_const -> tname "string"
|
||||
| "char" ->
|
||||
refuse
|
||||
"char * is a parameter C may write through, and a Flan string crosses \
|
||||
as a NUL-terminated copy — the writes would be lost. const char * is \
|
||||
a string; this one needs a declare-c saying (Ptr u8)"
|
||||
| _ -> value_ty env s
|
||||
end
|
||||
else value_ty env s
|
||||
|
||||
(* The return type. Every refusal here is one [Shim] would also make; it is
|
||||
made earlier so that the reason names the C spelling rather than the Flan
|
||||
one it was about to become. *)
|
||||
let ret_ty env (s : string) : Ast.texpr option =
|
||||
let s = String.trim s in
|
||||
if bare s = "void" && not (String.contains s '*') then None
|
||||
else if String.length s > 0 && s.[String.length s - 1] = '*' then begin
|
||||
let inner = String.trim (String.sub s 0 (String.length s - 1)) in
|
||||
match bare inner with
|
||||
| "char" ->
|
||||
refuse
|
||||
"returns char *, and a string only crosses as a parameter — a C \
|
||||
function that returns one returns something Flan has no owner for"
|
||||
| _ -> Some (value_ty env s)
|
||||
end
|
||||
else Some (value_ty env s)
|
||||
|
||||
(* ── One header, imported ──────────────────────────────────────────── *)
|
||||
|
||||
type imported = {
|
||||
decls : Ast.decl list;
|
||||
(* Name and reason, for [Load.refuse_hidden]: the name exists as a thing
|
||||
that cannot be had, and asking for it says why. Zig's [failDecl]. *)
|
||||
hidden : (string * string) list;
|
||||
}
|
||||
|
||||
(* [taken] is every name the package already declares, which is what makes the
|
||||
sidecar additive: a hand-written [(declare-c get-gamepad-name ...)] wins
|
||||
over the header, and a C symbol already bound by hand is not bound twice —
|
||||
which [Shim] would refuse for the whole build.
|
||||
|
||||
[-c] as well as the name itself, because [Shim] generates [foo-c] beside a
|
||||
[foo] whose signature has a struct in it, and a collision there is refused
|
||||
for the whole program rather than for the one binding. *)
|
||||
let of_dump ~env ~taken ~bound_syms (d : dump) : imported =
|
||||
let decls = ref [] and hidden = ref [] in
|
||||
(* Collisions are found before anything is emitted, and they take *every*
|
||||
name in the colliding group down with them.
|
||||
|
||||
Resolving one by taking the first and refusing the rest is the tempting
|
||||
shape and the wrong one: which C function ends up owning the Flan name
|
||||
would then depend on the order the header happens to declare them in, so
|
||||
moving two lines in somebody else's header silently rebinds a name a Flan
|
||||
program is already calling. There is no reading of [spin-2d] that is
|
||||
obviously right when the header offers both [Spin2D] and [spin2d], so
|
||||
neither gets it, and both say why. The author disambiguates with a
|
||||
hand-written declare-c, which is what that form is for.
|
||||
|
||||
[bound_syms] is excluded first: a C function the package already binds by
|
||||
hand is not competing for an imported name at all, so it cannot collide
|
||||
with one. *)
|
||||
let candidates =
|
||||
List.filter (fun f -> not (List.mem f.csym bound_syms)) d.fns
|
||||
in
|
||||
let groups = Hashtbl.create 512 in
|
||||
List.iter
|
||||
(fun f ->
|
||||
let k = kebab f.csym in
|
||||
Hashtbl.replace groups k (f.csym :: Option.value ~default:[]
|
||||
(Hashtbl.find_opt groups k)))
|
||||
candidates;
|
||||
List.iter
|
||||
(fun f ->
|
||||
let flan = kebab f.csym in
|
||||
let skip why = hidden := (flan, why) :: !hidden in
|
||||
match List.rev (Hashtbl.find groups flan) with
|
||||
| _ :: _ :: _ as all ->
|
||||
skip
|
||||
(Printf.sprintf
|
||||
"%s all kebab to %s, and which one got the name would depend on \
|
||||
the order the header declares them in — so none of them takes \
|
||||
it. Bind the one you want with a hand-written declare-c"
|
||||
(String.concat ", " all) flan)
|
||||
| _ ->
|
||||
if Hashtbl.mem taken flan || Hashtbl.mem taken (flan ^ "-c") then
|
||||
skip
|
||||
(Printf.sprintf
|
||||
"%s would be the imported name of %s, and the package declares \
|
||||
%s already" flan f.csym flan)
|
||||
else if f.cvariadic then
|
||||
skip
|
||||
(Printf.sprintf
|
||||
"%s is variadic, and a wrapper cannot forward an argument list \
|
||||
it does not know the shape of" f.csym)
|
||||
else
|
||||
match
|
||||
(try
|
||||
let ps =
|
||||
List.mapi
|
||||
(fun i (n, t) ->
|
||||
let n = if n = "" then Printf.sprintf "a%d" i else kebab n in
|
||||
{ Ast.fname = n; fty = param_ty env t; floc = f.cloc })
|
||||
f.cparams
|
||||
in
|
||||
(* [void] spelled as the only parameter is C for "none". clang
|
||||
reports it as no ParmVarDecl at all, so this is belt and
|
||||
braces. *)
|
||||
let ps = List.filter (fun (p : Ast.field) -> p.Ast.fname <> "void") ps in
|
||||
Ok (ps, ret_ty env f.cret)
|
||||
with Refused why -> Error why)
|
||||
with
|
||||
| Error why -> skip (Printf.sprintf "%s %s" f.csym why)
|
||||
| Ok (params, ret) ->
|
||||
decls :=
|
||||
{ Ast.d =
|
||||
Ast.DeclareC
|
||||
({ Ast.name = flan; params; ret; fbody = []; nloc = f.cloc },
|
||||
f.csym);
|
||||
dloc = f.cloc }
|
||||
:: !decls)
|
||||
candidates;
|
||||
(* One entry per name. A collision refuses every member of its group and each
|
||||
of them writes the same reason under the same name, which [refuse_hidden]
|
||||
would look up identically but a report would print twice. *)
|
||||
let seen = Hashtbl.create 64 in
|
||||
let hidden =
|
||||
List.filter
|
||||
(fun (n, _) ->
|
||||
if Hashtbl.mem seen n then false else (Hashtbl.add seen n (); true))
|
||||
(List.rev !hidden)
|
||||
in
|
||||
{ decls = List.rev !decls; hidden }
|
||||
|
||||
(* ── Checking the package's layouts against the header's ───────────── *)
|
||||
|
||||
(* The point of reading a header that the generator does not otherwise need.
|
||||
|
||||
BUILT.md rejected a [_Static_assert] on [sizeof]/[offsetof] as circular:
|
||||
both sides would have come from the same field list. This is not circular.
|
||||
The [defstruct] was written by hand and the record comes from the library's
|
||||
own header, so a disagreement is real information — and it is the failure
|
||||
mode the whole FFI is most exposed to, since a permuted [Texture2D] reads as
|
||||
five plausible numbers and no link error.
|
||||
|
||||
Reported and not raised. A package may legitimately describe a prefix of a
|
||||
struct it only ever holds by pointer, and a header that is a different
|
||||
version of the library is a normal state of affairs to be told about rather
|
||||
than stopped by. *)
|
||||
let check_structs ~env ~(structs : (string * Ast.field list) list) (d : dump) =
|
||||
let record n =
|
||||
match List.find_opt (fun r -> r.rname = n) d.records with
|
||||
| Some r -> Some r
|
||||
| None ->
|
||||
(* [defstruct Texture2D] against a header whose record is [Texture] and
|
||||
whose typedef says so. *)
|
||||
(match List.assoc_opt n d.typedefs with
|
||||
| Some u -> List.find_opt (fun r -> r.rname = bare u) d.records
|
||||
| None -> None)
|
||||
in
|
||||
(* Names and widths both. Order is what a permuted [defstruct] gets wrong and
|
||||
what BUILT.md says only a test can catch; width is the other half of the
|
||||
same hazard and the one it calls out by name — [f64] where the library
|
||||
says [float] lays out eight bytes where there are four, and every field
|
||||
after it moves. Comparing the rendered Flan type rather than the C
|
||||
spelling keeps the two sides commensurable: [u8] and [unsigned char] have
|
||||
to come out equal, and [f32] and [double] have to not. *)
|
||||
let field_mismatch (fs : Ast.field list) (r : crecord) =
|
||||
if List.length fs <> List.length r.rfields then
|
||||
Some
|
||||
(Printf.sprintf "defstruct has %d fields [%s] and %s has %d [%s]"
|
||||
(List.length fs)
|
||||
(String.concat " " (List.map (fun (f : Ast.field) -> f.Ast.fname) fs))
|
||||
r.rname (List.length r.rfields)
|
||||
(String.concat " " (List.map (fun (n, _) -> kebab n) r.rfields)))
|
||||
else
|
||||
List.find_map
|
||||
(fun ((f : Ast.field), (cn, ct)) ->
|
||||
if kebab cn <> f.Ast.fname then
|
||||
Some
|
||||
(Printf.sprintf
|
||||
"the defstruct has %s where %s has %s, so the field order disagrees"
|
||||
f.Ast.fname r.rname (kebab cn))
|
||||
else
|
||||
match (try Some (value_ty env ct) with Refused _ -> None) with
|
||||
| None -> None (* a field type this cannot render says nothing *)
|
||||
| Some want ->
|
||||
let a = ty_source want and b = ty_source f.Ast.fty in
|
||||
if String.equal a b then None
|
||||
else
|
||||
Some
|
||||
(Printf.sprintf "field %s is %s in the defstruct and %s (%s) in %s"
|
||||
f.Ast.fname b a ct r.rname))
|
||||
(List.combine fs r.rfields)
|
||||
in
|
||||
List.filter_map
|
||||
(fun (n, (fs : Ast.field list)) ->
|
||||
match record n with
|
||||
| None -> None
|
||||
| Some r -> Option.map (fun m -> (n, m)) (field_mismatch fs r))
|
||||
structs
|
||||
|
||||
(* ── The entry point ───────────────────────────────────────────────── *)
|
||||
|
||||
let dump_of_clang ~loc ~header ~flags =
|
||||
let text = run_clang ~loc ~header ~flags in
|
||||
let json =
|
||||
try Cjson.parse text
|
||||
with Cjson.Bad m ->
|
||||
fail loc "clang's AST dump of %s did not parse: %s" header m
|
||||
in
|
||||
read_dump ~header json
|
||||
|
||||
(* ── The cache ─────────────────────────────────────────────────────── *)
|
||||
|
||||
(* Measured, not assumed: reading raylib.h costs 64ms — 30ms for clang to write
|
||||
1.8 MB of JSON and the rest to parse it and map it — against an 8ms check
|
||||
for the whole program without it. The dev loop rebuilds constantly and the
|
||||
header does not change between two of those rebuilds, so paying it every
|
||||
time is eight times the cost of everything else put together.
|
||||
|
||||
What is cached is the *extracted* dump and not clang's JSON: it is the
|
||||
parse that is half the cost, and what comes out is a few hundred signatures
|
||||
rather than megabytes of source ranges.
|
||||
|
||||
Keyed the way the object cache is keyed, and for the same reason — on
|
||||
everything that could change the answer. The header's path, its size and
|
||||
mtime, and the full flag list, because a flag changes what clang sees; plus
|
||||
a format version, because the cached value is a marshalled OCaml value and a
|
||||
compiler whose [dump] type has changed must not read one written by the old
|
||||
one. [Marshal] does not check that for you and a mismatch is a segfault
|
||||
rather than an exception, so the discipline is: **change the [dump] type,
|
||||
bump [cache_format] in the same commit.** Nothing enforces it. *)
|
||||
|
||||
let cache_format = 1
|
||||
|
||||
let cachedir () =
|
||||
let d = Filename.concat (Filename.get_temp_dir_name ()) "flan-cimport" in
|
||||
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
||||
d
|
||||
|
||||
let dump_of ~loc ~header ~flags =
|
||||
let st = try Some (Unix.stat header) with Unix.Unix_error _ -> None in
|
||||
match st with
|
||||
| None -> dump_of_clang ~loc ~header ~flags
|
||||
| Some st ->
|
||||
let key =
|
||||
Digest.to_hex
|
||||
(Digest.string
|
||||
(String.concat "\000"
|
||||
[ string_of_int cache_format;
|
||||
(try Unix.realpath header with Unix.Unix_error _ -> header);
|
||||
string_of_int st.Unix.st_size;
|
||||
Printf.sprintf "%.6f" st.Unix.st_mtime;
|
||||
String.concat " " flags ]))
|
||||
in
|
||||
let path = Filename.concat (cachedir ()) (key ^ ".dump") in
|
||||
let cached =
|
||||
if not (Sys.file_exists path) then None
|
||||
else
|
||||
try
|
||||
let ch = open_in_bin path in
|
||||
Fun.protect
|
||||
~finally:(fun () -> close_in_noerr ch)
|
||||
(fun () -> Some (Marshal.from_channel ch : dump))
|
||||
with _ ->
|
||||
(* A truncated or stale file is not worth a build failure: the header
|
||||
is right there and can be read again. *)
|
||||
(try Sys.remove path with Sys_error _ -> ());
|
||||
None
|
||||
in
|
||||
(match cached with
|
||||
| Some d -> d
|
||||
| None ->
|
||||
let d = dump_of_clang ~loc ~header ~flags in
|
||||
(* Written to a distinct name and renamed, so two builds running at
|
||||
once cannot see a half-written file — the object cache does the
|
||||
same. *)
|
||||
(try
|
||||
let tmp = Printf.sprintf "%s.%d.tmp" path (Unix.getpid ()) in
|
||||
let ch = open_out_bin tmp in
|
||||
Fun.protect
|
||||
~finally:(fun () -> close_out_noerr ch)
|
||||
(fun () -> Marshal.to_channel ch d []);
|
||||
Sys.rename tmp path
|
||||
with Sys_error _ -> ());
|
||||
d)
|
||||
|
||||
let env_of ~known_structs ~known_enums d = { known_structs; known_enums; d }
|
||||
|
||||
let header ~loc ~header:h ~flags ~known_structs ~known_enums ~taken ~bound_syms =
|
||||
let d = dump_of ~loc ~header:h ~flags in
|
||||
let env = env_of ~known_structs ~known_enums d in
|
||||
(of_dump ~env ~taken ~bound_syms d, d, env)
|
||||
|
||||
(* ── Printing a declaration back as source ─────────────────────────── *)
|
||||
|
||||
(* Which makes the third option in DISCUSS.md item 6 available at no extra
|
||||
cost: generate the declarations from the header, *commit the result*, and
|
||||
regenerate when the library moves. That trade — explicit in the source,
|
||||
checked against reality, no header read at build time — is a real one, and
|
||||
it needs a printer and nothing else. [flan import-c] is it. *)
|
||||
|
||||
|
||||
let decl_source (d : Ast.decl) =
|
||||
match d.Ast.d with
|
||||
| Ast.DeclareC (fn, csym) ->
|
||||
Printf.sprintf "(declare-c %s [%s]%s %S)" fn.Ast.name
|
||||
(String.concat " "
|
||||
(List.map
|
||||
(fun (p : Ast.field) ->
|
||||
Printf.sprintf "%s %s" p.Ast.fname (ty_source p.Ast.fty))
|
||||
fn.Ast.params))
|
||||
(match fn.Ast.ret with None -> "" | Some t -> " " ^ ty_source t)
|
||||
csym
|
||||
| _ -> ""
|
||||
|
||||
(* ── A hand-written binding, against the header's own signature ────── *)
|
||||
|
||||
(* The other half of closing the trusted gap, and the one that pays off
|
||||
immediately: [vendor/raylib] carries 176 [declare-c] lines that were
|
||||
transcribed by hand from raylib's documentation, and until now nothing could
|
||||
say whether any of them was right. This says so, one at a time.
|
||||
|
||||
Compared as *rendered Flan types*, not as C spellings, because the two sides
|
||||
are not written in the same language and only the Flan rendering is
|
||||
commensurable. Three differences are expected and are not reported:
|
||||
|
||||
- the Flan name. [IsKeyPressed] is [key-pressed?] by hand and
|
||||
[is-key-pressed] by rule, and the hand-written one is better. The C symbol
|
||||
is what identifies the function here, not the name.
|
||||
- an enum parameter. The header says [KeyboardKey] and the importer has no
|
||||
way to know the package calls that [Key], so it says [i32]; the
|
||||
hand-written [Key] is the same int with a better face.
|
||||
- a [(Ptr T)] where the header says [T *] and the hand-written line chose
|
||||
something more specific for a reason it recorded.
|
||||
|
||||
What is left after those is a real disagreement about a width, an arity or a
|
||||
direction — which is exactly the class of bug BUILT.md warns about, where
|
||||
[f64] against the library's [float] reads as garbage rather than as a link
|
||||
error. *)
|
||||
|
||||
type sig_diff = { dsym : string; dflan : string; dwhy : string }
|
||||
|
||||
let diff_bound ~env ~(bound : (Ast.fn * string) list) (d : dump) =
|
||||
let by_sym = Hashtbl.create 512 in
|
||||
List.iter (fun f -> Hashtbl.replace by_sym f.csym f) d.fns;
|
||||
List.filter_map
|
||||
(fun ((fn : Ast.fn), csym) ->
|
||||
match Hashtbl.find_opt by_sym csym with
|
||||
| None ->
|
||||
Some
|
||||
{ dsym = csym; dflan = fn.Ast.name;
|
||||
dwhy = "the header does not declare this function at all" }
|
||||
| Some c ->
|
||||
let say why = Some { dsym = csym; dflan = fn.Ast.name; dwhy = why } in
|
||||
(* An enum on the Flan side against a plain int from the header is
|
||||
the expected difference and not a finding — that is what a Flan
|
||||
[defenum] *is* at the boundary, and giving it a name is the whole
|
||||
point of declaring one. Signedness goes with it: raylib spells
|
||||
[IsGestureDetected]'s parameter [unsigned int] and the package
|
||||
calls it [Gesture], and since both are four bytes in a register
|
||||
there is no ABI difference to report. What is still reported is an
|
||||
enum against something that is *not* a 32-bit integer, which would
|
||||
be a real one. *)
|
||||
let enum_like (t : Ast.texpr) =
|
||||
match t.Ast.t with
|
||||
| Ast.Tname n -> List.mem n env.known_enums
|
||||
| _ -> false
|
||||
in
|
||||
let int32_like s = String.equal s "i32" || String.equal s "u32" in
|
||||
let norm (t : Ast.texpr) = ty_source t in
|
||||
let same a b =
|
||||
String.equal (norm a) (norm b)
|
||||
|| (enum_like a && int32_like (norm b))
|
||||
|| (enum_like b && int32_like (norm a))
|
||||
in
|
||||
if c.cvariadic then None
|
||||
else if List.length fn.Ast.params <> List.length c.cparams then
|
||||
say
|
||||
(Printf.sprintf "declared with %d parameters and the header says %d (%s)"
|
||||
(List.length fn.Ast.params) (List.length c.cparams)
|
||||
(String.concat ", " (List.map snd c.cparams)))
|
||||
else
|
||||
let param_diff =
|
||||
List.find_map
|
||||
(fun ((p : Ast.field), (_, ct)) ->
|
||||
match (try Some (param_ty env ct) with Refused _ -> None) with
|
||||
| None -> None
|
||||
| Some want ->
|
||||
if same want p.Ast.fty then None
|
||||
else
|
||||
Some
|
||||
(Printf.sprintf "parameter %s is %s and the header says %s (%s)"
|
||||
p.Ast.fname (ty_source p.Ast.fty) (norm want) ct))
|
||||
(List.combine fn.Ast.params c.cparams)
|
||||
in
|
||||
match param_diff with
|
||||
| Some why -> say why
|
||||
| None ->
|
||||
(match (try Ok (ret_ty env c.cret) with Refused w -> Error w) with
|
||||
| Error _ -> None
|
||||
| Ok want ->
|
||||
let agrees =
|
||||
match (want, fn.Ast.ret) with
|
||||
| None, None -> true
|
||||
| Some a, Some b -> same a b
|
||||
| _ -> false
|
||||
in
|
||||
if agrees then None
|
||||
else
|
||||
say
|
||||
(Printf.sprintf "returns %s and the header says %s (%s)"
|
||||
(match fn.Ast.ret with None -> "nothing" | Some t -> ty_source t)
|
||||
(match want with None -> "nothing" | Some t -> ty_source t)
|
||||
c.cret)))
|
||||
bound
|
||||
174
lib/cjson.ml
Normal file
174
lib/cjson.ml
Normal file
@ -0,0 +1,174 @@
|
||||
(** Just enough JSON to read clang's AST dump.
|
||||
|
||||
Not a general JSON library and not a dependency. The compiler's build
|
||||
inputs are a [clang] on PATH and nothing else — that is plan.org's "Why
|
||||
LLVM IR as text" applied a second time — so reading clang's
|
||||
[-ast-dump=json] must not drag in an opam package to parse it. What the
|
||||
dump actually contains is a narrow subset: objects, arrays, strings,
|
||||
integers, [true]/[false]/[null]. No floats appear in a declaration dump,
|
||||
but one is accepted anyway rather than being a lurking parse error.
|
||||
|
||||
The reader is strict about structure and lax about what it keeps: a dump of
|
||||
raylib.h is 1.8 MB and roughly fifty thousand objects, almost all of it
|
||||
source ranges nobody asks for. Parsing it whole and then selecting is still
|
||||
well under the cost of the [clang] process that produced it, so there is no
|
||||
streaming filter here and no reason for one. *)
|
||||
|
||||
type t =
|
||||
| Null
|
||||
| Bool of bool
|
||||
| Num of float
|
||||
| Str of string
|
||||
| Arr of t list
|
||||
| Obj of (string * t) list
|
||||
|
||||
exception Bad of string
|
||||
|
||||
let bad fmt = Printf.ksprintf (fun m -> raise (Bad m)) fmt
|
||||
|
||||
let parse (s : string) : t =
|
||||
let n = String.length s in
|
||||
let i = ref 0 in
|
||||
let peek () = if !i < n then s.[!i] else '\000' in
|
||||
let rec skip_ws () =
|
||||
if !i < n then
|
||||
match s.[!i] with
|
||||
| ' ' | '\t' | '\n' | '\r' -> incr i; skip_ws ()
|
||||
| _ -> ()
|
||||
in
|
||||
let expect c =
|
||||
if !i >= n || s.[!i] <> c then
|
||||
bad "expected %c at byte %d" c !i
|
||||
else incr i
|
||||
in
|
||||
let lit word v =
|
||||
let l = String.length word in
|
||||
if !i + l <= n && String.sub s !i l = word then (i := !i + l; v)
|
||||
else bad "bad literal at byte %d" !i
|
||||
in
|
||||
(* Strings are the hot path — every node has several — so the common case of
|
||||
no escape at all is copied out in one [String.sub] rather than a character
|
||||
at a time through a Buffer. *)
|
||||
let string_ () =
|
||||
expect '"';
|
||||
let start = !i in
|
||||
let rec scan plain =
|
||||
if !i >= n then bad "unterminated string at byte %d" start
|
||||
else
|
||||
match s.[!i] with
|
||||
| '"' -> plain
|
||||
| '\\' -> i := !i + 2; scan false
|
||||
| _ -> incr i; scan plain
|
||||
in
|
||||
let plain = scan true in
|
||||
if plain then begin
|
||||
let r = String.sub s start (!i - start) in
|
||||
incr i; r
|
||||
end
|
||||
else begin
|
||||
let b = Buffer.create (!i - start) in
|
||||
let j = ref start in
|
||||
while !j < !i do
|
||||
(match s.[!j] with
|
||||
| '\\' ->
|
||||
incr j;
|
||||
(match s.[!j] with
|
||||
| 'n' -> Buffer.add_char b '\n'
|
||||
| 't' -> Buffer.add_char b '\t'
|
||||
| 'r' -> Buffer.add_char b '\r'
|
||||
| 'b' -> Buffer.add_char b '\b'
|
||||
| 'f' -> Buffer.add_char b '\012'
|
||||
| '/' -> Buffer.add_char b '/'
|
||||
| '"' -> Buffer.add_char b '"'
|
||||
| '\\' -> Buffer.add_char b '\\'
|
||||
| 'u' ->
|
||||
(* clang escapes a non-ASCII identifier or a comment this way.
|
||||
Encoded as UTF-8; a surrogate pair is not joined, which is
|
||||
acceptable because nothing this reads is ever a name Flan
|
||||
could use anyway. *)
|
||||
let hex = String.sub s (!j + 1) 4 in
|
||||
j := !j + 4;
|
||||
let c = int_of_string ("0x" ^ hex) in
|
||||
if c < 0x80 then Buffer.add_char b (Char.chr c)
|
||||
else if c < 0x800 then begin
|
||||
Buffer.add_char b (Char.chr (0xC0 lor (c lsr 6)));
|
||||
Buffer.add_char b (Char.chr (0x80 lor (c land 0x3F)))
|
||||
end
|
||||
else begin
|
||||
Buffer.add_char b (Char.chr (0xE0 lor (c lsr 12)));
|
||||
Buffer.add_char b (Char.chr (0x80 lor ((c lsr 6) land 0x3F)));
|
||||
Buffer.add_char b (Char.chr (0x80 lor (c land 0x3F)))
|
||||
end
|
||||
| c -> bad "unknown escape \\%c at byte %d" c !j)
|
||||
| c -> Buffer.add_char b c);
|
||||
incr j
|
||||
done;
|
||||
incr i;
|
||||
Buffer.contents b
|
||||
end
|
||||
in
|
||||
let number () =
|
||||
let start = !i in
|
||||
if peek () = '-' then incr i;
|
||||
let digits () = while !i < n && s.[!i] >= '0' && s.[!i] <= '9' do incr i done in
|
||||
digits ();
|
||||
if peek () = '.' then (incr i; digits ());
|
||||
if peek () = 'e' || peek () = 'E' then begin
|
||||
incr i;
|
||||
if peek () = '+' || peek () = '-' then incr i;
|
||||
digits ()
|
||||
end;
|
||||
if !i = start then bad "expected a number at byte %d" start;
|
||||
Num (float_of_string (String.sub s start (!i - start)))
|
||||
in
|
||||
let rec value () =
|
||||
skip_ws ();
|
||||
match peek () with
|
||||
| '{' ->
|
||||
incr i; skip_ws ();
|
||||
if peek () = '}' then (incr i; Obj [])
|
||||
else begin
|
||||
let acc = ref [] in
|
||||
let rec members () =
|
||||
skip_ws ();
|
||||
let k = string_ () in
|
||||
skip_ws (); expect ':';
|
||||
let v = value () in
|
||||
acc := (k, v) :: !acc;
|
||||
skip_ws ();
|
||||
if peek () = ',' then (incr i; members ()) else expect '}'
|
||||
in
|
||||
members ();
|
||||
Obj (List.rev !acc)
|
||||
end
|
||||
| '[' ->
|
||||
incr i; skip_ws ();
|
||||
if peek () = ']' then (incr i; Arr [])
|
||||
else begin
|
||||
let acc = ref [] in
|
||||
let rec items () =
|
||||
let v = value () in
|
||||
acc := v :: !acc;
|
||||
skip_ws ();
|
||||
if peek () = ',' then (incr i; items ()) else expect ']'
|
||||
in
|
||||
items ();
|
||||
Arr (List.rev !acc)
|
||||
end
|
||||
| '"' -> Str (string_ ())
|
||||
| 't' -> lit "true" (Bool true)
|
||||
| 'f' -> lit "false" (Bool false)
|
||||
| 'n' -> lit "null" Null
|
||||
| _ -> number ()
|
||||
in
|
||||
let v = value () in
|
||||
skip_ws ();
|
||||
if !i <> n then bad "trailing bytes at %d" !i;
|
||||
v
|
||||
|
||||
(* ── Getters ───────────────────────────────────────────────────────── *)
|
||||
|
||||
let mem k = function Obj kvs -> List.assoc_opt k kvs | _ -> None
|
||||
let str k j = match mem k j with Some (Str s) -> Some s | _ -> None
|
||||
let bool k j = match mem k j with Some (Bool b) -> b | _ -> false
|
||||
let arr k j = match mem k j with Some (Arr l) -> l | _ -> []
|
||||
254
lib/load.ml
254
lib/load.ml
@ -54,7 +54,14 @@ type t = {
|
||||
(see [Reach.link]). The aggregate fields remain what a dev build uses, where
|
||||
"not called yet" is not "not called". *)
|
||||
and pkg = { alias : string; dir : string; owns : string list;
|
||||
pcsrcs : string list; plflags : string list }
|
||||
pcsrcs : string list; plflags : string list;
|
||||
(* Names a [headers] file could have supplied and deliberately did
|
||||
not, each with the reason — already qualified, so [rl/…]. A
|
||||
wholesale header import refuses a great many functions and the
|
||||
caller cares about the one they wrote, so the reason is attached
|
||||
to the name and raised where it is used rather than printed at
|
||||
import. See [Cimport]. *)
|
||||
phidden : (string * string) list }
|
||||
|
||||
let fail loc fmt = Printf.ksprintf (fun m -> raise (Loc.Error (loc, m))) fmt
|
||||
|
||||
@ -466,6 +473,113 @@ let link_flags dir =
|
||||
close_in ch; r
|
||||
end
|
||||
|
||||
(* The [headers] file: C headers to read signatures out of, one per line, a
|
||||
path followed by any clang flags that header needs. Blank lines and
|
||||
comments ignored, [${NAME}] expanded from the environment, and a relative
|
||||
path taken against the package's own directory.
|
||||
|
||||
A sidecar rather than a new form, for the same reason [link] is one. The
|
||||
thing being named is a property of the *package* and not of any one
|
||||
declaration in it, the importing program should not have to know the header
|
||||
exists — [(import rl "vendor:raylib")] is unchanged at every call site — and
|
||||
a package whose headers move is edited in one place. It also means the
|
||||
reader, the parser and the AST are untouched: what comes back is ordinary
|
||||
[declare-c] declarations, which is the only thing downstream understands. *)
|
||||
let expand_env ~loc ~what line =
|
||||
let b = Buffer.create (String.length line) in
|
||||
let n = String.length line in
|
||||
let i = ref 0 in
|
||||
while !i < n do
|
||||
if !i + 1 < n && line.[!i] = '$' && line.[!i + 1] = '{' then
|
||||
match String.index_from_opt line !i '}' with
|
||||
| None -> Buffer.add_char b line.[!i]; incr i
|
||||
| Some close ->
|
||||
let name = String.sub line (!i + 2) (close - !i - 2) in
|
||||
(match Sys.getenv_opt name with
|
||||
| Some v -> Buffer.add_string b v
|
||||
| None ->
|
||||
fail loc
|
||||
"%s names ${%s} and %s is not set in the environment" what name name);
|
||||
i := close + 1
|
||||
else (Buffer.add_char b line.[!i]; incr i)
|
||||
done;
|
||||
Buffer.contents b
|
||||
|
||||
let read_lines path =
|
||||
if not (Sys.file_exists path) then []
|
||||
else begin
|
||||
let ch = open_in path in
|
||||
let rec go acc =
|
||||
match input_line ch with
|
||||
| line ->
|
||||
let line = String.trim line in
|
||||
go (if line = "" || line.[0] = '#' then acc else line :: acc)
|
||||
| exception End_of_file -> List.rev acc
|
||||
in
|
||||
let r = go [] in
|
||||
close_in ch; r
|
||||
end
|
||||
|
||||
(* Split on whitespace: the first word is the header, the rest are clang's. *)
|
||||
let words line =
|
||||
String.split_on_char ' ' line
|
||||
|> List.concat_map (String.split_on_char '\t')
|
||||
|> List.filter (fun w -> w <> "")
|
||||
|
||||
(* A line may begin with [?], meaning "read this header if it is there and say
|
||||
nothing if it is not".
|
||||
|
||||
That marker is what lets a package offer the check without requiring it.
|
||||
[vendor/raylib] builds today against a shared library alone — BUILT.md's "no
|
||||
raylib headers are needed", which is a real property: a build needs
|
||||
libraylib linkable and not raylib-devel installed. A required header would
|
||||
take that away from everyone in order to give the check to the people who
|
||||
have one. Optional, the default build is exactly what it was, and a
|
||||
developer with the matching header exports one variable and gets every
|
||||
signature checked against it. It is the same shape as [${FLAN_RAYLIB_WEB}]
|
||||
in [link], and for the same reason.
|
||||
|
||||
An unset [${NAME}] on an optional line skips it rather than failing, since
|
||||
"not set" is precisely how the line is turned off. On a required line it is
|
||||
still an error that names the variable. *)
|
||||
let header_specs ~loc dir =
|
||||
let path = Filename.concat dir "headers" in
|
||||
List.filter_map
|
||||
(fun line ->
|
||||
let optional = String.length line > 0 && line.[0] = '?' in
|
||||
let line =
|
||||
if optional then String.trim (String.sub line 1 (String.length line - 1))
|
||||
else line
|
||||
in
|
||||
match
|
||||
if optional then
|
||||
match expand_env ~loc ~what:path line with
|
||||
| v -> Some v
|
||||
| exception Loc.Error _ -> None
|
||||
else Some (expand_env ~loc ~what:path line)
|
||||
with
|
||||
| None -> None
|
||||
| Some expanded ->
|
||||
(match words expanded with
|
||||
| [] -> None
|
||||
| h :: flags ->
|
||||
let h =
|
||||
if Filename.is_relative h then Filename.concat dir h else h
|
||||
in
|
||||
(* An optional line that expanded to nothing at all is the
|
||||
line being switched off, which is the whole point of the
|
||||
marker. An optional line that expanded to a *path* is somebody
|
||||
opting in, and a path that is not there is their typo — told
|
||||
about by name, rather than silently behaving as though they had
|
||||
not opted in at all. Those two are the difference between an
|
||||
opt-in and a trap. *)
|
||||
if optional && String.trim expanded = "" then None
|
||||
else if not (Sys.file_exists h) then
|
||||
fail loc
|
||||
"%s names the header %s, and there is no such file" path h
|
||||
else Some (h, flags)))
|
||||
(read_lines path)
|
||||
|
||||
let real dir = try Unix.realpath dir with Unix.Unix_error _ -> dir
|
||||
|
||||
(* One package, and whatever it imports.
|
||||
@ -527,6 +641,130 @@ let rec import ~seen ~loc alias dir =
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
(* Every header the package names, read, and turned into the same
|
||||
[declare-c] declarations a human would have written. Done here, before
|
||||
anything below looks at what the package declares, so the generated ones
|
||||
are owned and qualified exactly like the hand-written ones and nothing
|
||||
downstream can tell which is which.
|
||||
|
||||
A single file is not a package with a directory, so it carries no
|
||||
headers, for the same reason it carries no [.c] and no [link]. *)
|
||||
let imported =
|
||||
if one_file then []
|
||||
else
|
||||
List.map
|
||||
(fun (h, flags) ->
|
||||
let taken = Hashtbl.create 64 in
|
||||
List.iter
|
||||
(fun d ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> Hashtbl.replace taken n ()
|
||||
| None -> ())
|
||||
ds;
|
||||
let known_structs =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defstruct (n, _) -> Some n
|
||||
| _ -> None)
|
||||
ds
|
||||
and known_enums =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defenum (n, _) -> Some n
|
||||
| _ -> None)
|
||||
ds
|
||||
(* A C symbol the package already binds by hand is left alone:
|
||||
the hand-written line wins, and [Shim] would refuse the
|
||||
program outright if one symbol arrived under two Flan names.
|
||||
That is what keeps [declare-c] the escape hatch — a signature
|
||||
the importer gets wrong, or a nicer face than the header can
|
||||
describe, is fixed by writing the line. *)
|
||||
and bound_syms =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Declare (_, sym) | Ast.DeclareC (_, sym) -> Some sym
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
let r, dump, env =
|
||||
Cimport.header ~loc ~header:h ~flags ~known_structs ~known_enums
|
||||
~taken ~bound_syms
|
||||
in
|
||||
(* The point of reading the header, and the reason it is not
|
||||
enough to generate declarations out of it.
|
||||
|
||||
Everything the generator produces agrees with itself by
|
||||
construction — the typedef and the Flan struct come from one
|
||||
[defstruct], the prototype and the wrapper from one
|
||||
declaration — so the only thing that can disagree is the
|
||||
*library*, and until a header was read nothing here had a
|
||||
second opinion to disagree with. Now it does, so it says so.
|
||||
|
||||
Build-stopping, not a note. The package named this header, so
|
||||
the header is the package's own claim about what it binds; a
|
||||
[defstruct] that disagrees with it lays fields out in the
|
||||
wrong order and reads as five plausible numbers rather than as
|
||||
a link error, which is the failure BUILT.md says only a test
|
||||
can catch. Continuing past a known-wrong layout to produce a
|
||||
program that will read garbage is the shape the house rule
|
||||
against swallowing things exists to prevent.
|
||||
|
||||
A structure the header does not describe at all is not
|
||||
checked and not complained about: a package may legitimately
|
||||
describe something the header does not name. *)
|
||||
let structs =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defstruct (n, fs) -> Some (n, fs, d.Ast.dloc)
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
List.iter
|
||||
(fun (n, why) ->
|
||||
let at =
|
||||
List.find_map
|
||||
(fun (m, _, l) -> if String.equal m n then Some l else None)
|
||||
structs
|
||||
in
|
||||
fail (Option.value ~default:loc at)
|
||||
"the defstruct %s disagrees with %s: %s" n h why)
|
||||
(Cimport.check_structs ~env
|
||||
~structs:(List.map (fun (n, fs, _) -> (n, fs)) structs) dump);
|
||||
(* And the hand-written bindings, against the header's own
|
||||
signatures. These are the lines the importer deliberately
|
||||
leaves alone, which is exactly why they are the ones nothing
|
||||
else can check: a wrong declare-c is wrong in the generated
|
||||
prototype too, so the two halves agree with each other and
|
||||
only the library knows better. *)
|
||||
let bound =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.DeclareC (fn, sym) -> Some (fn, sym)
|
||||
| _ -> None)
|
||||
ds
|
||||
in
|
||||
List.iter
|
||||
(fun (x : Cimport.sig_diff) ->
|
||||
let at =
|
||||
List.find_map
|
||||
(fun ((fn : Ast.fn), sym) ->
|
||||
if String.equal sym x.Cimport.dsym then Some fn.Ast.nloc
|
||||
else None)
|
||||
bound
|
||||
in
|
||||
fail (Option.value ~default:loc at)
|
||||
"the declare-c of %s disagrees with %s: %s"
|
||||
x.Cimport.dflan h x.Cimport.dwhy)
|
||||
(Cimport.diff_bound ~env ~bound dump);
|
||||
r)
|
||||
(header_specs ~loc dir)
|
||||
in
|
||||
let ds = ds @ List.concat_map (fun r -> r.Cimport.decls) imported in
|
||||
let own =
|
||||
List.filter (fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
@ -540,9 +778,18 @@ let rec import ~seen ~loc alias dir =
|
||||
let decls = List.map (qualify_decl owned alias) own in
|
||||
let lflags = if one_file then [] else link_flags dir in
|
||||
let csrcs = if one_file then [] else entries dir ".c" in
|
||||
let phidden =
|
||||
List.concat_map
|
||||
(fun r ->
|
||||
List.map
|
||||
(fun (n, why) -> (qualify alias n, qualify alias n ^ ": " ^ why))
|
||||
r.Cimport.hidden)
|
||||
imported
|
||||
in
|
||||
let here =
|
||||
{ decls; csrcs; lflags;
|
||||
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags } ] }
|
||||
pkgs = [ { alias; dir; owns = owned; pcsrcs = csrcs; plflags = lflags;
|
||||
phidden } ] }
|
||||
in
|
||||
List.fold_left
|
||||
(fun acc p ->
|
||||
@ -555,7 +802,8 @@ let rec import ~seen ~loc alias dir =
|
||||
(* What an import did *not* bring: the names an importer might reasonably write
|
||||
and that are not there, each with the reason it is not. *)
|
||||
let hidden_of (t : t) =
|
||||
List.filter_map
|
||||
List.concat_map (fun (p : pkg) -> p.phidden) t.pkgs
|
||||
@ List.filter_map
|
||||
(fun (p : pkg) ->
|
||||
let ds =
|
||||
List.concat_map (fun f -> Parse.program (Reader.read_file f))
|
||||
|
||||
10
lib/shim.ml
10
lib/shim.ml
@ -66,8 +66,14 @@
|
||||
A [_Static_assert] on [sizeof] and [offsetof] was considered and left out:
|
||||
both sides of it would come from the same field list, so it would check
|
||||
this module's arithmetic against clang's and say nothing about the library.
|
||||
What would convert the trusted half into a checked one is including the
|
||||
real header when one is installed, and that is not built. *)
|
||||
What converts the trusted half into a checked one is reading the real
|
||||
header, and that is built: [Cimport] asks clang for a JSON dump of one
|
||||
and compares both halves against it — every [defstruct] against the
|
||||
header's record, and every [declare-c] against the header's signature.
|
||||
Nothing in this module changed for it. The refusals below still raise,
|
||||
which is right for a signature a human named; the importer makes the
|
||||
same judgements and merely skips instead, since one returned
|
||||
[const char *] must not kill a header of five hundred functions. *)
|
||||
|
||||
let fail = Loc.fail
|
||||
|
||||
|
||||
@ -31,6 +31,11 @@
|
||||
; examples/digits.flan, so the directory has to be here whole.
|
||||
(glob_files %{workspace_root}/examples/*)
|
||||
(glob_files programs/*.flan)
|
||||
; The synthetic C header the importer's table reads. Committed rather than
|
||||
; reached for on the machine: the raylib case needs raylib installed, at the
|
||||
; right version, with a variable set, so it skips everywhere and covers
|
||||
; nothing. This one does not move.
|
||||
(glob_files headers/*.h)
|
||||
; The files programs/embed.flan bakes in. An embed reads them at *compile*
|
||||
; time, so they are a dependency of the checker run and not of the program.
|
||||
(glob_files programs/assets/*)
|
||||
|
||||
48
test/headers/sample.h
Normal file
48
test/headers/sample.h
Normal file
@ -0,0 +1,48 @@
|
||||
/* A small C header, for testing the importer against something that does not
|
||||
* move. The raylib case needs raylib installed, needs the right version of it,
|
||||
* and needs an environment variable set, so it is the wrong thing to hang the
|
||||
* refusal catalogue on: it would skip everywhere and cover nothing. This
|
||||
* header has one function per decision Cimport makes, and the test asserts on
|
||||
* the reasons rather than on the count.
|
||||
*
|
||||
* Deliberately includes nothing. A header that pulls in stdio would make the
|
||||
* dump thirty times larger and would put libc's declarations in the way of
|
||||
* reading the test's. */
|
||||
|
||||
typedef struct Pair { float x; float y; } Pair;
|
||||
typedef struct Shade { unsigned char r, g, b, a; } Shade;
|
||||
typedef struct Undescribed { int a; int b; } Undescribed;
|
||||
|
||||
/* A second typedef name for a record the package already describes under
|
||||
* another one. raylib does this: struct Texture is Texture2D and also
|
||||
* TextureCubemap. Both have to resolve to the one defstruct. */
|
||||
typedef struct Pair Point;
|
||||
|
||||
typedef enum Mood { MOOD_CALM = 0, MOOD_CROSS = 1 } Mood;
|
||||
|
||||
typedef void (*Notify)(void *user, unsigned int n);
|
||||
|
||||
/* --- accepted --- */
|
||||
void set_seed(unsigned int seed);
|
||||
int add_ints(int a, int b);
|
||||
Pair make_pair(float x, float y); /* aggregate out, by out-pointer */
|
||||
float pair_len(Pair p); /* aggregate in, by pointer */
|
||||
Shade tint(Shade base, Shade over);
|
||||
int name_length(const char *text); /* const char * is a string in */
|
||||
int count_at(const int *values, int n); /* T * is (Ptr T) */
|
||||
Pair point_of(Point p); /* the second typedef name */
|
||||
int mood_value(Mood m); /* a C enum is an int */
|
||||
void take_nothing(void);
|
||||
|
||||
/* --- refused, one per reason --- */
|
||||
const char *name_of(int which); /* returns char * */
|
||||
void fill_buffer(char *out, int cap); /* non-const char *: C writes it */
|
||||
int printf_like(const char *fmt, ...); /* variadic */
|
||||
void on_event(Notify cb); /* a callback */
|
||||
long file_time(const char *path); /* long varies across our targets */
|
||||
Undescribed make_undescribed(void); /* no defstruct for it */
|
||||
|
||||
/* Two names that kebab to one, so the collision is refused by name rather than
|
||||
* arriving at the checker as a duplicate declaration nobody wrote. */
|
||||
int Spin2D(int n);
|
||||
int spin2d(int n);
|
||||
36
test/programs/raylib-imported.flan
Normal file
36
test/programs/raylib-imported.flan
Normal file
@ -0,0 +1,36 @@
|
||||
;;;; Every binding called here came out of raylib's header, not out of
|
||||
;;;; raylib.flan. The package binds none of these four by hand, so if this
|
||||
;;;; program runs at all the importer produced working declarations — and
|
||||
;;;; what it prints pins rather more than that.
|
||||
;;;;
|
||||
;;;; Needs FLAN_RAYLIB_H pointing at a raylib 5.5 header; the acceptance case
|
||||
;;;; skips without it.
|
||||
|
||||
(import rl "vendor:raylib")
|
||||
|
||||
(defn main [] i32
|
||||
;; A scalar in, a scalar out. Seeded, and a range of one, so the answer is
|
||||
;; the bound rather than anything random.
|
||||
(rl/set-random-seed 12345)
|
||||
(println (rl/get-random-value 10 10))
|
||||
|
||||
;; A string parameter. A Flan string is ptr+len and never NUL-terminated, so
|
||||
;; this only answers 5 if the generated wrapper made the terminated copy.
|
||||
(println (rl/text-length "hello"))
|
||||
|
||||
;; A struct by value in, a scalar out. 0x11223344 is 287454020, and it is
|
||||
;; the four fields read in r,g,b,a order — swap any two and the number
|
||||
;; changes, which a round trip could not have told us.
|
||||
(println (rl/color-to-int (rl/Color {.r 17 .g 34 .b 51 .a 68})))
|
||||
|
||||
;; A struct in and a struct out, which is the whole flattening path: the
|
||||
;; argument goes by pointer and the result comes back through an
|
||||
;; out-parameter. Tinting by white is the identity, so the four bytes come
|
||||
;; back separately and in order.
|
||||
(let [t (rl/color-tint (rl/Color {.r 255 .g 255 .b 255 .a 255})
|
||||
(rl/Color {.r 17 .g 34 .b 51 .a 68}))]
|
||||
(println (.r t))
|
||||
(println (.g t))
|
||||
(println (.b t))
|
||||
(println (.a t)))
|
||||
0)
|
||||
@ -658,6 +658,39 @@ let () =
|
||||
else
|
||||
print_endline "acceptance: skipping the raylib FFI case (no libraylib)";
|
||||
|
||||
(* The same boundary, from declarations nobody wrote. Every binding this
|
||||
program calls came out of raylib's header through vendor/raylib/headers;
|
||||
the package binds none of the four by hand, so if it runs at all the
|
||||
importer produced working declarations.
|
||||
|
||||
What it prints pins more than that. ColorToInt of {17,34,51,68} is
|
||||
0x11223344 — the four fields read in r,g,b,a order, so exchanging any
|
||||
two changes the number — and ColorTint by white is the identity, which
|
||||
hands the four bytes back separately. That is the same argument the
|
||||
GetColor case makes and for the same reason: handing a struct over and
|
||||
reading it back proves nothing, because storing and returning is
|
||||
symmetric and a permuted layout comes back permuted the same way.
|
||||
TextLength of "hello" is 5, which is only true if the generated wrapper
|
||||
NUL-terminated the copy.
|
||||
|
||||
Skipped without FLAN_RAYLIB_H, because the import is opt-in — a build
|
||||
needs libraylib linkable and not raylib-devel installed, and that is a
|
||||
property worth keeping. The importer's own table does not skip: it runs
|
||||
against test/headers/sample.h, which is committed. *)
|
||||
(match Sys.getenv_opt "FLAN_RAYLIB_H" with
|
||||
| Some h when Sys.file_exists h
|
||||
&& Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 ->
|
||||
let out = "10\n5\n287454020\n17\n34\n51\n68\n" in
|
||||
outputs "raylib, bindings read from the header" "programs/raylib-imported.flan" out;
|
||||
(* At -O0 too, for the reason the rest of the table is: every struct
|
||||
here crosses as (addr v) on a local, which is the alloca mem2reg
|
||||
would launder before anyone noticed it was wrong. *)
|
||||
outputs ~opt:"-O0" "raylib, bindings read from the header, -O0"
|
||||
"programs/raylib-imported.flan" out
|
||||
| _ ->
|
||||
print_endline
|
||||
"acceptance: skipping the imported-bindings case (FLAN_RAYLIB_H unset)");
|
||||
|
||||
(* raylib's Image family, headless, and the strongest FFI case here: an
|
||||
Image is pixels in RAM, so raylib *computes* with it rather than
|
||||
storing and returning it.
|
||||
|
||||
@ -1120,6 +1120,231 @@ let () =
|
||||
"(defn f [] i32 (let [xs [1 2]] (destructure~nth xs 0 2 1)))"
|
||||
~needle:"means nothing outside a quasiquote";
|
||||
|
||||
(* ── Reading a C header (cimport.ml, cjson.ml) ─────────────────── *)
|
||||
|
||||
(* Against test/headers/sample.h, which is one function per decision the
|
||||
importer makes and is committed so that it cannot move. The raylib case
|
||||
is better evidence and worse coverage: it needs raylib installed, at the
|
||||
version whose .so is linked, with FLAN_RAYLIB_H set, so as the only test
|
||||
of this it would skip everywhere.
|
||||
|
||||
The assertions are on the *reasons*, not on the counts, for the reason the
|
||||
acceptance table gives: a refusal that fires for the wrong cause still
|
||||
refuses, and a count still matches. *)
|
||||
let imported, dump, env, fixture_ds =
|
||||
let fixture =
|
||||
"(defstruct Pair [x f32 y f32])\n\
|
||||
(defstruct Shade [r u8 g u8 b u8 a u8])\n\
|
||||
(defenum Mood [calm 0 cross 1])\n"
|
||||
in
|
||||
let ds = program fixture in
|
||||
let taken = Hashtbl.create 16 in
|
||||
List.iter
|
||||
(fun d ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> Hashtbl.replace taken n ()
|
||||
| None -> ())
|
||||
ds;
|
||||
let known_structs =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defstruct (n, _) -> Some n | _ -> None)
|
||||
ds
|
||||
and known_enums =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defenum (n, _) -> Some n | _ -> None)
|
||||
ds
|
||||
in
|
||||
let i, d, e =
|
||||
Cimport.header ~loc:Loc.unknown ~header:"headers/sample.h" ~flags:[]
|
||||
~known_structs ~known_enums ~taken ~bound_syms:[]
|
||||
in
|
||||
(i, d, e, ds)
|
||||
in
|
||||
|
||||
(* What came out, as source, so a wrong type is visible as the line somebody
|
||||
would otherwise have had to write by hand. *)
|
||||
let produced = List.map Cimport.decl_source imported.Cimport.decls in
|
||||
let emits name line =
|
||||
check ("import-c emits " ^ name) (List.mem line produced)
|
||||
in
|
||||
emits "a scalar signature" "(declare-c set-seed [seed u32] \"set_seed\")";
|
||||
emits "two scalars and a return"
|
||||
"(declare-c add-ints [a i32 b i32] i32 \"add_ints\")";
|
||||
(* An aggregate return is the flattening path: Shim turns it into an
|
||||
out-pointer, and the declaration it starts from has to say the struct. *)
|
||||
emits "an aggregate return"
|
||||
"(declare-c make-pair [x f32 y f32] Pair \"make_pair\")";
|
||||
emits "an aggregate parameter" "(declare-c pair-len [p Pair] f32 \"pair_len\")";
|
||||
(* const char * is a string going in — the one C spelling that means
|
||||
something different in a parameter than it does anywhere else. *)
|
||||
emits "const char * as a string parameter"
|
||||
"(declare-c name-length [text string] i32 \"name_length\")";
|
||||
emits "a pointer parameter"
|
||||
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
|
||||
(* struct Pair is both Pair and Point in the header and the package
|
||||
describes it once, so both names have to land on the one defstruct —
|
||||
raylib does exactly this with Texture2D and TextureCubemap. *)
|
||||
emits "a second typedef name for a described record"
|
||||
"(declare-c point-of [p Pair] Pair \"point_of\")";
|
||||
(* A C enum is an int, and so is a Flan defenum at the boundary; matching by
|
||||
name is what keeps the nicer face. *)
|
||||
emits "a C enum against a defenum of the same name"
|
||||
"(declare-c mood-value [m Mood] i32 \"mood_value\")";
|
||||
emits "a function of no arguments" "(declare-c take-nothing [] \"take_nothing\")";
|
||||
|
||||
(* And the refusals, each by its reason rather than by a count. *)
|
||||
let refused name needle =
|
||||
check
|
||||
("import-c refuses " ^ name ^ ": " ^ needle)
|
||||
(List.exists
|
||||
(fun (n, why) -> n = name && contains why needle)
|
||||
imported.Cimport.hidden)
|
||||
in
|
||||
refused "name-of" "returns char *";
|
||||
refused "fill-buffer" "C may write through";
|
||||
refused "printf-like" "is variadic";
|
||||
refused "on-event" "is a function pointer";
|
||||
refused "file-time" "width that differs";
|
||||
refused "make-undescribed" "the package does not describe";
|
||||
(* The order-dependent one. Spin2D and spin2d both kebab to spin-2d, so
|
||||
neither may have it: whichever won would depend on the order the header
|
||||
declares them in, and moving two lines in somebody else's header would
|
||||
rebind a name a program is already calling. *)
|
||||
refused "spin-2d" "would depend on the order";
|
||||
check "a colliding name is not imported after all"
|
||||
(not (List.exists (fun l -> contains l "\"Spin2D\"") produced));
|
||||
check "nor is the other half of the collision"
|
||||
(not (List.exists (fun l -> contains l "\"spin2d\"") produced));
|
||||
|
||||
(* A refused name is a name that exists and cannot be had — Zig's failDecl,
|
||||
which Load.refuse_hidden already implements for main. Nothing may be in
|
||||
both lists, or asking for a name that works would report that it does
|
||||
not. *)
|
||||
check "nothing is both imported and refused"
|
||||
(not
|
||||
(List.exists
|
||||
(fun (d : Ast.decl) ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> List.mem_assoc n imported.Cimport.hidden
|
||||
| None -> false)
|
||||
imported.Cimport.decls));
|
||||
|
||||
(* The struct check, which is the point of reading a header the generator
|
||||
does not otherwise need: the defstruct and the header's record have
|
||||
different authors, so a disagreement is real information. A
|
||||
_Static_assert was rejected in BUILT.md as circular for want of exactly
|
||||
that. *)
|
||||
let structs_of ds =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defstruct (n, fs) -> Some (n, fs) | _ -> None)
|
||||
ds
|
||||
in
|
||||
check "a defstruct that matches the header is not reported"
|
||||
(Cimport.check_structs ~env ~structs:(structs_of fixture_ds) dump = []);
|
||||
(* Permuted: the failure BUILT.md says only a test can catch, because every
|
||||
field still reads as a plausible number. *)
|
||||
check "a permuted defstruct is reported"
|
||||
(match
|
||||
Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Pair [y f32 x f32])\n")) dump
|
||||
with
|
||||
| [ ("Pair", why) ] -> contains why "field order"
|
||||
| _ -> false);
|
||||
(* Widened: the other half of the same hazard and the one BUILT.md names —
|
||||
f64 where the library says float lays out eight bytes where there are
|
||||
four, and every field after it moves. *)
|
||||
check "a widened field is reported"
|
||||
(match
|
||||
Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Pair [x f32 y f64])\n")) dump
|
||||
with
|
||||
| [ ("Pair", why) ] -> contains why "f64" && contains why "f32"
|
||||
| _ -> false);
|
||||
(* A struct the header says nothing about is not a disagreement: a package
|
||||
may describe something the library does not name. *)
|
||||
check "a struct the header does not describe is left alone"
|
||||
(Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Nowhere [q i32])\n")) dump
|
||||
= []);
|
||||
|
||||
(* diff_bound: a hand-written declare-c against the header's own signature.
|
||||
This is the check with no other source — a wrong declare-c is wrong in the
|
||||
generated prototype too, so the two halves agree with each other and only
|
||||
the library knows better. *)
|
||||
let bound_of src =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.DeclareC (fn, sym) -> Some (fn, sym) | _ -> None)
|
||||
(program src)
|
||||
in
|
||||
let differs name src needle =
|
||||
check ("declare-c against the header: " ^ name)
|
||||
(match Cimport.diff_bound ~env ~bound:(bound_of src) dump with
|
||||
| [ d ] -> contains d.Cimport.dwhy needle
|
||||
| _ -> false)
|
||||
in
|
||||
check "a declare-c that matches the header is not reported"
|
||||
(Cimport.diff_bound ~env
|
||||
~bound:(bound_of "(declare-c add [a i32 b i32] i32 \"add_ints\")") dump
|
||||
= []);
|
||||
differs "a wrong parameter width"
|
||||
"(declare-c add [a f64 b i32] i32 \"add_ints\")" "parameter a is f64";
|
||||
differs "a wrong arity" "(declare-c add [a i32] i32 \"add_ints\")"
|
||||
"the header says 2";
|
||||
differs "a wrong return type"
|
||||
"(declare-c add [a i32 b i32] f32 \"add_ints\")" "returns f32";
|
||||
(* A symbol the header does not have at all is the version-drift case, and
|
||||
it is how a package pinned to the wrong release announces itself. *)
|
||||
differs "a symbol the header does not declare"
|
||||
"(declare-c gone [] \"no_such_function\")" "does not declare";
|
||||
(* An enum face against a plain int is the expected difference and not a
|
||||
finding: that is what a defenum is at the boundary. *)
|
||||
check "an enum face against the header's int is not a difference"
|
||||
(Cimport.diff_bound ~env
|
||||
~bound:(bound_of "(declare-c mv [m Mood] i32 \"mood_value\")") dump
|
||||
= []);
|
||||
|
||||
(* The name rule. Reversibility is by storage — the C symbol is kept verbatim
|
||||
in the declaration — so what the rule has to be is injective over one
|
||||
header, which the collision case above asserts. These pin its shape. *)
|
||||
List.iter
|
||||
(fun (c, flan) ->
|
||||
check
|
||||
(Printf.sprintf "kebab %s -> %s" c flan)
|
||||
(String.equal (Cimport.kebab c) flan))
|
||||
[ ("InitWindow", "init-window");
|
||||
(* An acronym stays one word rather than becoming separate letters. *)
|
||||
("SetTargetFPS", "set-target-fps");
|
||||
("ColorToHSV", "color-to-hsv");
|
||||
("UnloadUTF8", "unload-utf8");
|
||||
(* A digit run takes the uppercase after it, so 2D is one word. *)
|
||||
("BeginMode2D", "begin-mode-2d");
|
||||
("GetScreenToWorld2D", "get-screen-to-world-2d");
|
||||
("snake_case_already", "snake-case-already") ];
|
||||
|
||||
(* cjson.ml, on the shapes clang's dump actually contains. *)
|
||||
check "json: an escaped string"
|
||||
(match Cjson.parse "{\"a\":\"x\\ny\"}" with
|
||||
| Cjson.Obj [ ("a", Cjson.Str "x\ny") ] -> true
|
||||
| _ -> false);
|
||||
check "json: nesting, numbers, booleans and null"
|
||||
(match Cjson.parse "{\"i\":[1,-2,3.5e2],\"b\":true,\"n\":null}" with
|
||||
| Cjson.Obj
|
||||
[ ("i", Cjson.Arr [ _; _; _ ]); ("b", Cjson.Bool true);
|
||||
("n", Cjson.Null) ] -> true
|
||||
| _ -> false);
|
||||
check "json: empty containers"
|
||||
(match Cjson.parse "{\"a\":{},\"b\":[]}" with
|
||||
| Cjson.Obj [ ("a", Cjson.Obj []); ("b", Cjson.Arr []) ] -> true
|
||||
| _ -> false);
|
||||
check "json: trailing bytes are refused"
|
||||
(match Cjson.parse "{} x" with
|
||||
| _ -> false
|
||||
| exception Cjson.Bad _ -> true);
|
||||
|
||||
(* ── The acceptance program checks end to end ──────────────────── *)
|
||||
accepts "calc-me.flan type checks"
|
||||
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
|
||||
|
||||
32
vendor/raylib/headers
vendored
Normal file
32
vendor/raylib/headers
vendored
Normal file
@ -0,0 +1,32 @@
|
||||
# C headers this package reads function signatures out of. One per line: a
|
||||
# path, then any clang flags that header needs. A relative path is against
|
||||
# this directory, ${NAME} expands from the environment, and a leading `?`
|
||||
# means "if it is there" — an optional line with nothing behind it is simply
|
||||
# not read.
|
||||
#
|
||||
# Why this exists. The declare-c lines in raylib.flan were transcribed by
|
||||
# hand from raylib's documentation, and until now nothing could check that
|
||||
# any of them matched the real function — BUILT.md records that as trusted
|
||||
# rather than guaranteed. Point this at raylib's own header and the compiler
|
||||
# reads the signatures instead: every hand-written line is compared against
|
||||
# the library's, every defstruct against the header's record, and any raylib
|
||||
# function the package has not bound becomes available under its own name.
|
||||
#
|
||||
# Why it is optional. A build needs libraylib linkable and *not* raylib-devel
|
||||
# installed, which is a property worth keeping; requiring a header would take
|
||||
# it from everyone to give the check to whoever has one. So the default build
|
||||
# is unchanged and this is opt-in, the same shape as ${FLAN_RAYLIB_WEB} in
|
||||
# `link`.
|
||||
#
|
||||
# The version must match the shared library `link` names — 5.5, libraylib.so.550.
|
||||
# Reading one version's header while linking another's library is exactly the
|
||||
# silent disagreement this exists to prevent, and `flan import-c` will say so:
|
||||
# against a 5.1-dev header it reports ten differences that are all real.
|
||||
#
|
||||
# export FLAN_RAYLIB_H=/path/to/raylib-5.5/src/raylib.h
|
||||
#
|
||||
# To see what it would do without building anything:
|
||||
#
|
||||
# flan import-c $FLAN_RAYLIB_H vendor/raylib/raylib.flan
|
||||
#
|
||||
?${FLAN_RAYLIB_H}
|
||||
Loading…
x
Reference in New Issue
Block a user