Joseph Ferano
3e68089cde
The type itself, the ABI its operations call into, and the one decision the feature could not avoid: (defn f [x y]) is one parameter or two, and which one depends on whether y names a type. Parse does not decide it. That lookup is the one its defn comment records being removed for being wrong twice in one day -- the set of type names is incomplete at parse time by construction, and macros generating definitions is what widened the failure. So the vector is carried undecided, as Ast.pitems, and paired in Check, after every file is loaded, every macro expanded and every header imported. The set is complete there. It is not complete across time, and the comment says so: a defstruct written later changes a signature with no edit to the function. The return slot stays mandatory and dyn is written out in it. The ambiguity there has no syntactic resolution at all -- a capitalised head in a list is both a type application and a struct literal -- so the third state the parameters needed does not exist for the return type, and ret = None goes on meaning Unit. What the feature costs, and what is taken back: a slot with no type used to be a syntax error, so a mistyped type now reads as an extra parameter with no diagnostic. A name within one edit of a type's gets the resolver's own did-you-mean, and an unknown capitalised name is reported as the unknown type it is -- not one parameter in the corpus is capitalised. A lowercase name resembling no type is the feature working, and is the residual. The x86 backend refuses dyn by name; both callers already name --llvm, and the daemon takes that backend by default, so this is the first thing a user of dyn sees. The JS dialect refuses it too, for the opposite reason -- every value there is already dynamic and what is missing is only the lowering. runtime/flan_dyn.h is the fixed ABI. flan_dyn_stub.c stands in until the real collector lands and says in its header that it verifies nothing about roots.
1712 lines
79 KiB
OCaml
1712 lines
79 KiB
OCaml
(** 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 docs/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 docs/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
|
|
|
|
(* The other direction, and it is deliberately not an inverse of [kebab].
|
|
|
|
A C *function* never needs one: the symbol is stored verbatim in the
|
|
declaration. A C *constant* does, because there is no declaration to store
|
|
it in — a [defenum] member and a [defconst] are Flan names with Flan
|
|
values and nothing in the source says which enumerator in the header they
|
|
came from. So the C name has to be reconstructed, and this is the rule:
|
|
uppercase, and a hyphen becomes an underscore. [left-shift] is
|
|
[LEFT_SHIFT], [msaa-4x-hint] is [MSAA_4X_HINT].
|
|
|
|
What it cannot reconstruct is the prefix — raylib's [KEY_], [FLAG_],
|
|
[GAMEPAD_BUTTON_] — because the Flan name does not contain it. That is
|
|
declared in the package's [bindings] file rather than guessed, for the
|
|
reason [read_config] gives about every other guess: a rule that quietly
|
|
fails to match a name would be worse than no check at all. *)
|
|
let screaming (s : string) : string =
|
|
String.map (fun c -> if c = '-' then '_' else Char.uppercase_ascii c)
|
|
(String.uppercase_ascii s)
|
|
|
|
(* ── 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 record, for checking a [defstruct] or a [defunion] against. [runion]
|
|
is which of the two it was declared as, and it is on the record rather than
|
|
inferred at the comparison because the two are checked by different rules:
|
|
a struct's members are ordered and a union's are not, and matching a
|
|
[defstruct] against a C union would report a field order that means
|
|
nothing. *)
|
|
type crecord =
|
|
{ rname : string; rfields : (string * string) list; runion : bool }
|
|
|
|
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;
|
|
(* Every enumerator in the header, flat: name to value.
|
|
|
|
Flat and not grouped by enum, because raylib's enums are *anonymous* —
|
|
[typedef enum { FLAG_VSYNC_HINT = 0x40, ... } ConfigFlags;] is an
|
|
[EnumDecl] with no name at all, and the typedef beside it is a separate
|
|
node. Keying on the enum's name would find nothing on the corpus this
|
|
exists for. C puts enumerators in the ordinary namespace at file scope
|
|
anyway, so the flat table is the one C itself keeps. *)
|
|
consts : (string * int64) 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
|
|
let consts = 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 — it has no name for a Flan field to carry and no way to
|
|
reach its members, so there is still nothing to compare.
|
|
|
|
What is no longer skipped is the case this used to be read as
|
|
covering all unions: a record with a *named* union member. That
|
|
field has a name and a type, [union Overlay], and now that Flan has
|
|
a union of its own the name resolves to a [defunion] and the whole
|
|
record is checked field by field like any other. The gap that
|
|
remains is the anonymous one, and it is a gap in the Flan side
|
|
rather than here — there is nothing to declare. *)
|
|
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;
|
|
runion = Cjson.str "tagUsed" d = Some "union" }
|
|
:: !records
|
|
(* An enumerator with no [= n] carries no [ConstantExpr] in the dump at
|
|
all, so the value has to be counted the way C counts it: one more
|
|
than the one before, starting at zero. That is not an edge case —
|
|
raylib's TraceLogLevel writes [LOG_ALL = 0] and then seven bare
|
|
names, so reading only the explicit ones would check one member of
|
|
eight and quietly pass the rest. *)
|
|
| Some "EnumDecl", _ when mine ->
|
|
let next = ref 0L in
|
|
List.iter
|
|
(fun c ->
|
|
if Cjson.str "kind" c = Some "EnumConstantDecl" then begin
|
|
(match
|
|
List.find_map
|
|
(fun i ->
|
|
if Cjson.str "kind" i = Some "ConstantExpr" then
|
|
Cjson.str "value" i
|
|
else None)
|
|
(Cjson.arr "inner" c)
|
|
with
|
|
| Some v ->
|
|
(match Int64.of_string_opt v with
|
|
| Some n -> next := n
|
|
| None -> ())
|
|
| None -> ());
|
|
(match Cjson.str "name" c with
|
|
| Some n -> consts := (n, !next) :: !consts
|
|
| None -> ());
|
|
next := Int64.add !next 1L
|
|
end)
|
|
(Cjson.arr "inner" d)
|
|
| 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;
|
|
consts = List.rev !consts }
|
|
|
|
(* ── 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_unions : string list; (* and its defunion 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 "(Map %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
|
|
(* A [union Overlay] parameter or field renders as the package's [defunion
|
|
Overlay], on the same terms a struct does: the package says the layout
|
|
exists and [check_unions] below says whether it agrees. *)
|
|
else if List.mem n env.known_unions 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;
|
|
}
|
|
|
|
(* ── The config beside the header ──────────────────────────────────── *)
|
|
|
|
(* Why a config file exists at all, when the importer decides everything else
|
|
from the header.
|
|
|
|
Because the generated declarations are *committed*. A generated file that is
|
|
read at build time can be hand-corrected and the correction survives, since
|
|
nothing rewrites it. A generated file that is checked in is rewritten by the
|
|
next regeneration, so a hand-edit to it is destroyed without anybody being
|
|
told — which is the worst shape an edit can have. The edits therefore have
|
|
to live somewhere regeneration *reads* rather than somewhere it writes, and
|
|
this is that place.
|
|
|
|
Two directives, which are the two things the header cannot decide:
|
|
|
|
- [exclude], a C symbol or a pattern of them, for what should not be
|
|
generated at all.
|
|
- [name], a C symbol and the Flan name it is to take, for where the kebab
|
|
rule gives something ugly.
|
|
|
|
A postprocessing transform pass over the generated file was the alternative
|
|
and was rejected: a second program to understand, run over text the
|
|
generator had already committed to. Both directives here are applied
|
|
*while* the declarations are made, so the file on disk is already what the
|
|
config says and nothing reads it twice. *)
|
|
|
|
type config = {
|
|
excludes : string list;
|
|
(* C symbol to Flan name. Keyed on the symbol and not on the kebab result,
|
|
because the symbol is the only spelling that is stable — the whole point
|
|
of an override is that the kebab result is not what is wanted. *)
|
|
renames : (string * string) list;
|
|
(* The three that say how a Flan constant is spelled in C, which is the one
|
|
thing neither the header nor the Flan source contains. See [screaming]
|
|
for why it has to be said and [check_constants] for what is done with it.
|
|
|
|
[enum_prefixes]: a [defenum]'s name, and the prefix its members carry in
|
|
C. [("Key", "KEY_")] checks [left-shift] against [KEY_LEFT_SHIFT]. The
|
|
prefix ["-"] means the header has nothing to check this enum against and
|
|
that is deliberate.
|
|
|
|
[const_prefixes]: a prefix of [defconst] names, and the prefix the
|
|
corresponding C enumerators carry. [("flag-", "FLAG_")] checks
|
|
[flag-vsync-hint] against [FLAG_VSYNC_HINT].
|
|
|
|
[constants]: one Flan name, spelled [Enum/member] or as a bare
|
|
[defconst] name, and the exact C name it answers to. The narrow
|
|
exception, for the one name a prefix rule gets wrong — raylib's
|
|
[GESTURE_DOUBLETAP] against a member the package spells [double-tap]. It
|
|
also brings a name under the check that no prefix rule covers. *)
|
|
enum_prefixes : (string * string) list;
|
|
const_prefixes : (string * string) list;
|
|
constants : (string * string) list;
|
|
}
|
|
|
|
let no_config =
|
|
{ excludes = []; renames = []; enum_prefixes = []; const_prefixes = [];
|
|
constants = [] }
|
|
|
|
(* [*] stands for any run of characters and nothing else does anything. Enough
|
|
for [rl*] or [*Callback], and small enough to read at a glance; a package
|
|
that needs more than this wants a hand-written declare-c, which it has. *)
|
|
let matches (pat : string) (s : string) =
|
|
let np = String.length pat and ns = String.length s in
|
|
let rec go i j =
|
|
if i = np then j = ns
|
|
else if pat.[i] = '*' then
|
|
let rec from k = (k <= ns && go (i + 1) k) || (k < ns && from (k + 1)) in
|
|
from j
|
|
else j < ns && Char.equal pat.[i] s.[j] && go (i + 1) (j + 1)
|
|
in
|
|
go 0 0
|
|
|
|
let excluded cfg sym = List.exists (fun p -> matches p sym) cfg.excludes
|
|
|
|
(* The one place the kebab rule is consulted, so an override is not a special
|
|
case anywhere below: collisions are computed on the name a function will
|
|
actually take, which means renaming one of two colliding symbols resolves
|
|
the collision rather than leaving both refused. *)
|
|
let flan_name cfg sym =
|
|
match List.assoc_opt sym cfg.renames with Some n -> n | None -> kebab sym
|
|
|
|
(* The file, in the shape of [headers] and [link] beside it: one directive per
|
|
line, [#] comments, blank lines ignored. A line that is neither directive is
|
|
an error rather than a line quietly skipped — the house rule against
|
|
swallowing things applies to a config as much as to a flag, and a typo in a
|
|
name override would otherwise show up as a binding under the wrong name. *)
|
|
let read_config path : config =
|
|
if not (Sys.file_exists path) then no_config
|
|
else begin
|
|
let ch = open_in path in
|
|
let excludes = ref [] and renames = ref [] in
|
|
let enum_prefixes = ref [] and const_prefixes = ref [] and constants = ref [] in
|
|
let rec go n =
|
|
match input_line ch with
|
|
| line ->
|
|
let t = String.trim line in
|
|
if t <> "" && t.[0] <> '#' then begin
|
|
let ws =
|
|
String.split_on_char ' ' t
|
|
|> List.concat_map (String.split_on_char '\t')
|
|
|> List.filter (fun w -> w <> "")
|
|
in
|
|
match ws with
|
|
| [ "exclude"; p ] -> excludes := p :: !excludes
|
|
| [ "name"; sym; flan ] -> renames := (sym, flan) :: !renames
|
|
| [ "enum"; flan; c ] -> enum_prefixes := (flan, c) :: !enum_prefixes
|
|
| [ "const"; flan; c ] -> const_prefixes := (flan, c) :: !const_prefixes
|
|
| [ "constant"; flan; c ] -> constants := (flan, c) :: !constants
|
|
| _ ->
|
|
close_in ch;
|
|
fail (Loc.make path n 0)
|
|
"a line here is `exclude <C symbol or pattern>`, `name <C \
|
|
symbol> <flan-name>`, `enum <FlanEnum> <C_PREFIX>`, `const \
|
|
<flan-prefix> <C_PREFIX>` or `constant <flan-name> <C_NAME>`, \
|
|
and this is neither: %s" t
|
|
end;
|
|
go (n + 1)
|
|
| exception End_of_file -> ()
|
|
in
|
|
go 1;
|
|
close_in ch;
|
|
{ excludes = List.rev !excludes; renames = List.rev !renames;
|
|
enum_prefixes = List.rev !enum_prefixes;
|
|
const_prefixes = List.rev !const_prefixes;
|
|
constants = List.rev !constants }
|
|
end
|
|
|
|
(* [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 ~config (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
|
|
(* Excluded before anything else looks at them, so an excluded symbol is not
|
|
in a collision group either — which is one of the things exclusion is for.
|
|
It still says why, under the name it would have taken: "there is no such
|
|
binding" and "the package decided against this binding" are different
|
|
answers and a reader deserves the second one. *)
|
|
let dropped, candidates =
|
|
List.partition (fun f -> excluded config f.csym) candidates
|
|
in
|
|
List.iter
|
|
(fun f ->
|
|
hidden :=
|
|
(flan_name config f.csym,
|
|
Printf.sprintf
|
|
"%s is excluded by the package's binding config, so no \
|
|
declaration is generated for it" f.csym)
|
|
:: !hidden)
|
|
dropped;
|
|
let groups = Hashtbl.create 512 in
|
|
List.iter
|
|
(fun f ->
|
|
let k = flan_name config f.csym in
|
|
Hashtbl.replace groups k (f.csym :: Option.value ~default:[]
|
|
(Hashtbl.find_opt groups k)))
|
|
candidates;
|
|
List.iter
|
|
(fun f ->
|
|
let flan = flan_name config 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. Give the one you want a `name` in the binding config, or \
|
|
bind it 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; praw = None; ret; fwhere = []; 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.
|
|
|
|
docs/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. *)
|
|
|
|
(* Two rendered Flan types, compared for *representation* rather than for
|
|
spelling.
|
|
|
|
The one difference that is not a difference is an enum against a 32-bit
|
|
integer. A Flan [defenum] is an [i32] — that is what [Shim.cty] lowers one
|
|
to, in a struct field and in a parameter alike — and a C enum is an [int],
|
|
so the two lay out the same four bytes and differ only in the face they
|
|
present. Signedness goes with it: raylib spells [IsGestureDetected]'s
|
|
parameter [unsigned int] and the package calls it [Gesture], and both are
|
|
four bytes in a register.
|
|
|
|
Symmetric on purpose. The enum may be on either side: the header says
|
|
[CameraProjection] and the [defstruct] says [i32], or the header says [int]
|
|
and the [defstruct] says [CameraProjection]. Both are the same statement
|
|
about four bytes, and reporting either was the bug this closes.
|
|
|
|
What it does *not* accept is anything else. [f64] against the library's
|
|
[float] is eight bytes where there are four, every field after it moves,
|
|
and it reads as plausible numbers rather than as a link error — which is
|
|
the whole reason this check exists. An enum against an [i16], an [i64] or
|
|
an [f32] is a real disagreement and stays one. *)
|
|
let enum_like env (t : Ast.texpr) =
|
|
match t.Ast.t with
|
|
| Ast.Tname n -> List.mem n env.known_enums
|
|
| _ -> false
|
|
|
|
let int32_like s = String.equal s "i32" || String.equal s "u32"
|
|
|
|
let agrees env (a : Ast.texpr) (b : Ast.texpr) =
|
|
let na = ty_source a and nb = ty_source b in
|
|
String.equal na nb
|
|
|| (enum_like env a && int32_like nb)
|
|
|| (enum_like env b && int32_like na)
|
|
|
|
(* ── A hand-written pointer, against the pointer the header spells ──
|
|
|
|
The second tolerance, and the one [agrees] cannot express on its own. By the
|
|
time a C parameter has become a Flan type, what the header actually said
|
|
about it is gone: [param_ty] renders [const char *] as [string] and
|
|
[value_ty] renders [void *] as [(Ptr u8)], and both of those are the
|
|
importer's own choice rather than the header's word. A hand-written line
|
|
that says [(Ptr u8)] over a [const char *] is not disagreeing with the
|
|
header — it is disagreeing with a rendering — so the comparison has to be
|
|
made against the C spelling, which is why this takes the string and [agrees]
|
|
does not.
|
|
|
|
It is consulted only from the [declare-c] check below, never from
|
|
[check_structs]. A struct field is about *layout*, and every pointer in a
|
|
struct is one word whatever it points at, so the element type is not the
|
|
thing that check is for; widening it there would buy nothing and would cost
|
|
the width discipline the field check exists to keep.
|
|
|
|
The [i8]/[u8] tolerance likewise lives here and not in [agrees]. Inside a
|
|
pointer, [char] and [unsigned char] are two spellings of one byte and the
|
|
package uses [(Ptr u8)] for both — [Image.data] is [void *] in the header.
|
|
As a *field* or a *scalar* they are still a real disagreement and [agrees]
|
|
goes on saying so. *)
|
|
|
|
let byte s = String.equal s "i8" || String.equal s "u8"
|
|
|
|
(* [const int *] → [Some "const int"]. Anything that is not a pointer, [None].
|
|
Only the outermost [*] comes off, so [void **] arrives here as a pointer to
|
|
[void *], which is a pointer to something and not a [void *]. *)
|
|
let c_pointee (s : string) : string option =
|
|
let s = String.trim s in
|
|
if String.length s > 0 && s.[String.length s - 1] = '*' then
|
|
Some (String.trim (String.sub s 0 (String.length s - 1)))
|
|
else None
|
|
|
|
let ptr_agrees env ~(c : string) (t : Ast.texpr) =
|
|
match (c_pointee c, t.Ast.t) with
|
|
| Some inner, Ast.Tapp ("Ptr", [ elem ]) ->
|
|
(* [void *] agrees with a pointer to anything, and this is the judgement
|
|
call of the arm. C's [void *] is opaque about *what it points at* — that
|
|
is the whole of what the spelling means — so there is no element type in
|
|
the header to disagree with, and a check that reported one would be
|
|
reporting [value_ty]'s guess of [u8] back at the author as if the header
|
|
had said it. What is *not* given up is that it is a pointer at all: the
|
|
match above requires [(Ptr _)] on the Flan side, so an [i32] or a
|
|
[string] declared against a [void *] is still a finding. That
|
|
asymmetry is the point — raylib spells thirty-odd parameters [void *]
|
|
and none of them is a scalar. *)
|
|
let b = bare inner in
|
|
if String.equal b "void" then true
|
|
else (
|
|
match (try Some (value_ty env inner) with Refused _ -> None) with
|
|
| None ->
|
|
(* A pointee this cannot render says nothing, exactly as an
|
|
unrenderable field type says nothing in [check_structs]. *)
|
|
false
|
|
| Some want ->
|
|
let a = ty_source want and b = ty_source elem in
|
|
(* [agrees] and not [String.equal], so a [(Ptr Key)] against the
|
|
header's [(Ptr int)] lands on the enum arm. The four bytes are the
|
|
same four bytes through a pointer as they are beside one. *)
|
|
agrees env want elem || (byte a && byte b))
|
|
| _ -> false
|
|
|
|
(* The two together, for the one caller that still has the C spelling. A
|
|
[(Ptr A)] against a [B *] for unrelated named [A] and [B] falls through
|
|
both and stays a finding: two structs of the same size are still two
|
|
different structs, and a binding that says the wrong one reads a
|
|
plausible picture out of the wrong offsets. *)
|
|
let agrees_c env ~(c : string) (want : Ast.texpr) (got : Ast.texpr) =
|
|
agrees env want got || ptr_agrees env ~c got
|
|
|
|
(* The header's record of a given name and a given kind. [want_union] is part
|
|
of the lookup rather than checked afterwards because a name is only one
|
|
half of the question: a [defstruct Overlay] and a C [union Overlay] are not
|
|
the same layout with a spelling disagreement, they are two different
|
|
layouts, and running the struct comparison over the union's members would
|
|
report a field order where a union has none. A kind mismatch is reported by
|
|
the caller, which has the Flan declaration to name. *)
|
|
let record_named (d : dump) ~want_union n =
|
|
let ofkind r = r.runion = want_union in
|
|
match List.find_opt (fun r -> r.rname = n && ofkind r) 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 && ofkind r) d.records
|
|
| None -> None)
|
|
|
|
let check_structs ~env ~(structs : (string * Ast.field list) list) (d : dump) =
|
|
let record n = record_named d ~want_union:false n in
|
|
(* Names and widths both. Order is what a permuted [defstruct] gets wrong and
|
|
what docs/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 agrees env want f.Ast.fty 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
|
|
| Some r -> Option.map (fun m -> (n, m)) (field_mismatch fs r)
|
|
(* The mirror of the finding [check_unions] makes, and it has to be
|
|
here or the kind mismatch goes quiet in one of its two directions:
|
|
asking for a struct of this name finds nothing when the header's
|
|
record is a union, and "nothing" is how a package the header says
|
|
nothing about is reported. Two different layouts under one name is
|
|
not that. *)
|
|
| None ->
|
|
match record_named d ~want_union:true n with
|
|
| Some r ->
|
|
Some (n,
|
|
Printf.sprintf
|
|
"%s is a union in the header and a defstruct here — its \
|
|
members are laid out over one another there and one after \
|
|
another here" r.rname)
|
|
| None -> None)
|
|
structs
|
|
|
|
(* The same claim for a [defunion], and it is deliberately a second function
|
|
rather than a flag on the one above.
|
|
|
|
What a struct check is *for* is order: a permuted [Texture2D] reads as five
|
|
plausible numbers, and the offsets are what moved. A union has no order to
|
|
permute. Every member is at offset zero, so a [defunion] that lists its
|
|
members in a different order from the header is not merely acceptable, it
|
|
is the same type — reporting it would be a false finding, and a check that
|
|
cries wolf is how a real disagreement gets ignored.
|
|
|
|
So: members by name, and the type of each. A member the header has and the
|
|
[defunion] does not is still a finding, and this is the one that matters
|
|
most, because it is the one that changes the *size*: a union missing its
|
|
widest member is narrower than C's, and a struct that holds one by value
|
|
then puts every field after it in the wrong place. The reverse — a member
|
|
Flan declares and C does not — is a finding too, for the same reason read
|
|
the other way, and because it is usually a typo in a name.
|
|
|
|
A member whose C type this cannot render says nothing, exactly as a
|
|
struct's does: the check is a second opinion, and having no opinion is not
|
|
a disagreement. *)
|
|
let check_unions ~env ~(unions : (string * Ast.field list) list) (d : dump) =
|
|
let mismatch (ms : Ast.field list) (r : crecord) =
|
|
let cnames = List.map (fun (n, _) -> kebab n) r.rfields in
|
|
let fnames = List.map (fun (f : Ast.field) -> f.Ast.fname) ms in
|
|
let missing = List.filter (fun n -> not (List.mem n fnames)) cnames in
|
|
let extra = List.filter (fun n -> not (List.mem n cnames)) fnames in
|
|
if missing <> [] then
|
|
Some
|
|
(Printf.sprintf
|
|
"%s has the member%s %s and the defunion does not — a union is as \
|
|
wide as its widest member, so a missing one makes the whole type \
|
|
narrower than C's"
|
|
r.rname (if List.length missing = 1 then "" else "s")
|
|
(String.concat " " missing))
|
|
else if extra <> [] then
|
|
Some
|
|
(Printf.sprintf
|
|
"the defunion has the member%s %s and %s does not"
|
|
(if List.length extra = 1 then "" else "s")
|
|
(String.concat " " extra) r.rname)
|
|
else
|
|
List.find_map
|
|
(fun (f : Ast.field) ->
|
|
match
|
|
List.find_opt (fun (cn, _) -> kebab cn = f.Ast.fname) r.rfields
|
|
with
|
|
| None -> None
|
|
| Some (_, ct) ->
|
|
match (try Some (value_ty env ct) with Refused _ -> None) with
|
|
| None -> None
|
|
| Some want ->
|
|
let a = ty_source want and b = ty_source f.Ast.fty in
|
|
if agrees env want f.Ast.fty then None
|
|
else
|
|
Some
|
|
(Printf.sprintf
|
|
"member %s is %s in the defunion and %s (%s) in %s"
|
|
f.Ast.fname b a ct r.rname))
|
|
ms
|
|
in
|
|
List.filter_map
|
|
(fun (n, (ms : Ast.field list)) ->
|
|
match record_named d ~want_union:true n with
|
|
| Some r -> Option.map (fun m -> (n, m)) (mismatch ms r)
|
|
(* The header has the name, and it is a struct. Two different layouts
|
|
under one name is worth saying out loud — it is the same class of
|
|
finding a permuted struct is, and the fix is the other keyword. *)
|
|
| None ->
|
|
match record_named d ~want_union:false n with
|
|
| Some r ->
|
|
Some (n,
|
|
Printf.sprintf
|
|
"%s is a struct in the header and a defunion here — its \
|
|
members are laid out one after another there and over one \
|
|
another here" r.rname)
|
|
| None -> None)
|
|
unions
|
|
|
|
(* ── Checking the package's constants against the header's ─────────── *)
|
|
|
|
(* The half of the claim that was missing, and the one with the worst failure
|
|
mode.
|
|
|
|
[generate-c] used to say that every [defstruct] and every hand-written
|
|
[declare-c] agreed with the header, and that claim held. It said nothing
|
|
about [defconst] or [defenum] — so a wrong flag bit or a wrong enum member
|
|
was *silent*, which is exactly the class of error the header read exists to
|
|
catch and the one hardest to see by reading. [FLAG_WINDOW_MINIMIZED] is
|
|
0x200; typing 0x100 gives a program that opens a window and hides it, with
|
|
no diagnostic anywhere and nothing in the source that looks wrong.
|
|
|
|
{2 How a Flan name is turned into a C one}
|
|
|
|
Not by a rule alone. [screaming] reconstructs [LEFT_SHIFT] from
|
|
[left-shift], but the prefix the C name carries — [KEY_], [FLAG_],
|
|
[GAMEPAD_BUTTON_] — is nowhere in the Flan source, so it is *declared*, in
|
|
the package's [bindings] file:
|
|
|
|
{v
|
|
enum Key KEY_ # (defenum Key [left-shift 340]) vs KEY_LEFT_SHIFT
|
|
const flag- FLAG_ # (defconst flag-vsync-hint ...) vs FLAG_VSYNC_HINT
|
|
constant Gesture/double-tap GESTURE_DOUBLETAP # the one the rule misses
|
|
v}
|
|
|
|
{2 Nothing goes quiet, in either direction}
|
|
|
|
A name the rule builds and the header does not have is *reported* and not
|
|
skipped. A mapping that silently matched nothing would be worse than no
|
|
check at all: it would read as coverage and provide none.
|
|
|
|
For the same reason a [defenum] with no [enum] line is itself a finding.
|
|
Otherwise the silence simply moves up one level — the next lane adds an
|
|
enum, adds no line, and nothing notices. [enum Foo -] is how a package says
|
|
out loud that the header has nothing to check [Foo] against; it is a
|
|
sentence somebody wrote rather than a line nobody did. An [enum] or [const]
|
|
rule that matches no Flan name at all is a finding too, which is what
|
|
catches a typo in the rule.
|
|
|
|
[defconst] is *not* held to that. A package's constants are mostly its own
|
|
— raylib's 26 colours, a screen size — and demanding a line for each would
|
|
be noise with no second author behind it. A [defconst] is checked when a
|
|
rule or a [constant] line brings it under the check, and raylib's
|
|
[gesture-all] is the honest example of one that is not: 1023 is the OR of
|
|
ten members and no C enumerator has that value to compare against. *)
|
|
|
|
(* Two kinds of finding, and they have different dispositions.
|
|
|
|
[cmapping = false] is a disagreement with the *library*: a value that does
|
|
not match, or a C name the header does not have. That is the same kind of
|
|
thing a permuted [defstruct] is, and an ordinary build stops on it.
|
|
|
|
[cmapping = true] is about the package's own [bindings] file — an enum
|
|
nobody mapped, a rule that reaches nothing. Real, and worth fixing, but it
|
|
is not the library contradicting anybody, and stopping a build over it
|
|
would tell a lane that added a [defenum] to go and edit a config file in a
|
|
message shaped like "your layout is wrong". Those gate [generate-c], which
|
|
is where the config is being edited and where the author is standing. *)
|
|
type const_diff = { cname : string; cwhy : string; cmapping : bool }
|
|
|
|
let check_constants ~config
|
|
~(enums : (string * (string * int64) list) list)
|
|
~(consts : (string * Ast.expr) list) (d : dump) : const_diff list =
|
|
let found = Hashtbl.create 512 in
|
|
List.iter (fun (n, v) -> Hashtbl.replace found n v) d.consts;
|
|
let out = ref [] in
|
|
let emit mapping name fmt =
|
|
Printf.ksprintf
|
|
(fun m -> out := { cname = name; cwhy = m; cmapping = mapping } :: !out)
|
|
fmt
|
|
in
|
|
let say name fmt = emit false name fmt in
|
|
let mapping_say name fmt = emit true name fmt in
|
|
(* One Flan name, its value, and the C name it claims to be. *)
|
|
let compare_one flan v cname =
|
|
match Hashtbl.find_opt found cname with
|
|
| None ->
|
|
say flan
|
|
"the header has no constant named %s, so nothing here checks %s — \
|
|
fix the mapping in `bindings` or the name in the source"
|
|
cname flan
|
|
| Some cv ->
|
|
if not (Int64.equal cv v) then
|
|
say flan "%s is %Ld here and %s is %Ld in the header" flan v cname cv
|
|
in
|
|
let explicit = config.constants in
|
|
let used = Hashtbl.create 16 in
|
|
(* Enum members. *)
|
|
List.iter
|
|
(fun (ename, members) ->
|
|
match List.assoc_opt ename config.enum_prefixes with
|
|
| None ->
|
|
mapping_say ename
|
|
"the defenum %s has no `enum` line in the package's `bindings`, so \
|
|
nothing checks its members against the header — add `enum %s \
|
|
<C_PREFIX>`, or `enum %s -` to say the header has nothing to \
|
|
check it against"
|
|
ename ename ename
|
|
| Some "-" -> Hashtbl.replace used ("enum:" ^ ename) ()
|
|
| Some prefix ->
|
|
Hashtbl.replace used ("enum:" ^ ename) ();
|
|
List.iter
|
|
(fun (m, v) ->
|
|
let flan = ename ^ "/" ^ m in
|
|
let cname =
|
|
match List.assoc_opt flan explicit with
|
|
| Some c -> c
|
|
| None -> prefix ^ screaming m
|
|
in
|
|
compare_one flan v cname)
|
|
members)
|
|
enums;
|
|
(* Plain constants, and only the ones a rule or a [constant] line reaches. *)
|
|
let int_of (e : Ast.expr) =
|
|
match e.Ast.e with Ast.Int v -> Some v | _ -> None
|
|
in
|
|
List.iter
|
|
(fun (n, e) ->
|
|
(* The prefix is marked as reaching something *before* an explicit
|
|
[constant] line is consulted, so a rule whose every match is also
|
|
spelled out by hand is not reported as reaching nothing. A false
|
|
finding in a check whose whole value is that a finding is real. *)
|
|
let by_rule =
|
|
List.find_map
|
|
(fun (fp, cp) ->
|
|
match strip_prefix fp n with
|
|
| Some rest ->
|
|
Hashtbl.replace used ("const:" ^ fp) ();
|
|
Some (cp ^ screaming rest)
|
|
| None -> None)
|
|
config.const_prefixes
|
|
in
|
|
let cname =
|
|
match List.assoc_opt n explicit with Some c -> Some c | None -> by_rule
|
|
in
|
|
match cname with
|
|
| None -> ()
|
|
| Some cname ->
|
|
(match int_of e with
|
|
| Some v -> compare_one n v cname
|
|
| None ->
|
|
say n
|
|
"%s is mapped to %s but its value is not a plain integer, so \
|
|
there is nothing to compare"
|
|
n cname))
|
|
consts;
|
|
(* A rule that reaches nothing. A typo in a prefix would otherwise read as
|
|
coverage and provide none, which is the failure this whole section is
|
|
about. *)
|
|
List.iter
|
|
(fun (ename, _) ->
|
|
if not (Hashtbl.mem used ("enum:" ^ ename)) then
|
|
mapping_say ename
|
|
"`enum %s` in the package's `bindings` names no defenum the \
|
|
package declares" ename)
|
|
config.enum_prefixes;
|
|
List.iter
|
|
(fun (fp, _) ->
|
|
if not (Hashtbl.mem used ("const:" ^ fp)) then
|
|
mapping_say fp
|
|
"`const %s` in the package's `bindings` matches no defconst the \
|
|
package declares" fp)
|
|
config.const_prefixes;
|
|
(* And a [constant] line naming nothing. *)
|
|
List.iter
|
|
(fun (flan, _) ->
|
|
let known =
|
|
List.mem_assoc flan consts
|
|
|| List.exists
|
|
(fun (ename, members) ->
|
|
List.exists (fun (m, _) -> String.equal (ename ^ "/" ^ m) flan)
|
|
members)
|
|
enums
|
|
in
|
|
if not known then
|
|
mapping_say flan
|
|
"`constant %s` in the package's `bindings` names no defconst and no \
|
|
enum member the package declares" flan)
|
|
explicit;
|
|
List.rev !out
|
|
|
|
(* ── 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 caches, two of them ───────────────────────────────────────── *)
|
|
|
|
(* 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.
|
|
|
|
It lives under the object cache directory, beside the [.o] files, because it
|
|
is the same kind of thing: derived from an input the compiler did not write,
|
|
stable across builds, and safe to delete. One directory to clear rather than
|
|
two. *)
|
|
|
|
let cache_format = 2
|
|
|
|
(* The same directory [Build.cachedir] makes, spelled here rather than called:
|
|
[Load] is upstream of this file and downstream of [Reach], so reaching
|
|
[Build] from here closes a cycle. Two lines that have to agree, and the
|
|
consequence of their disagreeing is a second cache directory rather than a
|
|
wrong answer. *)
|
|
let cachedir () =
|
|
let d = Filename.concat (Filename.get_temp_dir_name ()) "flan-objcache" in
|
|
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
|
d
|
|
|
|
let dump_of_disk ~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)
|
|
|
|
(* And in front of that file, the session's own copy — which is the level that
|
|
matters for the dev loop, because the daemon is a process that lives for as
|
|
long as the editor does and re-reads the file once per evaluation that
|
|
imports the package again. Reading the cached dump is 0.33ms and extracting
|
|
the declarations from it is another 3.3ms, so this is small; it is here
|
|
because *nothing* is the right amount for a long-lived process to pay twice
|
|
for an answer it already has.
|
|
|
|
**Keyed on the header's path and the flags, and deliberately not on its
|
|
mtime.** That is the whole of the mid-session question: a header edited
|
|
while a session is running is not re-read, and the session keeps the
|
|
signatures it started with until it is restarted. It is the same rule a
|
|
changed [.c] file follows — the daemon compiled the package's C once, at
|
|
startup, and a redefinition does not recompile it — and the same rule the
|
|
running program itself follows, since its layouts are the ones it was built
|
|
with. The alternative is worse in both directions: keying on mtime would put
|
|
a [stat] on a path that is supposed to cost nothing, and it would let a
|
|
header change take effect on the next [C-c C-c] in a *program that is still
|
|
running with the old layouts*, which is precisely the silent disagreement
|
|
the header check exists to prevent. A new session reads the new header, and
|
|
the disk cache above keys on mtime so it does not serve it the old one.
|
|
|
|
Two tables rather than one, because the two answers have different inputs.
|
|
The *dump* is the header's alone, so a second package importing the same
|
|
header shares it. The *declarations* are the dump read against one package —
|
|
which names it already has taken, which structs and enums it knows, which C
|
|
symbols it binds by hand — so they are keyed on those too, and a package
|
|
whose decls an evaluation has added to gets its declarations worked out
|
|
again rather than served an answer about the decls it used to have. *)
|
|
|
|
let dumps : (string, dump) Hashtbl.t = Hashtbl.create 4
|
|
let imports : (string, imported * dump * env) Hashtbl.t = Hashtbl.create 4
|
|
|
|
let header_key ~header ~flags =
|
|
String.concat "\000"
|
|
((try Unix.realpath header with Unix.Unix_error _ -> header) :: flags)
|
|
|
|
let dump_of ~loc ~header ~flags =
|
|
let k = header_key ~header ~flags in
|
|
match Hashtbl.find_opt dumps k with
|
|
| Some d -> d
|
|
| None ->
|
|
let d = dump_of_disk ~loc ~header ~flags in
|
|
Hashtbl.replace dumps k d;
|
|
d
|
|
|
|
let env_of ~known_structs ~known_unions ~known_enums d =
|
|
{ known_structs; known_unions; known_enums; d }
|
|
|
|
let header ~loc ~header:h ~flags ~known_structs ~known_unions ~known_enums ~taken ~bound_syms ~config =
|
|
let k =
|
|
(* Sorted, because neither the taken table nor the declaration order is a
|
|
fact about the package — two loads of the same file that enumerate them
|
|
differently are the same question and must not miss each other. *)
|
|
let sorted xs = List.sort compare xs in
|
|
String.concat "\000"
|
|
(header_key ~header:h ~flags
|
|
:: "\001" :: sorted known_structs
|
|
@ ("\001" :: sorted known_unions)
|
|
@ ("\001" :: sorted known_enums)
|
|
@ ("\001" :: sorted (Hashtbl.fold (fun n () acc -> n :: acc) taken []))
|
|
@ ("\001" :: sorted bound_syms)
|
|
(* The config is part of the question: two loads that disagree about
|
|
what is excluded or renamed are different questions, and serving one
|
|
the other's answer is the bug this key exists to prevent. *)
|
|
@ ("\001" :: sorted config.excludes)
|
|
@ ("\001" :: sorted (List.map (fun (a, b) -> a ^ "=" ^ b) config.renames))
|
|
@ ("\001" :: sorted (List.map (fun (a, b) -> a ^ "=" ^ b) config.enum_prefixes))
|
|
@ ("\001" :: sorted (List.map (fun (a, b) -> a ^ "=" ^ b) config.const_prefixes))
|
|
@ ("\001" :: sorted (List.map (fun (a, b) -> a ^ "=" ^ b) config.constants)))
|
|
in
|
|
match Hashtbl.find_opt imports k with
|
|
| Some r -> r
|
|
| None ->
|
|
let d = dump_of ~loc ~header:h ~flags in
|
|
let env = env_of ~known_structs ~known_unions ~known_enums d in
|
|
let r = (of_dump ~env ~taken ~bound_syms ~config d, d, env) in
|
|
Hashtbl.replace imports k r;
|
|
r
|
|
|
|
(* ── Printing a declaration back as source ─────────────────────────── *)
|
|
|
|
(* Which makes the third option in docs/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: every [declare-c] line in [vendor/raylib] was transcribed by
|
|
hand from raylib's documentation, and until this nothing could say whether
|
|
any of them was right. This says so, one at a time. (There is no count here
|
|
on purpose. The one that used to be said 176, and was twenty short by the
|
|
time anybody read it — which is what a hand-maintained census of a growing
|
|
file always ends up being. [grep -c '^(declare-c' vendor/raylib/*.flan] is
|
|
the answer and it is never stale.)
|
|
|
|
Compared as *rendered Flan types* wherever the rendering is the whole story,
|
|
and against the C spelling where it is not. Three differences are expected
|
|
and are not reported, and all three are now implemented rather than
|
|
promised:
|
|
|
|
- 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. That is [agrees].
|
|
- a [(Ptr T)] where the header says [T *] and the hand-written line chose
|
|
something more specific for a reason it recorded. That is [ptr_agrees],
|
|
and it needs the C spelling because the rendering has already thrown the
|
|
answer away: [param_ty] turns [const char *] into [string] and [value_ty]
|
|
turns [void *] into [(Ptr u8)], neither of which is what the header said.
|
|
[(Ptr u8)] over a [char *], and [(Ptr] anything[)] over a [void *], now
|
|
agree; [(Ptr A)] over a [B *] does not.
|
|
|
|
What [const] does here, since the arm above says nothing about it: nothing,
|
|
and the reason is worth knowing because it is invisible. A non-const
|
|
[char *] parameter makes [param_ty] *refuse*, and the [| None -> None] below
|
|
means a parameter the importer cannot render at all is skipped rather than
|
|
compared. So a hand-written [(Ptr u8)] over a [char *] has always passed —
|
|
unexamined, not approved. Only [const char *] ever reaches the comparison,
|
|
and that is the case the pointer arm exists for.
|
|
|
|
What is left after those is a real disagreement about a width, an arity or a
|
|
direction — which is exactly the class of bug docs/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
|
|
(* [agrees] above is the whole of it: an enum against a 32-bit
|
|
integer is the expected difference and not a finding, and an enum
|
|
against anything else still is one. *)
|
|
let norm (t : Ast.texpr) = ty_source t in
|
|
let same ~c a b = agrees_c env ~c a b 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 ~c:ct 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 ~c:c.cret 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
|
|
|
|
|
|
(* ── Regenerating the committed declarations ───────────────────────── *)
|
|
|
|
(* Generate once, commit the result, regenerate when the library moves.
|
|
|
|
What that buys is in docs/DISCUSS.md item 6 and it is not caching — the dump is
|
|
already cached on disk and in memory, so a build that reads the header pays
|
|
for it once either way. It is that no header is needed by *anybody*: the
|
|
declarations are in the repository, so they are greppable, they diff when
|
|
raylib moves, and a build needs libraylib linkable and nothing else. The
|
|
opt-in that used to decide whether a package had 172 bindings or 428 stops
|
|
deciding anything.
|
|
|
|
What it costs is the check. A header read at build time compared every
|
|
hand-written declaration against the library on every build; a committed
|
|
file compares nothing, because a file on disk has no second opinion. That
|
|
check is not decoration — it verified all 172 hand-written declarations and
|
|
all 16 struct layouts against raylib 5.5 and found them exactly right, and
|
|
against a 5.1-dev header on the same machine it found ten real differences.
|
|
|
|
So regeneration runs it, and the check *gates the write*. There is no way to
|
|
ask for new declarations without comparing the package against the header
|
|
they come from, because the one function that writes the file is this one
|
|
and it refuses when the two disagree. A regeneration that quietly rewrote
|
|
the bindings against a header the library does not match would produce
|
|
exactly the failure docs/BUILT.md warns about — a permuted struct read as five
|
|
plausible numbers rather than as a link error — and it would produce it in a
|
|
committed file that looks reviewed.
|
|
|
|
The hand-written declarations are what make the signature half of that check
|
|
mean anything, which is why they stay. Everything the generator emits agrees
|
|
with the header by construction, so diffing generated output against the
|
|
header it came from is a tautology; the hand-written lines were transcribed
|
|
from raylib's documentation by a person, so they are an independent second
|
|
opinion and the only thing here that the header can actually contradict. *)
|
|
|
|
type regen = {
|
|
gwrote : bool;
|
|
gdecls : int;
|
|
gfns : int;
|
|
ghidden : (string * string) list;
|
|
gstructs : (string * string) list;
|
|
gsigs : sig_diff list;
|
|
gconsts : const_diff list;
|
|
}
|
|
|
|
let banner h =
|
|
Printf.sprintf
|
|
";;;; Generated from %s by `flan generate-c`. Do not edit this file.\n\
|
|
;;;;\n\
|
|
;;;; Every line here was read out of the C header named by `headers`, and\n\
|
|
;;;; the next regeneration overwrites the file — so a correction made here\n\
|
|
;;;; is destroyed without anybody being told. Corrections go in `bindings`\n\
|
|
;;;; beside it, which is read *while* these lines are made: `exclude` drops\n\
|
|
;;;; a function, `name` gives one a Flan name the kebab rule would not.\n\
|
|
;;;; Anything neither directive can express is a hand-written declare-c in\n\
|
|
;;;; the package's own .flan, which wins over this file and is left alone.\n\
|
|
;;;;\n\
|
|
;;;; Regenerating compares the package against the header first and\n\
|
|
;;;; refuses to write when they disagree, so this file and the\n\
|
|
;;;; hand-written declarations beside it agreed with %s when it was made.\n\n"
|
|
(Filename.basename h) (Filename.basename h)
|
|
|
|
(* [ds] is the package's *hand-written* declarations: every .flan in the
|
|
directory except the one being written. Reading the output back in would
|
|
make regeneration idempotent in the worst way — every symbol would already
|
|
be bound, so the second run would generate nothing and cheerfully write an
|
|
empty file. *)
|
|
let regenerate ~loc ~header:h ~flags ~(ds : Ast.decl list) ~config ~out =
|
|
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 pick f = List.filter_map f ds in
|
|
let structs =
|
|
pick (fun (d : Ast.decl) ->
|
|
match d.Ast.d with Ast.Defstruct (n, fs) -> Some (n, fs) | _ -> None)
|
|
and enums =
|
|
pick (fun (d : Ast.decl) ->
|
|
match d.Ast.d with Ast.Defenum (n, ms) -> Some (n, ms) | _ -> None)
|
|
and pconsts =
|
|
pick (fun (d : Ast.decl) ->
|
|
match d.Ast.d with Ast.Defconst (n, _, e) -> Some (n, e) | _ -> None)
|
|
and bound_syms =
|
|
pick (fun (d : Ast.decl) ->
|
|
match d.Ast.d with
|
|
| Ast.Declare (_, s) | Ast.DeclareC (_, s) -> Some s
|
|
| _ -> None)
|
|
and bound =
|
|
pick (fun (d : Ast.decl) ->
|
|
match d.Ast.d with Ast.DeclareC (fn, s) -> Some (fn, s) | _ -> None)
|
|
in
|
|
let imported, dump, env =
|
|
header ~loc ~header:h ~flags ~known_structs:(List.map fst structs)
|
|
~known_unions:[] ~known_enums:(List.map fst enums) ~taken ~bound_syms
|
|
~config
|
|
in
|
|
let gstructs = check_structs ~env ~structs dump in
|
|
let gsigs = diff_bound ~env ~bound dump in
|
|
let gconsts = check_constants ~config ~enums ~consts:pconsts dump in
|
|
let gwrote = gstructs = [] && gsigs = [] && gconsts = [] in
|
|
if gwrote then begin
|
|
let b = Buffer.create 65536 in
|
|
Buffer.add_string b (banner h);
|
|
List.iter
|
|
(fun d ->
|
|
Buffer.add_string b (decl_source d);
|
|
Buffer.add_char b '\n')
|
|
imported.decls;
|
|
let ch = open_out out in
|
|
output_string ch (Buffer.contents b);
|
|
close_out ch
|
|
end;
|
|
{ gwrote; gdecls = List.length imported.decls;
|
|
gfns = List.length dump.fns; ghidden = imported.hidden; gstructs; gsigs;
|
|
gconsts }
|