From 19aa10158a99eaf9f2f891b6e730ab359a9901b9 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 15:15:01 +0700 Subject: [PATCH 1/7] Read the header instead of trusting the transcription MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit declare-c generates the wrapper, the typedefs and the prototype from one declaration, so they cannot disagree with each other. What nothing checked was whether the declaration matched the library — BUILT.md records that as trusted rather than guaranteed, because no header was ever read. This reads one. clang is asked for a JSON AST dump of the header and shelled out to, not linked: -Xclang -ast-dump=json is the same binary on PATH that every build already runs, which is plan.org's "Why LLVM IR as text" applied a second time. Zig's old @cImport linked clang as a library and that is precisely the dependency plan.org rejected. cjson.ml is enough JSON to read the dump and no more, so this adds no opam package to parse it. What comes out of the header is signatures and nothing else — not structs, not enums, not macros. The bound on how much is imported is the package's own defstructs: 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. Keeping the layouts hand-written is also what makes checking them against the header's records worth doing — a _Static_assert was rejected in BUILT.md as circular, and this is not, because the two sides have different authors. Refusals are demotions, taken from Zig's translator: it never drops a declaration it cannot handle, it binds the name to a @compileError carrying the reason so the failure lands at the use site. Load.refuse_hidden is already that mechanism. So a returned char * does not kill the header — it makes one name unavailable, with the reason attached. flan import-c prints what it would produce, what it refused, how the package's defstructs compare with the header's records, and how the hand-written declare-c lines compare with the header's signatures. Against raylib 5.5, the version whose .so vendor/raylib/link names: all 16 defstructs and all 172 hand-written declare-c agree exactly. Against the 5.1-dev header installed in /usr/local it reports ten differences, nine functions that version does not have and one that gained a parameter — so the check has teeth and the clean run is not a vacuous one. --- bin/main.ml | 98 +++++++ lib/cimport.ml | 747 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/cjson.ml | 174 ++++++++++++ 3 files changed, 1019 insertions(+) create mode 100644 lib/cimport.ml create mode 100644 lib/cjson.ml diff --git a/bin/main.ml b/bin/main.ml index 35d178f..4c8e3aa 100644 --- a/bin/main.ml +++ b/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) ...\n\ + \ flan import-c [package.flan...] [clang flags...]\n\ \ flan build [-o out] [--no-bounds-checks] [--dev] \ [--debug] [--sanitize] [--target=wasm32-wasi|web]\n\ \ flan run [args...]\n\ diff --git a/lib/cimport.ml b/lib/cimport.ml new file mode 100644 index 0000000..a019d9f --- /dev/null +++ b/lib/cimport.ml @@ -0,0 +1,747 @@ +(** 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.mem_assoc n env.d.typedefs then begin + let u = bare (List.assoc n env.d.typedefs) in + if u = n then refuse "%s is a typedef of itself" n else named env u + end + else if List.exists (fun r -> r.rname = n) env.d.records then + 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 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 [] and by_name = Hashtbl.create 512 in + List.iter + (fun f -> + let flan = kebab f.csym in + let skip why = hidden := (flan, why) :: !hidden in + if List.mem f.csym bound_syms then + (* Not hidden: the name the package wrote for it is there and works. + This is the escape hatch doing its job. *) + () + else 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 Hashtbl.mem by_name flan then + skip + (Printf.sprintf + "%s and %s both kebab to %s, so the header cannot be imported \ + whole — one of them needs a hand-written declare-c" + (Hashtbl.find by_name 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) -> + Hashtbl.replace by_name flan f.csym; + decls := + { Ast.d = + Ast.DeclareC + ({ Ast.name = flan; params; ret; fbody = []; nloc = f.cloc }, + f.csym); + dloc = f.cloc } + :: !decls) + d.fns; + { decls = List.rev !decls; hidden = List.rev !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 — 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 ~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 + +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 diff --git a/lib/cjson.ml b/lib/cjson.ml new file mode 100644 index 0000000..e4937c5 --- /dev/null +++ b/lib/cjson.ml @@ -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 | _ -> [] From 4a78e50375a3c74c007d4811daaad7627f644eb5 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 15:29:07 +0700 Subject: [PATCH 2/7] A package can name the headers it binds, and the import is nearly free MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `headers` beside `link`, read the same way: a path, any clang flags that header 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 leading `?` makes a line optional. vendor/raylib uses it, because "a build needs libraylib linkable and not raylib-devel installed" is a property worth keeping — requiring a header would take it from everyone 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 against raylib's own header. A C symbol the package already binds by hand is left alone, so declare-c remains the escape hatch and stays the thing that wins. A refused function becomes a hidden name through Load.refuse_hidden, so writing rl/get-gamepad-name says "GetGamepadName returns char *, and a string only crosses as a parameter" rather than "unknown name". Measured, because the cost is the whole argument for how much to import: release build +14ms cold, +4ms warm — Reach prunes the wrappers redefinition 31ms -> 46.5ms dev build +333ms cold — dev does not prune, 428 wrappers Reach.link already drops a generated wrapper whose declaration nothing reachable calls, and that is what makes a wholesale import cost nothing in a release build. It does not prune dev builds, on purpose, so a dev build compiles every wrapper once at session start; Build.shared compiles no C, so redefinition does not pay that again. Reading the header is cached — 64ms of a 72ms check, against 8ms for the whole program without it. Keyed like the object cache, on everything that could change the answer: the header's path, size and mtime, the full flag list, and a format version, since the cached value is a marshalled dump. The extracted signatures are cached rather than clang's JSON, because the parse is half the cost. That takes the delta to 17ms. Verified end to end and headless, using only imported declarations: ColorToInt of {17,34,51,68} is 0x11223344 and ColorTint hands the four bytes back separately, so field order is pinned by arithmetic rather than by a round trip. TextLength of "hello" is 5, so the string crossing works. --- lib/cimport.ml | 120 +++++++++++++++++++++++++--- lib/load.ml | 176 +++++++++++++++++++++++++++++++++++++++++- vendor/raylib/headers | 32 ++++++++ 3 files changed, 316 insertions(+), 12 deletions(-) create mode 100644 vendor/raylib/headers diff --git a/lib/cimport.ml b/lib/cimport.ml index a019d9f..a330cf2 100644 --- a/lib/cimport.ml +++ b/lib/cimport.ml @@ -379,15 +379,44 @@ let rec named env (n : string) : Ast.texpr = few calls where it matters, not a reason to refuse the other five hundred. *) tname "i32" - else if List.mem_assoc n env.d.typedefs then begin - let u = bare (List.assoc n env.d.typedefs) in - if u = n then refuse "%s is a typedef of itself" n else named env u - end else if List.exists (fun r -> r.rname = n) env.d.records then - refuse - "%s is a struct the package does not describe — add a defstruct for it, \ - or keep a hand-written declare-c" - n + (* 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 \ @@ -607,7 +636,7 @@ let check_structs ~env ~(structs : (string * Ast.field list) list) (d : dump) = (* ── The entry point ───────────────────────────────────────────────── *) -let dump_of ~loc ~header ~flags = +let dump_of_clang ~loc ~header ~flags = let text = run_clang ~loc ~header ~flags in let json = try Cjson.parse text @@ -616,6 +645,79 @@ let dump_of ~loc ~header ~flags = 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. *) + +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 = diff --git a/lib/load.ml b/lib/load.ml index 5514be6..f92872f 100644 --- a/lib/load.ml +++ b/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,103 @@ 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 + if optional && not (Sys.file_exists h) then None + 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 +631,62 @@ 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, _, _ = + Cimport.header ~loc ~header:h ~flags ~known_structs ~known_enums + ~taken ~bound_syms + in + 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 +700,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 +724,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)) diff --git a/vendor/raylib/headers b/vendor/raylib/headers new file mode 100644 index 0000000..4f001e7 --- /dev/null +++ b/vendor/raylib/headers @@ -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} From 1fb208a9913a196c94095b660c86237e2bde798d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 15:59:35 +0700 Subject: [PATCH 3/7] The header is checked at build time, not only by a tool MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reading the header produced declarations and nothing else, so the gap the whole thing exists to close — that nothing verifies a declaration against the library — was closed by a command somebody could run rather than by a property the build had. Now `import` runs both comparisons whenever a header resolves. Build-stopping, not a note. The package named the header, so the header is the package's own claim about what it binds; a defstruct that disagrees lays fields out in the wrong order and reads as five plausible numbers rather than as a link error. 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. Both messages point at the line in raylib.flan, not at the header. Verified by breaking it on purpose: a permuted Texture2D stops the build naming the field that moved, and `f64` where raylib says `float` stops it naming the parameter — which is the hazard BUILT.md calls out by name and says only a test can catch. A set-but-wrong FLAN_RAYLIB_H used to be indistinguishable from not opting in: the line was skipped and nothing was said. Unset still means off and silent; a path that is not there is now an error naming it. That is the difference between an opt-in and a trap. test/headers/sample.h is one function per decision the importer makes. The raylib case needs raylib installed, at the right version, with a variable set, so it would skip everywhere and cover nothing; this one does not move. It also found a bug, fixed next. Reach still prunes with 256 extra declarations in play: a wasm32-wasi build of a program that imports raylib and calls none of it links without libraylib, which is the case Reach.link exists for. --- lib/cimport.ml | 6 ++-- lib/load.ml | 82 +++++++++++++++++++++++++++++++++++++++++-- test/headers/sample.h | 48 +++++++++++++++++++++++++ 3 files changed, 132 insertions(+), 4 deletions(-) create mode 100644 test/headers/sample.h diff --git a/lib/cimport.ml b/lib/cimport.ml index a330cf2..058b77a 100644 --- a/lib/cimport.ml +++ b/lib/cimport.ml @@ -613,7 +613,7 @@ let check_structs ~env ~(structs : (string * Ast.field list) list) (d : dump) = if kebab cn <> f.Ast.fname then Some (Printf.sprintf - "the defstruct has %s where %s has %s — the field order disagrees" + "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 @@ -662,7 +662,9 @@ let dump_of_clang ~loc ~header ~flags = 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. *) + 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 diff --git a/lib/load.ml b/lib/load.ml index f92872f..fbb044c 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -566,7 +566,17 @@ let header_specs ~loc dir = let h = if Filename.is_relative h then Filename.concat dir h else h in - if optional && not (Sys.file_exists h) then None + (* 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) @@ -679,10 +689,78 @@ let rec import ~seen ~loc alias dir = | _ -> None) ds in - let r, _, _ = + 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 diff --git a/test/headers/sample.h b/test/headers/sample.h new file mode 100644 index 0000000..de56002 --- /dev/null +++ b/test/headers/sample.h @@ -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); From ef7650ec99639a403a5b4c3c30fda86f405b7737 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 16:02:16 +0700 Subject: [PATCH 4/7] A kebab collision takes every name in its group down MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two C functions whose names kebab to one Flan name used to resolve by order: the first won the name, the second was refused. Which one that is depends on the order the header happens to declare them in, so moving two lines in somebody else's header would silently rebind a name a Flan program is already calling — and the winner was left in the hidden list too, so using the name it did get reported that it could not be had. Neither takes it now. There is no reading of spin-2d that is obviously right when the header offers both Spin2D and spin2d, so both are refused and both say why; the author binds the one they want with a hand-written declare-c, which is what that form is for. Found by test/headers/sample.h, which is why it is a fixture rather than a raylib case. raylib is unaffected: its 581 names are injective under the rule. --- lib/cimport.ml | 63 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 15 deletions(-) diff --git a/lib/cimport.ml b/lib/cimport.ml index 058b77a..cb5d2f8 100644 --- a/lib/cimport.ml +++ b/lib/cimport.ml @@ -511,26 +511,50 @@ type imported = { [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 [] and by_name = Hashtbl.create 512 in + 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 - if List.mem f.csym bound_syms then - (* Not hidden: the name the package wrote for it is there and works. - This is the escape hatch doing its job. *) - () - else if Hashtbl.mem taken flan || Hashtbl.mem taken (flan ^ "-c") then + 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 Hashtbl.mem by_name flan then - skip - (Printf.sprintf - "%s and %s both kebab to %s, so the header cannot be imported \ - whole — one of them needs a hand-written declare-c" - (Hashtbl.find by_name flan) f.csym flan) else if f.cvariadic then skip (Printf.sprintf @@ -555,7 +579,6 @@ let of_dump ~env ~taken ~bound_syms (d : dump) : imported = with | Error why -> skip (Printf.sprintf "%s %s" f.csym why) | Ok (params, ret) -> - Hashtbl.replace by_name flan f.csym; decls := { Ast.d = Ast.DeclareC @@ -563,8 +586,18 @@ let of_dump ~env ~taken ~bound_syms (d : dump) : imported = f.csym); dloc = f.cloc } :: !decls) - d.fns; - { decls = List.rev !decls; hidden = List.rev !hidden } + 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 ───────────── *) From e12e3e11c5ce4711dd5943d0ed1e7419ad0af747 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 16:09:48 +0700 Subject: [PATCH 5/7] A table for the importer, against a header that does not move MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Nothing in dune test exercised cimport.ml or cjson.ml. The raylib case is the better evidence and the 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 and cover nothing. test/headers/sample.h is one function per decision the importer makes, and the table asserts on the reasons rather than the counts — a refusal that fires for the wrong cause still refuses, and a count still matches. Accepted: an aggregate in and out, const char * as a string, a pointer parameter, a second typedef name for a record described once, a C enum against a defenum. Refused, each by reason: a returned char *, a non-const char * C may write through, a variadic, a callback, a long, a struct with no defstruct, and a kebab collision. Plus that nothing is in both lists, which is the bug the collision case found. check_structs and diff_bound get a row each for agreeing, for a permuted field order, for a widened field, and for a symbol the header does not have — the last being how a package pinned to the wrong release announces itself. The name rule and the JSON reader get their own rows. Checked by breaking two of them on purpose and watching both fail. test/programs/raylib-imported.flan is the end-to-end evidence, back and in the new struct-literal spelling: four bindings the package does not bind by hand. ColorToInt of {17,34,51,68} is 0x11223344 and ColorTint by white hands the four bytes back separately, so field order is pinned by arithmetic and not by a round trip, which is the trap BUILT.md records. --- test/dune | 5 + test/programs/raylib-imported.flan | 36 +++++ test/test_flan.ml | 225 +++++++++++++++++++++++++++++ 3 files changed, 266 insertions(+) create mode 100644 test/programs/raylib-imported.flan diff --git a/test/dune b/test/dune index 446f9ba..89f7b30 100644 --- a/test/dune +++ b/test/dune @@ -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/*) diff --git a/test/programs/raylib-imported.flan b/test/programs/raylib-imported.flan new file mode 100644 index 0000000..0d8087c --- /dev/null +++ b/test/programs/raylib-imported.flan @@ -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) diff --git a/test/test_flan.ml b/test/test_flan.ml index 191f879..52c7ae1 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1091,6 +1091,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); From 6c2852983809b05e2838e6c8339bc92c7b4df28d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 16:13:28 +0700 Subject: [PATCH 6/7] An acceptance case for bindings nobody wrote MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The same boundary the raylib FFI case covers, reached from declarations generated out of the header instead of transcribed into raylib.flan. The package binds none of the four functions by hand, so the program running at all is the claim. What it prints pins more than that, by the argument the GetColor case already makes: handing a struct over and reading it back proves nothing, since storing and returning is symmetric and a permuted layout comes back permuted the same way. ColorToInt of {17,34,51,68} is 0x11223344, so exchanging any two fields changes the number, and ColorTint by white hands the four bytes back separately. TextLength of "hello" is 5 only if the wrapper NUL-terminated the copy. At -O0 as well, 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. Skipped without FLAN_RAYLIB_H, since the import is opt-in. The importer's own table does not skip — it runs against test/headers/sample.h, which is committed. --- test/test_acceptance.ml | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 660e507..ed9c16e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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. From 9d6784f2cdc4301615b75acfa507ed3c6d57eb7e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 16:17:30 +0700 Subject: [PATCH 7/7] Write down what was read, what was refused, and what it cost MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit BUILT.md gains "The header is read now", directly under the section whose last paragraph promised that reading a header was what would convert the trusted half into a checked one and that it was not built. That sentence is replaced by a pointer to the one below it, in BUILT.md and in shim.ml's docstring both. It records the things worth not re-deriving: why the dump and not libclang (and that Zig left libclang too, which strengthens the argument rather than weakening it), why the import is bounded by the package's own defstructs, why generating defstructs would make the check circular in exactly the way a _Static_assert was rejected for, refusal-by-demotion from Zig's failDecl, the naming rule and what it must actually guarantee, and both const-vs-non-const char * and the target-varying widths. The diff and the costs are stated as measurements, with the table: 16 of 16 defstructs and 172 of 172 declare-c agree against 5.5, ten real differences against 5.1-dev, release +4ms warm, redefinition 31.0 -> 46.5ms. DISCUSS.md item 6 is rewritten rather than removed. The mechanism question is settled and is now in BUILT.md; what is left is narrower and is two decisions that are the author's — whether the header stays a build-time read or becomes a committed generator, and whether the 172 hand-written lines migrate. Both have the argument on each side written out, including what migration would lose: key-pressed? is a better name than is-key-pressed, and an enum parameter imports as i32 because nothing tells the importer the package calls KeyboardKey "Key". --- BUILT.md | 158 ++++++++++++++++++++++++++++++++++++++++++++++++++++ DISCUSS.md | 71 ++++++++++++++++------- NEXT.md | 52 +++++++++++++++++ lib/shim.ml | 10 +++- 4 files changed, 268 insertions(+), 23 deletions(-) diff --git a/BUILT.md b/BUILT.md index 7723cd4..0200b33 100644 --- a/BUILT.md +++ b/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
[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. diff --git a/DISCUSS.md b/DISCUSS.md index 581f0f0..de129d3 100644 --- a/DISCUSS.md +++ b/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 diff --git a/NEXT.md b/NEXT.md index 091f38c..94017d9 100644 --- a/NEXT.md +++ b/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 diff --git a/lib/shim.ml b/lib/shim.ml index b9bfbee..6ced73d 100644 --- a/lib/shim.ml +++ b/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