diff --git a/NEXT.md b/NEXT.md index a131af4..74b256a 100644 --- a/NEXT.md +++ b/NEXT.md @@ -56,9 +56,10 @@ question 4 seriously now that there are two backends that can disagree. - ~~**Finish the macro branch**~~ — done. Macros are importable from a package, qualified like a `defn`, and the suite is green. Its customer, `with-drawing`/`with-mode-2d`, is now unblocked and - still unwritten. -- **`slice-from-ptr`** — queued below. Blocks three raylib examples and leaves the hand-written `Font` - surface with no example caller. + being written. +- ~~**`slice-from-ptr`**~~ — **built**. `examples/text-rectangle-bounds.flan` is the port it unblocked, + and the first example to call the hand-written `Font` surface. The other two it named — + `text_codepoints_loading` and `textures_image_processing` — are now ordinary porting work. - **`merged_serve`'s 10s warning path** (`lib/dev.ml:2322-2326`), the last item in `HANDOFF-f1.md`. - **The memcheck half of the registry** — `VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`. The registry answer and the memcheck answer are different tools and must not be blurred. @@ -145,7 +146,39 @@ the Emacs side". **Superseded** — the registry lane built that properly. Delet fits in `defvar` globals, nothing is move-only, and generics is off its critical path. Tier 0 and Tier 1 items 4, 5 and 6 are all done. Nothing blocks writing it. -## Queued: a pointer from C needs a length before it can be indexed +## Landed: a pointer from C needs a length before it can be indexed + +> **Built, 2026-09-13.** `(slice-from-ptr p n)` is in `lib/check.ml`, `Tast.SliceFromPtr` in `lib/tast.ml`, one +> `insertvalue` pair in `lib/emit.ml`. The section is kept as it was written, because the reasoning is the part +> worth having; what was built and what it refuses is in this box. + +**Option 1, and only option 1.** The reasoning below still holds: option 2 cannot reach `font.recs`, where the count +is a sibling *field*, so option 1 was the floor and turned out to be the whole thing. + +**No marker on the name.** A `!` in this language means *mutates* (`map-next!`) and a `?` means *asks* +(`font-valid?`); this does neither, and `zeroed` — the nearest neighbour, a value conjured rather than derived — +carries no marker either. `ptr` is the marker: a `(Ptr T)` only ever arrives from a `declare-c`. + +**Nothing new in the representation.** A `Types.Slice` is `{ptr, i64}` in `emit.ml` and in `x86.ml` already, which +is exactly ptr+len, so the form is two `insertvalue`s and no layout change. `x86.ml`'s `_ -> unsupported` arm takes +the new constructor without an edit. + +**What it refuses.** A first argument that is not a `(Ptr T)`; a negative literal length, at check time; a negative +computed length, at run time, through `signal_block` and `@flan_slice_error` — reusing that message rather than +growing the runtime a function, because the violated condition is `0 <= n`, which is a reversed range spelled the +other way. The run-time test is *signed* on purpose: `check_slice`'s comparisons are unsigned and a negative i32 +sign-extended to i64 walks straight through them. It is behind `f.md.checks` like the other two, so it is on at -O0 +and -O2 alike and off only when checks as a whole were asked off. + +**It owns nothing, and needed no analysis to say so.** The result is a `Types.Slice`, which is not move-only and +carries no allocator, so `free` refuses it by the rule it already had — the same rule that refuses `(as-slice v)`. + +**Where the promise is written.** `rl/font-recs` and `rl/font-glyphs` in `vendor/raylib/raylib.flan`, because that +is the one place raylib's invariant (both arrays hold `glyph-count` entries) is knowable. `examples/text-rectangle-bounds.flan` +is the port that motivated all of it and it runs; `test/programs/slice-from-ptr.flan` covers the form with no +raylib, no window and no C. + +### The reasoning, as it was written **Sequenced after the generics lane**, which holds `lib/check.ml`. diff --git a/examples/text-rectangle-bounds.flan b/examples/text-rectangle-bounds.flan new file mode 100644 index 0000000..25e4da0 --- /dev/null +++ b/examples/text-rectangle-bounds.flan @@ -0,0 +1,244 @@ +;;;; raylib [text] example - Rectangle bounds +;;;; +;;;; examples/text/text_rectangle_bounds.c. This is the example that could not +;;;; be ported at all until `slice-from-ptr` existed, and it is the reason the +;;;; form was built rather than an application found for it afterwards. +;;;; +;;;; Its inner loop reads `font.recs[index]` and `font.glyphs[index]`. Both +;;;; fields are `(Ptr T)` — that is what raylib hands back and there is nothing +;;;; else it could hand back — and a pointer from C carries no length, so +;;;; `(at (.recs font) i)` answered `(Ptr rl/Rectangle) cannot be indexed` and +;;;; the whole example stopped there. Element 0 through `deref` was the entire +;;;; readable surface of a two-hundred-glyph array. +;;;; +;;;; The count is not missing; it is in the struct, one field over, as +;;;; `glyph-count`. What was missing was a way to say so. `slice-from-ptr` is +;;;; that way, and `rl/font-recs` and `rl/font-glyphs` in the bindings are +;;;; where this example says it — once, beside the invariant, rather than at +;;;; every call site. Note which shape this is: the count is a sibling *field*, +;;;; not an out-parameter, so a per-binding declaration naming a count argument +;;;; (the alternative NEXT.md weighed) could not have reached it. +;;;; +;;;; This is also the only *procedural* font example upstream — every other one +;;;; in examples/text needs a TTF on disk — so until now the hand-written `Font` +;;;; surface (`get-font-default`, `get-glyph-index`, `draw-text-codepoint`, the +;;;; `GlyphInfo` and `Font` structs) had no example that called it. +;;;; +;;;; Two departures from the C, both deliberate: +;;;; +;;;; - `DrawTextBoxedSelectable` is not ported. The C defines it and then calls +;;;; it from `DrawTextBoxed` with `selectStart = 0`, `selectLength = 0` and +;;;; two `WHITE`s, so the selection half is dead code in this example: no +;;;; glyph is ever selected and no selection background is ever drawn. With +;;;; it goes the `k`/`lastk` pair, which exists only to keep a *codepoint* +;;;; index for the selection while `i` walks bytes. What is left is the word +;;;; wrap, which is the thing the example is about. +;;;; +;;;; - `GetCodepoint` wants a pointer into the middle of the text, and Flan has +;;;; the operation the C is spelling by hand: `(string (slice b i n))` is the +;;;; tail from `i` with no copy and no pointer arithmetic. It is not free: +;;;; the shim NUL-terminates a copy on the way into C, into a 256-byte stack +;;;; buffer or a malloc when the tail is longer — and this message is 284 +;;;; bytes, so the first thirty glyphs of each pass do allocate. Fine for one +;;;; string drawn once a frame; worth knowing before reaching for the same +;;;; shape in a hot loop. + +(import rl "vendor:raylib") + +(defconst screen-width 800) +(defconst screen-height 450) + +(defconst message + "Text cannot escape\tthis container\t...word wrap also works when active so here's a long text for testing.\n\nLorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Nec ullamcorper sit amet risus nullam eget felis eget.") + +;; The two halves of the wrap state machine. wordWrap on starts in `measure`, +;; which finds where the line has to break and then replays the same bytes in +;; `draw`; wordWrap off never leaves `draw`. +(defconst measure 0) +(defconst draw 1) + +;; Draw `text` inside `rec`, breaking lines on words when `word-wrap?`. +;; +;; The two `slice-from-ptr` uses are inside rl/font-recs and rl/font-glyphs; +;; from here they are ordinary slices, bounds-checked like any other, and the +;; index comes from raylib's own get-glyph-index so it is in range by +;; construction. +(defn draw-text-boxed [font rl/Font text [u8] rec rl/Rectangle + font-size f32 spacing f32 word-wrap? bool + tint rl/Color] () + (let [glyphs (rl/font-glyphs font) + recs (rl/font-recs font) + length (i32 (len text)) + scale (/ font-size (f32 (.base-size font))) + line-h (* (f32 (+ (.base-size font) (/ (.base-size font) 2))) scale) + off-x (f32 0.0) + off-y (f32 0.0) + state (if word-wrap? measure draw) + ;; Byte offsets: where the current line begins and where it must end. + ;; -1 is "not decided yet", which is why end-line is compared against 1 + ;; rather than 0 below — the C's `(endLine < 1)`. + start-line -1 + end-line -1 + i 0] + (while (< i length) + (let [size 0 + cp (rl/get-codepoint (string (slice text i length)) (addr size))] + ;; A byte that decodes to nothing answers '?' and raylib would normally + ;; stop; this walks on one byte at a time so the bad bytes get drawn. + (when (= cp (i32 \?)) (set size 1)) + (set i (+ i (- size 1))) + + (let [gi (rl/get-glyph-index font cp) + w (f32 0.0)] + (when (!= cp (i32 \newline)) + ;; advance-x is how far the pen moves; 0 means "use the atlas + ;; rectangle's width instead". This is the line that needed the + ;; slices — two parallel arrays, indexed by the same glyph index. + (set w (if (= (.advance-x (at glyphs gi)) 0) + (* (.width (at recs gi)) scale) + (* (f32 (.advance-x (at glyphs gi))) scale))) + ;; Spacing is added per gap, not per glyph, so the last one on the + ;; line does not get it. + (when (< (+ i 1) length) (set w (+ w spacing)))) + + (if (= state measure) + (do + ;; Any of these three is a legal place to break. + (when (or (= cp (i32 \space)) (= cp (i32 \tab)) + (= cp (i32 \newline))) + (set end-line i)) + (cond + (> (+ off-x w) (.width rec)) + (do + (when (< end-line 1) (set end-line i)) + (when (= i end-line) (set end-line (- end-line size))) + (when (= (+ start-line size) end-line) + (set end-line (- i size))) + (set state draw)) + + (= (+ i 1) length) + (do (set end-line i) (set state draw)) + + (= cp (i32 \newline)) + (set state draw)) + ;; Having decided where the line ends, rewind to where it began + ;; and walk the same bytes again, drawing this time. + (when (= state draw) + (set off-x 0.0) + (set i start-line) + (set w 0.0))) + + (do + (if (= cp (i32 \newline)) + (when (not word-wrap?) + (set off-y (+ off-y line-h)) + (set off-x 0.0)) + (do + (when (and (not word-wrap?) (> (+ off-x w) (.width rec))) + (set off-y (+ off-y line-h)) + (set off-x 0.0)) + ;; Out of vertical room: stop, rather than drawing outside. + (when (> (+ off-y (* (f32 (.base-size font)) scale)) + (.height rec)) + (break)) + (when (and (!= cp (i32 \space)) (!= cp (i32 \tab))) + (rl/draw-text-codepoint + font cp + (rl/Vector2 {.x (+ (.x rec) off-x) + .y (+ (.y rec) off-y)}) + font-size tint)))) + (when (and word-wrap? (= i end-line)) + (set off-y (+ off-y line-h)) + (set off-x 0.0) + (set start-line end-line) + (set end-line -1) + (set w 0.0) + (set state measure)))) + + ;; Leading spaces do not push the pen along; everything else does. + (when (or (!= off-x 0.0) (!= cp (i32 \space))) + (set off-x (+ off-x w))))) + (set i (+ i 1))))) + +(defn main [] () + (rl/init-window screen-width screen-height + "raylib [text] example - draw text inside a rectangle") + (defer (rl/close-window)) + + (let [text (bytes message) + resizing? false + word-wrap? true + container (rl/Rectangle {.x 25.0 .y 25.0 + .width (- (f32 screen-width) 50.0) + .height (- (f32 screen-height) 250.0)}) + resizer (rl/Rectangle {.x 0.0 .y 0.0 .width 14.0 .height 14.0}) + min-width (f32 60.0) + min-height (f32 60.0) + max-width (- (f32 screen-width) 50.0) + max-height (- (f32 screen-height) 160.0) + last-mouse (rl/Vector2 {.x 0.0 .y 0.0}) + border rl/maroon + ;; Needs the window: the default font is loaded as part of init-window. + font (rl/get-font-default)] + + (rl/set-target-fps 60) + + (until (rl/window-should-close?) + (when (rl/key-pressed? :space) (set word-wrap? (not word-wrap?))) + + (let [mouse (rl/get-mouse-position)] + ;; The border fades while the pointer is over the container. + (cond + (rl/collision-point-rec? mouse container) + (set border (rl/fade rl/maroon 0.4)) + (not resizing?) (set border rl/maroon)) + + (if resizing? + (do + (when (rl/mouse-button-released? :left) (set resizing? false)) + (let [w (+ (.width container) (- (.x mouse) (.x last-mouse))) + h (+ (.height container) (- (.y mouse) (.y last-mouse)))] + (set (.width container) + (clamp w min-width max-width)) + (set (.height container) + (clamp h min-height max-height)))) + (when (and (rl/mouse-button-down? :left) + (rl/collision-point-rec? mouse resizer)) + (set resizing? true))) + + (set (.x resizer) (- (+ (.x container) (.width container)) 17.0)) + (set (.y resizer) (- (+ (.y container) (.height container)) 17.0)) + (set last-mouse mouse)) + + (rl/begin-drawing) + (rl/clear-background rl/raywhite) + + (rl/draw-rectangle-lines-ex container 3.0 border) + + ;; The container with a little padding, which is where the wrap runs. + (draw-text-boxed font text + (rl/Rectangle {.x (+ (.x container) 4.0) + .y (+ (.y container) 4.0) + .width (- (.width container) 4.0) + .height (- (.height container) 4.0)}) + 20.0 2.0 word-wrap? rl/gray) + + (rl/draw-rectangle-rec resizer border) + + (rl/draw-rectangle 0 (- screen-height 54) screen-width 54 rl/gray) + (rl/draw-rectangle-rec + (rl/Rectangle {.x 382.0 .y (- (f32 screen-height) 34.0) + .width 12.0 .height 12.0}) + rl/maroon) + + (rl/draw-text "Word Wrap: " 313 (- screen-height 115) 20 rl/black) + (if word-wrap? + (rl/draw-text "ON" 447 (- screen-height 115) 20 rl/red) + (rl/draw-text "OFF" 447 (- screen-height 115) 20 rl/black)) + + (rl/draw-text "Press [SPACE] to toggle word wrap" + 218 (- screen-height 86) 20 rl/gray) + (rl/draw-text "Click hold & drag the to resize the container" + 155 (- screen-height 38) 20 rl/raywhite) + + (rl/end-drawing)))) diff --git a/lib/check.ml b/lib/check.ml index 868fd85..320d99a 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4484,6 +4484,63 @@ and named_call ctx ~want loc name args = [ target; lo; hi ]) | _ -> assert false) + (* (slice-from-ptr p n) — NEXT.md, "a pointer from C needs a length before + it can be indexed". A (Ptr T) that came back from C is readable at + element 0 through [deref] and nowhere else, because [indexed] takes an + Array or a Slice and a pointer is neither. C hands back an address and no + length, so the length has to come from the caller, and this is the form + that says so out loud. + + **What the caller is promising**, and the compiler checks none of it: that + [p] really addresses [n] consecutive [T], that they are initialised, and + that they outlive every use of the result. Get it wrong and this reads + memory that is not there — the bounds check the result carries will agree + with a length that was a lie, because the length *is* the lie. It is the + same trust [declare-c] already extends, written at the one site where + somebody had to know the answer anyway. + + No marker on the name. A [!] in this language means *mutates* + ([map-next!]) and a [?] means *asks* ([font-valid?]), and this does + neither; [zeroed], the nearest neighbour — a value conjured rather than + derived — carries no marker either. [ptr] is the marker: a (Ptr T) only + ever arrives from a [declare-c], so the word already names the C boundary, + and a reader who sees it has already been told where the promise comes + from. + + **It owns nothing.** The result is a [Types.Slice], which is not + move-only, carries no allocator, and is the same non-owning view + (as-slice v) answers — so [free] refuses it by the rule it already had + ("free takes a move-only value"), and nothing in the move analysis needed + to learn about this form. *) + | "slice-from-ptr" -> + arity loc name 2 args; + (match args with + | [ target; n ] -> + let target = check ctx target in + let elem = + match target.Tast.ty with + | Types.Ptr t -> t + | other -> + fail loc + "slice-from-ptr takes a (Ptr T) and the number of elements behind \ + it, found %s. It is for a pointer that came back from C, whose \ + length only the caller knows" + (Types.to_string other) + in + let n_loc = n.Ast.loc in + let n = check ctx ~want:index_ty n in + (* A negative literal is a lie the checker can see, so it does not wait + for the run-time test emit.ml plants beside it. *) + (match literal n with + | Some k when k < 0L -> + fail n_loc + "slice-from-ptr length %Ld is negative — the length is what the \ + caller promises the pointer addresses, and no pointer addresses \ + fewer than zero elements" k + | _ -> ()); + prim Tast.SliceFromPtr (Types.Slice elem) [ target; n ] + | _ -> assert false) + (* ── pointers ──────────────────────────────────────────────────── *) | "addr" -> arity loc name 1 args; diff --git a/lib/emit.ml b/lib/emit.ml index 3b08308..6d093da 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1838,6 +1838,47 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = let b = fresh f in ins f "%s = insertvalue %%slice %s, i64 %s, 1" b a d; b + (* (slice-from-ptr p n): the two words a %slice already is, with the pointer + the caller handed over and the length the caller promised. No new + representation — a Slice _ is {ptr, i64} here and in x86.ml, which is + exactly ptr+len, so this is an insertvalue pair and no more. + + The check is the *length itself*, not a range: there is nothing to compare + it against, because the only thing that knows how many elements live + behind that pointer is the caller. So what is checked is the one half that + can be — that the promise is not absurd. It is signed, and it has to be: + [check_slice]'s comparisons are unsigned, and a negative i32 sign-extended + to i64 is a huge unsigned value that [ule] waves straight through. + + It goes through [signal_block] for the reason the other two bounds checks + do — a bad length signals BoundsError and is answerable — and behind + [f.md.checks] for the reason they are: dropping bounds checks is a release + decision, not an optimisation one, so this is on at -O0 and -O2 alike and + off only when checks as a whole were asked off. + + It reuses @flan_slice_error rather than growing the runtime a function: + the violated condition is 0 <= n, which is the same shape as a reversed + slice, so the range reported is [0 n) against a length of 0 and the + message reads "slice [0 -5) is out of bounds for length 0". *) + | Tast.SliceFromPtr, [ p; n ] -> + let pv = value f p in + let nv = value f n in + let n64 = fresh f in + ins f "%s = sext i32 %s to i64" n64 nv; + if f.md.checks then begin + let ok = fresh f in + ins f "%s = icmp sge i64 %s, 0" ok n64; + signal_block f e.Tast.loc ~guard:(fun () -> guard f) ok (fun id len -> + ins f + "call void @flan_slice_error(ptr %s, i64 %d, i64 0, i64 %s, i64 0, \ + ptr %s)" + id len n64 xfer_param) + end; + let a = fresh f in + ins f "%s = insertvalue %%slice zeroinitializer, ptr %s, 0" a pv; + let b = fresh f in + ins f "%s = insertvalue %%slice %s, i64 %s, 1" b a n64; + b (* string and [u8] have the same layout, so bytes is the identity — a view, no copy (plan.org, Milestone-2 primitives). *) | Tast.Bytes, [ x ] -> value f x diff --git a/lib/tast.ml b/lib/tast.ml index 7d6bc15..1c6085b 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -24,6 +24,12 @@ type prim = | BitAnd | BitOr | BitXor | Shl | Shr (* containers: fixed arrays and slices only at milestone 2 *) | Len | At | Slice + (* (slice-from-ptr p n): a [T] made out of a (Ptr T) and a length the caller + supplies. It builds the same two words [Slice] builds and allocates + nothing — the storage stays whoever's it was, which in practice is C's. + The one thing the compiler cannot check is whether n is the truth; see + check.ml's "slice-from-ptr" case for what it can. *) + | SliceFromPtr (* the milestone-2 host primitives, plan.org. The four conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it — that is what calc-me's tokenizer and the prelude's printers each need. *) diff --git a/test/programs/bounds.flan b/test/programs/bounds.flan index 17e0f97..def7bdd 100644 --- a/test/programs/bounds.flan +++ b/test/programs/bounds.flan @@ -26,6 +26,12 @@ (= n 7) (set (at arr n) 1) ; write past the end (= n 4) (print (slice s n 9)) ; hi past the end (= n 2) (print (slice s n 1)) ; reversed range + ;; (slice-from-ptr p n) has nothing to check n against — the caller's + ;; number is the only length there is — so what it checks is that the + ;; number is not absurd. Signed, deliberately: the comparisons the other + ;; two checks use are unsigned, and a negative i32 sign-extended to i64 + ;; is a huge unsigned value that sails straight through them. + (= n -2) (print (len (slice-from-ptr (addr (at arr 0)) n))) :else (println "?")) 0)) diff --git a/test/programs/slice-from-ptr.flan b/test/programs/slice-from-ptr.flan new file mode 100644 index 0000000..a16e9c0 --- /dev/null +++ b/test/programs/slice-from-ptr.flan @@ -0,0 +1,61 @@ +;;;; (slice-from-ptr p n) — NEXT.md, "a pointer from C needs a length before it +;;;; can be indexed". The motivating pointers come from C, but nothing about +;;;; the form does: a (Ptr T) is a (Ptr T) whoever made it, so this case makes +;;;; its own with (addr (at a 0)) and needs no library and no window. +;;;; +;;;; What is asserted, line by line: +;;;; +;;;; - the length is the one the caller stated, and (len s) answers it; +;;;; - the elements read through are the same storage, not a copy — the last +;;;; two lines write through the slice and read the array back, which is +;;;; the whole ptr+len claim; +;;;; - a shorter promise than the truth is legal and is what indexing then +;;;; believes, because the caller's number is the only length there is; +;;;; - the result is an ordinary [T]: it slices, it is passed to a function +;;;; that takes a slice, and the prelude's algorithms work on it. +;;;; +;;;; What is NOT here, and is in test_flan.ml's refusal table instead: a +;;;; negative literal length, a first argument that is not a pointer, and +;;;; (free (slice-from-ptr ...)) — a slice owns nothing, so free refuses it by +;;;; the rule it already had. + +(defvar a [5 i32]) + +(defn total [s [i32]] i32 + (let [acc 0] + (dotimes [i (len s)] + (set acc (+ acc (at s i)))) + acc)) + +(defn main [] () + (dotimes [i 5] + (set (at a i) (* (+ i 1) 10))) + + ;; The whole array, as the caller promises it: five elements behind the + ;; address of the first. + (let [s (slice-from-ptr (addr (at a 0)) 5)] + (println (len s)) ; 5 + (println (at s 0)) ; 10 + (println (at s 4)) ; 50 + (println (total s)) ; 150 + ;; An ordinary [i32] from here on: slice it, and the sub-view still points + ;; into the same storage. + (println (total (slice s 1 3)))) ; 50 + + ;; A promise shorter than the truth. Nothing complains — there is nothing to + ;; complain with — and the length the caller gave is the length indexing and + ;; the bounds check both use. + (let [s (slice-from-ptr (addr (at a 1)) 2)] + (println (len s)) ; 2 + (println (total s))) ; 50 + + ;; Zero is a length like any other. An empty slice is not a null pointer and + ;; is not an error. + (println (len (slice-from-ptr (addr (at a 0)) 0))) ; 0 + + ;; It is a view, not a copy: a write through the slice is a write to the + ;; array, and this is what would fail if the form ever grew a memcpy. + (let [s (slice-from-ptr (addr (at a 0)) 5)] + (set (at s 2) 7) + (println (at a 2)) ; 7 + (println (total s)))) ; 127 diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 8395b0b..f857bc2 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -150,6 +150,18 @@ let () = -3 -3 0 5 5 7 12\n1 2 3 4 5\n\ 100 -1 0 4 9 9 200 300\n100 -1 0 4 9 9 200 300\n" in + (* (slice-from-ptr p n) — NEXT.md, "a pointer from C needs a length before + it can be indexed". The pointers that motivated it come from C, but the + form does not care where one came from, so this case makes its own and + needs no library: what it pins is that the result is an ordinary [T] — + it has the promised length, it indexes, it slices, it passes to a + function that takes a slice — and that it is a *view*, so the last two + lines write through it and read the array back. The refusals are in + test_flan.ml and the negative-length trap is in programs/bounds.flan. *) + let sfp_out = "5\n10\n50\n150\n50\n2\n50\n0\n7\n127\n" in + outputs "slice-from-ptr" "programs/slice-from-ptr.flan" sfp_out; + outputs ~opt:"-O0" "slice-from-ptr, -O0" "programs/slice-from-ptr.flan" + sfp_out; outputs "slice algorithms" "programs/slices.flan" slices_out; outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out; (* println, one row per arm of render.ml's walk. The walk is shared with @@ -1175,6 +1187,15 @@ let () = slice of length hi - lo as a huge unsigned, which is worse. *) traps "slice with a reversed range" "2" "slice [2 1) is out of bounds for length 5"; + (* (slice-from-ptr p n) with a length that cannot be true. There is no + length to compare n against — the caller's number *is* the length — so + the only check possible is that it is not negative, and it is a signed + one: the two above are unsigned, and a negative i32 sign-extended to + i64 passes both of them. The message is @flan_slice_error's, reused + rather than growing the runtime a function: the condition violated is + 0 <= n, which is a reversed range spelled the other way. *) + traps "slice-from-ptr with a negative length" "-2" + "slice [0 -2) is out of bounds for length 0"; (try Sys.remove exe with Sys_error _ -> ()) in bounds (); diff --git a/test/test_flan.ml b/test/test_flan.ml index f87652e..fd2b4d6 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -783,6 +783,27 @@ let () = accepts "a slice's length is not known here" "(defn f [s [u8]] [u8] (slice s 0 99))"; + (* (slice-from-ptr p n). The one form in the language whose central claim the + compiler cannot check — whether n is the truth about what p addresses — so + what it does check is worth pinning: the argument really is a pointer, the + length is not absurd on its face, and the result owns nothing. *) + accepts "a pointer plus a length is a slice" + "(defn f [p (Ptr i32) n i32] i32 (at (slice-from-ptr p n) 0))"; + accepts "zero is a length" + "(defn f [p (Ptr i32)] i32 (len (slice-from-ptr p 0)))"; + rejects_check "slice-from-ptr of something that is not a pointer" + "(defn f [s [i32]] i32 (len (slice-from-ptr s 3)))" + ~needle:"takes a (Ptr T)"; + rejects_check "slice-from-ptr with a negative literal length" + "(defn f [p (Ptr i32)] i32 (len (slice-from-ptr p -1)))" + ~needle:"is negative"; + (* The storage stays C's. A slice is not move-only and carries no allocator, + so free refuses one by the rule it already had — this pins that the new + form did not become a thing anybody could hand to free. *) + rejects_check "free of a slice made from a pointer" + "(defn f [p (Ptr i32)] () (free (slice-from-ptr p 3)))" + ~needle:"free takes a move-only value"; + (* ── Structs, fields and auto-deref ────────────────────────────── *) let cursor = "(defstruct Cursor [src [u8] pos i32]) " in accepts "struct literal, omitted field zeroed" diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index 6e1158d..e33cd74 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -1399,6 +1399,30 @@ [font Font text string font-size f32 spacing f32] Vector2 "MeasureTextEx") +;; `recs` and `glyphs` are the two places in this whole package where a C +;; pointer's length is knowable and the language could not say it. Both arrays +;; hold exactly `glyph-count` entries — raylib allocates them that way in +;; LoadFontData and every one of its own loops uses that bound — and +;; `glyph-count` is a sibling *field*, which is why naming a count argument in +;; `bindings` could never have covered these two. `slice-from-ptr` can. +;; +;; **These two wrappers are where the promise is made, and they are the reason +;; the promise is safe to make**: a caller of `font-recs` is trusting raylib's +;; own invariant rather than remembering a number, and there is one place to +;; fix if raylib ever changes it. Prefer them to writing `slice-from-ptr` at a +;; call site. +;; +;; The one way to break them is to call either on a Font that was unloaded, or +;; on a zeroed one: `unload-font` frees both arrays and does not clear the +;; pointers, so the slice would be a promise about freed memory. That is the +;; ordinary use-after-free a (Ptr T) already had; the slice does not own the +;; storage and freeing through one is not expressible. +(defn font-recs [font Font] [Rectangle] + (slice-from-ptr (.recs font) (.glyph-count font))) + +(defn font-glyphs [font Font] [GlyphInfo] + (slice-from-ptr (.glyphs font) (.glyph-count font))) + ;; The index into `recs` and `glyphs`, by linear search over glyph-count. Also ;; pure CPU, and it is what pins glyph-count as the loop bound. (declare-c get-glyph-index [font Font codepoint i32] i32 "GetGlyphIndex")