From 4b1e722854e0b2a433bd8d9ff199f94b4171936d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 22:14:36 +0700 Subject: [PATCH 1/3] slice-from makes a slice from a pointer and any integer count, and ((Ptr U) p) casts a pointer's element type without dropping const --- TODO.org | 17 +-- docs/BUGS-2026-09-18.md | 2 +- docs/PORTING.md | 26 +--- emacs/flan-mode.el | 2 +- examples/text-codepoints-loading.flan | 4 +- examples/text-rectangle-bounds.flan | 6 +- examples/textures-image-processing.flan | 14 +- lib/check.ml | 121 +++++++++++++++--- lib/emit.ml | 18 ++- lib/js.ml | 4 +- lib/prelude.ml | 8 +- lib/shim.ml | 4 +- lib/tast.ml | 6 +- lib/x86.ml | 17 +-- runtime/flan_rt.c | 8 +- spec-syntax.md | 3 +- test/programs/bounds.flan | 4 +- test/programs/const-slice.flan | 2 +- test/programs/ptr-cast.flan | 38 ++++++ test/programs/raylib-codepoints.flan | 4 +- .../{slice-from-ptr.flan => slice-from.flan} | 12 +- ...e-from-ptr.flan => x86-p7-slice-from.flan} | 6 +- test/test_acceptance.ml | 34 +++-- test/test_flan.ml | 50 ++++++-- vendor/raylib/raylib.flan | 50 +------- web/index.html | 2 +- 26 files changed, 280 insertions(+), 182 deletions(-) create mode 100644 test/programs/ptr-cast.flan rename test/programs/{slice-from-ptr.flan => slice-from.flan} (86%) rename test/programs/{x86-p7-slice-from-ptr.flan => x86-p7-slice-from.flan} (89%) diff --git a/TODO.org b/TODO.org index 1fc05579..cfe0dfdc 100644 --- a/TODO.org +++ b/TODO.org @@ -493,10 +493,10 @@ shapes. ** DONE A pointer from C needs a length before it can be indexed CLOSED: [2026-09-13] -=(slice-from-ptr p n)=: the caller states the length and owns being right about +=(slice-from p n)=: the caller states the length and owns being right about 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. +carries the count — cannot reach a count that is a sibling field. It owns nothing, +and =free= refuses it. ** DONE A string cannot be returned from C CLOSED: [2026-09-25] @@ -677,9 +677,10 @@ of !=. * Checker -** NEXT A slice from a C pointer, and a pointer cast -Decided 2026-09-25: =(slice-from p n)= makes a slice from a pointer and a count, and a -cast changes a pointer's element type; both unchecked. No pointer arithmetic. +** DONE A slice from a C pointer, and a pointer cast +CLOSED: [2026-09-25] +=(slice-from p n)= and =((Ptr U) p)=, both unchecked. Rules out pointer arithmetic +and a cast between a pointer and an integer; =addr= and =slice-from= are the routes. ** CANCELLED A pointer crossing into dyn Not needed: dyn code has no use for an address it cannot read through. @@ -1230,10 +1231,10 @@ allocated in the =restart-case= that offers it. Rules out =use-value= at the failing operation. Only a =saturate= restart on the cast arm alone was left as a question, and it is not written anywhere. -** DONE slice-from-ptr's runtime refusal names the promise +** DONE slice-from's runtime refusal names the promise CLOSED: [2026-09-14] It used to reuse the slice error and report a range and a length the caller -never wrote. =slice-from-ptr= is the one form where the compiler cannot check +never wrote. =slice-from= is the one form where the compiler cannot check the thing that matters, so its refusal is where the promise is spelled out. The check is signed on purpose: a negative length sign-extended is a huge unsigned value an unsigned compare waves through. diff --git a/docs/BUGS-2026-09-18.md b/docs/BUGS-2026-09-18.md index b7f923e8..105ab9b7 100644 --- a/docs/BUGS-2026-09-18.md +++ b/docs/BUGS-2026-09-18.md @@ -133,7 +133,7 @@ territory; fix or record, the lane's call. rather than the arithmetic: `flan_f64_to_bytes` and the two dev emitters render any NaN as unsigned `nan`, which is what `format-f64` in the prelude always did. Pinned in `test/programs/format.flan`. See docs/BUILT.md. -- **x86's slice-from-ptr refusal is the wrong sentence**: `x86.ml` still reports a +- **x86's slice-from-ptr refusal is the wrong sentence** — **fixed** 2026-09-25; x86 calls `flan_slice_promise_error`: `x86.ml` still reports a negative promise through `flan_slice_error` — "slice [0 -2) is out of bounds for length 0", naming a range and a length the caller never wrote — where `emit.ml` has its own `flan_slice_promise_error`. Same condition and same exit on both sides, only diff --git a/docs/PORTING.md b/docs/PORTING.md index 740af9be..79ba38ad 100644 --- a/docs/PORTING.md +++ b/docs/PORTING.md @@ -778,24 +778,10 @@ binding over a `const char *` cursor meets it. ### A.2 There is no cast between pointer types -> **Half closed, 2026-09-14, and the other half turned out to be somewhere else.** The -> header check does now accept it: a C `void *` is opaque about *what* it points at, so -> `ptr_agrees` lets a `(Ptr` anything `)` stand against one, and that was the refusal this -> section hit. What the refusal was masking is that `lib/shim.ml` will not take a second -> `declare-c` for a C symbol it already has — a shim emits one C prototype per -> declaration, and two prototypes for `UpdateTexture` that disagree about a parameter type -> is a C file that does not compile. So the natural binding fix named below is refused -> after all, by a rule that is right. -> -> Its own message says what to write instead — "another Flan name for it is a defn" — and -> `vendor/raylib/raylib.flan` now has `update-texture-colors`, a one-line defn over the -> generated `update-texture` that spells the conversion as `(addr (.r pixels))`. The -> `(Ptr u8)` face has to stay the declared one, because `(.data im-copy)` is already a -> `(Ptr u8)` over the same bytes and `(Ptr u8)` → `(Ptr Color)` is the direction that -> cannot be written. The example's call site is `(rl/update-texture-colors texture pixels)` -> and the slice-and-index is gone; the cast still exists, once, with a name and a comment -> on it. **What is still open is the general thing this section is about** — a pointer -> reinterpretation — and it is not a checker arm. +> **Closed, 2026-09-25.** `((Ptr U) p)` casts a pointer's element type, spelled as `(i32 x)` +> is, and checks nothing; it may add const and may not drop it. The example's call is now +> `(rl/update-texture texture ((Ptr u8) pixels))` and `update-texture-colors` is gone. There is +> still no cast between a pointer and an integer, and no pointer arithmetic. `textures_image_processing` hands the pixels `LoadImageColors` returned straight to @@ -816,7 +802,7 @@ A.1, with the same message. **Not built.** the first element is the address of the buffer. ```flan -(rl/update-texture texture (addr (.r (at (slice-from-ptr pixels n) 0)))) +(rl/update-texture texture (addr (.r (at (slice-from pixels n) 0)))) ``` `Color`'s first field is `r`, a `u8`, at offset 0. It compiles, it is the right address, @@ -827,7 +813,7 @@ often — `void *` appears thirty-odd times in raylib.h alone. Two smaller notes on the same call. `(.data im-copy)` is already a `(Ptr u8)` over the same bytes, so the whole round trip is avoidable; the example keeps it because it is what the C does and because nothing else in the corpus exercises -`LoadImageColors`/`UnloadImageColors`. And `slice-from-ptr` is what makes any of this +`LoadImageColors`/`UnloadImageColors`. And `slice-from` is what makes any of this readable — it is the one form that turns a raylib pointer plus a raylib count into something with a length, and it was reached for three times across the two files. diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 1efff081..0f4c4caa 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -173,7 +173,7 @@ face says.") ;; files "slurp" "barf" "delete-file" "make-directory" "rename-file" ;; containers and memory - "length" "at" "slice" "slice-from-ptr" "addr" "deref" + "length" "at" "slice" "slice-from" "addr" "deref" ;; options, bytes, the host "Some" "bytes" "bytes-view" "string" "bytes->f64" "bytes->i64" "f64->bytes" "i64->bytes" diff --git a/examples/text-codepoints-loading.flan b/examples/text-codepoints-loading.flan index 7c610e58..d96f2178 100644 --- a/examples/text-codepoints-loading.flan +++ b/examples/text-codepoints-loading.flan @@ -190,11 +190,11 @@ (defer (rl/close-window)) ;; Turn each UTF-8 character of the text into the codepoint the font file - ;; indexes its glyphs by. raylib owns the array; slice-from-ptr is the + ;; indexes its glyphs by. raylib owns the array; slice-from is the ;; promise that there are `codepoint-count` of them behind the pointer, and ;; raylib's own out-parameter is where that number came from. (let [codepoints (rl/load-codepoints text (addr codepoint-count))] - (collect-unique (slice-from-ptr codepoints codepoint-count)) + (collect-unique (slice-from codepoints codepoint-count)) (rl/unload-codepoints codepoints)) ;; The atlas is generated here, from the deduplicated set — a smaller set is diff --git a/examples/text-rectangle-bounds.flan b/examples/text-rectangle-bounds.flan index 8061a228..a3772a84 100644 --- a/examples/text-rectangle-bounds.flan +++ b/examples/text-rectangle-bounds.flan @@ -1,7 +1,7 @@ ;;;; 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 +;;;; be ported at all until `slice-from` 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 @@ -12,7 +12,7 @@ ;;;; 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 +;;;; `glyph-count`. What was missing was a way to say so. `slice-from` 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*, @@ -59,7 +59,7 @@ ;; 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; +;; The two `slice-from` 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. diff --git a/examples/textures-image-processing.flan b/examples/textures-image-processing.flan index bdd448eb..45dc6ad3 100644 --- a/examples/textures-image-processing.flan +++ b/examples/textures-image-processing.flan @@ -143,21 +143,15 @@ ;; because it is what the C does and because the pair is the only thing in the ;; corpus that exercises it. ;; -;; The awkward step in it is gone. LoadImageColors answers a (Ptr Color) and -;; UpdateTexture's parameter is `const void *`, which the importer has to -;; render as *something* and renders as (Ptr u8) — so the call used to be -;; written `(addr (.r (at (slice-from-ptr pixels n) 0)))`: the address of the -;; red channel of pixel zero, which is the address of the buffer said the long -;; way round. A `void *` is opaque about what it points at by construction, -;; and the header check now knows that, so the package can offer the same C -;; function under the element type the caller actually has. -;; update-texture-colors is that binding and this is its only caller. +;; LoadImageColors answers a (Ptr Color) and UpdateTexture's parameter is +;; `const void *`, which the importer renders as (Ptr const u8). The cast says +;; the same address is bytes. (defn reload-texture [] () (rl/unload-image im-copy) (set im-copy (rl/image-copy im-origin)) (apply-process (addr im-copy) current-process) (let [pixels (rl/load-image-colors im-copy)] - (rl/update-texture-colors texture pixels) + (rl/update-texture texture ((Ptr u8) pixels)) (rl/unload-image-colors pixels))) (defn main [] () diff --git a/lib/check.ml b/lib/check.ml index a3065a85..18f4ce86 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -9280,6 +9280,54 @@ and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) = [ 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 + (* ((Ptr Color) p): a pointer cast, spelled the way (i32 x) is — the type + is the head. It changes what the pointer is said to point at and nothing + else, and checks nothing: the caller is promising the bytes are that + type, as with [slice-from]. Both backends already lower a Ptr-to-Ptr + [Cast] to no instruction. Adding const is allowed; dropping it is not, + or a cast would undo the const [addr] put there. There is no cast between + a pointer and an integer, and no pointer arithmetic. *) + | Ast.Call ({ Ast.e = Ast.Var "Ptr"; _ }, _) + when (match type_of_expr head with Some _ -> true | None -> false) -> + let target = resolve ctx.env (Option.get (type_of_expr head)) in + let spelled = Types.to_string target in + (match args with + | [ a ] -> + let a_loc = a.Ast.loc in + let spelled_a = spell_arg "p" a in + let a = check ctx a in + (match a.Tast.ty, target with + | Types.Ptr (Types.Const, _), Types.Ptr (Types.Mut, u) -> + fail loc + "%s is a %s, which cannot be written through, and %s would allow \ + writes. Write (%s %s)" + spelled_a (Types.to_string a.Tast.ty) spelled + (Types.to_string (Types.Ptr (Types.Const, u))) spelled_a + | Types.Ptr _, _ -> + expect ctx loc ~want + (mk loc target (Tast.Prim (Tast.Cast target, [ a ]))) + | (Types.Slice _ | Types.Array _ | Types.String), _ -> + fail a_loc + "%s converts a pointer, found %s. The address of the first \ + element is (addr (at %s 0)); write (%s (addr (at %s 0)))" + spelled (Types.to_string a.Tast.ty) spelled_a spelled spelled_a + | Types.Int _, _ -> + fail a_loc + "%s converts a pointer, found %s. There is no conversion between \ + an integer and a pointer" + spelled (Types.to_string a.Tast.ty) + | Types.Dyn, _ -> + fail a_loc + "%s converts a pointer, found dyn. A dyn value never holds a \ + pointer; give %s a pointer type" + spelled spelled_a + | other, _ -> + fail a_loc + "%s converts a pointer, found %s. The address of a place is \ + (addr %s); write (%s (addr %s))" + spelled (Types.to_string other) spelled_a spelled spelled_a) + | _ -> + fail loc "%s takes one pointer, given %d" spelled (List.length 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. *) | _ -> call_value ctx ~want loc (check ctx head) args @@ -10938,11 +10986,11 @@ and named_call ?(qualified = false) ctx ~want loc name args = (match target.Tast.ty with | Types.Slice (_, e) -> Types.to_string e | t -> Types.to_string t) - (* A view written right here — (slice ...) or (slice-from-ptr ...) — + (* A view written right here — (slice ...) or (slice-from ...) — is storage something else owns, known without running anything. *) | Types.Slice (Types.Mut, _) when (match (List.hd args).Ast.e with - | Ast.Call ({ Ast.e = Ast.Var ("slice" | "slice-from-ptr"); _ }, _) -> + | Ast.Call ({ Ast.e = Ast.Var ("slice" | "slice-from"); _ }, _) -> true | _ -> false) -> fail loc @@ -11863,7 +11911,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = expect ctx loc ~want (mk loc result (Tast.Let ([ (s, target) ], [ body ]))))) - (* (slice-from-ptr p n) — TODO.org, "A pointer from C needs a length before + (* (slice-from p n) — TODO.org, "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 @@ -11880,42 +11928,72 @@ and named_call ?(qualified = false) ctx ~want loc name args = No marker on the name. A [?] in this language means *asks* ([font-valid?]), and this does not ask; [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. + neighbour — a value conjured rather than derived — carries no marker + either. The argument's type is the marker: only a (Ptr T) is accepted, + and a (Ptr T) only ever arrives from a [declare-c], an [addr] or a + pointer cast, so the site already says where the promise comes from. + + **The count is any integer.** It is widened to i64 here, sign- or + zero-extended by its own kind, so both backends see one i64 and the + length word is what the caller wrote. The [n >= 0] test the backends + plant runs in every build, release included and [--no-bounds-checks] + included: it is not a bounds check against a known length (there is + none), it is the claim that the word being stored is a count at all. A + u64 above 2^63 fails it too, and should — no pointer has that many + elements behind it. **It owns nothing.** The result is a [Types.Slice], the same non-owning view (slice v) answers; (free s) on it is the program's error, which a - dev build's registry traps as a slice no allocator handed out. *) - | "slice-from-ptr" -> + dev build's registry traps as a slice no allocator handed out. It carries + no allocator epoch either — a slice is two words, see TODO.org "A stale + slice reads poison in a dev build" — so a view made over arena memory + that is later freed reads the dev build's poison and does not trap. *) + | "slice-from" -> arity ctx loc name 2 args; (match args with | [ target; n ] -> + let target_loc = target.Ast.loc in + let spelled_target = spell_arg "p" target in 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" + fail target_loc + "slice-from takes a (Ptr T) and the number of elements behind \ + it, found %s. A slice or an array already has a length; \ + (slice v lo hi) views part of one" (Types.to_string other) in let n_loc = n.Ast.loc in - let n = check ctx ~want:index_ty n in + let spelled_n = spell_arg "n" n in + let n = check ctx n in + (match n.Tast.ty with + | Types.Int _ -> () + | Types.Var v -> + cast_operand ctx n_loc name ~needs:"integer?" + ~what:"an element count" ~is:"an integer" v + | other -> + fail n_loc + "slice-from counts elements with an integer, found %s. Write \ + (slice-from %s (i64 %s))" + (Types.to_string other) spelled_target spelled_n); (* 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" k + "slice-from length %Ld is negative" k | _ -> ()); - (* A read-only pointer gives a read-only slice, or [slice-from-ptr] + let i64 = Types.Int Types.I64 in + let n = + if Types.equal n.Tast.ty i64 then n + else mk n.Tast.loc i64 (Tast.Prim (Tast.Cast i64, [ n ])) + in + (* A read-only pointer gives a read-only slice, or [slice-from] would undo the const [addr] put there. *) let m = match target.Tast.ty with Types.Ptr (m, _) -> m | _ -> Types.Mut in - prim Tast.SliceFromPtr (Types.Slice (m, elem)) [ target; n ] + prim Tast.SliceFrom (Types.Slice (m, elem)) [ target; n ] | _ -> assert false) (* ── pointers ──────────────────────────────────────────────────── *) @@ -13812,10 +13890,11 @@ let builtins : (string * string * string) list = runs backwards is refused here. A string slices to a string. A view of \ a Vec is a borrow from storage the Vec owns, and a push, a put or a \ reserve on that Vec may invalidate it."); - ("slice-from-ptr", "slice-from-ptr [(Ptr T) i32] [T]", - "Puts a length on a pointer that came back from C. The caller promises \ - it addresses that many initialised T and that they outlive the result; \ - the compiler checks none of it."); + ("slice-from", "slice-from [(Ptr T) n] [T]", + "Puts a length on a pointer that came back from C; n is any integer \ + type. The caller promises it addresses that many initialised T and that \ + they outlive the result; the compiler checks none of it. A negative n \ + traps in every build."); ("addr", "addr [place] (Ptr T)", "The address of a place — a name, (.field x), (at a i) or (deref p) — \ and not of an arbitrary expression."); diff --git a/lib/emit.ml b/lib/emit.ml index fd4f6423..ad0c5807 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3923,7 +3923,7 @@ 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 + (* (slice-from 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. @@ -3959,11 +3959,10 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = to be stated, and it was the one place it was not. The signalled BoundsError is unchanged: same three fields, so a handler writes one clause for every bad index in the language. *) - | Tast.SliceFromPtr, [ p; n ] -> + | Tast.SliceFrom, [ 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; + (* check.ml has already widened n to i64, by its own signedness. *) + let n64 = value f n in 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 -> @@ -4149,11 +4148,10 @@ and cast f ~guard (x : Tast.expr) target = if Types.signed b then "fptosi" else "fptoui" | Types.Float a, Types.Float b -> if Types.bits_f b > Types.bits_f a then "fpext" else "fptrunc" - (* Nothing in the surface language writes this: [check.ml] has no cast - between pointer types. The locals thunk does — it is handed a slot's - address as a raw pointer and has to read it as the type the slot - holds — and under opaque pointers there is no instruction to emit for - it, both sides being [ptr]. *) + (* ((Ptr U) p), and the locals thunk, which is handed a slot's address + as a raw pointer and has to read it as the type the slot holds. + Under opaque pointers there is no instruction to emit, both sides + being [ptr]. *) | Types.Ptr _, Types.Ptr _ -> "bitcast" (* Also not written in the surface language. [resolve] needs it: the runtime answers a pointer or NULL and the Option is built in the diff --git a/lib/js.ml b/lib/js.ml index a8f01620..800dc2f9 100644 --- a/lib/js.ml +++ b/lib/js.ml @@ -903,9 +903,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = in Printf.sprintf "%s(%s, %s, %s, %s)" fn t a b (locstr loc) | _ -> assert false) - | Tast.SliceFromPtr, _ -> + | Tast.SliceFrom, _ -> at loc - "(slice-from-ptr p n) is not in the JS dialect — it makes a slice out of \ + "(slice-from p n) is not in the JS dialect — it makes a slice out of \ an address, and JavaScript has no addresses" (* [Bytes] and [StrOfBytes] are reinterprets in every backend: a string is a run of bytes here as it is there. See the header. *) diff --git a/lib/prelude.ml b/lib/prelude.ml index 5cc0ea01..a23d2f38 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -83,7 +83,7 @@ let source = {flan| ;; ;; It is signalled with `error`, from the runtime rather than from Flan: ;; flan_bounds_error, flan_slice_error and flan_slice_promise_error in -;; runtime/flan_rt.c — the last of those is (slice-from-ptr p n), whose +;; runtime/flan_rt.c — the last of those is (slice-from p n), whose ;; message is about the caller's promise because there is no container to ;; report, and which fills these fields with (0, n, 0): the condition it ;; violated, 0 <= n, written as a range. Between them they are where every @@ -1268,7 +1268,7 @@ let source = {flan| ;; ;; **The result borrows.** It is a view of the process environment, not a copy: ;; it needs no allocator and no free, and it stays valid because there is no -;; writer — that is the same promise `slice-from-ptr` asks a caller to make, +;; writer — that is the same promise `slice-from` asks a caller to make, ;; kept here once so that no caller has to. A program that wants to hold the ;; value past a point where that reasoning stops being obvious should copy it ;; into a Vec, which `concat` of one part already does. @@ -1289,7 +1289,7 @@ let source = {flan| p (getenv-raw name (addr n))] (if (< n 0) None - (Some (slice-from-ptr p (i32 n)))))) + (Some (slice-from p (i32 n)))))) ;; ── Byte classes ────────────────────────────────────────────────────── ;; @@ -2108,7 +2108,7 @@ let source = {flan| p (macro-slurp-raw path (addr n))] (if (< n 0) None - (Some (slice-from-ptr p (i32 n)))))) + (Some (slice-from p (i32 n)))))) ;; ── Form: what a macro takes and what it answers ────────────────────── ;; diff --git a/lib/shim.ml b/lib/shim.ml index 10475b19..e142a53a 100644 --- a/lib/shim.ml +++ b/lib/shim.ml @@ -888,7 +888,7 @@ let flan_wrapper ?track (fn : Ast.fn) (s : shim) raw : Ast.decl_kind = out ], Some (ty loc (Ast.Tname n)) ) | `Str -> - (* (string (bytes (string (slice-from-ptr p n)))): a view of C's bytes, + (* (string (bytes (string (slice-from 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. *) @@ -903,7 +903,7 @@ let flan_wrapper ?track (fn : Ast.fn) (s : shim) raw : Ast.decl_kind = ( [ app "string" [ app "bytes" [ app "string" - [ app "slice-from-ptr" [ v ptr_tmp; v len_tmp ] ] ] ] ], + [ app "slice-from" [ v ptr_tmp; v len_tmp ] ] ] ] ], fn.Ast.ret ) | _ -> ([ call args ], fn.Ast.ret) in diff --git a/lib/tast.ml b/lib/tast.ml index f165c8cc..c6eda366 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -25,12 +25,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 + (* (slice-from 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 + check.ml's "slice-from" case for what it can. *) + | SliceFrom (* 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/lib/x86.ml b/lib/x86.ml index 7e557646..cd6f993e 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3458,7 +3458,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = load_loc f ~reg:rcx llo lo.Tast.ty; sub_rr f.b ~dst:rax ~src:rcx; store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8 - (* (slice-from-ptr p n): the two words a slice already is, with the pointer + (* (slice-from p n): the two words a slice already is, with the pointer the caller handed over and the length the caller promised. A [Slice _] is {ptr, i64} here exactly as it is in [emit.ml], so there is no new representation to build — one store of the pointer and one of the length. @@ -3470,9 +3470,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = compares are unsigned, and a negative i32 sign-extended to 64 bits is a huge unsigned value that [jbe] waves straight through. - It reuses [flan_slice_error] for [emit.ml]'s reason: the violated - condition is 0 <= n, which has the shape of a reversed slice, so the range - is reported as [0 n) against a length of 0. + It calls [flan_slice_promise_error], as [emit.ml] does, so both backends + say the same sentence: the promise, not a range nobody wrote. The count + arrives as an i64 — check.ml widened it — so the compare is on all 64 bits. It is not behind [f.md.Emit.checks], and the reason is the one [check_slice] above spells out at length. [--no-bounds-checks] drops a @@ -3482,20 +3482,17 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = slice's count, and a count that is negative is not a slice with the bounds check taken off, it is not a slice. So the test runs in every build, exactly as [lo <= hi] does. *) - | Tast.SliceFromPtr, [ p; n ] -> + | Tast.SliceFrom, [ p; n ] -> let lp = eval f p in let ln = eval f n in scoped f (fun () -> - let a = ptmp f and b = ptmp f and c = ptmp f in - xor_rr f.b ~dst:rax ~src:rax; - store_int f.b ~src:rax ~mm:(Frame a) ~size:8; - store_int f.b ~src:rax ~mm:(Frame c) ~size:8; + let b = ptmp f in load_loc f ~reg:rax ln n.Tast.ty; store_int f.b ~src:rax ~mm:(Frame b) ~size:8; cmp_imm f.b ~dst:rax 0; let ok = new_label f "inb" in jcc_lbl f.b ~cc:cc_ge ok; - bounds_call f "flan_slice_error" e.Tast.loc [ a; b; c ]; + bounds_call f "flan_slice_promise_error" e.Tast.loc [ b ]; lbl f.b ok); load_loc f ~reg:rax lp p.Tast.ty; store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8; diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 28564e0e..5d3d2576 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -561,7 +561,7 @@ static int64_t fit(int n) { * last thing between that and a 511-byte read. check_slice no longer lets the * value out, which makes the negative case unreachable *from Flan* — and not * from here, because these take a raw (ptr, len) pair and the FFI, a C caller - * and slice-from-ptr's promise all reach them too. A function that is correct + * and slice-from's promise all reach them too. A function that is correct * on its own arguments does not become incorrect because its callers improved, * and two branches are not the price to argue about. */ static size_t clamp_len(int64_t n, size_t cap) { @@ -1303,7 +1303,7 @@ void flan_slice_error(const uint8_t *loc, int64_t loclen, int64_t lo, flan_slice_fail(loc, loclen, lo, hi, len); } -/* ── (slice-from-ptr p n), which has its own refusal ─────────────────── +/* ── (slice-from p n), which has its own refusal ─────────────────── * * It used to borrow flan_slice_error, and what came out named a range and a * length the caller never wrote: "slice [0 -2) is out of bounds for length 0". @@ -1329,7 +1329,7 @@ void flan_slice_error(const uint8_t *loc, int64_t loclen, int64_t lo, * Deliberately not (0, n, n) — that reads as a range in bounds, and a handler * testing high <= length would wave the failure through. */ static void promise_sentence(int64_t n) { - rt_sentence("slice-from-ptr was promised %lld elements behind the pointer, " + rt_sentence("slice-from was promised %lld elements behind the pointer, " "and a count is never negative", (long long)n); } @@ -4118,7 +4118,7 @@ void flan_sleep_ns(int64_t ns) { * a test the language does not offer, since a (Ptr T) only ever arrives from a * declare and nothing in the type says it may be nothing. Absent is *len = -1 * and a pointer to a valid empty string; present is *len >= 0 and the - * environment's own bytes, which (slice-from-ptr) then views. + * environment's own bytes, which (slice-from) then views. * * The bytes are the process environment's and are not copied. They outlive the * call — nothing in this language can call setenv or spawn a process, so there diff --git a/spec-syntax.md b/spec-syntax.md index 72a60321..38c8e9b6 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -169,7 +169,8 @@ Each item: the proposal, then the reason in one line. reads back through the fallback, `defonce(.init-once.counter, i64, 7)`. - **`and`, `or`, `not` are words**, since they are Flan's own names. **Built.** - **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`, - `max-value(u8)`, `the([3 f32], [1 2 3.5])`. **Built.** + `max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type + called: `Ptr(Color)(p)` reads `((Ptr Color) p)`. **Built.** ### Statements and blocks diff --git a/test/programs/bounds.flan b/test/programs/bounds.flan index 9c57c867..ff767eff 100644 --- a/test/programs/bounds.flan +++ b/test/programs/bounds.flan @@ -34,12 +34,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 + ;; (slice-from 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 (length (slice-from-ptr (addr (at arr 0)) n))) + (= n -2) (print (length (slice-from (addr (at arr 0)) n))) :else (println "?")) 0)) diff --git a/test/programs/const-slice.flan b/test/programs/const-slice.flan index 3c64505f..0790348e 100644 --- a/test/programs/const-slice.flan +++ b/test/programs/const-slice.flan @@ -60,6 +60,6 @@ (let [b (bytes "q")] (println (peek (addr (at r 1))) (peek (addr (at "abc" 2))) (peek (addr (at b 0))) - (string (slice-from-ptr (addr (at r 7)) 5)))) + (string (slice-from (addr (at r 7)) 5)))) (free names)) 0) diff --git a/test/programs/ptr-cast.flan b/test/programs/ptr-cast.flan new file mode 100644 index 00000000..f4e74e6d --- /dev/null +++ b/test/programs/ptr-cast.flan @@ -0,0 +1,38 @@ +;;;; ((Ptr T) p) and (slice-from p n) together: the bytes of one array read as +;;;; another element type, the way a C void * or a (Ptr u8) pixel buffer is +;;;; read as the structs it holds. + +(defstruct Rgba [r u8 g u8 b u8 a u8]) + +(defonce bytes [8 u8]) + +(defn sum [s [const Rgba]] i32 + (let [acc 0] + (dotimes [i (length s)] + (set acc (+ acc (i32 (.g (at s i)))))) + acc)) + +(defn main [] () + (dotimes [i 8] + (set (at bytes i) (u8 (+ i 1)))) + + ;; Eight bytes are two Rgba. The count is an i64, not an i32. + (let [p ((Ptr Rgba) (addr (at bytes 0))) + n (i64 2) + px (slice-from p n)] + (println (length px)) ; 2 + (println (.r (at px 0))) ; 1 + (println (.a (at px 1))) ; 8 + ;; A write through the cast pointer is a write to the bytes. + (set (.b (at px 1)) 70) + (println (at bytes 6))) ; 70 + + ;; Adding const is allowed, and the slice keeps it. + (let [c ((Ptr const Rgba) (addr (at bytes 0)))] + (println (sum (slice-from c (u8 2))))) ; 8 + + ;; And back: the struct pointer read as bytes again. + (let [p ((Ptr Rgba) (addr (at bytes 0))) + b ((Ptr u8) p)] + (println (deref b)) ; 1 + (println (length (slice-from b 8))))) ; 8 diff --git a/test/programs/raylib-codepoints.flan b/test/programs/raylib-codepoints.flan index 74aaab4c..926ed234 100644 --- a/test/programs/raylib-codepoints.flan +++ b/test/programs/raylib-codepoints.flan @@ -85,7 +85,7 @@ (let [total 0 raw (rl/load-codepoints cp/text (addr total))] (show "codepoints" total) - (cp/collect-unique (slice-from-ptr raw total)) + (cp/collect-unique (slice-from raw total)) (show "unique" cp/unique-count) (dotimes [i 5] (print "unique ") (print i) (print " ") @@ -123,7 +123,7 @@ ;; Item 3: and the forward walk is what raylib said the text contains. (let [agrees (= forward-n total) - all (slice-from-ptr raw total)] + all (slice-from raw total)] (dotimes [i forward-n] (when (and agrees (not (= (at forward i) (at all i)))) (set agrees false))) diff --git a/test/programs/slice-from-ptr.flan b/test/programs/slice-from.flan similarity index 86% rename from test/programs/slice-from-ptr.flan rename to test/programs/slice-from.flan index dc07fd34..dc0ba81b 100644 --- a/test/programs/slice-from-ptr.flan +++ b/test/programs/slice-from.flan @@ -1,4 +1,4 @@ -;;;; (slice-from-ptr p n) — TODO.org, "A pointer from C needs a length before +;;;; (slice-from p n) — TODO.org, "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. @@ -16,7 +16,7 @@ ;;;; ;;;; 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 +;;;; (free (slice-from ...)) — a slice owns nothing, so free refuses it by ;;;; the rule it already had. (defonce a [5 i32]) @@ -33,7 +33,7 @@ ;; 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)] + (let [s (slice-from (addr (at a 0)) 5)] (println (length s)) ; 5 (println (at s 0)) ; 10 (println (at s 4)) ; 50 @@ -45,17 +45,17 @@ ;; 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)] + (let [s (slice-from (addr (at a 1)) 2)] (println (length 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 (length (slice-from-ptr (addr (at a 0)) 0))) ; 0 + (println (length (slice-from (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)] + (let [s (slice-from (addr (at a 0)) 5)] (set (at s 2) 7) (println (at a 2)) ; 7 (println (total s)))) ; 127 diff --git a/test/programs/x86-p7-slice-from-ptr.flan b/test/programs/x86-p7-slice-from.flan similarity index 89% rename from test/programs/x86-p7-slice-from-ptr.flan rename to test/programs/x86-p7-slice-from.flan index 95fdd3f1..faa4346c 100644 --- a/test/programs/x86-p7-slice-from-ptr.flan +++ b/test/programs/x86-p7-slice-from.flan @@ -1,6 +1,6 @@ -;;;; (slice-from-ptr p n) with a length the checker cannot see. +;;;; (slice-from p n) with a length the checker cannot see. ;;;; -;;;; test/programs/slice-from-ptr.flan covers the form itself, but every length +;;;; test/programs/slice-from.flan covers the form itself, but every length ;;;; in it is a literal, and a negative literal is refused by check.ml before ;;;; any code is emitted. So the run-time half of the check -- the one both ;;;; backends plant beside the form -- is walked by nothing in the corpus. @@ -19,7 +19,7 @@ (defn promised [n i32] i32 ;; n is a parameter, so the checker has no literal to look at. (restart-case - (let [s (slice-from-ptr (addr (at a 0)) n)] + (let [s (slice-from (addr (at a 0)) n)] (length s)) (give-up [] -1))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index dd1821ca..467b617b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -693,7 +693,7 @@ let () = 1 2 4 4 5 6 9 9\nEIINNOORRSSTT\n\ 105\ninsertion\nion\ninsert\nrt\n" in - (* (slice-from-ptr p n) — TODO.org, "A pointer from C needs a length before + (* (slice-from p n) — TODO.org, "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] — @@ -702,9 +702,18 @@ let () = 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" + outputs "slice-from" "programs/slice-from.flan" sfp_out; + outputs ~opt:"-O0" "slice-from, -O0" "programs/slice-from.flan" sfp_out; + (* ((Ptr T) p): bytes read as structs and back, with slice-from counts of + other integer types. The cast is no instruction on either backend, so + what this pins is that the element size the slice indexes by is the + new type's. *) + let pcast_out = "2\n1\n8\n70\n8\n1\n8\n" in + outputs "pointer cast" "programs/ptr-cast.flan" pcast_out; + outputs ~opt:"-O0" "pointer cast, -O0" "programs/ptr-cast.flan" pcast_out; + outputs ~x86:true "pointer cast, --x86" "programs/ptr-cast.flan" pcast_out; + outputs ~dev:true "pointer cast, dev" "programs/ptr-cast.flan" pcast_out; outputs "slice algorithms" "programs/slices.flan" slices_out; outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out; (* And on the hand-written backend, because indexing a string is the one @@ -2936,8 +2945,8 @@ let () = the *reason*: the location, and which index against which length. The line and column are not pinned, because editing the program should not break the test that reads it. *) - let bounds ?opt () = - let exe = compile ?opt "programs/bounds.flan" in + let bounds ?opt ?x86 () = + let exe = compile ?opt ?x86 "programs/bounds.flan" in let traps name arg reason = let code, text = run exe (Some arg) in if code <> 134 @@ -2974,7 +2983,7 @@ 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 + (* (slice-from 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 @@ -2987,12 +2996,15 @@ let () = refusal is where the caller's promise gets stated. The asserted substring stays inside one output line; the second line is the part about what is *not* checked. *) - traps "slice-from-ptr with a negative length" "-2" - "slice-from-ptr was promised -2 elements behind the pointer"; + traps "slice-from with a negative length" "-2" + "slice-from was promised -2 elements behind the pointer"; (try Sys.remove exe with Sys_error _ -> ()) in bounds (); bounds ~opt:"-O0" (); + (* The hand-written backend says the same sentences, slice-from's promise + included — it used to borrow the slice sentence there. *) + bounds ~x86:true (); (* What the release build drops, and what it does not. Asserted on the IR for the first half, because an index past the end has no defined @@ -3001,7 +3013,7 @@ let () = The line: @flan_bounds_error is the bounds check and goes. The two slice calls stay, because what survives behind them is not a bounds check — - check_slice's lo <= hi and slice-from-ptr's n >= 0 are the claim that a + check_slice's lo <= hi and slice-from's n >= 0 are the claim that a %slice's length word holds a count. This assertion is written as "present" and not merely as "no longer looked at", so that re-gating either one on f.md.checks fails here rather than passing quietly. *) @@ -3051,8 +3063,8 @@ let () = end in still_traps "reversed slice" "2" "slice [2 1) is out of bounds for length 5"; - still_traps "slice-from-ptr with a negative length" "-2" - "slice-from-ptr was promised -2 elements behind the pointer"; + still_traps "slice-from with a negative length" "-2" + "slice-from was promised -2 elements behind the pointer"; let code, text = run unchecked (Some "0") in if text <> "0ello\n" || code <> 0 then begin incr failures; diff --git a/test/test_flan.ml b/test/test_flan.ml index 90ce6d94..861451e7 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2349,7 +2349,7 @@ let () = infers "the address of a string's byte" "(addr (at \"hi\" 0))" "(Ptr const u8)"; infers "a const pointer slices to a const slice" - "(slice-from-ptr (addr (at (bytes-view \"hi\") 0)) 2)" "[const u8]"; + "(slice-from (addr (at (bytes-view \"hi\") 0)) 2)" "[const u8]"; rejects_check "a store through a const pointer" "(defn f [p (Ptr const i32)] () (set (deref p) 1))" ~needle:"this writes through a (Ptr const i32)"; @@ -2368,8 +2368,8 @@ let () = rejects_check "a const pointer is not a writable one" "(defn g [p (Ptr u8)] i32 0) (defn f [v [const u8]] i32 (g (addr (at v 0))))" ~needle:"expected (Ptr u8), found (Ptr const u8)"; - rejects_check "slice-from-ptr keeps the const" - "(defn f [v [const u8]] [u8] (slice-from-ptr (addr (at v 0)) 1))" + rejects_check "slice-from keeps the const" + "(defn f [v [const u8]] [u8] (slice-from (addr (at v 0)) 1))" ~needle:"expected [u8], found [const u8]"; rejects_check "const alone is not a type" "(defn f [p (Ptr const)] i32 0)" ~needle:"const is not a type on its own"; @@ -2502,24 +2502,52 @@ let () = accepts "a generic reader takes both" "(defn f [a [const i32] b [i32]] i64 (+ (sum-i32 a) (sum-i32 b)))"; - (* (slice-from-ptr p n). The one form in the language whose central claim the + (* (slice-from 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))"; + "(defn f [p (Ptr i32) n i32] i32 (at (slice-from p n) 0))"; accepts "zero is a length" - "(defn f [p (Ptr i32)] i32 (length (slice-from-ptr p 0)))"; - rejects_check "slice-from-ptr of something that is not a pointer" - "(defn f [s [i32]] i32 (length (slice-from-ptr s 3)))" + "(defn f [p (Ptr i32)] i32 (length (slice-from p 0)))"; + rejects_check "slice-from of something that is not a pointer" + "(defn f [s [i32]] i32 (length (slice-from s 3)))" ~needle:"takes a (Ptr T)"; - rejects_check "slice-from-ptr with a negative literal length" - "(defn f [p (Ptr i32)] i32 (length (slice-from-ptr p -1)))" + rejects_check "slice-from with a negative literal length" + "(defn f [p (Ptr i32)] i32 (length (slice-from p -1)))" ~needle:"is negative"; + accepts "slice-from counts with any integer type" + "(defn f [p (Ptr i32) a i64 b u64 c u8] i64 \ + (+ (length (slice-from p a)) (length (slice-from p b)) \ + (length (slice-from p c))))"; + rejects_check "slice-from with a count that is not an integer" + "(defn f [p (Ptr i32) n f32] i32 (length (slice-from p n)))" + ~needle:"Write (slice-from p (i64 n))"; + + (* ((Ptr T) p): the type is the head, as in (i32 x). It changes what the + pointer points at and checks nothing else, but it keeps const. *) + accepts "a pointer cast" + "(defn f [p (Ptr u8)] (Ptr i32) ((Ptr i32) p))"; + accepts "a pointer cast may add const" + "(defn f [p (Ptr u8)] (Ptr const i32) ((Ptr const i32) p))"; + accepts "a const pointer casts to a const pointer" + "(defn f [p (Ptr const u8)] [const i32] (slice-from ((Ptr const i32) p) 2))"; + rejects_check "a pointer cast may not drop const" + "(defn f [p (Ptr const u8)] (Ptr i32) ((Ptr i32) p))" + ~needle:"Write ((Ptr const i32) p)"; + rejects_check "a pointer cast of a slice" + "(defn f [s [u8]] (Ptr i32) ((Ptr i32) s))" + ~needle:"write ((Ptr i32) (addr (at s 0)))"; + rejects_check "a pointer cast of an integer" + "(defn f [x i64] (Ptr i32) ((Ptr i32) x))" + ~needle:"no conversion between an integer and a pointer"; + rejects_check "a pointer cast of a dyn" + "(defn f [x dyn] (Ptr i32) ((Ptr i32) x))" + ~needle:"A dyn value never holds a pointer"; (* The storage stays C's, and a view made in place is refused at free without running anything. *) rejects_check "free of a slice made from a pointer" - "(defn f [p (Ptr i32)] () (free (slice-from-ptr p 3)))" + "(defn f [p (Ptr i32)] () (free (slice-from p 3)))" ~needle:"is a view of storage something else owns"; rejects_check "free of a slice written in place" "(defn f [v (Vec i32)] () (free (slice v)))" diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index 702129ba..defa08c7 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -619,42 +619,6 @@ (declare-c unload-texture [texture Texture2D] "UnloadTexture") -;; Refilling a texture's pixels from a Color buffer. -;; -;; UpdateTexture takes a `const void *` — raylib does not care what the buffer -;; is an array *of*, only that it is the right number of bytes in the format -;; the texture was made with. The importer has to render that as *something* -;; and renders it `(Ptr u8)`, which is the generated `update-texture` above. -;; -;; That face cannot be the only one, because the commonest source of pixels is -;; LoadImageColors and it answers a `(Ptr Color)`. It also cannot be replaced -;; by a `(Ptr Color)` one: `(.data im-copy)` is already a `(Ptr u8)` over the -;; same bytes and is the shorter route, and `(Ptr u8)` → `(Ptr Color)` is not -;; expressible while `(Ptr Color)` → `(Ptr u8)` is. So the byte face is the -;; declaration and the typed face is this. -;; -;; A second `declare-c` was the obvious shape and lib/shim.ml refuses it, for a -;; reason that is right: a shim emits one C prototype per declaration, and two -;; prototypes for one symbol that disagree about a parameter type is a C file -;; that does not compile. Its message says what to write instead — "another -;; Flan name for it is a defn" — and this is that defn. docs/PORTING.md §A.2 -;; expected the header check to be the only thing in the way; it was not. -;; -;; `(addr (.r pixels))` is the whole of the conversion. `.` auto-derefs one -;; level and `r` is Color's first field, so this is the address the pointer -;; already held, said in the only way the language has of saying it. It used -;; to be written at the call site as -;; `(addr (.r (at (slice-from-ptr pixels n) 0)))`, which is the same address -;; with a slice built and indexed on the way past. Once, here, with a name on -;; it is better than once per caller. -;; -;; Neither call checks that the buffer is big enough, because neither can: the -;; length raylib wants is width * height * bytes-per-pixel of the *texture*, -;; and a pointer has no length. That is the deal every raylib pointer -;; parameter offers. -(defn update-texture-colors [texture Texture2D pixels (Ptr Color)] () - (update-texture texture (addr (.r pixels)))) - ;; How a texture is sampled when it is drawn at anything other than its own ;; size. The header says `int` on SetTextureFilter and means one of these six. ;; @@ -1538,12 +1502,12 @@ ;; 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. +;; `bindings` could never have covered these two. `slice-from` 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 +;; fix if raylib ever changes it. Prefer them to writing `slice-from` at a ;; call site. ;; ;; The one way to break them is to call either on a Font that was unloaded, or @@ -1552,10 +1516,10 @@ ;; 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))) + (slice-from (.recs font) (.glyph-count font))) (defn font-glyphs [font Font] [GlyphInfo] - (slice-from-ptr (.glyphs font) (.glyph-count font))) + (slice-from (.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. @@ -1628,7 +1592,7 @@ ;; 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))). +;; (slice-from (.vertices mesh) (* 3 (.vertex-count mesh))). (defstruct Mesh [vertex-count i32 triangle-count i32 vertices (Ptr f32) texcoords (Ptr f32) texcoords-2 (Ptr f32) @@ -1672,7 +1636,7 @@ ;; 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) + (let [s (slice-from p 2147483647) out (vec-new u8) i 0] (while (!= (at s i) 0) @@ -1683,7 +1647,7 @@ (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)] + paths (slice-from (.paths files) n)] (dotimes [i n] (push out (c-string-copy (at paths i)))) out)) diff --git a/web/index.html b/web/index.html index cd8e96ef..44150fe4 100644 --- a/web/index.html +++ b/web/index.html @@ -525,7 +525,7 @@ notation reads as exactly one data item.

(Map K V)open addressing, owning, copies the same way. The only map spelling: braces in type position are not a typedata + len + log2cap + its allocator (Pool T)generational slab storage, owning, copies the same wayitems + slots + its allocator (Handle T)a reference into a pool that reports a dead referentindex and generation packed into an i64 -(Ptr T)raw pointera pointer +(Ptr T)raw pointer. ((Ptr U) p) reads it as a pointer to U; (slice-from p n) makes a [T] of the n elements behind it. Neither checks the memorya pointer (Ptr const T)a pointer nothing is written through: the address of read-only storage, and what a C const T * takes. A (Ptr T) converts to one, never the reversea pointer (Option T)Some / Nonetag byte + T (Fn [T ...] R)a function value, which may have captureda code address and an environment pointer From 24761dcf546de6e791f0e3e9ebe5e1b66bc91931 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 22:27:21 +0700 Subject: [PATCH 2/3] rl/update-texture-colors remains, as a one-line defn over the pointer cast --- docs/PORTING.md | 2 +- vendor/raylib/raylib.flan | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/docs/PORTING.md b/docs/PORTING.md index 79ba38ad..bd5fff1b 100644 --- a/docs/PORTING.md +++ b/docs/PORTING.md @@ -780,7 +780,7 @@ binding over a `const char *` cursor meets it. > **Closed, 2026-09-25.** `((Ptr U) p)` casts a pointer's element type, spelled as `(i32 x)` > is, and checks nothing; it may add const and may not drop it. The example's call is now -> `(rl/update-texture texture ((Ptr u8) pixels))` and `update-texture-colors` is gone. There is +> `(rl/update-texture texture ((Ptr u8) pixels))`; `update-texture-colors` stays as a one-line defn over the cast. There is > still no cast between a pointer and an integer, and no pointer arithmetic. diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index defa08c7..5a085a9f 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -619,6 +619,11 @@ (declare-c unload-texture [texture Texture2D] "UnloadTexture") +;; UpdateTexture over a Color buffer, such as the one LoadImageColors answers. +;; The generated update-texture takes the `const void *` as (Ptr const u8). +(defn update-texture-colors [texture Texture2D pixels (Ptr Color)] () + (update-texture texture ((Ptr u8) pixels))) + ;; How a texture is sampled when it is drawn at anything other than its own ;; size. The header says `int` on SetTextureFilter and means one of these six. ;; From a39d96149d178420b78b31260f70795d96f9051e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 22:35:24 +0700 Subject: [PATCH 3/3] slice-from-ptr is refused with the slice-from call to write, and the pointer cast's const rule is documented as covering the outer pointer only --- lib/check.ml | 21 +++++++++++++++++++-- test/test_flan.ml | 5 +++++ web/index.html | 2 +- 3 files changed, 25 insertions(+), 3 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 18f4ce86..33633b18 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -9285,8 +9285,12 @@ and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) = else, and checks nothing: the caller is promising the bytes are that type, as with [slice-from]. Both backends already lower a Ptr-to-Ptr [Cast] to no instruction. Adding const is allowed; dropping it is not, - or a cast would undo the const [addr] put there. There is no cast between - a pointer and an integer, and no pointer arithmetic. *) + or a cast would undo the const [addr] put there. The rule is about the + outer pointer only: the cast is unchecked, so ((Ptr (Ptr u8)) q) over a + (Ptr const (Ptr const u8)) is refused for the outer const but a + (Ptr (Ptr const u8)) casts to (Ptr (Ptr u8)) — what lies deeper is the + writer's promise, like everything else the cast asserts. There is no cast + between a pointer and an integer, and no pointer arithmetic. *) | Ast.Call ({ Ast.e = Ast.Var "Ptr"; _ }, _) when (match type_of_expr head with Some _ -> true | None -> false) -> let target = resolve ctx.env (Option.get (type_of_expr head)) in @@ -12688,6 +12692,19 @@ and ordinary_call ctx ~want loc name args = says what the view is: over a Vec it borrows the storage the Vec \ owns, over an array or a string it looks at the value itself. \ Write %s" call + else if name = "slice-from-ptr" then + (* The name this form had before; code written against it lands here. + Said as the form to write, with the reader's arguments, and not as + a rename — a first-time reader has no old name to be told about. *) + let call = + match args with + | [ p; n ] -> + "(slice-from " ^ spell_arg "p" p ^ " " ^ spell_arg "n" n ^ ")" + | _ -> "(slice-from p n)" + in + Loc.failk "check/unknown-function" loc + "there is no slice-from-ptr. A slice from a pointer and a count of \ + the elements behind it is slice-from. Write %s" call else if no_such_rand name <> None then (* A retired randomness name, which is a name and not a near miss: "did you mean rand?" for [rand-f32] would be true and would not say diff --git a/test/test_flan.ml b/test/test_flan.ml index 861451e7..c92e97c5 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2541,6 +2541,11 @@ let () = rejects_check "a pointer cast of an integer" "(defn f [x i64] (Ptr i32) ((Ptr i32) x))" ~needle:"no conversion between an integer and a pointer"; + rejects_check "slice-from-ptr names slice-from" + "(defn f [p (Ptr i32) n i32] i32 (length (slice-from-ptr p n)))" + ~needle:"Write (slice-from p n)"; + accepts "a pointer cast checks the outer const only" + "(defn f [q (Ptr (Ptr const u8))] (Ptr (Ptr u8)) ((Ptr (Ptr u8)) q))"; rejects_check "a pointer cast of a dyn" "(defn f [x dyn] (Ptr i32) ((Ptr i32) x))" ~needle:"A dyn value never holds a pointer"; diff --git a/web/index.html b/web/index.html index 44150fe4..570f9fcd 100644 --- a/web/index.html +++ b/web/index.html @@ -525,7 +525,7 @@ notation reads as exactly one data item.

(Map K V)open addressing, owning, copies the same way. The only map spelling: braces in type position are not a typedata + len + log2cap + its allocator (Pool T)generational slab storage, owning, copies the same wayitems + slots + its allocator (Handle T)a reference into a pool that reports a dead referentindex and generation packed into an i64 -(Ptr T)raw pointer. ((Ptr U) p) reads it as a pointer to U; (slice-from p n) makes a [T] of the n elements behind it. Neither checks the memorya pointer +(Ptr T)raw pointer. ((Ptr U) p) reads it as a pointer to U, and may add const but not drop it (the outer pointer only: what it points at is taken on trust); (slice-from p n) makes a [T] of the n elements behind it. Neither checks the memorya pointer (Ptr const T)a pointer nothing is written through: the address of read-only storage, and what a C const T * takes. A (Ptr T) converts to one, never the reversea pointer (Option T)Some / Nonetag byte + T (Fn [T ...] R)a function value, which may have captureda code address and an environment pointer