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

A string returned from C is copied into the context allocator, Model, Mesh and FilePathList cross the raylib boundary, rlgl's matrix stack is a package, and a dev build reports the library resources a program never released

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 10:44:49 +07:00
parent bf827dc55b
commit 0863b62711
31 changed files with 6524 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
README.md
View File

@ -184,10 +184,10 @@ $ flan import-c test/headers/sample.h
(declare-c add-ints [a i32 b i32] i32 "add_ints")
(declare-c name-length [text string] i32 "name_length")
...
;; 8 imported, 12 refused, of 21 functions in test/headers/sample.h
;; refused name-of: name_of returns char *, and a string only crosses as a
;; parameter — a C function that returns one returns something Flan has no
;; owner for
;; 9 imported, 12 refused, of 22 functions in test/headers/sample.h
;; refused owned-text: owned_text returns char *, which the caller owns and
;; releases through the library — a copy would leave the original with no
;; owner. Declare it with a declare-c returning (Ptr u8)
;; refused printf-like: printf_like is variadic, and a wrapper cannot forward
;; an argument list it does not know the shape of
;; refused file-time: file_time long has a width that differs between this
@ -217,8 +217,8 @@ and it writes `generated.flan`.
```text
$ flan generate-c vendor/raylib
;; refused get-clipboard-text: GetClipboardText returns char *, and a string
;; only crosses as a parameter — ...
;; refused text-format: TextFormat is variadic, and a wrapper cannot forward
;; an argument list it does not know the shape of
;; refused load-shader: LoadShader Shader is a struct the package does not
;; describe — add a defstruct for it, or keep a hand-written declare-c
```

62
TODO.org
View File

@ -448,19 +448,28 @@ it. The alternative weighed — a per-binding declaration naming which argument
carries the count — cannot reach a count that is a sibling field. No marker on the
name; =ptr= is the marker, it owns nothing, and =free= refuses it.
** NEXT A string cannot be returned from C
Decided 2026-09-25: copy the returned text into the context allocator at the boundary. =TextFormat= stays unbound, being variadic.
A string crosses as a parameter only — a C function that returns one returns
something Flan has no owner for. It is what makes =GetGamepadName= unbindable, and
the same rule refuses =TextFormat=, which is variadic and so has no honest
signature either.
** DONE A string cannot be returned from C
CLOSED: [2026-09-25]
A =declare-c= may return =string=: the text is copied into the context allocator
at the boundary, through =bytes=, and lives until that allocator's =free-all=. The
importer maps a returned =const char *= to =string= and still refuses a plain
=char *=, which the caller owns and releases through the library. =TextFormat=
stays unbound, being variadic. docs/BUILT.md, "A string returned from C is
copied into the context allocator".
** NEXT Model, Mesh and FilePathList want a defstruct, and a callback wants the other direction
Decided 2026-09-25: =FilePathList= crosses by the same copy-at-the-boundary rule, in the lane with =Model= and =Mesh=. Callbacks wait until a program needs one.
=Ray= and =BoundingBox= have their defstructs now. =FilePathList= is a =char**=
and blocks the drop-files example; =Model= and =Mesh= are ordinary widening.
Function-pointer parameters — =SetTraceLogCallback=, the audio stream processors —
are the callback direction of the FFI and nothing has needed it yet.
** DONE Model, Mesh and FilePathList have a defstruct
CLOSED: [2026-09-25]
=Model=, =Mesh= and =Matrix= are described and the generated half widened over
them; =Model='s material, bone and pose pointers are =(Ptr u8)= until =Material=
and =BoneInfo= can be, both holding a fixed array. =FilePathList= crosses by the
returned-string rule: =dropped-files=, =directory-files= and
=directory-files-ex= copy the paths and unload raylib's list before returning.
docs/BUILT.md, "=Model=, =Mesh=, =Matrix= and =FilePathList=".
** WAIT A callback is the other direction of the FFI
Blocked on a program that needs one. =SetTraceLogCallback= and the audio stream
processors take a C function pointer, and the shim refuses a function type by
name until then.
** DONE raymath is written in Flan, because static inline has no symbol
CLOSED: [2026-09-13]
@ -470,9 +479,16 @@ guard. The C-shim alternative was rejected: it buys identical arithmetic for a
compilation unit in the build and a second place raylib's semantics are written
down.
** TODO rlgl's matrix stack is unbound
=core_2d_camera_mouse_zoom= is skipped for want of it — a different reason from
the raymath one.
** DONE rlgl's matrix stack is bound
CLOSED: [2026-09-25]
=vendor/rlgl= is its own package over =rlgl-5.5.h=, binding the matrix stack by
hand and generating nothing else. A package and not more of =vendor/raylib=
because the header check is per package. =core_2d_camera_mouse_zoom= is ported
and builds. docs/BUILT.md, "rlgl is its own package".
** TODO examples/core-input-virtual-controls.flan does not build
It defines =abs-f32=, which the prelude defines too, and a second definition is
refused. Nothing builds the examples wholesale, so nothing noticed.
** CANCELLED cstring as a type
Odin has no string-to-cstring conversion at all; it pays the same copy the shim
@ -1694,13 +1710,15 @@ Precision over completeness: a site that does not allocate is never marked, and
=vec-new=, =map-new=, dyn arithmetic, keywords and dyn push and put are
deliberately silent, each for its own reason.
** NEXT A debug tracking allocator over the raylib boundary
Decided 2026-09-25: build it. A dev build counts loads against unloads in the generated wrappers and lists what is still held at exit, by type and load site. Release builds pay nothing.
ASan's leak detection covers memory instrumented code allocated — the Flan
allocator, already clean. It does not cover a leaked texture, because that memory
belongs to uninstrumented raylib. Every raylib call goes through a generated
wrapper, so a dev build can count acquisitions against releases there and report
what is still held at exit, by name.
** DONE A debug tracking allocator over the raylib boundary
CLOSED: [2026-09-25]
A dev build counts calls to bindings named =Unload*= against the bindings that
return the same type (not =Get*=), at the call site, keyed by a hash of the
value's leaf fields, and reports at exit what is still held by type and load
site, and each unload that matched nothing. Release builds drop the notes. Rules
out tracking in the C wrapper, which cannot know the call site, and keying on
the struct's bytes, which include padding. docs/BUILT.md, "A dev build counts a
library's resources".
** DONE --dev --sanitize was unbuildable, and nothing built it
CLOSED: [2026-09-21]

92
docs/BUILT.md
View File

@ -146,7 +146,7 @@ would have passed a weaker test. That case is in the acceptance table, skipped i
The bindings are 171 calls across thirteen structs: window, keyboard and mouse; drawing (rectangles, circles, lines, triangles, rings, ellipses, text); the eleven `collision-*` predicates; textures; the Image family; `Camera2D`; `RenderTexture2D`; the whole audio surface (device, `Wave`, `Sound`, `Music`); fonts and glyphs; and gamepads, touch and gestures — plus eleven enums — `Key`, `MouseButton`, `TraceLogLevel`, `CameraProjection`, `CameraMode`, `GamepadButton`, `GamepadAxis`, `Gesture`, `MouseCursor`, `TextureFilter` and `PixelFormat` — raylib's own named colour palette, and the `FLAG_` window hints. Every one of the eleven carries a Flan-side prefix on its members, so a call site reads `:key-r`, `:filter-bilinear`, `:axis-left-trigger`; see the `bindings` section below for why that is a reading choice and not a collision fix. Adding a call is a single `declare-c` line; there is no C to write.
Two things the ported examples in `examples/` wanted and could not have, both refused for reasons that are right. `GetGamepadName` returns a `char *` into raylib's static storage: *the return type of get-gamepad-name is a string, and a string only crosses as a parameter — a C function that* returns *one returns something Flan has no owner for*. And an enum parameter cannot be indexed — `GetGamepadAxisMovement` takes a `GamepadAxis`, a loop variable is an `i32`, *expected rl/GamepadAxis, found i32*, and a second `declare-c` of the same symbol with an `i32` face is refused too: *one declare-c per C function, and another Flan name for it is a defn* — which cannot help, because a wrapper renames and does not retype. The caller spells the loop as a `cond` over the members it knows.
Two things the ported examples in `examples/` wanted and could not have. `GetGamepadName` returns a `char *` into raylib's static storage, and a returned string had no owner in Flan; it has one now — see "A string returned from C is copied into the context allocator" below. And an enum parameter cannot be indexed — `GetGamepadAxisMovement` takes a `GamepadAxis`, a loop variable is an `i32`, *expected rl/GamepadAxis, found i32*, and a second `declare-c` of the same symbol with an `i32` face is refused too: *one declare-c per C function, and another Flan name for it is a defn* — which cannot help, because a wrapper renames and does not retype. The caller spells the loop as a `cond` over the members it knows.
The texture calls are the first ones with no headless test, because loading one needs a GL context. What the acceptance
case does instead is pin the two new struct layouts using the only things raylib computes from those fields without a
@ -207,9 +207,9 @@ 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".
built for `main` — so `rl/text-format` is not a name, and a program that
writes it is told *TextFormat is variadic, and a wrapper cannot forward an
argument list it does not know the shape of* 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
@ -673,6 +673,90 @@ window it answers 0 for every string. Measured against `libraylib.so.550`, not r
and `GetScreenWidth`/`Height` are all 0 headless for the same kind of reason. All five are bound, and all five are
exercised by running `sand.flan` and looking, which is the whole of what can be claimed for them.
### A string returned from C is copied into the context allocator
A `declare-c` may return `string`. The C wrapper answers the pointer and its length, and the generated Flan wrapper is
`(string (bytes (string (slice-from-ptr p n))))`: a view of C's bytes, copied by `bytes` into the context allocator. The
copy is Flan's rather than C's so that it goes through the same allocation guard (`StorageExhausted` with `retry`) and
the same registry note every other allocation does, and `with-allocator` picks where it lands. The string lives until
that allocator's `free-all` or destroy, which is the lifetime `(bytes s)` already has; a caller calling one every frame
wraps it in `(with-allocator context/temp ...)`.
When the call also took a string argument, the returned pointer may point into the wrapper's NUL-terminated copy of it —
`GetFileName` answers `strrchr(path, '/') + 1` — and that copy is on the wrapper's stack or freed before it returns. So
in that case the wrapper first moves the text into one scratch buffer the shim owns, and the Flan side copies from
there. Without a string argument the pointer is the library's own and nothing is moved twice. A null is the empty
string.
The importer follows `const`. `const char *` returned is text the caller only reads, so it becomes `string`; `char *`
without `const` is text the caller owns and releases through the library (`LoadFileText` and `UnloadFileText`), and a
copy would leave the original with nothing to release it through, so that one stays refused and a hand-written
`declare-c` saying `(Ptr u8)` binds it. `TextFormat` stays unbound because it is variadic. Twenty raylib functions came
in with this — the path helpers, the case conversions, `GetClipboardText`, `GetMonitorName`, `GetGamepadName`.
`test/programs/cstr-return.flan` runs all three shapes against a package with its own C, so it needs no library:
a static buffer overwritten by the next call, a pointer into the argument at both a stack-sized and a heap-sized
length, and a null. `raylib-strings.flan` does the same against raylib, headless.
### `Model`, `Mesh`, `Matrix` and `FilePathList`
Layouts only, and each is checked against `raylib-5.5.h` on every build like the others. Describing them is what widened
the generated half by the `Load`/`Gen`/`Draw`/`Unload` families over models and meshes. Three pointers in `Model` —
`materials`, `bones`, `bind-pose` — are `(Ptr u8)`, because `Material` holds `float params[4]` and `BoneInfo`
`char name[32]`, and a fixed-array field is refused at the C boundary; a pointer is one word whatever it points at, so
the layout is exact. `Matrix`'s fields are `m-0` to `m-15` in raylib's column-major order because the layout check pairs
fields through the kebab rule. `raylib-strings.flan` pins `Mesh` and `Model` by making raylib compute bounding boxes
over a mesh built in Flan and a model translated by its `transform`.
`FilePathList` is a `char **` raylib owns until the matching `Unload`. It crosses by the returned-string rule:
`dropped-files`, `directory-files` and `directory-files-ex` copy each path into the context allocator, release raylib's
list before returning, and answer a `(Vec string)`. There is nothing of raylib's left for the caller to unload, which is
why they are not named `load-`.
### rlgl is its own package
`vendor/rlgl` binds rlgl's matrix stack — `push-matrix`, `pop-matrix`, `load-identity`, `translate`, `rotate`, `scale`
— by hand, checked against `rlgl-5.5.h` from the raylib 5.5 tag. It is a package rather than more of `vendor/raylib`
because the header check is per package: every `declare-c` in a package is compared against every header it names,
and raylib's functions are not in `rlgl.h` or rlgl's in `raylib.h`, so one package over both would report each half
missing from the other header. rlgl is compiled into `libraylib.so`, so the package links the same library. Nothing
else in `rlgl.h` is generated (`exclude rl*`): it is the GL backend raylib drives for itself.
`examples/core-2d-camera-mouse-zoom.flan` is what it was bound for.
### A dev build counts a library's resources
A texture, an image's pixels, a sound: memory raylib allocated, which ASan does not see because uninstrumented code made
it, and which the allocation registry does not see because no Flan allocator did. What does see it is the call that made
it, so a dev build counts there.
**Which calls.** `Shim.resources` reads it off the `declare-c` forms by raylib's naming convention. A type is a resource
when a binding whose C symbol begins with `Unload` takes one of it and nothing else — a struct, or a pointer for the
arrays raylib hands out bare (`LoadFileData`, `LoadImageColors`). Any other binding returning that type acquires one,
except a C symbol beginning with `Get`: `GetFontDefault` and `GetShapesTexture` answer something raylib keeps. A binding
taking a `(Ptr T)` to a resource struct may change it in place — `ImageFormat` reallocates the pixels — and is a re-key.
A library that names its pairs differently is not tracked.
**Where.** At the call, in the checker, not in the wrapper: the call site is the only place that knows the source
location, which is what the report is for. Each call to a tracked binding binds its arguments and is wrapped in
`flan_dev_reg_note_res_*` calls, the family a release build drops before building the arguments. A release build keeps
the argument slots and nothing else.
**Identity.** A resource is matched by a hash of its value, because an `Unload` is handed the value a `Load` answered and
not an address. The hash is over each leaf field's own bytes, combined in order — the struct-key walk a `Map` uses —
so padding never reaches it: `Sound`, `Music` and `Model` all have padding, and an LLVM aggregate copy does not preserve
it. Two resources with identical values share a key; a release then removes one of them, the counts stay right, and
only which load site is named can be wrong. Headless textures all have id 0 and are the realistic case of that.
**The report**, at exit and only when there is something to say: what is still held, grouped by type and load site in
the order loaded, and each `Unload` that matched no load — twice over, or of a value raylib keeps. It is registered by
the first note, so a program that touches no tracked binding registers nothing, and it cannot run for a program ended by
a signal, the same limit the block report has.
What it cannot see: a call through a function value, which has no name to look up; and a resource whose fields the
program changes itself, whose key no longer matches its load — it reports as held and its unload as unmatched.
`test/programs/res-leaks.flan` runs all of it against a stub package with its own C — padding, a re-key, a pointer
resource, a stray release — so it needs no library and no window.
## Packages
`lib/load.ml` resolves `(import rl "vendor:raylib")` before the checker runs. The directory is the package; `vendor:` is

108
examples/core-2d-camera-mouse-zoom.flan Normal file
View File

@ -0,0 +1,108 @@
;;;; raylib [core] example - 2d camera mouse zoom
;;;;
;;;; examples/core/core_2d_camera_mouse_zoom.c at the raylib 5.5 tag. It
;;;; needed rlgl's matrix stack: the grid is a 3D grid on the XZ plane, and the
;;;; C stands it up in the XY plane by pushing a matrix, translating, rotating
;;;; ninety degrees about X and drawing. vendor/rlgl binds that stack.
;;;;
;;;; One difference from the C. The mouse read-out is `TextFormat("[%i, %i]",
;;;; ...)` through DrawTextEx with a spacing of 2. TextFormat is variadic and
;;;; unbound, so the read-out is drawn in pieces with draw-text and
;;;; digits.flan's draw-int, which space the glyphs raylib's default way.
(import rl "vendor:raylib")
(import rlgl "vendor:rlgl")
(import d "digits.flan")
(defconst screen-width 800)
(defconst screen-height 450)
;; 0 zooms with the mouse wheel, 1 with a right-button drag.
(defonce zoom-mode i32)
(defonce camera rl/Camera2D)
;; Put the world point under the mouse at the camera's origin, and the origin
;; under the mouse, so a zoom that follows keeps that point still.
(defn anchor-at-mouse [] ()
(let [mouse-world (rl/get-screen-to-world-2d (rl/get-mouse-position) camera)]
(set (.offset camera) (rl/get-mouse-position))
(set (.target camera) mouse-world)))
;; One zoom step: `amount` is how far the input moved, and the direction is its
;; sign. The zoom stays between 1/8 and 64.
(defn zoom-by [amount f32 rate f32] ()
(let [factor (+ 1.0 (* rate (abs-f32 amount)))
factor (if (< amount 0.0) (/ 1.0 factor) factor)]
(set (.zoom camera) (clamp (* (.zoom camera) factor) 0.125 64.0))))
(defn main [] ()
(rl/init-window screen-width screen-height
"raylib [core] example - 2d camera mouse zoom")
(defer (rl/close-window))
;; A zero zoom makes the camera's transform singular.
(set camera (rl/Camera2D {.zoom 1.0}))
(set zoom-mode 0)
(rl/set-target-fps 60)
(until (rl/window-should-close?)
;; Update
(cond
(rl/key-pressed? :key-one) (set zoom-mode 0)
(rl/key-pressed? :key-two) (set zoom-mode 1))
;; Drag to move: the mouse's screen delta, scaled back into world units.
(when (rl/mouse-button-down? :mouse-left)
(let [delta (rl/v2-scale (rl/get-mouse-delta) (/ -1.0 (.zoom camera)))]
(set (.target camera) (rl/v2-add (.target camera) delta))))
(if (= zoom-mode 0)
(let [wheel (rl/get-mouse-wheel-move)]
(when (!= wheel 0.0)
(anchor-at-mouse)
(zoom-by wheel 0.25)))
(do
(when (rl/mouse-button-pressed? :mouse-right)
(anchor-at-mouse))
(when (rl/mouse-button-down? :mouse-right)
(zoom-by (.x (rl/get-mouse-delta)) 0.01))))
;; Draw
(rl/with-drawing
(rl/clear-background rl/raywhite)
(rl/begin-mode-2d camera)
;; The 3D grid, rotated ninety degrees and centred on the origin, so it
;; lies in the XY plane the 2D camera looks at.
(rlgl/push-matrix)
(rlgl/translate 0.0 (* 25.0 50.0) 0.0)
(rlgl/rotate 90.0 1.0 0.0 0.0)
(rl/draw-grid 100 50.0)
(rlgl/pop-matrix)
;; A reference circle.
(rl/draw-circle (/ (rl/get-screen-width) 2) (/ (rl/get-screen-height) 2)
50.0 rl/maroon)
(rl/end-mode-2d)
;; The mouse, and where it is in screen pixels.
(let [mouse (rl/get-mouse-position)
x (- (i32 (.x mouse)) 44)
y (- (i32 (.y mouse)) 24)]
(rl/draw-circle-v mouse 4.0 rl/darkgray)
(rl/draw-text "[" x y 20 rl/black)
(let [x (+ x (rl/measure-text "[" 20))
x (+ x (d/draw-int (rl/get-mouse-x) x y 20 rl/black))]
(rl/draw-text ", " x y 20 rl/black)
(let [x (+ x (rl/measure-text ", " 20))
x (+ x (d/draw-int (rl/get-mouse-y) x y 20 rl/black))]
(rl/draw-text "]" x y 20 rl/black))))
(rl/draw-text "[1][2] Select mouse zoom mode (Wheel or Move)"
20 20 20 rl/darkgray)
(if (= zoom-mode 0)
(rl/draw-text "Mouse left button drag to move, mouse wheel to zoom"
20 50 20 rl/darkgray)
(rl/draw-text "Mouse left button drag to move, mouse press and move to zoom"
20 50 20 rl/darkgray)))))

28
examples/core-input-gamepad.flan
View File

@ -15,16 +15,10 @@
;;;; circles and needs no asset at all. That branch is what this ports, in
;;;; full. It is also the branch a Linux desktop usually takes anyway.
;;;;
;;;; **GetGamepadName is not bound, and cannot be.** It is what the C matches
;;;; on, and declare-c refuses it by name:
;;;;
;;;; the return type of get-gamepad-name is a string, and a string only
;;;; crosses as a parameter — a C function that *returns* one returns
;;;; something Flan has no owner for
;;;;
;;;; which is correct: raylib hands back a pointer into its own static storage
;;;; and Flan has nothing that owns a borrowed C string. So the pad's name is
;;;; not on screen and the branch that used it is not here.
;;;; **The name is drawn and not matched on.** get-gamepad-name copies
;;;; raylib's static text into the context allocator, which this program never
;;;; frees — so the name is read once per frame into the frame arena, and the
;;;; branches that matched on it are the artwork's and are gone with it.
;;;;
;;;; **The VIBRATE button is drawn and inert.** SetGamepadVibration is the one
;;;; call in the C this refuses to bind, and vendor/raylib/raylib.flan already
@ -172,6 +166,8 @@
(rl/set-target-fps 60)
(until (rl/window-should-close?)
;; The frame arena holds the pad's name for one frame.
(free-all context/temp)
;; Update
(when (and (rl/key-pressed? :key-left) (> gamepad 0))
(set gamepad (- gamepad 1)))
@ -189,13 +185,13 @@
(if (rl/gamepad-available? gamepad)
(do
;; The C draws `TextFormat("GP%d: %s", gamepad, GetGamepadName(...))`.
;; The name is unbindable — see the header — so this is the index and
;; the word the C would have followed it with.
;; TextFormat is variadic and unbound, so the pieces are drawn in turn.
(rl/draw-text "GP" 10 10 10 rl/black)
(let [x (+ 10 (rl/measure-text "GP" 10))]
(rl/draw-text ": CONNECTED (name unbindable)"
(+ x (d/draw-int gamepad x 10 10 rl/black))
10 10 rl/black))
(let [x (+ 10 (rl/measure-text "GP" 10))
x (+ x (d/draw-int gamepad x 10 10 rl/black))]
(rl/draw-text ": " x 10 10 rl/black)
(rl/draw-text (with-allocator context/temp (rl/get-gamepad-name gamepad))
(+ x (rl/measure-text ": " 10)) 10 10 rl/black))
(let [lx (deadzone (rl/get-gamepad-axis-movement gamepad :axis-left-x)
stick-deadzone)

96
lib/check.ml
View File

@ -181,6 +181,10 @@ type env = {
flag is what lets [resolve_name] say the honest thing in each place
instead of a suggestion that cannot be followed. *)
mutable in_field : bool;
(* The bindings a dev build counts at every call: [Shim.resources], read off
the declare-c forms before [Shim.expand] rewrites them. Keyed by the Flan
name a program calls. *)
tracks : (string, Shim.track) Hashtbl.t;
}
let new_env () = {
@ -210,6 +214,7 @@ let new_env () = {
tvpreds = [];
chain = [];
in_field = false;
tracks = Hashtbl.create 16;
}
(* Where a named type was declared, and what it has, as a note.
@ -3309,6 +3314,92 @@ let given_once ~noun ?(known = fun _ _ -> ()) kvs =
kvs;
seen
(* ── Counting a library's resources at the call ──────────────────────
[Shim.resources] says which bindings acquire, release or change a resource
in place; this is the call to one of them, with the notes around it. The
arguments are bound first, in order, so each is evaluated once and the notes
read the same values the call is given.
A resource is known by a hash of its value — every leaf field's own bytes,
combined in order, so a struct's padding never reaches it. That is the
identity an Unload call can be matched on: it is handed the value the Load
answered, not an address. Two resources with identical values share a key,
which costs nothing but the load site the report names for one of them: a
release removes one entry with that key, and the counts stay right.
Every note is a [flan_dev_reg_note_] call, which is the family a release
build drops before its arguments are built — the hashes included. What a
release build keeps is the argument slots, which the optimiser folds away. *)
let rec res_key loc env (e : Tast.expr) : Tast.expr =
let seed = mk loc hash_ty (Tast.Int (0L, Types.U64)) in
match e.Tast.ty with
| Types.Named n when Hashtbl.mem env.structs n ->
let fields = (Hashtbl.find env.structs n).Tast.fields in
snd
(List.fold_left
(fun (i, acc) (fl : Tast.field) ->
let leaf = mk loc fl.Tast.fty (Tast.Field (e, i)) in
(i + 1,
rt loc hash_ty "flan_hash_combine" [ acc; res_key loc env leaf ]))
(0, seed) fields)
| t -> rt loc hash_ty "flan_key_hash_flat" [ addr_of loc e; seed; size_of loc t ]
let tracked_call ctx loc name (tr : Shim.track) params ret
(args : Tast.expr list) =
let env = ctx.env in
let binds = List.map2 (fun p a -> (fresh_slot ctx p, a)) params args in
let locals = List.map2 (fun p (s, _) -> mk loc p (Tast.Local s)) params binds in
let str x = mk loc Types.String (Tast.Str x) in
let note sym key ty =
rt loc Types.Unit sym [ key; str (Types.to_string ty); here loc ]
in
let releases =
match (tr.Shim.release, locals) with
| true, [ a ] ->
[ note "flan_dev_reg_note_res_release" (res_key loc env a) a.Tast.ty ]
| _ -> []
in
let rekeyed =
List.filter_map
(fun i ->
match List.nth_opt locals i with
| Some ({ Tast.ty = Types.Ptr t; _ } as p) ->
Some (mk loc t (Tast.Deref p), t)
| _ -> None)
tr.Shim.rekey
in
(* The old keys go to the runtime before the call and the new ones after,
in the reverse order, so it can pair them on a stack. *)
let before =
List.map
(fun (v, _) ->
rt loc Types.Unit "flan_dev_reg_note_res_rekey_from" [ res_key loc env v ])
rekeyed
in
let after =
List.rev_map
(fun (v, t) ->
rt loc Types.Unit "flan_dev_reg_note_res_rekey_to"
[ res_key loc env v; str (Types.to_string t) ])
rekeyed
in
let call = mk loc ret (Tast.Call (name, locals)) in
let body =
match ret with
| Types.Unit -> (call :: after) @ [ unit_at loc ]
| _ ->
let r = fresh_slot ctx ret in
let rv = mk loc ret (Tast.Local r) in
let acquired =
if tr.Shim.acquire then
[ note "flan_dev_reg_note_res_acquire" (res_key loc env rv) ret ]
else []
in
[ mk loc ret (Tast.Let ([ (r, call) ], acquired @ after @ [ rv ])) ]
in
mk loc ret (Tast.Let (binds, releases @ before @ body))
let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let loc = e.Ast.loc in
(* Read the permission this form was given and withdraw it in the same
@ -9025,7 +9116,9 @@ and ordinary_call ctx ~want loc name args =
let args =
map2_lr (fun p a -> incr i; check_arg ctx name !i p a) params args
in
expect ctx loc ~want (mk loc ret (Tast.Call (name, args)))
(match Hashtbl.find_opt ctx.env.tracks name with
| Some tr -> expect ctx loc ~want (tracked_call ctx loc name tr params ret args)
| None -> expect ctx loc ~want (mk loc ret (Tast.Call (name, args))))
| None ->
if Hashtbl.mem ctx.env.datas name then
fail loc
@ -12139,6 +12232,7 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
flattened [declare] with a Flan [defn] over it, and the C that does the
flattening comes back to be compiled into the build. Nothing below this
line knows the form exists. *)
List.iter (fun (n, t) -> Hashtbl.replace env.tracks n t) (Shim.resources decls);
let decls, cshim = Shim.expand decls in
(* And on the same line: every class and generic function becomes the
[defn]s it stands for. It runs over the whole list because a method may

43
lib/cimport.ml
View File

@ -56,14 +56,13 @@
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".
[rl/text-format] is not a name, and a program that writes it is told
*why* — "TextFormat is variadic" — 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
function and wrong for a wholesale import: one variadic function would
otherwise kill the whole header. Same judgement, different
disposition — a hand-written [declare-c] still hard-fails, and [Shim] is
untouched. *)
@ -560,19 +559,28 @@ let param_ty env (s : string) : Ast.texpr =
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. *)
(* The return type, where const decides again, the other way round.
[const char *] is text the caller only reads — a static buffer, a pointer
into an argument, a string literal — and [Shim] copies it into the context
allocator, so it becomes a [string]. [char *] without the const is text the
caller owns and must hand back through the library's own release function
([LoadFileText] and [UnloadFileText]); copying it would leak the original
with nothing left to release it through, so it is refused and a
hand-written declare-c saying [(Ptr u8)] binds it. *)
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
let is_const = strip_prefix "const " inner <> None in
match bare inner with
| "char" when is_const -> Some (tname "string")
| "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"
"returns char *, which the caller owns and releases through the \
library — a copy would leave the original with no owner. Declare it \
with a declare-c returning (Ptr u8)"
| _ -> Some (value_ty env s)
end
else Some (value_ty env s)
@ -1615,7 +1623,20 @@ let diff_bound ~env ~(bound : (Ast.fn * string) list) (d : dump) =
| Some why -> say why
| None ->
(match (try Ok (ret_ty env c.cret) with Refused w -> Error w) with
| Error _ -> None
(* A return the importer refuses says nothing, as a parameter
does — except a [string] over a [char *] without const. That
one is a real disagreement: the shim would copy the text and
leave the library's buffer with no owner. *)
| Error _ ->
(match fn.Ast.ret with
| Some { Ast.t = Ast.Tname "string"; _ } ->
say
(Printf.sprintf
"returns string and the header says %s, which the \
caller owns and releases through the library — \
declare it (Ptr u8)"
c.cret)
| _ -> None)
| Ok want ->
let agrees =
match (want, fn.Ast.ret) with

4
lib/emit.ml
View File

@ -4285,6 +4285,10 @@ declare void @flan_gc_init()
declare void @flan_dev_reg_enable()
declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64)
declare void @flan_dev_reg_note_res_acquire(i64, ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_res_release(i64, ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_res_rekey_from(i64)
declare void @flan_dev_reg_note_res_rekey_to(i64, ptr, i64)
declare i8 @flan_vec_init(ptr, ptr, i64, i64, i64, ptr, i64)
declare i8 @flan_vec_reserve(ptr, i64, i64, i64, ptr, i64)
declare i8 @flan_vec_push(ptr, ptr, i64, i64, ptr, i64)

216
lib/shim.ml
View File

@ -29,7 +29,8 @@
- emits an [extern] prototype for the real function, in its true signature;
- emits a wrapper that flattens — a struct returns through an out-pointer,
a struct argument goes by pointer, a Flan string arrives as ptr+len and
the wrapper NUL-terminates a copy;
the wrapper NUL-terminates a copy, and a returned string goes back as a
pointer and a length for the Flan side to copy;
- and rewrites the declaration into the flattened [declare] the Flan side
calls, with an ordinary Flan [defn] above it carrying the nice signature.
@ -72,8 +73,8 @@
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. *)
same judgements and merely skips instead, since one variadic function
must not kill a header of five hundred functions. *)
let fail = Loc.fail
@ -115,6 +116,8 @@ let raw_name flan_name = flan_name ^ "-c"
name beginning with '%'. *)
let tmp i = Printf.sprintf "%%a%d" i
let out_tmp = "%out"
let len_tmp = "%n"
let ptr_tmp = "%p"
(* ── The declarations in scope ──────────────────────────────────────── *)
@ -210,7 +213,8 @@ let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string =
what n n
else if String.equal n "string" then
fail loc
"%s is a string, and a string only crosses as a parameter"
"%s is a string, and a string crosses only as a parameter or a \
return value — declare (Ptr u8) and read it in Flan"
what
else if String.equal n "Unit" || String.equal n "Never" then
fail loc "%s is %s, which is not a value C can carry" what n
@ -330,13 +334,48 @@ let cstr_helpers =
let cstr_cap = 256
(* The return direction. C hands back a [const char *] Flan has no owner for:
it may be the library's static buffer, overwritten by the next call, or a
pointer into an argument. The wrapper answers the pointer and its length,
and the generated Flan wrapper copies the bytes into the context allocator
before anything else can run — which is where the owner comes from, and why
the copy is Flan's and not C's: it goes through the same guard and the same
registry note as (bytes s).
[flan_shim_ret_len] is the whole of it when the call took no string, since
nothing the wrapper frees can be under the pointer. [flan_shim_ret_keep] is
for when it did: the argument copies die when the wrapper returns, so the
text is moved first to one scratch buffer the shim owns and reuses. A null
is the empty string. The length is an [i32] because a slice's is; a C
string past two gigabytes is cut there, and malloc failing is cut at the
buffer that exists, which is the argument copy's policy too. *)
let ret_helpers =
"static const char *flan_shim_ret_len(const char *r, int32_t *n) {\n\
\ size_t len = r == NULL ? 0 : strlen(r);\n\
\ *n = len > INT32_MAX ? INT32_MAX : (int32_t)len;\n\
\ return r;\n\
}\n\n\
static const char *flan_shim_ret_keep(const char *r, int32_t *n) {\n\
\ static char *buf = NULL;\n\
\ static size_t cap = 0;\n\
\ size_t len = r == NULL ? 0 : strlen(r);\n\
\ if (len > INT32_MAX) len = INT32_MAX;\n\
\ if (len > cap) {\n\
\ char *d = (char *)realloc(buf, len);\n\
\ if (d != NULL) { buf = d; cap = len; } else len = cap;\n\
\ }\n\
\ if (len != 0) memcpy(buf, r, len);\n\
\ *n = (int32_t)len;\n\
\ return buf;\n\
}\n\n"
(* One [declare-c], reduced to what both halves need. *)
type shim = {
sflan : string; (* the Flan name as written *)
ssym : string; (* the C symbol being bound *)
swrap : string; (* the generated wrapper's symbol *)
sargs : (pkind * string) list; (* kind and C type, per parameter *)
sret : [ `Void | `Scalar of string | `Struct of string * string ];
sret : [ `Void | `Scalar of string | `Struct of string * string | `Str ];
sloc : Loc.t;
}
@ -363,6 +402,7 @@ let wrapper_params s =
in
match s.sret with
| `Struct (_, c) -> ps @ [ Printf.sprintf "%s *out" c ]
| `Str -> ps @ [ "int32_t *out_n" ]
| _ -> ps
let c_for (s : shim) =
@ -376,11 +416,16 @@ let c_for (s : shim) =
s.sargs
in
let proto_ret =
match s.sret with `Void -> "void" | `Scalar c -> c | `Struct (_, c) -> c
match s.sret with
| `Void -> "void" | `Scalar c -> c | `Struct (_, c) -> c
| `Str -> "const char *"
in
Printf.bprintf b "extern %s %s(%s);\n" proto_ret s.ssym
(match proto_args with [] -> "void" | _ -> String.concat ", " proto_args);
let wret = match s.sret with `Struct _ | `Void -> "void" | `Scalar c -> c in
let wret =
match s.sret with
| `Struct _ | `Void -> "void" | `Scalar c -> c | `Str -> "const char *"
in
let wparams = wrapper_params s in
Printf.bprintf b "%s %s(%s) {\n" wret s.swrap
(match wparams with [] -> "void" | _ -> String.concat ", " wparams);
@ -414,7 +459,19 @@ let c_for (s : shim) =
(* The result is named rather than returned straight through when there
are copies to free: the free has to happen after the call. *)
if has_str then Printf.bprintf b " %s r = %s;\n" c call
else Printf.bprintf b " return %s;\n" call);
else Printf.bprintf b " return %s;\n" call
(* A returned string may point into one of the argument copies —
GetFileName answers a pointer into the path it was given — and those die
below or when this function returns. So when there are copies it is
moved to the scratch buffer first. Without them it points at the
library's own storage, which outlives the call, and the length is all
that is needed. *)
| `Str ->
Printf.bprintf b " const char *r = %s(%s, out_n);\n"
(if has_str then "flan_shim_ret_keep" else "flan_shim_ret_len") call);
(match s.sret with
| `Str when not has_str -> Buffer.add_string b " return r;\n"
| _ -> ());
if has_str then begin
List.iteri
(fun i (k, _) ->
@ -425,7 +482,7 @@ let c_for (s : shim) =
| _ -> ())
s.sargs;
match s.sret with
| `Scalar _ -> Buffer.add_string b " return r;\n"
| `Scalar _ | `Str -> Buffer.add_string b " return r;\n"
| _ -> ()
end;
Buffer.add_string b "}\n\n";
@ -525,6 +582,14 @@ let flattened (fn : Ast.fn) (s : shim) name : Ast.fn =
@ [ { Ast.fname = "out"; floc = loc;
fty = ty loc (Ast.Tapp ("Ptr", [ ty loc (Ast.Tname n) ])) } ];
ret = None }
| `Str ->
{ fn with
Ast.name;
params =
params
@ [ { Ast.fname = "out-n"; floc = loc;
fty = ty loc (Ast.Tapp ("Ptr", [ ty loc (Ast.Tname "i32") ])) } ];
ret = Some (ty loc (Ast.Tapp ("Ptr", [ ty loc (Ast.Tname "u8") ]))) }
| _ -> { fn with Ast.name; params }
(* The ordinary Flan function that carries the nice signature: it copies each
@ -563,6 +628,24 @@ let flan_wrapper (fn : Ast.fn) (s : shim) raw : Ast.decl_kind =
( [ call (args @ [ ex loc (Ast.Call (ex loc (Ast.Var "addr"), [ out ])) ]);
out ],
Some (ty loc (Ast.Tname n)) )
| `Str ->
(* (string (bytes (string (slice-from-ptr p n)))): a view of C's bytes,
copied by [bytes] into the context allocator, and seen as a string
again. The length is bound before the pointer is, so its address
exists to be written through. *)
let v n = ex loc (Ast.Var n) in
let app f xs = ex loc (Ast.Call (v f, xs)) in
binds :=
!binds
@ [ { Ast.bname = len_tmp; bty = Some (ty loc (Ast.Tname "i32"));
bval = ex loc (Ast.Int 0L); bloc = loc };
{ Ast.bname = ptr_tmp; bty = None;
bval = call (args @ [ app "addr" [ v len_tmp ] ]); bloc = loc } ];
( [ app "string"
[ app "bytes"
[ app "string"
[ app "slice-from-ptr" [ v ptr_tmp; v len_tmp ] ] ] ] ],
fn.Ast.ret )
| _ -> ([ call args ], fn.Ast.ret)
in
Ast.Defn { fn with Ast.ret; fbody = [ ex loc (Ast.Let (!binds, body)) ] }
@ -587,6 +670,7 @@ let one env ~taken (fn : Ast.fn) csym loc =
let t' = unalias env t in
(match t'.Ast.t with
| Ast.Tname "Unit" -> `Void
| Ast.Tname "string" -> `Str
| Ast.Tname n when Hashtbl.mem env.structs n ->
ignore (cty env ~needed ~loc ~what t');
`Struct (n, ctype_name n)
@ -601,7 +685,7 @@ let one env ~taken (fn : Ast.fn) csym loc =
do. A string is not one of those — it crosses as ptr+len either way, and
it is the C wrapper that terminates it. *)
let needs_flan =
(match sret with `Struct _ -> true | _ -> false)
(match sret with `Struct _ | `Str -> true | _ -> false)
|| List.exists (fun (k, _) -> match k with Pstruct _ -> true | _ -> false)
sargs
in
@ -621,6 +705,116 @@ let one env ~taken (fn : Ast.fn) csym loc =
in
(decls, s, !needed)
(* ── Resources a dev build counts ──────────────────────────────────
TODO.org, "A debug tracking allocator over the raylib boundary". A library
like raylib allocates memory Flan's allocators never see — a texture, an
image's pixels — and hands it back through a Load call that must be paired
with an Unload. ASan does not see that memory and the allocation registry
does not either. What does see every one of those calls is the declaration
of it, so a dev build counts them there: [Check] wraps each call to a
tracked binding in notes the runtime keeps a table of, and a release build
drops the notes before their arguments are built.
Which bindings are tracked is read off the declarations, by the naming
convention raylib keeps throughout:
- a type is a resource when a declare-c whose C symbol begins with
[Unload] takes one of it and nothing else — a struct, or a pointer for
the arrays raylib hands out as bare pointers (LoadFileData,
LoadImageColors). That call releases one.
- any other declare-c that returns a resource type acquires one, except a
C symbol beginning with [Get]. GetFontDefault and GetShapesTexture answer
something raylib keeps and frees itself; unloading one of those is a
bug, and it is reported as a release nothing acquired.
- a declare-c taking a [(Ptr T)] to a resource struct may change it in
place — ImageFormat reallocates an image's pixels — so the value it had
before the call is re-keyed to the value it has after. The count does
not change.
A library that names its pairs some other way is not tracked, and nothing
is reported about it. *)
type track = { acquire : bool; release : bool; rekey : int list }
let prefixed p s =
String.length s >= String.length p && String.sub s 0 (String.length p) = p
let resources (decls : Ast.decl list) : (string * track) list =
let env = scan decls in
(* The spelling a resource type is matched by: a struct's name, or a pointer
to anything. [None] for everything else, which is never a resource. *)
let rec spell (t : Ast.texpr) =
match (unalias env t).Ast.t with
| Ast.Tname n when Hashtbl.mem env.structs n -> Some n
| Ast.Tname n when prim_cty n <> None -> Some n
| Ast.Tapp ("Ptr", [ e ]) ->
Option.map (fun e -> "(Ptr " ^ e ^ ")") (spell e)
| _ -> None
in
let is_resource_type (t : Ast.texpr) =
match (unalias env t).Ast.t with
| Ast.Tname n -> Hashtbl.mem env.structs n
| Ast.Tapp ("Ptr", _) -> true
| _ -> false
in
let decl_cs =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.DeclareC (fn, csym) -> Some (fn, csym)
| _ -> None)
decls
in
let released = Hashtbl.create 16 in
List.iter
(fun ((fn : Ast.fn), csym) ->
match fn.Ast.params with
| [ p ] when prefixed "Unload" csym && is_resource_type p.Ast.fty ->
Option.iter (fun n -> Hashtbl.replace released n ()) (spell p.Ast.fty)
| _ -> ())
decl_cs;
List.filter_map
(fun ((fn : Ast.fn), csym) ->
let release =
prefixed "Unload" csym
&& (match fn.Ast.params with
| [ p ] ->
(match spell p.Ast.fty with
| Some n -> Hashtbl.mem released n
| None -> false)
| _ -> false)
in
let acquire =
(not (prefixed "Unload" csym)) && (not (prefixed "Get" csym))
&& (match fn.Ast.ret with
| Some t ->
(match spell t with
| Some n -> Hashtbl.mem released n
| None -> false)
| None -> false)
in
let rekey =
if prefixed "Unload" csym then []
else
List.concat
(List.mapi
(fun i (p : Ast.field) ->
match (unalias env p.Ast.fty).Ast.t with
| Ast.Tapp ("Ptr", [ e ]) ->
(match (unalias env e).Ast.t with
| Ast.Tname n
when Hashtbl.mem env.structs n
&& Hashtbl.mem released n -> [ i ]
| _ -> [])
| _ -> [])
fn.Ast.params)
in
if acquire || release || rekey <> [] then
Some (fn.Ast.name, { acquire; release; rekey })
else None)
decl_cs
(* Every [declare-c] in the program, rewritten, with the one C file they share.
The file is [None] when there are none, so a program that binds nothing pays
no C compile. *)
@ -679,6 +873,8 @@ let expand (decls : Ast.decl list) : Ast.decl list * (string * string) list =
Buffer.add_string b header;
if List.exists (fun s -> List.exists (fun (k, _) -> k = Pstr) s.sargs) shims
then Buffer.add_string b cstr_helpers;
if List.exists (fun s -> s.sret = `Str) shims then
Buffer.add_string b ret_helpers;
(* Every typedef the program needs, kept whole even when wrappers are
dropped: an unused typedef costs nothing, and working out which ones a
surviving subset still needs is a second dependency walk for no gain. *)

189
runtime/flan_dev.c
View File

@ -1895,6 +1895,195 @@ static void flan_reg_report(void) {
"count\n");
}
/* ── A library's resources, counted at the boundary ────────────────────
*
* TODO.org, "A debug tracking allocator over the raylib boundary". A texture
* or an image's pixels is memory raylib allocated, which neither ASan nor the
* registry above can see: nothing instrumented made it. What does see it is
* the call that made it. lib/shim.ml says which declare-c bindings acquire and
* release a resource, lib/check.ml wraps each call to one in the notes below,
* and this is the table they keep.
*
* An entry is one acquisition not yet released: the resource's key — a hash of
* its value, computed by the compiler from its fields — its type and the
* source location of the call that made it. A release removes one entry with
* the same key and type. A release that finds none is a release of something
* this run never loaded — an unload twice over, or of a value raylib keeps for
* itself — and is counted separately, by type and site, because it is a bug of
* its own.
*
* Only a dev build calls in here: the notes are [flan_dev_reg_note_] calls,
* which a release build drops. The report at exit is registered by the first
* note, so a program that never touches a tracked binding registers nothing.
* It prints only when something is still held or a release matched nothing,
* and like the block report above it cannot run for a program ended by a
* signal.
*
* One thread, the game's, calls these; nothing reads the table while the
* program runs. The type and site strings are literals the compiler emitted
* beside the call, and a module is never unloaded, so they outlive the table. */
typedef struct {
uint64_t key;
const char *type;
int64_t typelen;
const char *site;
int64_t sitelen;
int64_t count; /* 1 for a held resource; the total for a stray release */
} flan_res_entry;
static flan_res_entry *flan_res_held;
static int64_t flan_res_nheld, flan_res_capheld;
static flan_res_entry *flan_res_stray;
static int64_t flan_res_nstray, flan_res_capstray;
static int flan_res_lost; /* an entry was dropped because malloc failed */
static int flan_res_armed;
static void flan_res_report(void);
static void flan_res_arm(void) {
if (flan_res_armed) return;
flan_res_armed = 1;
atexit(flan_res_report);
}
static int flan_res_same(const char *a, int64_t an, const char *b, int64_t bn) {
return an == bn && memcmp(a, b, (size_t)an) == 0;
}
static flan_res_entry *flan_res_push(flan_res_entry **v, int64_t *n,
int64_t *cap) {
if (*n == *cap) {
int64_t nc = *cap ? *cap * 2 : 64;
flan_res_entry *nv =
(flan_res_entry *)realloc(*v, (size_t)nc * sizeof **v);
/* A diagnostic that runs out of memory says so and keeps the program
going: the report then calls itself a floor rather than a count. */
if (nv == NULL) { flan_res_lost = 1; return NULL; }
*v = nv;
*cap = nc;
}
return &(*v)[(*n)++];
}
void flan_dev_reg_note_res_acquire(uint64_t key, const char *type,
int64_t typelen, const char *site,
int64_t sitelen) {
flan_res_entry *e;
flan_res_arm();
e = flan_res_push(&flan_res_held, &flan_res_nheld, &flan_res_capheld);
if (e == NULL) return;
e->key = key; e->type = type; e->typelen = typelen;
e->site = site; e->sitelen = sitelen; e->count = 1;
}
void flan_dev_reg_note_res_release(uint64_t key, const char *type,
int64_t typelen, const char *site,
int64_t sitelen) {
int64_t i;
flan_res_entry *e;
flan_res_arm();
/* Newest first: a resource loaded and unloaded in one frame is the common
case, and it is at the end. */
for (i = flan_res_nheld - 1; i >= 0; i--) {
flan_res_entry *h = &flan_res_held[i];
if (h->key == key && flan_res_same(h->type, h->typelen, type, typelen)) {
/* Shifted down rather than swapped with the last, so the report lists
what is left in the order it was loaded. */
memmove(&flan_res_held[i], &flan_res_held[i + 1],
(size_t)(flan_res_nheld - i - 1) * sizeof *flan_res_held);
flan_res_nheld--;
return;
}
}
for (i = 0; i < flan_res_nstray; i++) {
e = &flan_res_stray[i];
if (flan_res_same(e->type, e->typelen, type, typelen)
&& flan_res_same(e->site, e->sitelen, site, sitelen)) {
e->count++;
return;
}
}
e = flan_res_push(&flan_res_stray, &flan_res_nstray, &flan_res_capstray);
if (e == NULL) return;
e->key = key; e->type = type; e->typelen = typelen;
e->site = site; e->sitelen = sitelen; e->count = 1;
}
/* A call that changes a resource in place — ImageFormat reallocates an
* image's pixels — gives it a new key. The old keys arrive before the call
* and the new ones after it, in reverse order, so they pair on a stack. More
* than eight at once would be a binding with nine pointer parameters to one
* resource type; past that the pairing is dropped rather than guessed. */
#define FLAN_RES_REKEY_MAX 8
static uint64_t flan_res_rekey[FLAN_RES_REKEY_MAX];
static int flan_res_nrekey, flan_res_rekey_over;
void flan_dev_reg_note_res_rekey_from(uint64_t old) {
if (flan_res_nrekey < FLAN_RES_REKEY_MAX)
flan_res_rekey[flan_res_nrekey++] = old;
else
flan_res_rekey_over++;
}
void flan_dev_reg_note_res_rekey_to(uint64_t now, const char *type,
int64_t typelen) {
uint64_t old;
int64_t i;
if (flan_res_rekey_over > 0) { flan_res_rekey_over--; return; }
if (flan_res_nrekey == 0) return;
old = flan_res_rekey[--flan_res_nrekey];
if (old == now) return;
for (i = flan_res_nheld - 1; i >= 0; i--) {
flan_res_entry *h = &flan_res_held[i];
if (h->key == old && flan_res_same(h->type, h->typelen, type, typelen)) {
h->key = now;
return;
}
}
}
/* The held entries, grouped by type and site, in the order they were first
* loaded. Quadratic in the number of groups, which is the number of distinct
* load sites and not the number of resources. */
static void flan_res_report(void) {
int64_t i, j;
if (flan_res_nheld > 0) {
fprintf(stderr, "flan: %lld resource%s still held at exit, loaded and "
"never unloaded:\n",
(long long)flan_res_nheld, flan_res_nheld == 1 ? "" : "s");
for (i = 0; i < flan_res_nheld; i++) {
flan_res_entry *e = &flan_res_held[i];
int64_t n = 0;
int seen = 0;
for (j = 0; j < i && !seen; j++)
seen = flan_res_same(flan_res_held[j].type, flan_res_held[j].typelen,
e->type, e->typelen)
&& flan_res_same(flan_res_held[j].site, flan_res_held[j].sitelen,
e->site, e->sitelen);
if (seen) continue;
for (j = i; j < flan_res_nheld; j++)
if (flan_res_same(flan_res_held[j].type, flan_res_held[j].typelen,
e->type, e->typelen)
&& flan_res_same(flan_res_held[j].site, flan_res_held[j].sitelen,
e->site, e->sitelen))
n++;
fprintf(stderr, "flan: %lld %.*s, loaded at %.*s\n", (long long)n,
(int)e->typelen, e->type, (int)e->sitelen, e->site);
}
}
for (i = 0; i < flan_res_nstray; i++) {
flan_res_entry *e = &flan_res_stray[i];
fprintf(stderr, "flan: %.*s released %lld time%s at %.*s with nothing "
"loaded to match\n",
(int)e->typelen, e->type, (long long)e->count,
e->count == 1 ? "" : "s", (int)e->sitelen, e->site);
}
if (flan_res_lost)
fprintf(stderr, "flan: the resource table ran out of memory, so this "
"is a floor and not a count\n");
}
/* ── A segfault in a dev session is a stop, not a silent death ─────────
*
* The dogfooding session this exists for: an in-place sort over

2
test/dune
View File

@ -23,6 +23,8 @@
; import reads the directory at build time. sand.flan itself is above: the
; headless case imports it as a single-file package.
(glob_files %{workspace_root}/vendor/raylib/*)
; rlgl's matrix stack, which an example imports beside raylib.
(glob_files %{workspace_root}/vendor/rlgl/*)
; The dev agent package: its Flan declarations and the C that implements them.
(glob_files %{workspace_root}/vendor/agent/*)
; The EDN package — the tokenizer and the dynamic reader over it — which

5
test/headers/sample.h
View File

@ -69,8 +69,11 @@ void blit(void *dst, const void *src, int n);
void *scratch(int n);
float pair_len_p(const Pair *p);
/* const char * returned is text the caller only reads, so it is a string. */
const char *name_of(int which);
/* --- refused, one per reason --- */
const char *name_of(int which); /* returns char * */
char *owned_text(void); /* returns char * the caller owns */
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 */

33
test/programs/cstr-return.flan Normal file
View File

@ -0,0 +1,33 @@
;;;; A string returned from C is copied into the context allocator at the
;;;; boundary, so it stays what it was after C reuses its buffer.
;;;;
;;;; cret/count answers the same static buffer every call: the first answer
;;;; still reads "count 1" after the second call has overwritten that buffer.
;;;; cret/after-slash answers a pointer into its own argument, which is the
;;;; wrapper's temporary copy — short enough for the stack buffer and, in the
;;;; second call, long enough to be on the heap. cret/nothing answers NULL,
;;;; which is the empty string. The last case copies into a named arena, and
;;;; the arena's free-all is what releases it.
(import cret "pkgs/cret")
(defn main [] i32
(let [a (cret/count 1)
b (cret/count 2)]
(println a)
(println b))
(println (cret/after-slash "assets/brush.png"))
(let [path (vec-new u8)]
(append (addr path) (bytes-view "dir/"))
(dotimes [i 300] (push path \x))
(let [tail (cret/after-slash (string (slice path)))
long-name (string (slice path 4))]
(println (length tail))
(println (= tail long-name))))
(println (length (cret/nothing)))
(let [ar (arena-new 4096)
before (alloc-live-blocks ar)
s (with-allocator ar (cret/count 3))]
(println s)
(println (- (alloc-live-blocks ar) before))
(arena-destroy ar))
0)

25
test/programs/pkgs/cret/cret.c Normal file
View File

@ -0,0 +1,25 @@
/* C functions that return strings, for programs/cstr-return.flan. Each one is
* a way a real library hands text back, and each has a failure the copy at
* the boundary has to survive. */
#include <stddef.h>
#include <stdio.h>
#include <string.h>
/* The library's static buffer, overwritten by the next call: TextFormat and
* GetGamepadName's shape. */
const char *cret_count(int n) {
static char buf[32];
snprintf(buf, sizeof buf, "count %d", n);
return buf;
}
/* A pointer into the argument: GetFileName's shape. The argument is the
* wrapper's own NUL-terminated copy, which is gone once the wrapper returns. */
const char *cret_after_slash(const char *path) {
const char *s = strrchr(path, '/');
return s == NULL ? path : s + 1;
}
/* No text at all. */
const char *cret_nothing(void) { return NULL; }

5
test/programs/pkgs/cret/cret.flan Normal file
View File

@ -0,0 +1,5 @@
;;;; Strings returned from C, bound through declare-c. See cret.c beside this.
(declare-c count [n i32] string "cret_count")
(declare-c after-slash [path string] string "cret_after_slash")
(declare-c nothing [] string "cret_nothing")

41
test/programs/pkgs/res/res.c Normal file
View File

@ -0,0 +1,41 @@
/* A stand-in for a library that hands out resources the way raylib does — a
* Load that allocates, an Unload that frees, a Get that answers something the
* library keeps — for programs/res-leaks.flan. Nothing here needs a window or
* a library installed.
*
* Thing has padding after `flag` and after `w`, so a key made from its bytes
* would read whatever those bytes happened to hold. */
#include <stdint.h>
#include <stdlib.h>
typedef struct {
int32_t id;
uint8_t flag;
float w;
void *data;
} Thing;
Thing LoadThing(int32_t id) {
Thing t = { id, 1, 0.5f, malloc(16) };
return t;
}
void UnloadThing(Thing t) { free(t.data); }
/* Changes the Thing in place, as ImageFormat changes an Image. */
void ThingGrow(Thing *t) {
void *d = realloc(t->data, 64);
if (d != NULL) t->data = d;
t->w *= 2.0f;
}
/* The library's own Thing, which a caller must not unload. */
Thing GetDefaultThing(void) {
Thing t = { 0, 0, 0.0f, NULL };
return t;
}
unsigned char *LoadBytes(int32_t n) { return (unsigned char *)malloc((size_t)n); }
void UnloadBytes(unsigned char *p) { free(p); }

11
test/programs/pkgs/res/res.flan Normal file
View File

@ -0,0 +1,11 @@
;;;; Bindings over res.c, named the way raylib names its pairs, which is what
;;;; makes a dev build count them.
(defstruct Thing [id i32 flag u8 w f32 data (Ptr u8)])
(declare-c load-thing [id i32] Thing "LoadThing")
(declare-c unload-thing [t Thing] "UnloadThing")
(declare-c thing-grow [t (Ptr Thing)] "ThingGrow")
(declare-c get-default-thing [] Thing "GetDefaultThing")
(declare-c load-bytes [n i32] (Ptr u8) "LoadBytes")
(declare-c unload-bytes [p (Ptr u8)] "UnloadBytes")

40
test/programs/raylib-strings.flan Normal file
View File

@ -0,0 +1,40 @@
;;;; raylib, headless: strings returned from C, a directory listing, and the
;;;; Model, Mesh and Matrix layouts. Nothing here opens a window.
;;;;
;;;; get-file-name answers a pointer into its own argument, which is the
;;;; wrapper's temporary copy, so this is the case the scratch buffer exists
;;;; for. text-to-upper answers raylib's static buffer, which the second call
;;;; overwrites; the first answer must not change when it does.
;;;;
;;;; The layouts are pinned by making raylib compute with them.
;;;; GetMeshBoundingBox reads vertex-count and the vertices pointer, and
;;;; GetModelBoundingBox reads mesh-count, meshes and the transform — a
;;;; translation by (10, 20, 30), which lands in m-12, m-13 and m-14 and moves
;;;; the box by exactly that. A permuted field reads a wrong count, a wrong
;;;; pointer or a wrong translation.
(import rl "vendor:raylib")
(defn show-box [b rl/BoundingBox] ()
(println (.x (.min b)) (.y (.min b)) (.z (.min b)) "/"
(.x (.max b)) (.y (.max b)) (.z (.max b))))
(defn main [] i32
(println (rl/get-file-name "assets/sprites/brush.png"))
(println (rl/get-file-extension "brush.png"))
(println (rl/get-directory-path "assets/sprites/brush.png"))
(let [a (rl/text-to-upper "first")
b (rl/text-to-upper "second")]
(println a b))
(println (length (rl/directory-files "programs/pkgs/cret")))
(let [verts (array 6 f32)]
(set (at verts 0) -1.0) (set (at verts 1) 2.0) (set (at verts 2) -3.0)
(set (at verts 3) 4.0) (set (at verts 4) -5.0) (set (at verts 5) 6.0)
(let [mesh (rl/Mesh {.vertex-count 2 .vertices (addr (at verts 0))})
model (rl/Model {.transform (rl/Matrix {.m-0 1.0 .m-5 1.0 .m-10 1.0 .m-15 1.0
.m-12 10.0 .m-13 20.0 .m-14 30.0})
.mesh-count 1
.meshes (addr mesh)})]
(show-box (rl/get-mesh-bounding-box mesh))
(show-box (rl/get-model-bounding-box model))))
0)

23
test/programs/res-leaks.flan Normal file
View File

@ -0,0 +1,23 @@
;;;; A dev build counts what a library's Load calls hand out against its Unload
;;;; calls, and says at exit what was never released and where it was loaded.
;;;;
;;;; Three Things and two byte buffers are loaded. b is changed in place by
;;;; thing-grow before it is unloaded, so its key has to follow it. c and q are
;;;; never unloaded, and the report names their lines. The last unload is of
;;;; the library's own Thing, which nothing loaded, and is reported apart.
;;;; A release build prints "done" and nothing else.
(import res "pkgs/res")
(defn main [] i32
(let [a (res/load-thing 1)
b (res/load-thing 2)
c (res/load-thing 3)
p (res/load-bytes 8)
q (res/load-bytes 8)]
(res/thing-grow (addr b))
(res/unload-thing a)
(res/unload-thing b)
(res/unload-bytes p)
(res/unload-thing (res/get-default-thing))
(println "done"))
0)

76
test/test_acceptance.ml
View File

@ -880,6 +880,39 @@ let () =
text code
end;
(try Sys.remove exe with Sys_error _ -> ());
(* And the return direction: text C hands back is copied into the context
allocator before C can reuse the buffer it lives in. The package's C is
its own, so this needs no library installed. Both backends and a dev
build, because the copy is a Flan wrapper the shim generates and a dev
build notes the block it lands in. *)
let cstr_ret_out = "count 1\ncount 2\nbrush.png\n300\ntrue\n0\ncount 3\n1\n" in
outputs "a string returned from C" "programs/cstr-return.flan" cstr_ret_out;
outputs ~x86:true "a string returned from C, x86" "programs/cstr-return.flan"
cstr_ret_out;
outputs ~dev:true "a string returned from C, dev" "programs/cstr-return.flan"
cstr_ret_out;
(* A library's resources, counted in a dev build. The package's C stands in
for raylib — Load, Unload, a Get that must not be unloaded and a call
that changes a resource in place — so this runs with no library
installed and through the same generated wrappers raylib's bindings
use. The report names the two loads never unloaded and the unload that
matched nothing; a release build prints none of it, because the notes
are dropped there. *)
let res_dev_out =
"done\n\
flan: 2 resources still held at exit, loaded and never unloaded:\n\
flan: 1 res/Thing, loaded at programs/res-leaks.flan:14:11\n\
flan: 1 (Ptr u8), loaded at programs/res-leaks.flan:16:11\n\
flan: res/Thing released 1 time at programs/res-leaks.flan:21:5 with \
nothing loaded to match\n"
in
outputs "library resources: a release build counts nothing"
"programs/res-leaks.flan" "done\n";
outputs ~dev:true "library resources: a dev build reports what is held"
"programs/res-leaks.flan" res_dev_out;
outputs ~dev:true ~x86:true
"library resources: a dev build reports what is held, x86"
"programs/res-leaks.flan" res_dev_out;
(* handler-bind and signal, spec-conditions.md §1 and §2: signal returns
Unit and carries on, an unhandled one is a no-op, a nested frame does
not displace the one outside it, and the stack is restored after. *)
@ -2007,6 +2040,35 @@ let () =
outputs ~opt:"-O0" "raylib, bindings generated from the header, -O0"
"programs/raylib-imported.flan" out;
(* Strings returned from raylib, a directory listing, and the Model, Mesh
and Matrix layouts, pinned by raylib computing bounding boxes over them.
The program says which call tests what. *)
let out =
"brush.png\n.png\n./assets/sprites\nFIRST SECOND\n2\n\
-1 -5 -3 / 4 2 6\n9 15 27 / 14 22 36\n"
in
outputs "raylib strings and model layouts, headless"
"programs/raylib-strings.flan" out;
outputs ~opt:"-O0" "raylib strings and model layouts, headless, -O0"
"programs/raylib-strings.flan" out;
(* Two examples that need a window, so they are built and never run: the
one that draws the gamepad's name, and the one rlgl's matrix stack was
bound for. Building is the claim — every binding they call resolves,
agrees with its header and links. *)
List.iter
(fun path ->
match compile path with
| exe -> (try Sys.remove exe with Sys_error _ -> ())
| exception e ->
incr failures;
Printf.printf "FAIL %s does not build: %s\n" path
(match e with
| Loc.Error { Loc.dmsg = m; _ } -> m
| e -> Printexc.to_string e))
[ "../examples/core-input-gamepad.flan";
"../examples/core-2d-camera-mouse-zoom.flan" ];
(* The raylib package's begin/end macros — vendor/raylib/modes.flan.
Nothing here draws: every one of the five brackets calls that want a
window and a GL context, so what can be asserted headless is that the
@ -3755,9 +3817,19 @@ level "1"
shim_refuses "declare-c: a map"
"(declare-c takes [m (Map string i32)] \"Takes\")"
"which has no C representation";
shim_refuses "declare-c: a returned string"
(* A returned string comes back as the pointer and its length. With no
string argument the pointer is the library's own; with one, it may point
into the argument's copy, so it is moved to the scratch buffer before
that copy is freed. programs/cstr-return.flan runs both. *)
shim_case "declare-c: a returned string answers its length"
"(declare-c name [] string \"Name\")"
"a string only crosses as a parameter";
[ "extern const char * Name(void);";
"const char *r = flan_shim_ret_len(Name(), out_n);";
"int32_t *out_n" ];
shim_case "declare-c: a returned string outlives the argument copies"
"(declare-c base [p string] string \"Base\")"
[ "const char *r = flan_shim_ret_keep(Base(a0), out_n);\n\
\ flan_shim_cstr_free(a0, a0_b);\n return r;\n" ];
shim_refuses "declare-c: a callback"
"(declare-c each [f (Fn [i32] ())] \"Each\")"
"a C callback is not implemented";

15
test/test_flan.ml
View File

@ -4290,6 +4290,9 @@ let () =
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 returned: text the caller only reads, which the shim copies. *)
emits "const char * as a string return"
"(declare-c name-of [which i32] string \"name_of\")";
(* And the refusals, each by its reason rather than by a count. *)
let refused name needle =
@ -4299,7 +4302,7 @@ let () =
(fun (n, why) -> n = name && contains why needle)
imported.Cimport.hidden)
in
refused "name-of" "returns char *";
refused "owned-text" "which the caller owns";
refused "fill-buffer" "C may write through";
refused "printf-like" "is variadic";
refused "on-event" "is a function pointer";
@ -4943,6 +4946,16 @@ let () =
i8 and u8 are two spellings of one byte, and as a scalar they are not. *)
differs "a byte where the header says a wider integer"
"(declare-c add [a u8 b i32] i32 \"add_ints\")" "parameter a is u8";
(* A returned string is copied, so it has to be text the caller only reads.
Over a char * without const the copy would leave the library's buffer
with no owner; over a const char * it is the importer's own face. *)
agreed "a string returned where the header says const char *"
"(declare-c name-of [which i32] string \"name_of\")";
differs "a string returned where the header says char *"
"(declare-c owned-text [] string \"owned_text\")"
"which the caller owns";
agreed "a (Ptr u8) returned where the header says char *"
"(declare-c owned-text [] (Ptr u8) \"owned_text\")";
(* 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

2
test/test_sanitize.ml
View File

@ -132,6 +132,7 @@ let corpus =
"programs/bytes-copy.flan", [];
"programs/cleanup.flan", [];
"programs/conditions.flan", [];
"programs/cstr-return.flan", [];
"programs/debug.flan", [];
"programs/debug-permuted.flan", [];
"programs/destructure.flan", [];
@ -187,6 +188,7 @@ let corpus =
"programs/pkg-unused.flan", [];
"programs/printers.flan", [];
"programs/println.flan", [];
"programs/res-leaks.flan", [];
"programs/restarts.flan", [];
(* The dyn programs, which reach flan_dyn.c from Flan rather than from the
hand-written C below — and the difference is the whole reason they are

2
test/test_valgrind.ml
View File

@ -205,6 +205,7 @@ let corpus =
"programs/bytes-copy.flan", [];
"programs/cleanup.flan", [];
"programs/conditions.flan", [];
"programs/cstr-return.flan", [];
"programs/debug.flan", [];
"programs/debug-permuted.flan", [];
"programs/defer-let.flan", [];
@ -239,6 +240,7 @@ let corpus =
"programs/printers.flan", [];
"programs/println.flan", [];
"programs/reach-walk.flan", [];
"programs/res-leaks.flan", [];
"programs/restarts.flan", [];
"programs/sand-headless.flan", [];
"programs/signedness.flan", [];

1
vendor/raylib/bindings vendored
View File

@ -64,6 +64,7 @@ name IsPathFile path-file?
name IsAudioStreamValid audio-stream-valid?
name IsAudioStreamPlaying audio-stream-playing?
name IsAudioStreamProcessed audio-stream-processed?
name IsModelValid model-valid?
# Hand-written in raylib.flan, so excluded here: a second declare-c for one C
# symbol is refused for the whole program. These three are on a game's

51
vendor/raylib/generated.flan vendored
View File

@ -49,7 +49,9 @@
(declare-c get-monitor-refresh-rate [monitor i32] i32 "GetMonitorRefreshRate")
(declare-c get-window-position [] Vector2 "GetWindowPosition")
(declare-c get-window-scale-dpi [] Vector2 "GetWindowScaleDPI")
(declare-c get-monitor-name [monitor i32] string "GetMonitorName")
(declare-c set-clipboard-text [text string] "SetClipboardText")
(declare-c get-clipboard-text [] string "GetClipboardText")
(declare-c get-clipboard-image [] Image "GetClipboardImage")
(declare-c enable-event-waiting [] "EnableEventWaiting")
(declare-c disable-event-waiting [] "DisableEventWaiting")
@ -62,6 +64,8 @@
(declare-c end-vr-stereo-mode [] "EndVrStereoMode")
(declare-c get-screen-to-world-ray-ex [position Vector2 camera Camera3D width i32 height i32] Ray "GetScreenToWorldRayEx")
(declare-c get-world-to-screen-ex [position Vector3 camera Camera3D width i32 height i32] Vector2 "GetWorldToScreenEx")
(declare-c get-camera-matrix [camera Camera3D] Matrix "GetCameraMatrix")
(declare-c get-camera-matrix-2d [camera Camera2D] Matrix "GetCameraMatrix2D")
(declare-c swap-screen-buffer [] "SwapScreenBuffer")
(declare-c poll-input-events [] "PollInputEvents")
(declare-c wait-time [seconds f64] "WaitTime")
@ -79,6 +83,13 @@
(declare-c directory-exists [dir-path string] bool "DirectoryExists")
(declare-c file-extension? [file-name string ext string] bool "IsFileExtension")
(declare-c get-file-length [file-name string] i32 "GetFileLength")
(declare-c get-file-extension [file-name string] string "GetFileExtension")
(declare-c get-file-name [file-path string] string "GetFileName")
(declare-c get-file-name-without-ext [file-path string] string "GetFileNameWithoutExt")
(declare-c get-directory-path [file-path string] string "GetDirectoryPath")
(declare-c get-prev-directory-path [dir-path string] string "GetPrevDirectoryPath")
(declare-c get-working-directory [] string "GetWorkingDirectory")
(declare-c get-application-directory [] string "GetApplicationDirectory")
(declare-c make-directory [dir-path string] i32 "MakeDirectory")
(declare-c change-directory [dir string] bool "ChangeDirectory")
(declare-c path-file? [path string] bool "IsPathFile")
@ -95,6 +106,7 @@
(declare-c stop-automation-event-recording [] "StopAutomationEventRecording")
(declare-c get-key-pressed-raw [] i32 "GetKeyPressed")
(declare-c get-char-pressed-raw [] i32 "GetCharPressed")
(declare-c get-gamepad-name [gamepad i32] string "GetGamepadName")
(declare-c set-gamepad-mappings [mappings string] i32 "SetGamepadMappings")
(declare-c set-gamepad-vibration [gamepad i32 left-motor f32 right-motor f32 duration f32] "SetGamepadVibration")
(declare-c get-mouse-x [] i32 "GetMouseX")
@ -230,10 +242,18 @@
(declare-c get-codepoint-count [text string] i32 "GetCodepointCount")
(declare-c get-codepoint [text string codepoint-size (Ptr i32)] i32 "GetCodepoint")
(declare-c get-codepoint-next [text string codepoint-size (Ptr i32)] i32 "GetCodepointNext")
(declare-c codepoint-to-utf8 [codepoint i32 utf-8size (Ptr i32)] string "CodepointToUTF8")
(declare-c text-is-equal [text-1 string text-2 string] bool "TextIsEqual")
(declare-c text-length [text string] u32 "TextLength")
(declare-c text-subtext [text string position i32 length i32] string "TextSubtext")
(declare-c text-join [text-list (Ptr (Ptr i8)) count i32 delimiter string] string "TextJoin")
(declare-c text-split [text string delimiter i8 count (Ptr i32)] (Ptr (Ptr i8)) "TextSplit")
(declare-c text-find-index [text string find string] i32 "TextFindIndex")
(declare-c text-to-upper [text string] string "TextToUpper")
(declare-c text-to-lower [text string] string "TextToLower")
(declare-c text-to-pascal [text string] string "TextToPascal")
(declare-c text-to-snake [text string] string "TextToSnake")
(declare-c text-to-camel [text string] string "TextToCamel")
(declare-c text-to-integer [text string] i32 "TextToInteger")
(declare-c text-to-float [text string] f32 "TextToFloat")
(declare-c draw-line-3d [start-pos Vector3 end-pos Vector3 color Color] "DrawLine3D")
@ -250,15 +270,46 @@
(declare-c draw-capsule [start-pos Vector3 end-pos Vector3 radius f32 slices i32 rings i32 color Color] "DrawCapsule")
(declare-c draw-capsule-wires [start-pos Vector3 end-pos Vector3 radius f32 slices i32 rings i32 color Color] "DrawCapsuleWires")
(declare-c draw-plane [center-pos Vector3 size Vector2 color Color] "DrawPlane")
(declare-c load-model [file-name string] Model "LoadModel")
(declare-c load-model-from-mesh [mesh Mesh] Model "LoadModelFromMesh")
(declare-c model-valid? [model Model] bool "IsModelValid")
(declare-c unload-model [model Model] "UnloadModel")
(declare-c get-model-bounding-box [model Model] BoundingBox "GetModelBoundingBox")
(declare-c draw-model [model Model position Vector3 scale f32 tint Color] "DrawModel")
(declare-c draw-model-ex [model Model position Vector3 rotation-axis Vector3 rotation-angle f32 scale Vector3 tint Color] "DrawModelEx")
(declare-c draw-model-wires [model Model position Vector3 scale f32 tint Color] "DrawModelWires")
(declare-c draw-model-wires-ex [model Model position Vector3 rotation-axis Vector3 rotation-angle f32 scale Vector3 tint Color] "DrawModelWiresEx")
(declare-c draw-model-points [model Model position Vector3 scale f32 tint Color] "DrawModelPoints")
(declare-c draw-model-points-ex [model Model position Vector3 rotation-axis Vector3 rotation-angle f32 scale Vector3 tint Color] "DrawModelPointsEx")
(declare-c draw-bounding-box [box BoundingBox color Color] "DrawBoundingBox")
(declare-c draw-billboard [camera Camera3D texture Texture2D position Vector3 scale f32 tint Color] "DrawBillboard")
(declare-c draw-billboard-rec [camera Camera3D texture Texture2D source Rectangle position Vector3 size Vector2 tint Color] "DrawBillboardRec")
(declare-c draw-billboard-pro [camera Camera3D texture Texture2D source Rectangle position Vector3 up Vector3 size Vector2 origin Vector2 rotation f32 tint Color] "DrawBillboardPro")
(declare-c upload-mesh [mesh (Ptr Mesh) dynamic bool] "UploadMesh")
(declare-c update-mesh-buffer [mesh Mesh index i32 data (Ptr u8) data-size i32 offset i32] "UpdateMeshBuffer")
(declare-c unload-mesh [mesh Mesh] "UnloadMesh")
(declare-c get-mesh-bounding-box [mesh Mesh] BoundingBox "GetMeshBoundingBox")
(declare-c gen-mesh-tangents [mesh (Ptr Mesh)] "GenMeshTangents")
(declare-c export-mesh [mesh Mesh file-name string] bool "ExportMesh")
(declare-c export-mesh-as-code [mesh Mesh file-name string] bool "ExportMeshAsCode")
(declare-c gen-mesh-poly [sides i32 radius f32] Mesh "GenMeshPoly")
(declare-c gen-mesh-plane [width f32 length f32 res-x i32 res-z i32] Mesh "GenMeshPlane")
(declare-c gen-mesh-cube [width f32 height f32 length f32] Mesh "GenMeshCube")
(declare-c gen-mesh-sphere [radius f32 rings i32 slices i32] Mesh "GenMeshSphere")
(declare-c gen-mesh-hemi-sphere [radius f32 rings i32 slices i32] Mesh "GenMeshHemiSphere")
(declare-c gen-mesh-cylinder [radius f32 height f32 slices i32] Mesh "GenMeshCylinder")
(declare-c gen-mesh-cone [radius f32 height f32 slices i32] Mesh "GenMeshCone")
(declare-c gen-mesh-torus [radius f32 size f32 rad-seg i32 sides i32] Mesh "GenMeshTorus")
(declare-c gen-mesh-knot [radius f32 size f32 rad-seg i32 sides i32] Mesh "GenMeshKnot")
(declare-c gen-mesh-heightmap [heightmap Image size Vector3] Mesh "GenMeshHeightmap")
(declare-c gen-mesh-cubicmap [cubicmap Image cube-size Vector3] Mesh "GenMeshCubicmap")
(declare-c set-model-mesh-material [model (Ptr Model) mesh-id i32 material-id i32] "SetModelMeshMaterial")
(declare-c check-collision-spheres [center-1 Vector3 radius-1 f32 center-2 Vector3 radius-2 f32] bool "CheckCollisionSpheres")
(declare-c check-collision-boxes [box-1 BoundingBox box-2 BoundingBox] bool "CheckCollisionBoxes")
(declare-c check-collision-box-sphere [box BoundingBox center Vector3 radius f32] bool "CheckCollisionBoxSphere")
(declare-c get-ray-collision-sphere [ray Ray center Vector3 radius f32] RayCollision "GetRayCollisionSphere")
(declare-c get-ray-collision-box [ray Ray box BoundingBox] RayCollision "GetRayCollisionBox")
(declare-c get-ray-collision-mesh [ray Ray mesh Mesh transform Matrix] RayCollision "GetRayCollisionMesh")
(declare-c get-ray-collision-triangle [ray Ray p-1 Vector3 p-2 Vector3 p-3 Vector3] RayCollision "GetRayCollisionTriangle")
(declare-c get-ray-collision-quad [ray Ray p-1 Vector3 p-2 Vector3 p-3 Vector3 p-4 Vector3] RayCollision "GetRayCollisionQuad")
(declare-c load-wave-from-memory [file-type string file-data (Ptr u8) data-size i32] Wave "LoadWaveFromMemory")

101
vendor/raylib/raylib.flan vendored
View File

@ -1610,3 +1610,104 @@
(if (<= offset 0)
(do (set (deref codepoint-size) 0) 0)
(get-codepoint-previous-raw (addr (at text offset)) codepoint-size)))
;; ── Models and meshes ───────────────────────────────────────────────
;;
;; Layouts only, read off raylib.h 5.5 and checked against it on every build.
;; Describing them is what lets the importer bind the Load/Gen/Draw/Unload
;; families over them in generated.flan; none of those calls is written here.
;;
;; The field names are the header's through the kebab rule, which is how the
;; layout check pairs them, so Matrix's are m-0 to m-15 in raylib's order — a
;; column-major 4x4 with m-0 m-4 m-8 m-12 as the first row.
(defstruct Matrix
[m-0 f32 m-4 f32 m-8 f32 m-12 f32
m-1 f32 m-5 f32 m-9 f32 m-13 f32
m-2 f32 m-6 f32 m-10 f32 m-14 f32
m-3 f32 m-7 f32 m-11 f32 m-15 f32])
;; Every array a mesh owns is a pointer and a count held elsewhere in the
;; struct: vertex-count vertices, triangle-count triangles. Reading one is
;; (slice-from-ptr (.vertices mesh) (* 3 (.vertex-count mesh))).
(defstruct Mesh
[vertex-count i32 triangle-count i32
vertices (Ptr f32) texcoords (Ptr f32) texcoords-2 (Ptr f32)
normals (Ptr f32) tangents (Ptr f32) colors (Ptr u8) indices (Ptr u16)
anim-vertices (Ptr f32) anim-normals (Ptr f32) bone-ids (Ptr u8)
bone-weights (Ptr f32) bone-matrices (Ptr Matrix) bone-count i32
vao-id u32 vbo-id (Ptr u32)])
;; materials, bones and bind-pose are (Ptr u8) because what they point at
;; cannot be described yet: Material holds `float params[4]` and BoneInfo
;; `char name[32]`, and a fixed-array field is refused at the C boundary.
;; Transform needs Quaternion, which nothing here needs otherwise. The
;; pointers are one word whatever they point at, so the layout is exact.
(defstruct Model
[transform Matrix mesh-count i32 material-count i32 meshes (Ptr Mesh)
materials (Ptr u8) mesh-material (Ptr i32)
bone-count i32 bones (Ptr u8) bind-pose (Ptr u8)])
;; ── Dropped files and directory listings ────────────────────────────
;;
;; FilePathList is an array of C strings raylib owns until the matching
;; Unload call. It crosses the way a returned string does: each path is copied
;; into the context allocator, raylib's list is released before the function
;; returns, and the caller gets a (Vec string) with nothing of raylib's left
;; to unload. `free` on the Vec releases the Vec; the paths live until their
;; allocator's free-all, as (bytes s) does.
(defstruct FilePathList [capacity u32 count u32 paths (Ptr (Ptr i8))])
(declare-c load-dropped-files-raw [] FilePathList "LoadDroppedFiles")
(declare-c unload-dropped-files-raw [files FilePathList] "UnloadDroppedFiles")
(declare-c load-directory-files-raw [dir-path string] FilePathList
"LoadDirectoryFiles")
(declare-c load-directory-files-ex-raw
[base-path string filter string scan-subdirs bool] FilePathList
"LoadDirectoryFilesEx")
(declare-c unload-directory-files-raw [files FilePathList]
"UnloadDirectoryFiles")
;; The bytes of a NUL-terminated C string, copied into the context allocator.
;; The NUL is the only thing that says where a C string ends, so the walk
;; stops there and nothing past it is read. `char` is i8 in the header, and
;; each byte is converted as it is copied.
(defn- c-string-copy [p (Ptr i8)] string
(let [s (slice-from-ptr p 2147483647)
out (vec-new u8)
i 0]
(while (!= (at s i) 0)
(push out (u8 (at s i)))
(set i (+ i 1)))
(string (slice out))))
(defn- file-path-list-copy [files FilePathList] (Vec string)
(let [out (vec-new string)
n (i32 (.count files))
paths (slice-from-ptr (.paths files) n)]
(dotimes [i n]
(push out (c-string-copy (at paths i))))
out))
;; The paths dropped on the window since the last call; empty when
;; file-dropped? is false.
(defn dropped-files [] (Vec string)
(let [files (load-dropped-files-raw)
out (file-path-list-copy files)]
(unload-dropped-files-raw files)
out))
;; The entries of one directory, files and subdirectories both.
(defn directory-files [dir-path string] (Vec string)
(let [files (load-directory-files-raw dir-path)
out (file-path-list-copy files)]
(unload-directory-files-raw files)
out))
;; `filter` is raylib's: extensions such as ".png;.jpg", or "DIR" for
;; directories only. `scan-subdirs` walks the tree.
(defn directory-files-ex [base-path string filter string scan-subdirs bool]
(Vec string)
(let [files (load-directory-files-ex-raw base-path filter scan-subdirs)
out (file-path-list-copy files)]
(unload-directory-files-raw files)
out))

9
vendor/rlgl/bindings vendored Normal file
View File

@ -0,0 +1,9 @@
# The directives vendor/raylib/bindings describes.
#
# Nothing in rlgl.h is generated. Its functions all begin with `rl`, which the
# kebab rule would keep (rlgl/rl-push-matrix), and most of it is the GL
# backend raylib drives for itself — buffers, shaders, framebuffers — which a
# program calling raylib has no use for. The part a program does use is the
# matrix stack, and rlgl.flan binds that by hand under shorter names. Each of
# those lines is still checked against the header on every build.
exclude rl*

4
vendor/rlgl/headers vendored Normal file
View File

@ -0,0 +1,4 @@
# The C header this package's declarations are checked against, in the format
# vendor/raylib/headers describes. rlgl.h at the raylib 5.5 tag — RLGL_VERSION
# "5.0" inside it — which is the rlgl compiled into libraylib.so.550.
rlgl-5.5.h

7
vendor/rlgl/link vendored Normal file
View File

@ -0,0 +1,7 @@
# rlgl is compiled into raylib, so this package links the same library
# vendor/raylib/link names, for the same targets and for the same reasons.
@native -l:libraylib.so.550
@native -lm
@web ${FLAN_RAYLIB_WEB}
@web -sUSE_GLFW=3
@web -sGL_ENABLE_GET_PROC_ADDRESS

5262
vendor/rlgl/rlgl-5.5.h vendored Normal file
View File

File diff suppressed because it is too large Load Diff

33
vendor/rlgl/rlgl.flan vendored Normal file
View File

@ -0,0 +1,33 @@
;;;; rlgl's matrix stack, declared for Flan. (import rlgl "vendor:rlgl")
;;;; qualifies it as rlgl/…
;;;;
;;;; rlgl is raylib's layer over OpenGL, and every raylib draw goes through
;;;; it. The stack is how a draw is moved without moving its arguments: push,
;;;; transform, draw, pop, and everything drawn in between is transformed.
;;;; raylib's own begin-mode-2d and begin-mode-3d load a matrix onto the same
;;;; stack.
;;;;
;;;; Each call needs a window and a GL context, so none of this runs headless.
;;;;
;;;; The names drop rlgl's `rl` prefix, which the package alias already says,
;;;; and the `f` suffix, which says the arguments are floats — the signature
;;;; says that.
;; Save the current matrix, so the transforms after it can be undone.
(declare-c push-matrix [] "rlPushMatrix")
;; Restore the matrix the last push-matrix saved.
(declare-c pop-matrix [] "rlPopMatrix")
;; Replace the current matrix with the identity.
(declare-c load-identity [] "rlLoadIdentity")
;; Multiply the current matrix by a translation.
(declare-c translate [x f32 y f32 z f32] "rlTranslatef")
;; Multiply the current matrix by a rotation of `angle` degrees about the axis
;; (x, y, z).
(declare-c rotate [angle f32 x f32 y f32 z f32] "rlRotatef")
;; Multiply the current matrix by a scale along each axis.
(declare-c scale [x f32 y f32 z f32] "rlScalef")