Raylib's strings, models, file lists and matrix stack are bound, and a dev build can name what is still loaded at exit
This commit is contained in:
commit
5062052425
12
README.md
12
README.md
@ -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
|
||||
```
|
||||
|
||||
64
TODO.org
64
TODO.org
@ -480,19 +480,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]
|
||||
@ -502,9 +511,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
|
||||
@ -1819,14 +1835,16 @@ 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 struct type (not =Get*=, except =GetClipboardImage=), noting
|
||||
the release and acquisition in the generated wrapper and the site at the call.
|
||||
A resource is keyed by its first pointer field, or its =id=, so writing other
|
||||
fields keeps the match. The report at exit is behind =FLAN_DEV_LEAKS=. Release
|
||||
builds emit what they did before. Rules out keying on the whole value and
|
||||
tracking bare pointers. docs/BUILT.md, "A dev build counts a library's
|
||||
resources".
|
||||
** DONE --dev --sanitize was unbuildable, and nothing built it
|
||||
CLOSED: [2026-09-21]
|
||||
clang's sanitizer pass faulted on a constructor table naming a function the
|
||||
|
||||
101
docs/BUILT.md
101
docs/BUILT.md
@ -147,7 +147,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
|
||||
@ -208,9 +208,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
|
||||
@ -674,6 +674,99 @@ 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. Eighteen 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 struct type is a
|
||||
resource when a binding whose C symbol begins with `Unload` takes one of it and nothing else. Any other binding returning
|
||||
that type acquires one, except a C symbol beginning with `Get` — `GetFontDefault` and `GetShapesTexture` answer
|
||||
something raylib keeps. That rule has one exception in raylib 5.5, `GetClipboardImage`, which builds a new image with
|
||||
`LoadImageFromMemory` and hands it over; `owned_gets` names it. `consumes` names the one call that takes a resource
|
||||
over: `LoadModelFromMesh` stores the mesh in the model, and `UnloadModel` frees it, so the mesh counts as released at
|
||||
that call. `LoadTextureFromImage`, `LoadSoundFromWave` and `LoadFontFromImage` copy what they need and leave their
|
||||
argument to the caller. A binding that takes a `(Ptr T)` to a resource and returns nothing may change it in place —
|
||||
`ImageFormat` reallocates the pixels — and moves its key. Pointers are not resources: raylib's bare buffers are freed by
|
||||
calls not named for them (`CompressData` by `MemFree`), and a half-fitting rule would report leaks that are not there.
|
||||
A library that names its pairs differently is not tracked.
|
||||
|
||||
**Where.** The wrapper `Shim` generates for a tracked binding — every one has a wrapper, since each passes or returns a
|
||||
struct — notes the release of its arguments and the acquisition of its result, over the locals it already binds. The
|
||||
call site, in `Check`, notes where the call is, because only it knows the source location; the runtime pairs the two by
|
||||
the binding's name, on a stack, so a tracked call inside another's arguments names its own column. All of it is
|
||||
`flan_dev_reg_note_*` calls, the family a release build drops before building their arguments, and none of it binds a
|
||||
slot. A release build therefore emits the same machine code it emitted before the tracker existed: compared function by
|
||||
function against master over six raylib programs, on both backends, the only differences are string-constant numbering
|
||||
and the length of the source path baked into a bounds message.
|
||||
|
||||
**Identity.** A resource is matched by one field, not its whole value, because a program sets `looping` on a Music or
|
||||
the `transform` of a Model and still unloads the same resource. The field is the first pointer in the struct, depth
|
||||
first — an Image's pixels, a Sound's buffer, a Mesh's vertices, a Model's meshes, a Font's rectangles — and in a
|
||||
struct with no pointer, a field named `id`, which is how a Texture2D or a RenderTexture2D names its GPU object. A
|
||||
struct with neither is keyed by every leaf field, hashed one at a time so padding never reaches the key. Two resources
|
||||
with the same identifying field share a key; a release then removes one of them and the count stays right. Headless
|
||||
textures all have id 0 and are the realistic case of that.
|
||||
|
||||
**The report**, at exit, when `FLAN_DEV_LEAKS` is set — the switch the block report uses: what is still held, grouped by
|
||||
type and load site in the order loaded, and each `Unload` that matched no load. It cannot run for a program ended by a
|
||||
signal. A binding reached through a function value opened no site, and its entries say so instead of naming one.
|
||||
|
||||
`test/programs/res-leaks.flan` runs all of it against a stub package with its own C — field writes before an unload, a
|
||||
pointerless struct keyed by its id, a re-key, the clipboard override, a consumed mesh, a nested load, 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
108
examples/core-2d-camera-mouse-zoom.flan
Normal 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)))))
|
||||
@ -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)
|
||||
|
||||
169
lib/check.ml
169
lib/check.ml
@ -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.
|
||||
@ -3338,6 +3343,142 @@ let given_once ~noun ?(known = fun _ _ -> ()) kvs =
|
||||
kvs;
|
||||
seen
|
||||
|
||||
(* ── Counting a library's resources ─────────────────────────────────
|
||||
|
||||
[Shim.resources] says which bindings acquire, release or change a resource
|
||||
in place. The generated wrapper of each one carries [%res-acquire],
|
||||
[%res-release] and [%res-done] forms over its own locals — names the reader
|
||||
cannot produce, so no program can write them — and the call site opens the
|
||||
note with where it is. The runtime pairs the two by the binding's name.
|
||||
|
||||
A resource is known by one field, not by its whole value: a program sets
|
||||
[looping] on a Music or the [transform] of a Model and still unloads the
|
||||
same resource. The field is the first pointer in the struct, depth first —
|
||||
an Image's pixels, a Sound's audio buffer, a Mesh's vertices, a Model's
|
||||
meshes — and, in a struct that holds no pointer, a field named [id], which
|
||||
is how a Texture2D or a RenderTexture2D names its GPU object. A struct with
|
||||
neither is keyed by every leaf field, hashed separately so padding never
|
||||
reaches the key.
|
||||
|
||||
Every note is a [flan_dev_reg_note_] call. A release build drops that
|
||||
family before building its arguments, and none of the notes binds a slot,
|
||||
so what a release build emits is exactly what it emitted before the notes
|
||||
existed. *)
|
||||
let res_field env (t : Types.t) : int list option =
|
||||
let fields n =
|
||||
match Hashtbl.find_opt env.structs n with
|
||||
| Some s -> s.Tast.fields
|
||||
| None -> []
|
||||
in
|
||||
let rec first_ptr t =
|
||||
match t with
|
||||
| Types.Named n when Hashtbl.mem env.structs n ->
|
||||
List.find_map
|
||||
(fun (i, (f : Tast.field)) ->
|
||||
match f.Tast.fty with
|
||||
| Types.Ptr _ -> Some [ i ]
|
||||
| ft -> Option.map (fun p -> i :: p) (first_ptr ft))
|
||||
(List.mapi (fun i f -> (i, f)) (fields n))
|
||||
| _ -> None
|
||||
in
|
||||
match first_ptr t with
|
||||
| Some p -> Some p
|
||||
| None ->
|
||||
(match t with
|
||||
| Types.Named n ->
|
||||
List.find_map
|
||||
(fun (i, (f : Tast.field)) ->
|
||||
if String.equal f.Tast.fname "id" then Some [ i ] else None)
|
||||
(List.mapi (fun i f -> (i, f)) (fields n))
|
||||
| _ -> None)
|
||||
|
||||
let rec res_hash 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_hash 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 res_key loc env (e : Tast.expr) : Tast.expr =
|
||||
match res_field env e.Tast.ty with
|
||||
| None -> res_hash loc env e
|
||||
| Some path ->
|
||||
let leaf =
|
||||
List.fold_left
|
||||
(fun (x : Tast.expr) i ->
|
||||
match x.Tast.ty with
|
||||
| Types.Named n ->
|
||||
let f = List.nth (Hashtbl.find env.structs n).Tast.fields i in
|
||||
mk loc f.Tast.fty (Tast.Field (x, i))
|
||||
| _ -> x)
|
||||
e path
|
||||
in
|
||||
res_hash loc env leaf
|
||||
|
||||
(* An argument that can be evaluated a second time and mean the same thing:
|
||||
a name, or the address of one or of a field of one. The in-place re-key
|
||||
reads its argument before and after the call, and anything with an effect
|
||||
in it is not re-keyed. *)
|
||||
let rec res_pure (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Local _ | Tast.Global _ -> true
|
||||
| Tast.Field (x, _) -> res_pure x
|
||||
| Tast.Addr p | Tast.Prim (Tast.AddrOf, [ { Tast.e = Tast.Addr p; _ } ]) ->
|
||||
res_place p
|
||||
| Tast.Prim (Tast.AddrOf, [ x ]) -> res_pure x
|
||||
| _ -> false
|
||||
|
||||
and res_place (p : Tast.place) =
|
||||
match p with
|
||||
| Tast.Plocal _ | Tast.Pglobal _ -> true
|
||||
| Tast.Pfield (t, _) -> res_pure t
|
||||
| _ -> false
|
||||
|
||||
let tracked_call loc env name (tr : Shim.track) ret (args : Tast.expr list) =
|
||||
let str x = mk loc Types.String (Tast.Str x) in
|
||||
let call = mk loc ret (Tast.Call (name, args)) in
|
||||
let opened =
|
||||
if tr.Shim.acquire || tr.Shim.releases <> [] then
|
||||
[ rt loc Types.Unit "flan_dev_reg_note_res_site" [ str name; here loc ] ]
|
||||
else []
|
||||
in
|
||||
let rekeyed =
|
||||
if ret <> Types.Unit then []
|
||||
else
|
||||
List.filter_map
|
||||
(fun i ->
|
||||
match List.nth_opt args i with
|
||||
| Some ({ Tast.ty = Types.Ptr t; _ } as p) when res_pure 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
|
||||
match opened @ before, after with
|
||||
| [], [] -> call
|
||||
| pre, post -> mk loc ret (Tast.Do (pre @ [ call ] @ post))
|
||||
|
||||
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
|
||||
@ -6318,6 +6459,29 @@ and indexed ?place ctx (target : Tast.expr) (idx : Ast.expr list) =
|
||||
|
||||
and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) =
|
||||
match head.Ast.e with
|
||||
(* The resource notes [Shim] writes into a tracked binding's wrapper; see
|
||||
[res_key]. The reader never produces a name beginning with '%'. *)
|
||||
| Ast.Var (("%res-acquire" | "%res-release") as which) ->
|
||||
(match args with
|
||||
| [ v; { Ast.e = Ast.Str owner; _ } ] ->
|
||||
let v = check ctx v in
|
||||
let sym =
|
||||
if which = "%res-acquire" then "flan_dev_reg_note_res_acquire"
|
||||
else "flan_dev_reg_note_res_release"
|
||||
in
|
||||
expect ctx loc ~want
|
||||
(rt loc Types.Unit sym
|
||||
[ res_key loc ctx.env v;
|
||||
mk loc Types.String (Tast.Str (Types.to_string v.Tast.ty));
|
||||
mk loc Types.String (Tast.Str owner) ])
|
||||
| _ -> fail loc "internal: %s takes a local and a name — a compiler bug" which)
|
||||
| Ast.Var "%res-done" ->
|
||||
(match args with
|
||||
| [ { Ast.e = Ast.Str owner; _ } ] ->
|
||||
expect ctx loc ~want
|
||||
(rt loc Types.Unit "flan_dev_reg_note_res_done"
|
||||
[ mk loc Types.String (Tast.Str owner) ])
|
||||
| _ -> fail loc "internal: %%res-done takes a name — a compiler bug")
|
||||
| Ast.Var name -> named_call ctx ~want loc name args
|
||||
(* A computed head: ((choose k) 3). The head is an ordinary expression and
|
||||
the only thing asked of it is that it be a function. *)
|
||||
@ -9187,7 +9351,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 loc ctx.env name tr 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
|
||||
@ -12389,6 +12555,7 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -4535,6 +4535,12 @@ 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 void @flan_dev_reg_note_res_site(ptr, i64, ptr, i64)
|
||||
declare void @flan_dev_reg_note_res_done(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)
|
||||
|
||||
267
lib/shim.ml
267
lib/shim.ml
@ -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";
|
||||
@ -495,6 +552,131 @@ let typedefs env needed =
|
||||
List.iter define all;
|
||||
Buffer.contents b
|
||||
|
||||
(* ── 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.
|
||||
|
||||
Which bindings are tracked is read off the declarations, by the naming
|
||||
convention raylib keeps throughout:
|
||||
|
||||
- a struct type is a resource when a declare-c whose C symbol begins with
|
||||
[Unload] takes one of it and nothing else. 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. [owned_gets] names the [Get] calls that do hand
|
||||
the caller a new one.
|
||||
- [consumes] names the calls that take a resource over, so the caller no
|
||||
longer releases it: the argument counts as released at that call.
|
||||
- a declare-c taking a [(Ptr T)] to a resource struct and returning nothing
|
||||
may change it in place — ImageFormat reallocates an image's pixels — so
|
||||
the key it had before the call is moved to the key it has after.
|
||||
|
||||
Pointers are not resources: raylib returns bare buffers from calls whose
|
||||
pairs are not named the same way (CompressData is freed with MemFree), and
|
||||
a rule that half-fits them would report leaks that are not there.
|
||||
|
||||
A library that names its pairs some other way is not tracked, and nothing
|
||||
is reported about it.
|
||||
|
||||
The notes go in two places. The generated Flan wrapper — which every
|
||||
tracked binding has, since each one passes or returns a struct — notes the
|
||||
acquisition or the release, because only there are the values in named
|
||||
locals. The call site, in [Check], says where the call is, because only it
|
||||
knows. Every note is a [flan_dev_reg_note_] call, which a release build
|
||||
drops before building its arguments, so a release build's code is what it
|
||||
was before any of this existed. *)
|
||||
|
||||
type track = {
|
||||
acquire : bool; (* the result is a new resource *)
|
||||
releases : int list; (* these arguments stop being the caller's *)
|
||||
rekey : int list; (* these (Ptr T) arguments may be changed in place *)
|
||||
}
|
||||
|
||||
let prefixed p s =
|
||||
String.length s >= String.length p && String.sub s 0 (String.length p) = p
|
||||
|
||||
(* raylib 5.5 builds the clipboard image with LoadImageFromMemory and hands it
|
||||
over (rcore_desktop_glfw.c); it is the one [Get] that is a load. *)
|
||||
let owned_gets = [ "GetClipboardImage" ]
|
||||
|
||||
(* The model owns the mesh from here on: UnloadModel frees model.meshes, and
|
||||
the mesh is model.meshes[0] (rmodels.c). No other raylib 5.5 call that
|
||||
takes a resource by value keeps it — LoadTextureFromImage,
|
||||
LoadSoundFromWave and LoadFontFromImage copy what they need and leave the
|
||||
argument to the caller. *)
|
||||
let consumes = [ ("LoadModelFromMesh", [ 0 ]) ]
|
||||
|
||||
let resources (decls : Ast.decl list) : (string * track) list =
|
||||
let env = scan decls in
|
||||
let struct_name (t : Ast.texpr) =
|
||||
match (unalias env t).Ast.t with
|
||||
| Ast.Tname n when Hashtbl.mem env.structs n -> Some n
|
||||
| _ -> None
|
||||
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 ->
|
||||
Option.iter (fun n -> Hashtbl.replace released n ()) (struct_name p.Ast.fty)
|
||||
| _ -> ())
|
||||
decl_cs;
|
||||
let resource t =
|
||||
match struct_name t with Some n -> Hashtbl.mem released n | None -> false
|
||||
in
|
||||
List.filter_map
|
||||
(fun ((fn : Ast.fn), csym) ->
|
||||
let unload = prefixed "Unload" csym in
|
||||
let releases =
|
||||
if unload then
|
||||
(match fn.Ast.params with
|
||||
| [ p ] when resource p.Ast.fty -> [ 0 ]
|
||||
| _ -> [])
|
||||
else
|
||||
match List.assoc_opt csym consumes with
|
||||
| Some is ->
|
||||
List.filter
|
||||
(fun i ->
|
||||
match List.nth_opt fn.Ast.params i with
|
||||
| Some p -> resource p.Ast.fty
|
||||
| None -> false)
|
||||
is
|
||||
| None -> []
|
||||
in
|
||||
let acquire =
|
||||
(not unload)
|
||||
&& ((not (prefixed "Get" csym)) || List.mem csym owned_gets)
|
||||
&& (match fn.Ast.ret with Some t -> resource t | None -> false)
|
||||
in
|
||||
let rekey =
|
||||
if unload || fn.Ast.ret <> None then []
|
||||
else
|
||||
List.concat
|
||||
(List.mapi
|
||||
(fun i (p : Ast.field) ->
|
||||
match (unalias env p.Ast.fty).Ast.t with
|
||||
| Ast.Tapp ("Ptr", [ e ]) when resource e -> [ i ]
|
||||
| _ -> [])
|
||||
fn.Ast.params)
|
||||
in
|
||||
if acquire || releases <> [] || rekey <> [] then
|
||||
Some (fn.Ast.name, { acquire; releases; rekey })
|
||||
else None)
|
||||
decl_cs
|
||||
|
||||
(* ── The Flan halves ────────────────────────────────────────────────── *)
|
||||
|
||||
let ty loc t = { Ast.t; tloc = loc }
|
||||
@ -525,13 +707,21 @@ 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
|
||||
struct argument into a local — a parameter is not an assignable place, so
|
||||
there is no address to take without one — and, when C returns a struct,
|
||||
zeroes one and hands over its address. *)
|
||||
let flan_wrapper (fn : Ast.fn) (s : shim) raw : Ast.decl_kind =
|
||||
let flan_wrapper ?track (fn : Ast.fn) (s : shim) raw : Ast.decl_kind =
|
||||
let loc = fn.Ast.nloc in
|
||||
let binds = ref [] in
|
||||
let args =
|
||||
@ -563,13 +753,56 @@ 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
|
||||
(* The resource notes, when this binding is tracked: each released argument
|
||||
before the call, the acquired result after it, and the note that closes
|
||||
the call site [Check] opened. They read the locals the wrapper already
|
||||
binds and bind none of their own. *)
|
||||
let body =
|
||||
match track with
|
||||
| None -> body
|
||||
| Some tr ->
|
||||
let note f xs = ex loc (Ast.Call (ex loc (Ast.Var f), xs)) in
|
||||
let name = ex loc (Ast.Str fn.Ast.name) in
|
||||
let released =
|
||||
List.map (fun i -> note "%res-release" [ ex loc (Ast.Var (tmp i)); name ])
|
||||
tr.releases
|
||||
in
|
||||
let acquired =
|
||||
match s.sret with
|
||||
| `Struct _ when tr.acquire ->
|
||||
[ note "%res-acquire" [ ex loc (Ast.Var out_tmp); name ] ]
|
||||
| _ -> []
|
||||
in
|
||||
let fin = acquired @ [ note "%res-done" [ name ] ] in
|
||||
(match s.sret, List.rev body with
|
||||
| `Struct _, value :: rest -> released @ List.rev rest @ fin @ [ value ]
|
||||
| _ -> released @ body @ fin)
|
||||
in
|
||||
Ast.Defn { fn with Ast.ret; fbody = [ ex loc (Ast.Let (!binds, body)) ] }
|
||||
|
||||
(* ── Expansion ──────────────────────────────────────────────────────── *)
|
||||
|
||||
let one env ~taken (fn : Ast.fn) csym loc =
|
||||
let one env ~taken ~tracks (fn : Ast.fn) csym loc =
|
||||
let needed = ref [] in
|
||||
let sargs =
|
||||
List.map
|
||||
@ -587,6 +820,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 +835,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
|
||||
@ -616,7 +850,9 @@ let one env ~taken (fn : Ast.fn) csym loc =
|
||||
"the declare-c of %s needs the name %s for the declaration it \
|
||||
generates, and %s is declared already — rename one of them"
|
||||
fn.Ast.name raw raw
|
||||
else [ Ast.Declare (flattened fn s raw, s.swrap); flan_wrapper fn s raw ]
|
||||
else
|
||||
[ Ast.Declare (flattened fn s raw, s.swrap);
|
||||
flan_wrapper ?track:(List.assoc_opt fn.Ast.name tracks) fn s raw ]
|
||||
else [ Ast.Declare (flattened fn s fn.Ast.name, s.swrap) ]
|
||||
in
|
||||
(decls, s, !needed)
|
||||
@ -642,6 +878,7 @@ let expand (decls : Ast.decl list) : Ast.decl list * (string * string) list =
|
||||
| Some n -> Hashtbl.replace taken n d.Ast.dloc
|
||||
| None -> ())
|
||||
decls;
|
||||
let tracks = resources decls in
|
||||
let shims = ref [] in
|
||||
let needed = ref [] in
|
||||
let out =
|
||||
@ -649,7 +886,7 @@ let expand (decls : Ast.decl list) : Ast.decl list * (string * string) list =
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.DeclareC (fn, csym) ->
|
||||
let ds, s, n = one env ~taken fn csym d.Ast.dloc in
|
||||
let ds, s, n = one env ~taken ~tracks fn csym d.Ast.dloc in
|
||||
shims := !shims @ [ s ];
|
||||
List.iter
|
||||
(fun x -> if not (List.mem x !needed) then needed := !needed @ [ x ])
|
||||
@ -679,6 +916,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. *)
|
||||
|
||||
@ -1910,6 +1910,250 @@ 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 and writes notes into their wrappers; lib/check.ml opens
|
||||
* each call to one with where it is. This is the table they keep.
|
||||
*
|
||||
* An entry is one acquisition not yet released: the resource's key — a hash of
|
||||
* its identifying field, computed by the compiler — 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 off unless
|
||||
* FLAN_DEV_LEAKS is set, the same switch as the block report above, and like
|
||||
* that one 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 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;
|
||||
if (getenv("FLAN_DEV_LEAKS") != NULL) 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;
|
||||
}
|
||||
|
||||
/* ── Where the call is ──
|
||||
*
|
||||
* The call site opens a note with the binding's name and its location, and
|
||||
* the wrapper's notes read it and close it. A stack, because a tracked call
|
||||
* can sit in the arguments of another — (load-texture-from-image
|
||||
* (gen-image-color ...)) opens the outer site, then the inner one, and the
|
||||
* inner wrapper runs and closes first. The wrapper names itself, so a site is
|
||||
* only used by the call it was opened for; a wrapper reached through a
|
||||
* function value opened none, finds a different name on top, and says it does
|
||||
* not know where it was called from. A transfer out of a wrapper leaves its
|
||||
* entry behind, under whatever is pushed next, which is why the depth is
|
||||
* bounded and the oldest entry is the one dropped. */
|
||||
#define FLAN_RES_SITES 64
|
||||
static struct { const char *name; int64_t namelen; const char *site;
|
||||
int64_t sitelen; } flan_res_sites[FLAN_RES_SITES];
|
||||
static int flan_res_nsites;
|
||||
|
||||
void flan_dev_reg_note_res_site(const char *name, int64_t namelen,
|
||||
const char *site, int64_t sitelen) {
|
||||
if (flan_res_nsites == FLAN_RES_SITES) {
|
||||
memmove(&flan_res_sites[0], &flan_res_sites[1],
|
||||
(FLAN_RES_SITES - 1) * sizeof flan_res_sites[0]);
|
||||
flan_res_nsites--;
|
||||
}
|
||||
flan_res_sites[flan_res_nsites].name = name;
|
||||
flan_res_sites[flan_res_nsites].namelen = namelen;
|
||||
flan_res_sites[flan_res_nsites].site = site;
|
||||
flan_res_sites[flan_res_nsites].sitelen = sitelen;
|
||||
flan_res_nsites++;
|
||||
}
|
||||
|
||||
static int flan_res_top_is(const char *name, int64_t namelen) {
|
||||
return flan_res_nsites > 0
|
||||
&& flan_res_same(flan_res_sites[flan_res_nsites - 1].name,
|
||||
flan_res_sites[flan_res_nsites - 1].namelen, name,
|
||||
namelen);
|
||||
}
|
||||
|
||||
static const char flan_res_unknown[] = "a call through a function value";
|
||||
|
||||
static void flan_res_site_of(const char *name, int64_t namelen,
|
||||
const char **site, int64_t *sitelen) {
|
||||
if (flan_res_top_is(name, namelen)) {
|
||||
*site = flan_res_sites[flan_res_nsites - 1].site;
|
||||
*sitelen = flan_res_sites[flan_res_nsites - 1].sitelen;
|
||||
} else {
|
||||
*site = flan_res_unknown;
|
||||
*sitelen = (int64_t)(sizeof flan_res_unknown - 1);
|
||||
}
|
||||
}
|
||||
|
||||
void flan_dev_reg_note_res_done(const char *name, int64_t namelen) {
|
||||
if (flan_res_top_is(name, namelen)) flan_res_nsites--;
|
||||
}
|
||||
|
||||
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 *name,
|
||||
int64_t namelen) {
|
||||
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->count = 1;
|
||||
flan_res_site_of(name, namelen, &e->site, &e->sitelen);
|
||||
}
|
||||
|
||||
void flan_dev_reg_note_res_release(uint64_t key, const char *type,
|
||||
int64_t typelen, const char *name,
|
||||
int64_t namelen) {
|
||||
int64_t i;
|
||||
flan_res_entry *e;
|
||||
const char *site;
|
||||
int64_t sitelen;
|
||||
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;
|
||||
}
|
||||
}
|
||||
flan_res_site_of(name, namelen, &site, &sitelen);
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
33
test/programs/cstr-return.flan
Normal 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
25
test/programs/pkgs/cret/cret.c
Normal 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
5
test/programs/pkgs/cret/cret.flan
Normal 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")
|
||||
69
test/programs/pkgs/res/res.c
Normal file
69
test/programs/pkgs/res/res.c
Normal file
@ -0,0 +1,69 @@
|
||||
/* A stand-in for a library that hands out resources the way raylib does, for
|
||||
* programs/res-leaks.flan. Nothing here needs a window or a library
|
||||
* installed. Two names are raylib's own — GetClipboardImage and
|
||||
* LoadModelFromMesh — because the tracker knows those two by name: the first
|
||||
* is a Get that hands the caller a new resource, the second takes its
|
||||
* argument over.
|
||||
*
|
||||
* Thing has padding after `flag`, and its pointer is what identifies it. Tex
|
||||
* holds no pointer, so its `id` does, as a GPU handle would. */
|
||||
|
||||
#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;
|
||||
}
|
||||
|
||||
/* A Get that hands over a new one. */
|
||||
Thing GetClipboardImage(void) { return LoadThing(99); }
|
||||
|
||||
typedef struct { uint32_t id; int32_t width; } Tex;
|
||||
|
||||
static uint32_t next_tex = 1;
|
||||
Tex LoadTex(int32_t width) { Tex t = { next_tex++, width }; return t; }
|
||||
void UnloadTex(Tex t) { (void)t; }
|
||||
|
||||
typedef struct { int32_t n; float *v; } Mesh;
|
||||
typedef struct { int32_t count; Mesh *meshes; } Model;
|
||||
|
||||
Mesh GenMeshThing(void) { Mesh m = { 3, calloc(3, sizeof(float)) }; return m; }
|
||||
void UnloadMesh(Mesh m) { free(m.v); }
|
||||
|
||||
Model LoadModelFromMesh(Mesh m) {
|
||||
Model o = { 1, malloc(sizeof(Mesh)) };
|
||||
o.meshes[0] = m;
|
||||
return o;
|
||||
}
|
||||
|
||||
void UnloadModel(Model o) {
|
||||
for (int32_t i = 0; i < o.count; i++) UnloadMesh(o.meshes[i]);
|
||||
free(o.meshes);
|
||||
}
|
||||
|
||||
/* A bare buffer, freed by a call not named for it: not a resource. */
|
||||
unsigned char *LoadBytes(int32_t n) { return (unsigned char *)malloc((size_t)n); }
|
||||
void UnloadBytes(unsigned char *p) { free(p); }
|
||||
21
test/programs/pkgs/res/res.flan
Normal file
21
test/programs/pkgs/res/res.flan
Normal file
@ -0,0 +1,21 @@
|
||||
;;;; 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)])
|
||||
(defstruct Tex [id u32 width i32])
|
||||
(defstruct Mesh [n i32 v (Ptr f32)])
|
||||
(defstruct Model [count i32 meshes (Ptr Mesh)])
|
||||
|
||||
(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 get-clipboard-image [] Thing "GetClipboardImage")
|
||||
(declare-c load-tex [width i32] Tex "LoadTex")
|
||||
(declare-c unload-tex [t Tex] "UnloadTex")
|
||||
(declare-c gen-mesh-thing [] Mesh "GenMeshThing")
|
||||
(declare-c unload-mesh [m Mesh] "UnloadMesh")
|
||||
(declare-c load-model-from-mesh [m Mesh] Model "LoadModelFromMesh")
|
||||
(declare-c unload-model [o Model] "UnloadModel")
|
||||
(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
40
test/programs/raylib-strings.flan
Normal 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)
|
||||
40
test/programs/res-leaks.flan
Normal file
40
test/programs/res-leaks.flan
Normal file
@ -0,0 +1,40 @@
|
||||
;;;; 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.
|
||||
;;;;
|
||||
;;;; Released, and so not reported: a, whose fields other than its pointer are
|
||||
;;;; set before it is unloaded; b, changed in place by thing-grow; tx, a
|
||||
;;;; pointerless Tex known by its id, whose width is set; the model, which took
|
||||
;;;; the mesh over, with its count set and set back; and the buffers, which are
|
||||
;;;; not resources. Reported: c, loaded and never unloaded; the clipboard Thing,
|
||||
;;;; a Get that hands over a new one; on the last line, a Tex loaded inside
|
||||
;;;; the arguments of a Thing's load, each named by its own column; and the
|
||||
;;;; unload of the library's own Thing, which nothing loaded.
|
||||
;;;;
|
||||
;;;; The report is off unless FLAN_DEV_LEAKS is set, and a release build has
|
||||
;;;; nothing to report either way.
|
||||
(import res "pkgs/res")
|
||||
|
||||
(defn main [] i32
|
||||
(let [a (res/load-thing 1)
|
||||
b (res/load-thing 2)
|
||||
c (res/load-thing 3)
|
||||
tx (res/load-tex 8)
|
||||
clip (res/get-clipboard-image)
|
||||
m (res/load-model-from-mesh (res/gen-mesh-thing))
|
||||
p (res/load-bytes 8)]
|
||||
(set (.w a) 9.0)
|
||||
(set (.flag a) 0)
|
||||
(set (.id a) 7)
|
||||
(res/thing-grow (addr b))
|
||||
(set (.width tx) 99)
|
||||
(set (.count m) 0)
|
||||
(set (.count m) 1)
|
||||
(res/unload-thing a)
|
||||
(res/unload-thing b)
|
||||
(res/unload-tex tx)
|
||||
(res/unload-model m)
|
||||
(res/unload-bytes p)
|
||||
(res/unload-thing (res/get-default-thing))
|
||||
(println (.id (res/load-thing (.width (res/load-tex 5)))))
|
||||
(println "done"))
|
||||
0)
|
||||
@ -921,6 +921,60 @@ 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, one that
|
||||
must, a call that changes a resource in place and one that takes its
|
||||
argument over — so this runs with no library installed and through the
|
||||
same generated wrappers raylib's bindings use. The program says what is
|
||||
released and what is reported. The report is behind FLAN_DEV_LEAKS, so
|
||||
the same dev build prints nothing without it; a release build has no
|
||||
notes at all. *)
|
||||
let res_dev_out =
|
||||
"5\ndone\n\
|
||||
flan: 4 resources still held at exit, loaded and never unloaded:\n\
|
||||
flan: 1 res/Thing, loaded at programs/res-leaks.flan:20:11\n\
|
||||
flan: 1 res/Thing, loaded at programs/res-leaks.flan:22:14\n\
|
||||
flan: 1 res/Tex, loaded at programs/res-leaks.flan:38:43\n\
|
||||
flan: 1 res/Thing, loaded at programs/res-leaks.flan:38:19\n\
|
||||
flan: res/Thing released 1 time at programs/res-leaks.flan:37:5 with \
|
||||
nothing loaded to match\n"
|
||||
in
|
||||
let leaks_run ?(x86 = false) ~dev ~env name expected =
|
||||
let exe = compile ~dev ~x86 "programs/res-leaks.flan" in
|
||||
let out = exe ^ ".out" in
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf "%s%s > %s 2>&1"
|
||||
(if env then "FLAN_DEV_LEAKS=1 " else "")
|
||||
(Filename.quote exe) (Filename.quote out))
|
||||
in
|
||||
let text = In_channel.with_open_bin out In_channel.input_all in
|
||||
(try Sys.remove out; Sys.remove exe with Sys_error _ -> ());
|
||||
if code <> 0 || text <> expected then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n"
|
||||
name text code expected
|
||||
end
|
||||
in
|
||||
leaks_run ~dev:false ~env:true "library resources: a release build counts nothing"
|
||||
"5\ndone\n";
|
||||
leaks_run ~dev:true ~env:false
|
||||
"library resources: no report without FLAN_DEV_LEAKS" "5\ndone\n";
|
||||
leaks_run ~dev:true ~env:true
|
||||
"library resources: a dev build reports what is held" res_dev_out;
|
||||
leaks_run ~x86:true ~dev:true ~env:true
|
||||
"library resources: a dev build reports what is held, x86" 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. *)
|
||||
@ -2131,6 +2185,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
|
||||
@ -3904,9 +3987,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";
|
||||
|
||||
@ -4348,6 +4348,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 =
|
||||
@ -4357,7 +4360,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";
|
||||
@ -5001,6 +5004,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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
1
vendor/raylib/bindings
vendored
@ -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
51
vendor/raylib/generated.flan
vendored
@ -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
101
vendor/raylib/raylib.flan
vendored
@ -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
9
vendor/rlgl/bindings
vendored
Normal 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
4
vendor/rlgl/headers
vendored
Normal 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
7
vendor/rlgl/link
vendored
Normal 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
5262
vendor/rlgl/rlgl-5.5.h
vendored
Normal file
File diff suppressed because it is too large
Load Diff
33
vendor/rlgl/rlgl.flan
vendored
Normal file
33
vendor/rlgl/rlgl.flan
vendored
Normal 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")
|
||||
Loading…
x
Reference in New Issue
Block a user