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

A slice or pointer can be read-only, and what it reaches cannot be written through it

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 13:39:04 +07:00
commit b2eb81f7bf
47 changed files with 1250 additions and 533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
TODO.org
View File

@ -955,20 +955,9 @@ CLOSED: [2026-09-25]
=(the T expr)= gives any expression its want and =let= stays a flat list of =(the T expr)= gives any expression its want and =let= stays a flat list of
pairs. Rules out a type slot in =let=. pairs. Rules out a type slot in =let=.
** NEXT A read-only slice type ** DONE A read-only slice type
Decided 2026-09-25: =[const u8]=, Zig's spelling in Flan's brackets. =bytes-view= answers one and a =set= through it is a compile error; a =[T]= converts to =[const T]= and not back, and the prelude's read-only functions take it. =const= is reserved as a name, since =[n T]= accepts a constant's name for =n=. CLOSED: [2026-09-25]
=bytes-view= is read-only by convention only — the type system cannot say a =[u8]= =[const T]= and =(Ptr const T)=; a =[T]= or =(Ptr T)= converts at the top of a type or under another const one, never inside a writable one. The const is shallow: an element of a =[const [u8]]= and a Vec's buffer are writable. The address of read-only storage, a string's byte included, is a =(Ptr const T)=, and a C =const T *= parameter takes one.
may not be stored through, so a trap on read-only memory is the enforcement. A
read-only slice type, or provenance, is what would move that refusal to compile
time.
** NEXT Writing through a string literal
Decided 2026-09-25: closed by the read-only slice type above.
=(let [s (bytes-view "Hi")] (set (at s 0) \h))= stores into read-only memory at
=-O0= and is deleted as undefined at =-O2= — same source, and which way it fails
depends on a flag. Narrowed when =(bytes s)= started copying, so the common
spelling no longer reaches the edge. Emitting literals as mutable globals is not a
fix: it moves which flag misbehaves and costs their read-only placement.
** TODO (slice d 1) over a dyn string is refused where (at d i) works ** TODO (slice d 1) over a dyn string is refused where (at d i) works
The typed and dyn spaces disagree about a spelling, which the standing rule The typed and dyn spaces disagree about a spelling, which the standing rule
@ -1073,11 +1062,6 @@ An unknown call whose near miss is a value — =(context-allocator)= against
=context/allocator=, or a global — says the name is a value written without =context/allocator=, or a global — says the name is a value written without
parentheses, and names no call at all when the call had arguments. parentheses, and names no call at all when the call had arguments.
** NEXT (Ptr const T), the pointer beside [const T]
Decided 2026-09-25: addr through a read-only slice gives a (Ptr const T), which
nothing writes through; (Ptr T) widens to it and never back; a C parameter
declared const T* takes one. Closes the addr hole in [const T].
* Backends * Backends
** DONE The x86 backend tracks LLVM at -O0 ** DONE The x86 backend tracks LLVM at -O0

4
calc-me.flan
View File

@ -20,7 +20,7 @@
;; ── one by pointer. `addr` takes the address of a local; the pointer never ;; ── one by pointer. `addr` takes the address of a local; the pointer never
;; ── outlives the frame, so no allocator is involved. ;; ── outlives the frame, so no allocator is involved.
(defstruct Cursor (defstruct Cursor
[src [u8] ; non-owning slice into argv — calc-me never owns a byte [src [const u8] ; non-owning slice into argv — calc-me never owns a byte
pos i32]) ; no initialiser means zeroed pos i32]) ; no initialiser means zeroed
(defn peek [c (Ptr Cursor)] u8 (defn peek [c (Ptr Cursor)] u8
@ -105,7 +105,7 @@
(Some lhs))) (Some lhs)))
;; ── Whole input, or nothing. Trailing junk is an error, not ignored. ── ;; ── Whole input, or nothing. Trailing junk is an error, not ignored. ──
(defn evaluate [src [u8]] (Option f64) (defn evaluate [src [const u8]] (Option f64)
(let [c (Cursor {.src src})] ; pos omitted: zeroed (let [c (Cursor {.src src})] ; pos omitted: zeroed
(let [v (some (parse-expr (addr c) 1))] (let [v (some (parse-expr (addr c) 1))]
(skip-spaces (addr c)) (skip-spaces (addr c))

22
docs/BUILT.md
View File

@ -1043,7 +1043,7 @@ the only two under which a mark and a sweep run at all. `dev_segv` sits beside t
program that faults cannot be compared against an unsanitized run — that build's handler parks in the break loop, and program that faults cannot be compared against an unsanitized run — that build's handler parks in the break loop, and
the two builds are *supposed* to differ, since `flan_dev_crash_enable` checks a weak `__asan_init` and declines to the two builds are *supposed* to differ, since `flan_dev_crash_enable` checks a weak `__asan_init` and declines to
install the handler when ASan is in the process. So the case asserts ASan's report and the absence of the handler's install the handler when ASan is in the process. So the case asserts ASan's report and the absence of the handler's
line, built at `-O0` because at `-O2` the write through a bytes-view of a literal does not fault at all. That yield had line, built at `-O0` because at `-O2` a store through a zeroed `(Ptr u8)` is undefined and need not fault. That yield had
never run in any build anywhere: it was behind a link that did not happen. Twenty-six seconds of the alias's 2m30 warm. never run in any build anywhere: it was behind a link that did not happen. Twenty-six seconds of the alias's 2m30 warm.
What it still does not reach is a program driven by a real daemon under ASan: `flan dev` builds its host through its own What it still does not reach is a program driven by a real daemon under ASan: `flan dev` builds its host through its own
path and has no `--sanitize` to pass it. path and has no `--sanitize` to pass it.
@ -3001,7 +3001,7 @@ fires.
| `(clone v)` / `(clone v a)` | the only copy; assignment moves | | `(clone v)` / `(clone v a)` | the only copy; assignment moves |
| `(free v)` | consumes its argument | | `(free v)` | consumes its argument |
| `(bytes s)` / `(bytes s a)` | a writable copy of a string's bytes, against the context or a named allocator — an allocating operation like `vec-new`: StorageExhausted with retry, a registry note in dev builds. The answer is a `[u8]` view of the block, so nothing can `free` it through the slice; it lives until its allocator's `free-all` or destroy | | `(bytes s)` / `(bytes s a)` | a writable copy of a string's bytes, against the context or a named allocator — an allocating operation like `vec-new`: StorageExhausted with retry, a registry note in dev builds. The answer is a `[u8]` view of the block, so nothing can `free` it through the slice; it lives until its allocator's `free-all` or destroy |
| `(bytes-view s)` | the string's own storage as a `[u8]`, costing nothing — the old `(bytes s)` reinterpret, renamed. Read-only by convention: a literal's view points into `.rodata` and a store through it traps | | `(bytes-view s)` | the string's own storage as a `[const u8]`, costing nothing — the old `(bytes s)` reinterpret, renamed. A store through it is a compile error, because a literal's view points into `.rodata` |
### A view of a `Vec` goes stale at the `push`, and nothing checks it ### A view of a `Vec` goes stale at the `push`, and nothing checks it
@ -4181,7 +4181,7 @@ held at once; these copy out of that buffer before returning, so the hazard ends
many numbers as it likes. `strings.flan` puts two integers and a float on one line, which is the case that could not many numbers as it likes. `strings.flan` puts two integers and a float on one line, which is the case that could not
be written before. be written before.
### `split` answers a `(Vec [u8])`, and the owning shape is unrepresentable ### `split` answers a `(Vec [const u8])`, and the owning shape is unrepresentable
The fields are slices *of the input*. That was not a performance choice when this was written: `(Vec (Vec u8))` was The fields are slices *of the input*. That was not a performance choice when this was written: `(Vec (Vec u8))` was
**refused outright**, so there was no owning shape to have chosen instead. That refusal has since been narrowed — see **refused outright**, so there was no owning shape to have chosen instead. That refusal has since been narrowed — see
@ -4195,7 +4195,7 @@ The rule is `split-on-byte`'s, unchanged: n separators always yield n+1 fields,
field and a trailing separator yields a trailing empty one. That is Odin's allocating `strings.split` and not Odin's field and a trailing separator yields a trailing empty one. That is Odin's allocating `strings.split` and not Odin's
`split_by_byte_iterator`, which disagree with each other on exactly that input. `split_by_byte_iterator`, which disagree with each other on exactly that input.
Constructing it needed a one-line `(defn slices-new [] (Vec [u8]) (vec-new))`, because `check.ml`'s `vec_new_elem` Constructing it needed a one-line `(defn slices-new [] (Vec [const u8]) (vec-new))`, because `check.ml`'s `vec_new_elem`
takes the element type as a single bare symbol and `[u8]` is not one — so a `(Vec [u8])` can only be made where the takes the element type as a single bare symbol and `[u8]` is not one — so a `(Vec [u8])` can only be made where the
*context* names the type, and a return type is a context while a `let` is not. Written down in TODO.org, *context* names the type, and a return type is a context while a `let` is not. Written down in TODO.org,
"(vec-new [u8]) is refused", as a compiler gap rather than worked around silently. "(vec-new [u8]) is refused", as a compiler gap rather than worked around silently.
@ -4831,7 +4831,7 @@ and the rule is easier to state and to trust with one construct in it.
## Assets are baked in, and the reason it is a compiler feature ## Assets are baked in, and the reason it is a compiler feature
TODO.org, "Assets are embedded at compile time". `(embed "brush.png")` is a `[u8]`, `(embed "brush.png" string)` is a `string`, and TODO.org, "Assets are embedded at compile time". `(embed "brush.png")` is a `[const u8]`, `(embed "brush.png" string)` is a `string`, and
`(embed-dir "assets")` is a `[n EmbedFile]` sorted by name. Odin's `#load` and `#load_directory` are the model `(embed-dir "assets")` is a `[n EmbedFile]` sorted by name. Odin's `#load` and `#load_directory` are the model
(`src/parser.cpp`, and `check_load_directive` / `check_load_directory_directive` in `src/check_builtin.cpp`); Odin's (`src/parser.cpp`, and `check_load_directive` / `check_load_directory_directive` in `src/check_builtin.cpp`); Odin's
`#` is not imported, because an s-expression language already has a head position for a name and these resolve as `#` is not imported, because an s-expression language already has a head position for a name and these resolve as
@ -4844,12 +4844,12 @@ so a program can never be a package: the single file doing `(rl/load-texture "br
with **no link channel at all**. The web lane found that hole and did not invent a flag for it. Embedding has no such with **no link channel at all**. The web lane found that hole and did not invent a flag for it. Embedding has no such
hole, because there is nothing to tell the linker. hole, because there is nothing to tell the linker.
**It costs nothing at run time.** The bytes reach the program as a `Tast.Str` node typed `[u8]`, which emit.ml turns **It costs nothing at run time.** The bytes reach the program as a `Tast.Str` node typed `[const u8]`, which emit.ml turns
into the same `private unnamed_addr constant` every string literal already becomes, and its `escape` is byte-exact into the same `private unnamed_addr constant` every string literal already becomes, and its `escape` is byte-exact
across the whole 0–255 range, so a PNG survives the round trip through the `.ll`. Bound with `defconst` at top level an across the whole 0–255 range, so a PNG survives the round trip through the `.ll`. Bound with `defconst` at top level an
`embed-dir` is an LLVM constant outright, through emit.ml's `const`. `embed-dir` is an LLVM constant outright, through emit.ml's `const`.
**A `Str` node typed `[u8]`, not a `Bytes` prim over a `string`.** This is the one non-obvious choice. `Bytes` is **A `Str` node typed `[const u8]`, not a `Bytes` prim over a `string`.** This is the one non-obvious choice. `Bytes` is
identity — emit.ml lowers `Types.String` and `Types.Slice _` to the same `%slice` — but wrapping the literal in a prim identity — emit.ml lowers `Types.String` and `Types.Slice _` to the same `%slice` — but wrapping the literal in a prim
makes the node non-constant, and `const` then refuses an `embed-dir` in a `defconst` with *a global's value must be a makes the node non-constant, and `const` then refuses an `embed-dir` in a `defconst` with *a global's value must be a
compile-time constant*. Both of emit.ml's string emitters take the bytes and ignore the node's type, so it is the same compile-time constant*. Both of emit.ml's string emitters take the bytes and ignore the node's type, so it is the same
@ -4876,11 +4876,9 @@ the call reads `(embed-find (slice assets 0 (length assets)) "brush.png")`. Entr
order is filesystem-dependent and an unsorted embed would make two builds of identical sources emit different `.ll`. order is filesystem-dependent and an unsorted embed would make two builds of identical sources emit different `.ll`.
Non-recursive, files only — Odin again. Non-recursive, files only — Odin again.
**The sharp edge, inherited and not widened.** The slice points into `.rodata`, so a store through it segfaults at **Read-only, and the type says so.** The slice points into `.rodata`, where a store would segfault at `-O0` and be
`-O0` and is deleted as undefined behaviour at `-O2` — the same trap the prelude's ASCII-case note measures for deleted as undefined behaviour at `-O2`, so it is a `[const u8]` and a store through it is refused at compile time.
`(bytes "Hi")`, and the same one TODO.org tracks as "Writing through a string literal". Nothing here makes it worse and To decode an asset in place, copy the bytes into a `Vec` first.
nothing here fixes it; provenance is what would. **To get a mutable copy, clone the bytes into a `Vec`.** It is worth
saying loudly because an embedded asset is precisely the thing someone will try to decode in place.
**What this does not do.** `sand.flan` still calls `(rl/load-texture "brush.png")`, which hands raylib a path for **What this does not do.** `sand.flan` still calls `(rl/load-texture "brush.png")`, which hands raylib a path for
raylib to open. Pointing raylib at embedded bytes needs `LoadImageFromMemory` and `LoadTextureFromImage` in place of raylib to open. Pointing raylib at embedded bytes needs `LoadImageFromMemory` and `LoadTextureFromImage` in place of

6
emacs/flan-mode.el
View File

@ -242,7 +242,9 @@ reason and is the odd one — it is legal only as the last item of a `def' or a
;; resolves and the two function types, `Fn' and `CFn'. `dyn' is ;; resolves and the two function types, `Fn' and `CFn'. `dyn' is
;; lowercase on purpose — it is a primitive beside `i64' and `bool', not ;; lowercase on purpose — it is a primitive beside `i64' and `bool', not
;; a container over something. ;; a container over something.
;; `int' and `float' are builtin aliases for `i32' and `f32'. ;; `int' and `float' are builtin aliases for `i32' and `f32'. `const'
;; is the reserved word of the read-only slice type, `[const u8]', and is
;; drawn as part of the type it spells.
;; ;;
;; `Unit' is deliberately absent, though `Types.primitive_names' has it. ;; `Unit' is deliberately absent, though `Types.primitive_names' has it.
;; The resolver answers to the name because `Cimport' builds one for C's ;; The resolver answers to the name because `Cimport' builds one for C's
@ -250,7 +252,7 @@ reason and is the odd one — it is legal only as the last item of a `def' or a
;; word outright — unit is spelled `()'. Drawing it as a valid type would ;; word outright — unit is spelled `()'. Drawing it as a valid type would
;; advertise a spelling the parser rejects, which is the same reason ;; advertise a spelling the parser rejects, which is the same reason
;; `find-restart' and `await' are left out of `flan--special'. ;; `find-restart' and `await' are left out of `flan--special'.
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|dyn\\|int\\|float\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>" ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|dyn\\|const\\|int\\|float\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
. font-lock-type-face) . font-lock-type-face)
;; A type variable, `$t', which is what a generic `defn' names its ;; A type variable, `$t', which is what a generic `defn' names its
;; parameter types with and what `{:where (ordered? $t)}' constrains. ;; parameter types with and what `{:where (ordered? $t)}' constrains.

2
emacs/test-flan-mode.el
View File

@ -491,6 +491,8 @@
"a package alias") "a package alias")
("(defn f [x int] float 1.0)" "int" font-lock-type-face ("(defn f [x int] float 1.0)" "int" font-lock-type-face
"int, the builtin alias") "int, the builtin alias")
("(defn f [s [const u8]] 1)" "const" font-lock-type-face
"const, in a read-only slice type")
;; Constants that stand for themselves. ;; Constants that stand for themselves.
("(set done true)" "true" font-lock-constant-face "true") ("(set done true)" "true" font-lock-constant-face "true")
("(= o None)" "None" font-lock-constant-face "None") ("(= o None)" "None" font-lock-constant-face "None")

2
examples/text-rectangle-bounds.flan
View File

@ -63,7 +63,7 @@
;; from here they are ordinary slices, bounds-checked like any other, and the ;; 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 ;; index comes from raylib's own get-glyph-index so it is in range by
;; construction. ;; construction.
(defn draw-text-boxed [font rl/Font text [u8] rec rl/Rectangle (defn draw-text-boxed [font rl/Font text [const u8] rec rl/Rectangle
font-size f32 spacing f32 word-wrap? bool font-size f32 spacing f32 word-wrap? bool
tint rl/Color] () tint rl/Color] ()
(let [glyphs (rl/font-glyphs font) (let [glyphs (rl/font-glyphs font)

2
lib/ast.ml
View File

@ -14,7 +14,7 @@ type texpr = { t : texpr_kind; tloc : Loc.t }
and texpr_kind = and texpr_kind =
| Tname of string (* i32 bool Cursor string *) | Tname of string (* i32 bool Cursor string *)
| Tslice of texpr (* [u8] ptr+len *) | Tslice of bool * texpr (* [u8] [const u8] ptr+len *)
| Tarray of len * texpr (* [4 f32] [rows [cols u32]] *) | Tarray of len * texpr (* [4 f32] [rows [cols u32]] *)
| Tmap of texpr * texpr (* (Map string i32) *) | Tmap of texpr * texpr (* (Map string i32) *)
| Tapp of string * texpr list (* (Ptr Cursor) (Option f64) *) | Tapp of string * texpr list (* (Ptr Cursor) (Option f64) *)

614
lib/check.ml
View File

File diff suppressed because it is too large Load Diff

24
lib/cimport.ml
View File

@ -407,7 +407,8 @@ let rec ty_source (t : Ast.texpr) =
| Ast.Tname n -> n | Ast.Tname n -> n
| Ast.Tapp (n, args) -> | Ast.Tapp (n, args) ->
Printf.sprintf "(%s %s)" n (String.concat " " (List.map ty_source args)) Printf.sprintf "(%s %s)" n (String.concat " " (List.map ty_source args))
| Ast.Tslice e -> Printf.sprintf "[%s]" (ty_source e) | Ast.Tslice (c, e) ->
Printf.sprintf "[%s%s]" (if c then "const " else "") (ty_source e)
| Ast.Tarray (Ast.Lint n, e) -> Printf.sprintf "[%Ld %s]" n (ty_source e) | Ast.Tarray (Ast.Lint n, e) -> Printf.sprintf "[%Ld %s]" n (ty_source e)
| Ast.Tarray (Ast.Lname n, e) -> Printf.sprintf "[%s %s]" n (ty_source e) | Ast.Tarray (Ast.Lname n, e) -> Printf.sprintf "[%s %s]" n (ty_source e)
| Ast.Tmap (k, v) -> | Ast.Tmap (k, v) ->
@ -555,6 +556,13 @@ let param_ty env (s : string) : Ast.texpr =
"char * is a parameter C may write through, and a Flan string crosses \ "char * is a parameter C may write through, and a Flan string crosses \
as a NUL-terminated copy — the writes would be lost. const char * is \ as a NUL-terminated copy — the writes would be lost. const char * is \
a string; this one needs a declare-c saying (Ptr u8)" a string; this one needs a declare-c saying (Ptr u8)"
(* [const T *] is the one pointer C promises not to write through, so it
takes a (Ptr const T) — and with it the address of a read-only
element, which a (Ptr T) parameter would refuse. *)
| _ when is_const ->
(match (value_ty env s).Ast.t with
| Ast.Tapp ("Ptr", [ e ]) -> ty (Ast.Tapp ("Ptr", [ tname "const"; e ]))
| _ -> value_ty env s)
| _ -> value_ty env s | _ -> value_ty env s
end end
else value_ty env s else value_ty env s
@ -948,9 +956,7 @@ let c_pointee (s : string) : string option =
Some (String.trim (String.sub s 0 (String.length s - 1))) Some (String.trim (String.sub s 0 (String.length s - 1)))
else None else None
let ptr_agrees env ~(c : string) (t : Ast.texpr) = let ptr_agrees_elem env ~inner (elem : Ast.texpr) =
match (c_pointee c, t.Ast.t) with
| Some inner, Ast.Tapp ("Ptr", [ elem ]) ->
(* [void *] agrees with a pointer to anything, and this is the judgement (* [void *] agrees with a pointer to anything, and this is the judgement
call of the arm. C's [void *] is opaque about *what it points at* — that call of the arm. C's [void *] is opaque about *what it points at* — that
is the whole of what the spelling means — so there is no element type in is the whole of what the spelling means — so there is no element type in
@ -975,6 +981,16 @@ let ptr_agrees env ~(c : string) (t : Ast.texpr) =
header's [(Ptr int)] lands on the enum arm. The four bytes are the header's [(Ptr int)] lands on the enum arm. The four bytes are the
same four bytes through a pointer as they are beside one. *) same four bytes through a pointer as they are beside one. *)
agrees env want elem || (byte a && byte b)) agrees env want elem || (byte a && byte b))
let ptr_agrees env ~(c : string) (t : Ast.texpr) =
match (c_pointee c, t.Ast.t) with
(* A (Ptr const T) promises C will not write, so the header has to promise
it too: over a [T *] without const, C may write through storage Flan
holds read-only. *)
| Some inner, Ast.Tapp ("Ptr", [ { Ast.t = Ast.Tname "const"; _ }; elem ]) ->
strip_prefix "const " inner <> None
&& ptr_agrees_elem env ~inner elem
| Some inner, Ast.Tapp ("Ptr", [ elem ]) -> ptr_agrees_elem env ~inner elem
| _ -> false | _ -> false
(* The two together, for the one caller that still has the C spelling. A (* The two together, for the one caller that still has the C spelling. A

8
lib/dev.ml
View File

@ -2742,7 +2742,7 @@ let type_of_spelling t spelling : (Types.t, string) result =
let addr_extern : Tast.extern = let addr_extern : Tast.extern =
{ Tast.ename = "flan/dev-addr"; esym = "flan_dev_reg_addr"; { Tast.ename = "flan/dev-addr"; esym = "flan_dev_reg_addr";
eparams = [ Types.Int Types.I64 ]; eparams = [ Types.Int Types.I64 ];
eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown } eret = Types.Ptr (Types.Mut, (Types.Int Types.U8)); eloc = Loc.unknown }
(* Renders the value [(Ptr ty)] holding [addr], in the program. (* Renders the value [(Ptr ty)] holding [addr], in the program.
@ -2777,7 +2777,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
extra := ty :: !extra; extra := ty :: !extra;
i) } i) }
in in
let pty = Types.Ptr ty in let pty = Types.Ptr (Types.Mut, ty) in
let root = let root =
{ Tast.e = { Tast.e =
Tast.Prim Tast.Prim
@ -2787,7 +2787,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
("flan/dev-addr", ("flan/dev-addr",
[ { Tast.e = Tast.Int (Int64.of_int addr, Types.I64); [ { Tast.e = Tast.Int (Int64.of_int addr, Types.I64);
ty = Types.Int Types.I64; loc } ]); ty = Types.Int Types.I64; loc } ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ]); ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc } ]);
ty = pty; loc } ty = pty; loc }
in in
match Render.render c 0 root with match Render.render c 0 root with
@ -2951,7 +2951,7 @@ let inspect_addr t ~addr ~want_type =
| Ok v -> | Ok v ->
ok ok
([ Printf.sprintf ":addr %d" addr; ([ Printf.sprintf ":addr %d" addr;
":type " ^ Wire.quote (Types.to_string (Types.Ptr ty)); ":type " ^ Wire.quote (Types.to_string (Types.Ptr (Types.Mut, ty)));
":value " ^ Wire.quote v; ":live " ^ live ] ":value " ^ Wire.quote v; ":live " ^ live ]
@ told @ where)))))) @ told @ where))))))

32
lib/emit.ml
View File

@ -1009,7 +1009,7 @@ let rec dty m d (t : Types.t) : int =
| Types.Bool -> basic "bool" 8 "DW_ATE_boolean" | Types.Bool -> basic "bool" 8 "DW_ATE_boolean"
| Types.Enum e -> basic e 32 "DW_ATE_signed" | Types.Enum e -> basic e 32 "DW_ATE_signed"
| Types.Unit | Types.Never -> composite (Types.to_string t) [] | Types.Unit | Types.Never -> composite (Types.to_string t) []
| Types.Ptr e -> | Types.Ptr (_, e) ->
let id = dalloc d in let id = dalloc d in
Hashtbl.replace d.dtys key id; Hashtbl.replace d.dtys key id;
(* [(Ptr Unit)] and [(Ptr Never)] are the opaque pointer, and a DWARF (* [(Ptr Unit)] and [(Ptr Never)] are the opaque pointer, and a DWARF
@ -1035,10 +1035,10 @@ let rec dty m d (t : Types.t) : int =
capacity, so two members are the whole truth about a slice. *) capacity, so two members are the whole truth about a slice. *)
| Types.String -> | Types.String ->
composite "string" composite "string"
[ ("ptr", Types.Ptr (Types.Int Types.U8)); ("len", Types.Int Types.I64) ] [ ("ptr", Types.Ptr (Types.Mut, (Types.Int Types.U8))); ("len", Types.Int Types.I64) ]
| Types.Slice e -> | Types.Slice (_, e) ->
composite (Types.to_string t) composite (Types.to_string t)
[ ("ptr", Types.Ptr e); ("len", Types.Int Types.I64) ] [ ("ptr", Types.Ptr (Types.Mut, e)); ("len", Types.Int Types.I64) ]
| Types.Option e -> | Types.Option e ->
composite (Types.to_string t) composite (Types.to_string t)
[ ("tag", Types.Int Types.U8); ("value", e) ] [ ("tag", Types.Int Types.U8); ("value", e) ]
@ -1106,7 +1106,7 @@ let rec dty m d (t : Types.t) : int =
would put the reader's offsets out by one. *) would put the reader's offsets out by one. *)
| Types.Vec e -> | Types.Vec e ->
composite (Types.to_string t) composite (Types.to_string t)
[ ("ptr", Types.Ptr e); ("len", Types.Int Types.I64); [ ("ptr", Types.Ptr (Types.Mut, e)); ("len", Types.Int Types.I64);
("cap", Types.Int Types.I64); ("allocator", Types.Alloc); ("cap", Types.Int Types.I64); ("allocator", Types.Alloc);
("epoch", Types.Int Types.I64) ] ("epoch", Types.Int Types.I64) ]
(* Five fields again, and shown as five for the same reason: a debugger (* Five fields again, and shown as five for the same reason: a debugger
@ -1116,7 +1116,7 @@ let rec dty m d (t : Types.t) : int =
describing a field that is not there. *) describing a field that is not there. *)
| Types.Map (k, v) -> | Types.Map (k, v) ->
composite (Types.to_string t) composite (Types.to_string t)
[ ("data", Types.Ptr (Types.Int Types.U8)); [ ("data", Types.Ptr (Types.Mut, (Types.Int Types.U8)));
("len", Types.Int Types.I64); ("log2cap", Types.Int Types.I64); ("len", Types.Int Types.I64); ("log2cap", Types.Int Types.I64);
("allocator", Types.Alloc); ("epoch", Types.Int Types.I64) ] ("allocator", Types.Alloc); ("epoch", Types.Int Types.I64) ]
|> fun n -> ignore k; ignore v; n |> fun n -> ignore k; ignore v; n
@ -1131,7 +1131,7 @@ let rec dty m d (t : Types.t) : int =
locals, where they are under the names the source gave them. *) locals, where they are under the names the source gave them. *)
| Types.Fn _ -> | Types.Fn _ ->
composite (Types.to_string t) composite (Types.to_string t)
[ ("code", Types.Ptr Types.Unit); ("env", Types.Ptr Types.Unit) ] [ ("code", Types.Ptr (Types.Mut, Types.Unit)); ("env", Types.Ptr (Types.Mut, Types.Unit)) ]
(* And the bare one is what it always was: a pointer to code, and lldb (* And the bare one is what it always was: a pointer to code, and lldb
is told exactly that and no more. DWARF has DW_TAG_subroutine_type is told exactly that and no more. DWARF has DW_TAG_subroutine_type
for the signature behind it, and spelling one out would buy a reader for the signature behind it, and spelling one out would buy a reader
@ -2831,7 +2831,7 @@ and element_addr f (target : Tast.expr) idx =
same way, bounds check included. *) same way, bounds check included. *)
| Types.Slice _ | Types.String -> | Types.Slice _ | Types.String ->
let elem = let elem =
match ty with Types.Slice e -> e | _ -> Types.Int Types.U8 in match ty with Types.Slice (_, e) -> e | _ -> Types.Int Types.U8 in
(* A slice is ptr+len, so step through the pointer it holds. *) (* A slice is ptr+len, so step through the pointer it holds. *)
let s = load f ptr ty in let s = load f ptr ty in
let base = fresh f in let base = fresh f in
@ -2858,7 +2858,7 @@ and place f (p : Tast.place) : string * Types.t =
| Tast.Pindex (target, idx) -> element_addr f target idx | Tast.Pindex (target, idx) -> element_addr f target idx
| Tast.Pderef target -> | Tast.Pderef target ->
let t = match target.Tast.ty with let t = match target.Tast.ty with
| Types.Ptr t -> t | t -> internal "deref of %s" (Types.to_string t) | Types.Ptr (_, t) -> t | t -> internal "deref of %s" (Types.to_string t)
in in
value f target, t value f target, t
@ -3716,7 +3716,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
ins f "%s = getelementptr inbounds %s, ptr %s, i64 0, i64 %s" ins f "%s = getelementptr inbounds %s, ptr %s, i64 0, i64 %s"
p (ll target.Tast.ty) a lo64; p (ll target.Tast.ty) a lo64;
p p
| Types.Slice elem -> | Types.Slice (_, elem) ->
let v = value f target in let v = value f target in
let q = fresh f in let q = fresh f in
ins f "%s = extractvalue %%slice %s, 0" q v; ins f "%s = extractvalue %%slice %s, 0" q v;
@ -3822,9 +3822,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
term f "unreachable"; term f "unreachable";
"zeroinitializer" "zeroinitializer"
| Tast.Argv, [] -> | Tast.Argv, [] ->
let tmp = alloca f (Types.Slice Types.String) in let tmp = alloca f (Types.Slice (Types.Mut, Types.String)) in
ins f "call void @flan_argv(ptr %s)" tmp; ins f "call void @flan_argv(ptr %s)" tmp;
load f tmp (Types.Slice Types.String) load f tmp (Types.Slice (Types.Mut, Types.String))
(* One arm for every runtime entry point the allocator and container runtime (* One arm for every runtime entry point the allocator and container runtime
has. The result type is the node's own and the argument types are the has. The result type is the node's own and the argument types are the
arguments' own, so nothing here has to know which symbol it is calling. *) arguments' own, so nothing here has to know which symbol it is calling. *)
@ -3926,17 +3926,17 @@ and shim_in f name ret x =
and shim_out f name (x : Tast.expr) (buf : Tast.expr) = and shim_out f name (x : Tast.expr) (buf : Tast.expr) =
let v = value f x in let v = value f x in
let b = value f buf in let b = value f buf in
let tmp = alloca f (Types.Slice (Types.Int Types.U8)) in let tmp = alloca f (Types.Slice (Types.Mut, (Types.Int Types.U8))) in
ins f "call void %s(%s %s, ptr %s, ptr %s)" name (ll x.Tast.ty) v b tmp; ins f "call void %s(%s %s, ptr %s, ptr %s)" name (ll x.Tast.ty) v b tmp;
load f tmp (Types.Slice (Types.Int Types.U8)) load f tmp (Types.Slice (Types.Mut, (Types.Int Types.U8)))
(* Slice in, slice out: [shim_in] returns a scalar and [shim_out] takes one, so (* Slice in, slice out: [shim_in] returns a scalar and [shim_out] takes one, so
a shim that transforms bytes into bytes is neither. *) a shim that transforms bytes into bytes is neither. *)
and shim_in_out f name (x : Tast.expr) = and shim_in_out f name (x : Tast.expr) =
let p, n = explode f x in let p, n = explode f x in
let tmp = alloca f (Types.Slice (Types.Int Types.U8)) in let tmp = alloca f (Types.Slice (Types.Mut, (Types.Int Types.U8))) in
ins f "call void %s(ptr %s, i64 %s, ptr %s)" name p n tmp; ins f "call void %s(ptr %s, i64 %s, ptr %s)" name p n tmp;
load f tmp (Types.Slice (Types.Int Types.U8)) load f tmp (Types.Slice (Types.Mut, (Types.Int Types.U8)))
and cast f ~guard (x : Tast.expr) target = and cast f ~guard (x : Tast.expr) target =
let v = value f x in let v = value f x in

4
lib/js.ml
View File

@ -219,7 +219,7 @@ let rec refuse_ty loc (t : Types.t) =
match t with match t with
| Types.Int _ | Types.Float _ | Types.Bool | Types.String | Types.Unit | Types.Int _ | Types.Float _ | Types.Bool | Types.String | Types.Unit
| Types.Never | Types.Named _ | Types.Enum _ -> () | Types.Never | Types.Named _ | Types.Enum _ -> ()
| Types.Slice t | Types.Array (_, t) | Types.Option t -> refuse_ty loc t | Types.Slice (_, t) | Types.Array (_, t) | Types.Option t -> refuse_ty loc t
| Types.Vec t -> refuse_ty loc t | Types.Vec t -> refuse_ty loc t
| Types.Fn (ps, r) | Types.CFn (ps, r) -> | Types.Fn (ps, r) | Types.CFn (ps, r) ->
List.iter (refuse_ty loc) ps; refuse_ty loc r List.iter (refuse_ty loc) ps; refuse_ty loc r
@ -654,7 +654,7 @@ let struct_of m loc (t : Types.t) =
let elem_ty loc (t : Types.t) = let elem_ty loc (t : Types.t) =
match t with match t with
| Types.Slice e | Types.Array (_, e) -> e | Types.Slice (_, e) | Types.Array (_, e) -> e
| Types.String -> Types.Int Types.U8 | Types.String -> Types.Int Types.U8
| t -> at loc "indexing %s is not in the JS dialect" (Types.to_string t) | t -> at loc "indexing %s is not in the JS dialect" (Types.to_string t)

4
lib/load.ml
View File

@ -198,7 +198,7 @@ let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr =
match t.Ast.t with match t.Ast.t with
| Ast.Tname n when List.mem n owned -> Ast.Tname (qualify alias n) | Ast.Tname n when List.mem n owned -> Ast.Tname (qualify alias n)
| Ast.Tname _ as k -> k | Ast.Tname _ as k -> k
| Ast.Tslice e -> Ast.Tslice (rename_texpr owned alias e) | Ast.Tslice (c, e) -> Ast.Tslice (c, rename_texpr owned alias e)
(* The length too: [rows] in [[rows [cols u32]]] is an ordinary (* The length too: [rows] in [[rows [cols u32]]] is an ordinary
compile-time constant of the package, not part of the type syntax. *) compile-time constant of the package, not part of the type syntax. *)
| Ast.Tarray (l, e) -> | Ast.Tarray (l, e) ->
@ -786,7 +786,7 @@ let exported n = not (String.equal n "main")
let rec texpr_uses acc (t : Ast.texpr) = let rec texpr_uses acc (t : Ast.texpr) =
match t.Ast.t with match t.Ast.t with
| Ast.Tname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Tname n -> acc := (n, t.Ast.tloc) :: !acc
| Ast.Tslice e -> texpr_uses acc e | Ast.Tslice (_, e) -> texpr_uses acc e
| Ast.Tarray (l, e) -> | Ast.Tarray (l, e) ->
(match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ()); (match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ());
texpr_uses acc e texpr_uses acc e

19
lib/parse.ml
View File

@ -89,10 +89,23 @@ let rec texpr (f : Form.t) : Ast.texpr =
emitter go on speaking. *) emitter go on speaking. *)
| Sym "Unit" -> fail f "unit is written (), not Unit" | Sym "Unit" -> fail f "unit is written (), not Unit"
| Sym s -> mk (Ast.Tname s) | Sym s -> mk (Ast.Tname s)
| Vec [ elem ] -> mk (Ast.Tslice (texpr elem)) (* [const T] is matched before [n T], which it would otherwise be: [const]
is a reserved name exactly so that no constant can be called that and
make the two spellings mean the same brackets. *)
| Vec [ { v = Sym "const"; _ } ] ->
fail f "[const] names no element type — a read-only slice is [const T]"
| Vec [ { v = Sym "const"; _ }; elem ] -> mk (Ast.Tslice (true, texpr elem))
| Vec [ elem ] -> mk (Ast.Tslice (false, texpr elem))
| Vec [ n; elem ] -> mk (Ast.Tarray (len n, texpr elem)) | Vec [ n; elem ] -> mk (Ast.Tarray (len n, texpr elem))
| Vec items when List.exists (fun (i : Form.t) -> i.v = Sym "const") items ->
fail f
"a read-only slice is written [const T], and a fixed array [n T] has no \
read-only form — take a read-only view of one with (slice a) where a \
[const T] is wanted"
| Vec _ -> | Vec _ ->
fail f "a type in brackets is [T] for a slice or [n T] for a fixed array" fail f
"a type in brackets is [T] for a slice, [const T] for a read-only \
slice or [n T] for a fixed array"
(* Braces are not a type. [{K V}] used to spell [(Map K V)] and the two (* Braces are not a type. [{K V}] used to spell [(Map K V)] and the two
resolved to the same thing; the brace spelling is withdrawn, and the resolved to the same thing; the brace spelling is withdrawn, and the
refusal names the surviving one rather than letting the form fall through refusal names the surviving one rather than letting the form fall through
@ -1814,7 +1827,7 @@ let rec decl (f : Form.t) : Ast.decl =
what keeps the compiler's own parameter out of the way of what keeps the compiler's own parameter out of the way of
every name the author might bind. Same trick as [gensym]. *) every name the author might bind. Same trick as [gensym]. *)
params = [ { Ast.fname = macro_args; params = [ { Ast.fname = macro_args;
fty = { Ast.t = Ast.Tslice form_t; tloc = ps.loc }; fty = { Ast.t = Ast.Tslice (false, form_t); tloc = ps.loc };
floc = ps.loc } ]; floc = ps.loc } ];
(* Written out, not deferred: a macro takes [[Form]] and (* Written out, not deferred: a macro takes [[Form]] and
returns a [Form], and neither half of that is the user's to returns a [Form], and neither half of that is the user's to

117
lib/prelude.ml
View File

@ -295,7 +295,7 @@ let source = {flan|
;; One family per element type, because there are no generics: each of these ;; One family per element type, because there are no generics: each of these
;; is a *copy* per element type, and the set below is i32 (what indices, ids ;; is a *copy* per element type, and the set below is i32 (what indices, ids
;; and tile values are), f32 (what positions, velocities and weights are) and ;; and tile values are), f32 (what positions, velocities and weights are) and
;; [u8] (what a field coming out of `split` is). ;; [const u8] (what a field coming out of `split` is).
;; ;;
;; A slice is ptr+len and non-owning, so these mutate the storage they were ;; A slice is ptr+len and non-owning, so these mutate the storage they were
;; handed: sorting (slice grid 4 9) sorts those five elements of grid and ;; handed: sorting (slice grid 4 9) sorts those five elements of grid and
@ -410,7 +410,7 @@ let source = {flan|
;; The first index holding x. None rather than -1, because Option is what the ;; The first index holding x. None rather than -1, because Option is what the
;; language has and a sentinel index is the bug this avoids. ;; language has and a sentinel index is the bug this avoids.
(defn index-of [s [$t] x $t] (Option i32) (defn index-of [s [const $t] x $t] (Option i32)
{:where (equal? $t)} {:where (equal? $t)}
(dotimes [i (length s)] (dotimes [i (length s)]
(when (= (at s i) x) (when (= (at s i) x)
@ -428,7 +428,7 @@ let source = {flan|
;; either. These reduce a slice, which is a different operation with a ;; either. These reduce a slice, which is a different operation with a
;; different arity, so the different name is honest rather than a workaround. ;; different arity, so the different name is honest rather than a workaround.
;; A type's own limits are (min-value T) and (max-value T). ;; A type's own limits are (min-value T) and (max-value T).
(defn min-of [s [$t]] (Option $t) (defn min-of [s [const $t]] (Option $t)
{:where (ordered? $t)} {:where (ordered? $t)}
(if (= (length s) 0) (if (= (length s) 0)
None None
@ -437,7 +437,7 @@ let source = {flan|
(set m (min m (at s i)))) (set m (min m (at s i))))
(Some m)))) (Some m))))
(defn max-of [s [$t]] (Option $t) (defn max-of [s [const $t]] (Option $t)
{:where (ordered? $t)} {:where (ordered? $t)}
(if (= (length s) 0) (if (= (length s) 0)
None None
@ -522,7 +522,7 @@ let source = {flan|
;; The general fold, of which sum-i32 is the special case with the + written ;; The general fold, of which sum-i32 is the special case with the + written
;; in. The accumulator comes first in the step, which is the order that reads ;; in. The accumulator comes first in the step, which is the order that reads
;; as (f acc x) and the order Odin's slice.reduce uses. ;; as (f acc x) and the order Odin's slice.reduce uses.
(defn reduce [s [$t] init $t f (Fn [$t $t] $t)] $t (defn reduce [s [const $t] init $t f (Fn [$t $t] $t)] $t
(let [acc init] (let [acc init]
(dotimes [i (length s)] (dotimes [i (length s)]
(set acc (f acc (at s i)))) (set acc (f acc (at s i))))
@ -535,7 +535,7 @@ let source = {flan|
;; allocates — (vec-new t), push, returns (Vec t) — and the type-erased Vec ;; allocates — (vec-new t), push, returns (Vec t) — and the type-erased Vec
;; runtime needed no change at all, because SizeOf and AlignOf are computed at ;; runtime needed no change at all, because SizeOf and AlignOf are computed at
;; the instantiation site, where the element type is concrete. ;; the instantiation site, where the element type is concrete.
(defn filter [s [$t] keep? (Fn [$t] bool)] (Vec $t) (defn filter [s [const $t] keep? (Fn [$t] bool)] (Vec $t)
(let [v (vec-new t)] (let [v (vec-new t)]
(dotimes [i (length s)] (dotimes [i (length s)]
(when (keep? (at s i)) (when (keep? (at s i))
@ -599,7 +599,7 @@ let source = {flan|
;; total silently wraps. The per-element (i64 ...) would happen on its own now; ;; total silently wraps. The per-element (i64 ...) would happen on its own now;
;; it is written to keep the accumulator's type visible at the line that feeds ;; it is written to keep the accumulator's type visible at the line that feeds
;; it. ;; it.
(defn sum-i32 [s [i32]] i64 (defn sum-i32 [s [const i32]] i64
(let [t (i64 0)] (let [t (i64 0)]
(dotimes [i (length s)] (dotimes [i (length s)]
(set t (+ t (i64 (at s i))))) (set t (+ t (i64 (at s i)))))
@ -612,7 +612,7 @@ let source = {flan|
;; is silently short rather than obviously wrong. An f64 accumulator has 29 ;; is silently short rather than obviously wrong. An f64 accumulator has 29
;; more bits of mantissa and pushes that failure out of reach of any array a ;; more bits of mantissa and pushes that failure out of reach of any array a
;; game holds. ;; game holds.
(defn sum-f32 [s [f32]] f64 (defn sum-f32 [s [const f32]] f64
(let [t 0.0] (let [t 0.0]
(dotimes [i (length s)] (dotimes [i (length s)]
(set t (+ t (f64 (at s i))))) (set t (+ t (f64 (at s i)))))
@ -620,12 +620,12 @@ let source = {flan|
;; ── Bytes ───────────────────────────────────────────────────────────── ;; ── Bytes ─────────────────────────────────────────────────────────────
;; ;;
;; Over [u8] and not over string, so (bytes-view s) is what a caller writes and one ;; Over [const u8] and not over string, so (bytes-view s) is what a caller writes
;; copy of each serves strings and byte slices both — which is as close to a ;; and one copy of each serves strings and byte slices both, writable or not — which is as close to a
;; generic as a language without them gets. Nothing here allocates: every ;; generic as a language without them gets. Nothing here allocates: every
;; result is a bool, an index, or a number. ;; result is a bool, an index, or a number.
(defn bytes=? [a [u8] b [u8]] bool (defn bytes=? [a [const u8] b [const u8]] bool
(if (!= (length a) (length b)) (if (!= (length a) (length b))
false false
(do (do
@ -637,11 +637,11 @@ let source = {flan|
;; The length test comes first and `and` short-circuits, so the slice is only ;; The length test comes first and `and` short-circuits, so the slice is only
;; built once it is known to be in bounds — otherwise a prefix longer than the ;; built once it is known to be in bounds — otherwise a prefix longer than the
;; string would trap rather than answer false. ;; string would trap rather than answer false.
(defn starts-with? [s [u8] p [u8]] bool (defn starts-with? [s [const u8] p [const u8]] bool
(and (<= (length p) (length s)) (and (<= (length p) (length s))
(bytes=? (slice s 0 (length p)) p))) (bytes=? (slice s 0 (length p)) p)))
(defn ends-with? [s [u8] p [u8]] bool (defn ends-with? [s [const u8] p [const u8]] bool
(and (<= (length p) (length s)) (and (<= (length p) (length s))
(bytes=? (slice s (- (length s) (length p)) (length s)) p))) (bytes=? (slice s (- (length s) (length p)) (length s)) p)))
@ -652,7 +652,7 @@ let source = {flan|
;; libc-dependent, and a parser in the language gives the same answer on ;; libc-dependent, and a parser in the language gives the same answer on
;; wasm32 as on native for the same reason rand does. ;; wasm32 as on native for the same reason rand does.
;; Overflow wraps, as all arithmetic here does; it is not reported. ;; Overflow wraps, as all arithmetic here does; it is not reported.
(defn parse-i64 [s [u8]] (Option i64) (defn parse-i64 [s [const u8]] (Option i64)
(let [i 0 (let [i 0
n (i64 0) n (i64 0)
neg false] neg false]
@ -1243,7 +1243,7 @@ let source = {flan|
;; ;;
;; Naive, O(n·m), and that is the deliberate choice: Boyer–Moore wants a skip ;; Naive, O(n·m), and that is the deliberate choice: Boyer–Moore wants a skip
;; table, which is an array sized by the needle, which is an allocation. ;; table, which is an array sized by the needle, which is an allocation.
(defn index-of-bytes [s [u8] p [u8]] (Option i32) (defn index-of-bytes [s [const u8] p [const u8]] (Option i32)
(when (> (length p) (length s)) (when (> (length p) (length s))
(return None)) (return None))
(let [last (- (length s) (length p)) (let [last (- (length s) (length p))
@ -1262,7 +1262,7 @@ let source = {flan|
;; The two loops both test (< lo hi), so an all-whitespace input walks lo up ;; The two loops both test (< lo hi), so an all-whitespace input walks lo up
;; to hi and stops there, and the result is the empty slice. Without that test ;; to hi and stops there, and the result is the empty slice. Without that test
;; lo would pass hi and (slice s lo hi) would be a reversed range, which traps. ;; lo would pass hi and (slice s lo hi) would be a reversed range, which traps.
(defn trim [s [u8]] [u8] (defn trim [s [const u8]] [const u8]
(let [lo 0 (let [lo 0
hi (length s)] hi (length s)]
(while (and (< lo hi) (space? (at s lo))) (while (and (< lo hi) (space? (at s lo)))
@ -1290,7 +1290,7 @@ let source = {flan|
;; 511 cap is flan_bytes_to_f64's buffer: past it the shim truncates, and a ;; 511 cap is flan_bytes_to_f64's buffer: past it the shim truncates, and a
;; validator that said yes to 600 digits would be approving a different ;; validator that said yes to 600 digits would be approving a different
;; number than the one strtod reads. ;; number than the one strtod reads.
(defn parse-f64 [s [u8]] (Option f64) (defn parse-f64 [s [const u8]] (Option f64)
(let [i 0 (let [i 0
digits 0] digits 0]
(when (or (= (length s) 0) (> (length s) 511)) (when (or (= (length s) 0) (> (length s) 511))
@ -1372,7 +1372,7 @@ let source = {flan|
(defn rune-start? [b u8] bool (defn rune-start? [b u8] bool
(!= (bit-and b 0xc0) 0x80)) (!= (bit-and b 0xc0) 0x80))
(defn decode-rune [s [u8]] Rune (defn decode-rune [s [const u8]] Rune
(when (= (length s) 0) (when (= (length s) 0)
(return (Rune {.code 0 .width 0 .ok false}))) (return (Rune {.code 0 .width 0 .ok false})))
(let [b0 (at s 0)] (let [b0 (at s 0)]
@ -1428,7 +1428,7 @@ let source = {flan|
;; Decode at a byte offset. None when the offset is not on a rune boundary or ;; Decode at a byte offset. None when the offset is not on a rune boundary or
;; the bytes there are malformed, which is stricter than Odin's rune_at — that ;; the bytes there are malformed, which is stricter than Odin's rune_at — that
;; one hands back RUNE_ERROR and the caller carries on with a wrong character. ;; one hands back RUNE_ERROR and the caller carries on with a wrong character.
(defn rune-at [s [u8] i i32] (Option i32) (defn rune-at [s [const u8] i i32] (Option i32)
(if (or (< i 0) (>= i (length s))) (if (or (< i 0) (>= i (length s)))
None None
(let [r (decode-rune (slice s i (length s)))] (let [r (decode-rune (slice s i (length s)))]
@ -1441,7 +1441,7 @@ let source = {flan|
;; ;;
;; A malformed byte counts as one, which is what a replacement-character ;; A malformed byte counts as one, which is what a replacement-character
;; renderer would draw, so this agrees with what the screen shows. ;; renderer would draw, so this agrees with what the screen shows.
(defn rune-count [s [u8]] i32 (defn rune-count [s [const u8]] i32
(let [i 0 (let [i 0
n 0] n 0]
(while (< i (length s)) (while (< i (length s))
@ -1450,7 +1450,7 @@ let source = {flan|
(set n (+ n 1)))) (set n (+ n 1))))
n)) n))
(defn valid-utf8? [s [u8]] bool (defn valid-utf8? [s [const u8]] bool
(let [i 0] (let [i 0]
(while (< i (length s)) (while (< i (length s))
(let [r (decode-rune (slice s i (length s)))] (let [r (decode-rune (slice s i (length s)))]
@ -1529,12 +1529,12 @@ let source = {flan|
;; empty field, and `rest` is exhausted only after the last one is taken. That ;; empty field, and `rest` is exhausted only after the last one is taken. That
;; is the rule you can state without exceptions, and the one a caller counting ;; is the rule you can state without exceptions, and the one a caller counting
;; comma-separated columns needs. ;; comma-separated columns needs.
(defstruct Split [rest [u8] sep u8 more bool]) (defstruct Split [rest [const u8] sep u8 more bool])
(defn split-on-byte [s [u8] sep u8] Split (defn split-on-byte [s [const u8] sep u8] Split
(Split {.rest s .sep sep .more true})) (Split {.rest s .sep sep .more true}))
(defn split-next [it (Ptr Split)] (Option [u8]) (defn split-next [it (Ptr Split)] (Option [const u8])
(when (not (.more it)) (when (not (.more it))
(return None)) (return None))
(match (index-of (.rest it) (.sep it)) (match (index-of (.rest it) (.sep it))
@ -1556,25 +1556,11 @@ let source = {flan|
;; the ones in the building section below; these are the forms that allocate ;; the ones in the building section below; these are the forms that allocate
;; nothing, and they stay the right call when a copy is not wanted — folding a ;; nothing, and they stay the right call when a copy is not wanted — folding a
;; comparison over two inputs beats lowering both and comparing. What is *not* ;; comparison over two inputs beats lowering both and comparing. What is *not*
;; on offer is the third shape, lowering a [u8] in place, and it is worth ;; on offer is the third shape, lowering a [u8] in place: the text a caller
;; saying why rather than shipping it. A string ;; has is most often a (bytes-view s), which is a [const u8] because a string
;; literal is emitted `private unnamed_addr constant` (emit.ml), so (bytes-view ;; literal's bytes are in read-only memory, and an in-place lower could not
;; "Hello") is a [u8] pointing straight into read-only memory. An in-place ;; take it. (bytes s) is the writable copy; a caller that owns its buffer
;; lower-ascii type checks against that slice, and what happens next depends ;; writes the two-line loop itself.
;; on the optimiser — which is the worst of the available answers. Measured,
;; with (set (at (bytes-view "Hi") 0) \h):
;;
;; -O0 the store is emitted against the constant and the program takes
;; SIGSEGV.
;; -O2 LLVM deletes the store as undefined behaviour and the program
;; carries on and prints "Hi".
;;
;; So the same source either dies or silently does nothing depending on a
;; flag, and the -O2 half is the quiet-wrongness class this file keeps
;; refusing elsewhere. (bytes s) answers a writable copy now for exactly this
;; reason; these byte functions stay the right call when no copy is wanted,
;; and a caller that really does own its buffer writes the two-line loop
;; itself over storage it can see the declaration of.
;; ;;
;; ASCII only, and only the 26 letters: case outside ASCII is not a byte ;; ASCII only, and only the 26 letters: case outside ASCII is not a byte
;; operation at all — it is per-code-point, it is not length-preserving (ß ;; operation at all — it is per-code-point, it is not length-preserving (ß
@ -1589,7 +1575,7 @@ let source = {flan|
;; Case-insensitive comparison as a fold over both inputs, which is the useful ;; Case-insensitive comparison as a fold over both inputs, which is the useful
;; half of to_lower and needs no storage at all: comparing two lowered copies ;; half of to_lower and needs no storage at all: comparing two lowered copies
;; is what a caller wanted, and this is that answer without either copy. ;; is what a caller wanted, and this is that answer without either copy.
(defn bytes-ci=? [a [u8] b [u8]] bool (defn bytes-ci=? [a [const u8] b [const u8]] bool
(if (!= (length a) (length b)) (if (!= (length a) (length b))
false false
(do (do
@ -1601,7 +1587,7 @@ let source = {flan|
;; ── Ordering byte slices, and sorting them ──────────────────────────── ;; ── Ordering byte slices, and sorting them ────────────────────────────
;; ;;
;; The third element type the slice family covers, and the one a caller of ;; The third element type the slice family covers, and the one a caller of
;; `split` actually has: a [[u8]] of fields, wanting to come out in order. ;; `split` actually has: a [[const u8]] of fields, wanting to come out in order.
;; ;;
;; The order is bytewise-lexicographic — memcmp's, and the one every sane ;; The order is bytewise-lexicographic — memcmp's, and the one every sane
;; sorted format uses. It is explicitly *not* alphabetical and not a collation: ;; sorted format uses. It is explicitly *not* alphabetical and not a collation:
@ -1618,7 +1604,7 @@ let source = {flan|
;; A prefix sorts before what extends it — "ab" before "abc" — which falls out ;; A prefix sorts before what extends it — "ab" before "abc" — which falls out
;; of running to the shorter length and then comparing lengths, and is the case ;; of running to the shorter length and then comparing lengths, and is the case
;; a loop written to (length a) alone reads off the end for. ;; a loop written to (length a) alone reads off the end for.
(defn bytes<? [a [u8] b [u8]] bool (defn bytes<? [a [const u8] b [const u8]] bool
(let [n (min (length a) (length b))] (let [n (min (length a) (length b))]
(dotimes [i n] (dotimes [i n]
(when (!= (at a i) (at b i)) (when (!= (at a i) (at b i))
@ -1626,7 +1612,7 @@ let source = {flan|
(< (length a) (length b)))) (< (length a) (length b))))
;; sort-by with the comparison written in, over the same in-place contract: ;; sort-by with the comparison written in, over the same in-place contract:
;; the *slices* move, never the bytes they point at, so this sorts a [[u8]] of ;; the *slices* move, never the bytes they point at, so this sorts a [[const u8]] of
;; fields borrowed from one buffer without touching the buffer. Stable, and ;; fields borrowed from one buffer without touching the buffer. Stable, and
;; here that is observable — two equal fields are two distinct slices of ;; here that is observable — two equal fields are two distinct slices of
;; different parts of the input, and a caller can see which one came first. ;; different parts of the input, and a caller can see which one came first.
@ -1637,7 +1623,7 @@ let source = {flan|
;; lexicographically is a loop and not an instruction. bytes<? is that loop. ;; lexicographically is a loop and not an instruction. bytes<? is that loop.
;; So this is the shape a generic takes when the operation it needs is not a ;; So this is the shape a generic takes when the operation it needs is not a
;; primitive: pass it in. ;; primitive: pass it in.
(defn sort-bytes [s [[u8]]] () (defn sort-bytes [s [[const u8]]] ()
(sort-by s (fn [a b] (bytes<? a b)))) (sort-by s (fn [a b] (bytes<? a b))))
;; ── Building bytes, which is the tier that needed an allocator ──────── ;; ── Building bytes, which is the tier that needed an allocator ────────
@ -1676,7 +1662,7 @@ let source = {flan|
;; It takes a (Ptr (Vec u8)) and not a (Vec u8), and the difference is not ;; It takes a (Ptr (Vec u8)) and not a (Vec u8), and the difference is not
;; style: a Vec parameter *moves*, so (append b s) taking one by value would ;; style: a Vec parameter *moves*, so (append b s) taking one by value would
;; consume the caller's builder on the first call and refuse the second. ;; consume the caller's builder on the first call and refuse the second.
(defn append [b (Ptr (Vec u8)) s [u8]] () (defn append [b (Ptr (Vec u8)) s [const u8]] ()
(dotimes [i (length s)] (dotimes [i (length s)]
(push (deref b) (at s i)))) (push (deref b) (at s i))))
@ -1695,12 +1681,13 @@ let source = {flan|
;; concat and join. Both take a slice of slices, which is the shape a caller ;; concat and join. Both take a slice of slices, which is the shape a caller
;; already has: an array literal of them, [(bytes-view "a") (bytes-view b)], slices to a ;; already has: an array literal of them, [(bytes-view "a") (bytes-view b)], slices to a
;; [[u8]] and copies nothing. ;; [[const u8]] and copies nothing. The outer slice is const too, which is what
;; lets a [[u8]] in as well: nothing here can store a read-only slice into it.
;; ;;
;; join with an empty separator is concat, and concat is here anyway because ;; join with an empty separator is concat, and concat is here anyway because
;; the empty (bytes-view "") a caller would have to write is the kind of argument ;; the empty (bytes-view "") a caller would have to write is the kind of argument
;; that reads like a mistake at the call site. ;; that reads like a mistake at the call site.
(defn concat [parts [[u8]]] (Vec u8) (defn concat [parts [const [const u8]]] (Vec u8)
(let [b (vec-new u8)] (let [b (vec-new u8)]
(dotimes [i (length parts)] (dotimes [i (length parts)]
(append (addr b) (at parts i))) (append (addr b) (at parts i)))
@ -1710,7 +1697,7 @@ let source = {flan|
;; result rather than a leading separator — which is the off-by-one a join ;; result rather than a leading separator — which is the off-by-one a join
;; written as "append part then separator, then chop the tail" gets wrong on ;; written as "append part then separator, then chop the tail" gets wrong on
;; exactly that input, because there is no tail to chop. ;; exactly that input, because there is no tail to chop.
(defn join [parts [[u8]] sep [u8]] (Vec u8) (defn join [parts [const [const u8]] sep [const u8]] (Vec u8)
(let [b (vec-new u8)] (let [b (vec-new u8)]
(dotimes [i (length parts)] (dotimes [i (length parts)]
(when (> i 0) (when (> i 0)
@ -1718,24 +1705,21 @@ let source = {flan|
(append (addr b) (at parts i))) (append (addr b) (at parts i)))
b)) b))
(defn repeat-bytes [s [u8] n i32] (Vec u8) (defn repeat-bytes [s [const u8] n i32] (Vec u8)
(let [b (vec-new u8)] (let [b (vec-new u8)]
(dotimes [i n] (dotimes [i n]
(append (addr b) s)) (append (addr b) s))
b)) b))
;; The allocating halves of the ASCII case pair. The note above lower-ascii ;; The allocating halves of the ASCII case pair. The note above lower-ascii
;; explains why lowering a [u8] *in place* is a trap — a string literal is ;; says why there is no in-place one; these write only bytes of their own.
;; emitted into .rodata, so the store either segfaults at -O0 or is deleted at (defn to-lower [s [const u8]] (Vec u8)
;; -O2 — and this is the shape that has no such hole: the bytes it writes are
;; its own.
(defn to-lower [s [u8]] (Vec u8)
(let [b (vec-new u8)] (let [b (vec-new u8)]
(dotimes [i (length s)] (dotimes [i (length s)]
(push b (lower-ascii (at s i)))) (push b (lower-ascii (at s i))))
b)) b))
(defn to-upper [s [u8]] (Vec u8) (defn to-upper [s [const u8]] (Vec u8)
(let [b (vec-new u8)] (let [b (vec-new u8)]
(dotimes [i (length s)] (dotimes [i (length s)]
(push b (upper-ascii (at s i)))) (push b (upper-ascii (at s i))))
@ -1754,7 +1738,7 @@ let source = {flan|
;; choice: returning a Vec *moves* it, and the move analysis is a dead set over ;; choice: returning a Vec *moves* it, and the move analysis is a dead set over
;; the whole function, so a `return b` on one branch kills the binding for the ;; the whole function, so a `return b` on one branch kills the binding for the
;; `b` at the foot of the other. One exit, one move. ;; `b` at the foot of the other. One exit, one move.
(defn replace-bytes [s [u8] from [u8] to [u8]] (Vec u8) (defn replace-bytes [s [const u8] from [const u8] to [const u8]] (Vec u8)
(let [b (vec-new u8) (let [b (vec-new u8)
i 0] i 0]
(if (= (length from) 0) (if (= (length from) 0)
@ -1779,7 +1763,7 @@ let source = {flan|
;; the other way. A return type does say it. That is a compiler gap rather than ;; the other way. A return type does say it. That is a compiler gap rather than
;; a language decision, and it is written down in TODO.org, "(vec-new [u8]) is ;; a language decision, and it is written down in TODO.org, "(vec-new [u8]) is
;; refused". ;; refused".
(defn slices-new [] (Vec [u8]) (vec-new)) (defn slices-new [] (Vec [const u8]) (vec-new))
;; split, which the file used to refuse by name. The fields are slices *of the ;; split, which the file used to refuse by name. The fields are slices *of the
;; input* and not copies, so nothing here owns bytes and the result dies with ;; input* and not copies, so nothing here owns bytes and the result dies with
@ -1791,7 +1775,7 @@ let source = {flan|
;; always yield n+1 fields, so the empty input yields one empty field and a ;; always yield n+1 fields, so the empty input yields one empty field and a
;; trailing separator yields a trailing empty one. That is Odin's allocating ;; trailing separator yields a trailing empty one. That is Odin's allocating
;; strings.split and not Odin's iterator, which disagree with each other. ;; strings.split and not Odin's iterator, which disagree with each other.
(defn split [s [u8] sep u8] (Vec [u8]) (defn split [s [const u8] sep u8] (Vec [const u8])
(let [v (slices-new) (let [v (slices-new)
it (split-on-byte s sep) it (split-on-byte s sep)
going true] going true]
@ -1951,10 +1935,9 @@ let source = {flan|
;; ;;
;; `data` points into the program's own .rodata, exactly as a string literal ;; `data` points into the program's own .rodata, exactly as a string literal
;; does, so an embed costs nothing at run time and nothing at startup. It is ;; does, so an embed costs nothing at run time and nothing at startup. It is
;; also read-only, and the same trap the ASCII-case note above measures applies ;; also read-only, so `data` is a [const u8] and a store through it is refused
;; here: a store through it either segfaults at -O0 or is deleted at -O2. To ;; at compile time. To get a writable copy, copy the bytes into a Vec.
;; get a mutable copy, clone the bytes into a Vec. (defstruct EmbedFile [name string data [const u8]])
(defstruct EmbedFile [name string data [u8]])
;; A linear scan, deliberately. A directory embed is tens of entries, the scan ;; A linear scan, deliberately. A directory embed is tens of entries, the scan
;; is over names already in cache-warm .rodata, and the alternative — a ;; is over names already in cache-warm .rodata, and the alternative — a
@ -1965,7 +1948,7 @@ let source = {flan|
;; It takes a slice rather than the array (embed-dir) answers, because an array ;; It takes a slice rather than the array (embed-dir) answers, because an array
;; length is part of its type and there are no generics: write ;; length is part of its type and there are no generics: write
;; (embed-find (slice assets 0 (length assets)) "brush.png"). ;; (embed-find (slice assets 0 (length assets)) "brush.png").
(defn embed-find [files [EmbedFile] name string] (Option [u8]) (defn embed-find [files [EmbedFile] name string] (Option [const u8])
(dotimes [i (length files)] (dotimes [i (length files)]
(when (bytes=? (bytes-view (.name (at files i))) (bytes-view name)) (when (bytes=? (bytes-view (.name (at files i))) (bytes-view name))
(return (Some (.data (at files i)))))) (return (Some (.data (at files i))))))

10
lib/render.ml
View File

@ -110,7 +110,7 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in
let bytes_of s = let bytes_of s =
{ Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]); { Tast.e = Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str s; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc } ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc }
in in
let lit s = c.emit.ebytes (bytes_of s) in let lit s = c.emit.ebytes (bytes_of s) in
let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in let int64 n = { Tast.e = Tast.Int (n, Types.I64); ty = Types.Int Types.I64; loc } in
@ -152,10 +152,10 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
| Types.String -> | Types.String ->
[ c.emit.estr [ c.emit.estr
{ Tast.e = Tast.Prim (Tast.Bytes, [ e ]); { Tast.e = Tast.Prim (Tast.Bytes, [ e ]);
ty = Types.Slice (Types.Int Types.U8); loc } ] ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc } ]
(* Bytes are almost always text, and escaping makes the case where they are (* Bytes are almost always text, and escaping makes the case where they are
not readable rather than a mess. *) not readable rather than a mess. *)
| Types.Slice (Types.Int Types.U8) -> [ c.emit.estr e ] | Types.Slice (_, (Types.Int Types.U8)) -> [ c.emit.estr e ]
(* An enum's members are erased to i32 before the backend sees them, so the (* An enum's members are erased to i32 before the backend sees them, so the
name has to be recovered here, from the checker's table, as a chain of name has to be recovered here, from the checker's table, as a chain of
comparisons. Falling through to the number is not a failure: a value comparisons. Falling through to the number is not a failure: a value
@ -193,7 +193,7 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
An address the registry never saw is neither: it prints [<ptr>]. That An address the registry never saw is neither: it prints [<ptr>]. That
is a stack local, a global, or a pointer from C, and the shadow stack is a stack local, a global, or a pointer from C, and the shadow stack
and the static type table already answer for the first two by name. *) and the static type table already answer for the first two by name. *)
| Types.Ptr t -> | Types.Ptr (_, t) ->
(match c.ptrs with (match c.ptrs with
| None -> [ lit "<ptr>" ] | None -> [ lit "<ptr>" ]
| Some pt -> | Some pt ->
@ -355,7 +355,7 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
(* A slice's length is not known until it runs, so this is the one case (* A slice's length is not known until it runs, so this is the one case
that needs a loop. The slice goes into a slot first: the expression it that needs a loop. The slice goes into a slot first: the expression it
came from must not be evaluated once per element. *) came from must not be evaluated once per element. *)
| Types.Slice t -> | Types.Slice (_, t) ->
let sv = c.alloc e.Tast.ty and iv = c.alloc (Types.Int Types.I32) in let sv = c.alloc e.Tast.ty and iv = c.alloc (Types.Int Types.I32) in
let local i ty = { Tast.e = Tast.Local i; ty; loc } in let local i ty = { Tast.e = Tast.Local i; ty; loc } in
let len = let len =

52
lib/session.ml
View File

@ -1206,8 +1206,8 @@ let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
type emitter = { ename : string; ety : Types.t } type emitter = { ename : string; ety : Types.t }
let emit_bytes = { ename = "flan/dev-emit"; ety = Types.Slice (Types.Int Types.U8) } let emit_bytes = { ename = "flan/dev-emit"; ety = Types.Slice (Types.Mut, (Types.Int Types.U8)) }
let emit_str = { ename = "flan/dev-emit-str"; ety = Types.Slice (Types.Int Types.U8) } let emit_str = { ename = "flan/dev-emit-str"; ety = Types.Slice (Types.Mut, (Types.Int Types.U8)) }
let emit_i64 = { ename = "flan/dev-emit-i64"; ety = Types.Int Types.I64 } let emit_i64 = { ename = "flan/dev-emit-i64"; ety = Types.Int Types.I64 }
let emit_u64 = { ename = "flan/dev-emit-u64"; ety = Types.Int Types.U64 } let emit_u64 = { ename = "flan/dev-emit-u64"; ety = Types.Int Types.U64 }
let emit_f64 = { ename = "flan/dev-emit-f64"; ety = Types.Float Types.F64 } let emit_f64 = { ename = "flan/dev-emit-f64"; ety = Types.Float Types.F64 }
@ -1229,12 +1229,12 @@ let externs : Tast.extern list =
is. See [render_locals]. *) is. See [render_locals]. *)
{ Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot"; { Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot";
eparams = [ Types.Int Types.I64; Types.Int Types.I64 ]; eparams = [ Types.Int Types.I64; Types.Int Types.I64 ];
eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown }; eret = Types.Ptr (Types.Mut, (Types.Int Types.U8)); eloc = Loc.unknown };
(* The condition the stopped program is holding, same contract: the agent (* The condition the stopped program is holding, same contract: the agent
resolves it against the snapshot on top when the thunk runs, and NULL resolves it against the snapshot on top when the thunk runs, and NULL
when there is none. See [render_condition]. *) when there is none. See [render_condition]. *)
{ Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition"; { Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition";
eparams = []; eret = Types.Ptr (Types.Int Types.U8); eparams = []; eret = Types.Ptr (Types.Mut, (Types.Int Types.U8));
eloc = Loc.unknown }; eloc = Loc.unknown };
(* The character beside a rendered byte. See [Render.pointers]. *) (* The character beside a rendered byte. See [Render.pointers]. *)
{ Tast.ename = "flan/dev-emit-u8-char"; esym = "flan_dev_emit_u8_char"; { Tast.ename = "flan/dev-emit-u8-char"; esym = "flan_dev_emit_u8_char";
@ -1259,10 +1259,10 @@ let externs : Tast.extern list =
written" is already the right rendering for an address the registry written" is already the right rendering for an address the registry
never saw. *) never saw. *)
{ Tast.ename = "flan/reg-live"; esym = "flan_dev_reg_live"; { Tast.ename = "flan/reg-live"; esym = "flan_dev_reg_live";
eparams = [ Types.Ptr (Types.Int Types.U8) ]; eparams = [ Types.Ptr (Types.Mut, (Types.Int Types.U8)) ];
eret = Types.Int Types.I32; eloc = Loc.unknown }; eret = Types.Int Types.I32; eloc = Loc.unknown };
{ Tast.ename = "flan/reg-emit"; esym = "flan_dev_reg_emit"; { Tast.ename = "flan/reg-emit"; esym = "flan_dev_reg_emit";
eparams = [ Types.Ptr (Types.Int Types.U8) ]; eparams = [ Types.Ptr (Types.Mut, (Types.Int Types.U8)) ];
eret = Types.Int Types.I32; eloc = Loc.unknown } ] eret = Types.Int Types.I32; eloc = Loc.unknown } ]
(* The REPL's emitter. Each piece is one extern call: the dev runtime already (* The REPL's emitter. Each piece is one extern call: the dev runtime already
@ -1291,8 +1291,8 @@ let dev_pointers : Render.pointers =
let ask name (p : Tast.expr) : Tast.expr = let ask name (p : Tast.expr) : Tast.expr =
let loc = p.Tast.loc in let loc = p.Tast.loc in
let byte = let byte =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Int Types.U8)), [ p ]); { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, (Types.Int Types.U8))), [ p ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
in in
{ Tast.e = Tast.Call (name, [ byte ]); ty = i32; loc } { Tast.e = Tast.Call (name, [ byte ]); ty = i32; loc }
in in
@ -1421,7 +1421,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
let bytes_of str = let bytes_of str =
{ Tast.e = { Tast.e =
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]); Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc } ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc }
in in
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
let refused = ref [] in let refused = ref [] in
@ -1432,11 +1432,11 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
in in
let address = let address =
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx i ]); { Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx i ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
in in
let typed = let typed =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]); { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
ty = Types.Ptr ty; loc } ty = Types.Ptr (Types.Mut, ty); loc }
in in
let v = { Tast.e = Tast.Deref typed; ty; loc } in let v = { Tast.e = Tast.Deref typed; ty; loc } in
match Render.render c 0 v with match Render.render c 0 v with
@ -1533,18 +1533,18 @@ let render_condition t ~(st : Tast.structure) : change * (string * string) list
let bytes_of str = let bytes_of str =
{ Tast.e = { Tast.e =
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]); Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc } ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc }
in in
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
let refused = ref [] in let refused = ref [] in
let cty = Types.Named st.Tast.sname in let cty = Types.Named st.Tast.sname in
let address = let address =
{ Tast.e = Tast.Call ("flan/dev-cond", []); { Tast.e = Tast.Call ("flan/dev-cond", []);
ty = Types.Ptr (Types.Int Types.U8); loc } ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
in in
let typed = let typed =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr cty), [ address ]); { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, cty)), [ address ]);
ty = Types.Ptr cty; loc } ty = Types.Ptr (Types.Mut, cty); loc }
in in
let root = { Tast.e = Tast.Deref typed; ty = cty; loc } in let root = { Tast.e = Tast.Deref typed; ty = cty; loc } in
let one i (f : Tast.field) = let one i (f : Tast.field) =
@ -1652,7 +1652,7 @@ let step_into t (v : Tast.expr) (s : step) : (Tast.expr, string) result =
{ Tast.e = Tast.Int (Int64.of_int i, Types.I32); { Tast.e = Tast.Int (Int64.of_int i, Types.I32);
ty = Types.Int Types.I32; loc } ]); ty = Types.Int Types.I32; loc } ]);
ty = el; loc } ty = el; loc }
| Types.Slice el -> | Types.Slice (_, el) ->
(* A slice's length is not in its type, so this is the one step whose (* A slice's length is not in its type, so this is the one step whose
range cannot be settled here. It is checked in the program, like range cannot be settled here. It is checked in the program, like
every other index in a dev build. *) every other index in a dev build. *)
@ -1797,11 +1797,11 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
let ty = fn.Tast.slots.(slot) in let ty = fn.Tast.slots.(slot) in
let address = let address =
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]); { Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
in in
let typed = let typed =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]); { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
ty = Types.Ptr ty; loc } ty = Types.Ptr (Types.Mut, ty); loc }
in in
let root = { Tast.e = Tast.Deref typed; ty; loc } in let root = { Tast.e = Tast.Deref typed; ty; loc } in
let rec walk v = function let rec walk v = function
@ -1832,7 +1832,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
Tast.Prim Tast.Prim
(Tast.Cast (Types.Int Types.I64), (Tast.Cast (Types.Int Types.I64),
[ { Tast.e = Tast.Prim (Tast.AddrOf, [ v ]); [ { Tast.e = Tast.Prim (Tast.AddrOf, [ v ]);
ty = Types.Ptr v.Tast.ty; loc } ]); ty = Types.Ptr (Types.Mut, v.Tast.ty); loc } ]);
ty = Types.Int Types.I64; loc } ty = Types.Int Types.I64; loc }
in in
let newline = let newline =
@ -1840,7 +1840,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
Tast.Prim Tast.Prim
(Tast.Bytes, (Tast.Bytes,
[ { Tast.e = Tast.Str "\n"; ty = Types.String; loc } ]); [ { Tast.e = Tast.Str "\n"; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc } ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc }
in in
dev_emitter.Render.ei64 addr :: dev_emitter.Render.ebytes newline dev_emitter.Render.ei64 addr :: dev_emitter.Render.ebytes newline
:: parts :: parts
@ -2012,11 +2012,11 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
let ty = fn.Tast.slots.(slot) in let ty = fn.Tast.slots.(slot) in
let address = let address =
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]); { Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx slot ]);
ty = Types.Ptr (Types.Int Types.U8); loc } ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
in in
let typed = let typed =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]); { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
ty = Types.Ptr ty; loc } ty = Types.Ptr (Types.Mut, ty); loc }
in in
let root = { Tast.e = Tast.Deref typed; ty; loc } in let root = { Tast.e = Tast.Deref typed; ty; loc } in
let rec walk v = function let rec walk v = function
@ -2194,7 +2194,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
let bytes_of str = let bytes_of str =
{ Tast.e = { Tast.e =
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]); Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc } ty = Types.Slice (Types.Mut, (Types.Int Types.U8)); loc }
in in
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in

2
lib/shim.ml
View File

@ -221,6 +221,8 @@ let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string =
else else
fail loc "%s is %s, which is not a type this shim generator knows" what n) fail loc "%s is %s, which is not a type this shim generator knows" what n)
| Ast.Tapp ("Ptr", [ e ]) -> cty env ~needed ~loc ~what e ^ " *" | Ast.Tapp ("Ptr", [ e ]) -> cty env ~needed ~loc ~what e ^ " *"
| Ast.Tapp ("Ptr", [ { Ast.t = Ast.Tname "const"; _ }; e ]) ->
"const " ^ cty env ~needed ~loc ~what e ^ " *"
| Ast.Tapp ("Option", _) -> | Ast.Tapp ("Option", _) ->
fail loc fail loc
"%s is an Option, which C has no shape for — declare what C returns and \ "%s is an Option, which C has no shape for — declare what C returns and \

64
lib/types.ml
View File

@ -18,6 +18,17 @@ type ikind = I8 | I16 | I32 | I64 | U8 | U16 | U32 | U64
type fkind = F32 | F64 type fkind = F32 | F64
(* Whether a slice may be stored through. [[const T]] is a view that can only
be read: [bytes-view] answers one, because its bytes are a string's and a
string literal's are in read-only memory. A [[T]] converts to a
[[const T]] implicitly and never back — see [const_widens] at the bottom of
this file — so every writable view is also a readable one, and a
read-only one cannot be laundered into a writable one. The const is
shallow: a [[const [u8]]] may not have its elements replaced, but each
element is a writable [[u8]] of its own. Both are the same two words at
run time; only the checker reads the flag. *)
type access = Mut | Const
type t = type t =
| Int of ikind | Int of ikind
| Float of fkind | Float of fkind
@ -29,10 +40,10 @@ type t =
(* A C enum: an i32 at run time, but its own type, so a keyword at a call (* A C enum: an i32 at run time, but its own type, so a keyword at a call
site has something to resolve against and a plain integer does not fit. *) site has something to resolve against and a plain integer does not fit. *)
| Enum of string | Enum of string
| Slice of t (* [T] ptr+len, non-owning *) | Slice of access * t (* [T] [const T] ptr+len, non-owning *)
| Array of int64 * t (* [n T] inline, a value, copies *) | Array of int64 * t (* [n T] inline, a value, copies *)
| Map of t * t (* (Map K V) *) | Map of t * t (* (Map K V) *)
| Ptr of t (* (Ptr T) *) | Ptr of access * t (* (Ptr T) (Ptr const T) *)
(* [Allocator]: a builtin opaque type, the way [string] is a builtin (* [Allocator]: a builtin opaque type, the way [string] is a builtin
ptr+len. It is a [Types.t] case with no user-writable constructor, which ptr+len. It is a [Types.t] case with no user-writable constructor, which
is what lets spec-memory.md's "procedure plus an opaque data pointer" be is what lets spec-memory.md's "procedure plus an opaque data pointer" be
@ -179,10 +190,10 @@ let rec equal a b =
one dyn type the way there is one string type. *) one dyn type the way there is one string type. *)
| Bool, Bool | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true | Bool, Bool | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true
| Named x, Named y | Enum x, Enum y -> String.equal x y | Named x, Named y | Enum x, Enum y -> String.equal x y
| Slice x, Slice y -> equal x y | Slice (a, x), Slice (b, y) -> a = b && equal x y
| Array (n, x), Array (m, y) -> Int64.equal n m && equal x y | Array (n, x), Array (m, y) -> Int64.equal n m && equal x y
| Map (k, v), Map (k', v') -> equal k k' && equal v v' | Map (k, v), Map (k', v') -> equal k k' && equal v v'
| Ptr x, Ptr y -> equal x y | Ptr (a, x), Ptr (b, y) -> a = b && equal x y
| Alloc, Alloc -> true | Alloc, Alloc -> true
| Vec x, Vec y -> equal x y | Vec x, Vec y -> equal x y
| Option x, Option y -> equal x y | Option x, Option y -> equal x y
@ -204,10 +215,12 @@ let rec to_string = function
| Unit -> "()" | Unit -> "()"
| Never -> "Never" | Never -> "Never"
| Named n | Enum n -> n | Named n | Enum n -> n
| Slice t -> "[" ^ to_string t ^ "]" | Slice (Mut, t) -> "[" ^ to_string t ^ "]"
| Slice (Const, t) -> "[const " ^ to_string t ^ "]"
| Array (n, t) -> Printf.sprintf "[%Ld %s]" n (to_string t) | Array (n, t) -> Printf.sprintf "[%Ld %s]" n (to_string t)
| Map (k, v) -> Printf.sprintf "(Map %s %s)" (to_string k) (to_string v) | Map (k, v) -> Printf.sprintf "(Map %s %s)" (to_string k) (to_string v)
| Ptr t -> "(Ptr " ^ to_string t ^ ")" | Ptr (Mut, t) -> "(Ptr " ^ to_string t ^ ")"
| Ptr (Const, t) -> "(Ptr const " ^ to_string t ^ ")"
| Alloc -> "Allocator" | Alloc -> "Allocator"
| Vec t -> "(Vec " ^ to_string t ^ ")" | Vec t -> "(Vec " ^ to_string t ^ ")"
| Option t -> "(Option " ^ to_string t ^ ")" | Option t -> "(Option " ^ to_string t ^ ")"
@ -318,3 +331,42 @@ let join a b =
else if widens_to ~from:a ~into:b then Some b else if widens_to ~from:a ~into:b then Some b
else if widens_to ~from:b ~into:a then Some a else if widens_to ~from:b ~into:a then Some a
else None else None
(* The one conversion between the two slice types, and it goes one way: a
[[T]] may be seen as a [[const T]], because a view that can only be read
asks less of its bytes than one that can be written. Under a const slice
the same holds one level down — [[[u8]]] reads as [[const [const u8]]] —
because nothing can be stored through the outer view to put a read-only
slice where the writable original expects a writable one. Under a writable
slice it does not: a [[[u8]]] seen as [[[const u8]]] could have a
read-only slice stored into it and read back out as a [[u8]]. Like
[widens_to] this is a predicate and not a loosening of [equal]; the
caller is [Check.expect], which retypes the value — the two words are the
same at run time. *)
let rec const_widens ~(from : t) ~(into : t) =
match from, into with
| Slice (_, a), Slice (Const, b) | Ptr (_, a), Ptr (Const, b) ->
equal a b || const_widens ~from:a ~into:b
| _ -> false
(* The one type two branches of an [if], or two arguments at one type
variable, meet at when they differ only in const: the read-only one,
whichever came first. *)
let const_join a b =
if equal a b then Some a
else if const_widens ~from:a ~into:b then Some b
else if const_widens ~from:b ~into:a then Some a
else None
(* A function of one signature standing where another is wanted, when the
two differ only in const. A parameter may be more permissive than asked —
a function that takes a [[const T]] only reads what it is handed, so a
caller handing it a [[T]] loses nothing — and a result may be less so: a
[[T]] returned where a [[const T]] is wanted is [const_widens]'s case. The
two words are the same either way, so [Check.expect] only retypes. *)
let fn_accepts ~(from : t list * t) ~(into : t list * t) =
let ps', r' = from and ps, r = into in
List.length ps = List.length ps'
&& List.for_all2
(fun p p' -> equal p p' || const_widens ~from:p ~into:p') ps ps'
&& (equal r r' || const_widens ~from:r' ~into:r)

20
lib/x86.ml
View File

@ -1557,7 +1557,7 @@ type arg =
move-only container by address. *) move-only container by address. *)
let classify_c (l : loc) (t : Types.t) = let classify_c (l : loc) (t : Types.t) =
match t with match t with
| Types.String | Types.Slice _ -> [ Aint (l, Types.Ptr Types.Unit); Alen l ] | Types.String | Types.Slice _ -> [ Aint (l, Types.Ptr (Types.Mut, Types.Unit)); Alen l ]
| Types.Unit | Types.Never -> [] | Types.Unit | Types.Never -> []
| Types.Vec _ | Types.Map _ -> [ Aptr l ] | Types.Vec _ | Types.Map _ -> [ Aptr l ]
(* A fixed array crossing into a dyn view (M2 item 3) needs its address for (* A fixed array crossing into a dyn view (M2 item 3) needs its address for
@ -1845,7 +1845,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
| None -> xor_rr f.b ~dst:rax ~src:rax | None -> xor_rr f.b ~dst:rax ~src:rax
| Some (`Made p) -> load_int f.b ~dst:rax ~mm:(Frame p) ~size:8 ~signed:false | Some (`Made p) -> load_int f.b ~dst:rax ~mm:(Frame p) ~size:8 ~signed:false
| Some (`Expr ev) -> | Some (`Expr ev) ->
let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr Types.Unit)); let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr (Types.Mut, Types.Unit)));
store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8 store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8
| Tast.FnAddr r -> | Tast.FnAddr r ->
fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; fnaddr_at f ~loc:e.Tast.loc ~reg:rax r;
@ -1873,7 +1873,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
let c = eval f callee in let c = eval f callee in
let env = let env =
match callee.Tast.ty with match callee.Tast.ty with
| Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr Types.Unit)) | Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr (Types.Mut, Types.Unit)))
| _ -> None | _ -> None
in in
call_flan f ?env ~target:(`Loc c) ~args ~rty:t dst call_flan f ?env ~target:(`Loc c) ~args ~rty:t dst
@ -2088,7 +2088,7 @@ and emit_handled f frames body dst t =
(match h.Tast.henv with (match h.Tast.henv with
| Some ev -> | Some ev ->
let l = scoped f (fun () -> eval f ev) in let l = scoped f (fun () -> eval f ev) in
load_loc f ~reg:rax l (Types.Ptr Types.Unit) load_loc f ~reg:rax l (Types.Ptr (Types.Mut, Types.Unit))
| None -> xor_rr f.b ~dst:rax ~src:rax); | None -> xor_rr f.b ~dst:rax ~src:rax);
store_int f.b ~src:rax ~mm:(Frame (slot + h_env)) ~size:8; store_int f.b ~src:rax ~mm:(Frame (slot + h_env)) ~size:8;
lea f.b ~dst:rdi ~mm:(Frame slot); lea f.b ~dst:rdi ~mm:(Frame slot);
@ -2602,7 +2602,7 @@ and emit_match f (scrut : Tast.expr) (arms : Tast.arm list) dst t =
and field_loc f (base : loc) (ty : Types.t) i = and field_loc f (base : loc) (ty : Types.t) i =
match ty with match ty with
| Types.Named sn -> shift base (List.nth (field_offsets f sn) i) | Types.Named sn -> shift base (List.nth (field_offsets f sn) i)
| Types.Ptr (Types.Named sn) -> | Types.Ptr (_, (Types.Named sn)) ->
shift (Lp (off_of base, 0)) (List.nth (field_offsets f sn) i) shift (Lp (off_of base, 0)) (List.nth (field_offsets f sn) i)
| Types.String | Types.Slice _ -> shift base (if i = 0 then 0 else 8) | Types.String | Types.Slice _ -> shift base (if i = 0 then 0 else 8)
| Types.Option el -> let ot, ov = option_lay f el in | Types.Option el -> let ot, ov = option_lay f el in
@ -2635,7 +2635,7 @@ and elements f (base : loc) (ty : Types.t) (is : Tast.expr list) : loc =
| i :: rest -> | i :: rest ->
let elem = let elem =
match ty with match ty with
| Types.Array (_, el) | Types.Slice el | Types.Ptr el -> el | Types.Array (_, el) | Types.Slice (_, el) | Types.Ptr (_, el) -> el
| Types.String -> Types.Int Types.U8 | Types.String -> Types.Int Types.U8
| t -> unsupported "index into %s" (Types.to_string t) | t -> unsupported "index into %s" (Types.to_string t)
in in
@ -2933,7 +2933,7 @@ and check_cast f (loc : Loc.t) (src : Types.fkind) (k : Types.ikind) =
and element f (base : loc) (ty : Types.t) (i : Tast.expr) : loc = and element f (base : loc) (ty : Types.t) (i : Tast.expr) : loc =
let elem = let elem =
match ty with match ty with
| Types.Array (_, el) | Types.Slice el | Types.Ptr el -> el | Types.Array (_, el) | Types.Slice (_, el) | Types.Ptr (_, el) -> el
| Types.String -> Types.Int Types.U8 | Types.String -> Types.Int Types.U8
| t -> unsupported "index into %s" (Types.to_string t) | t -> unsupported "index into %s" (Types.to_string t)
in in
@ -2995,7 +2995,7 @@ and call_flan f ?env ~target ~args ~rty dst =
in in
(* The channel is this frame's own: a callee that transfers writes through (* The channel is this frame's own: a callee that transfers writes through
the pointer we were handed, so one cell serves the whole chain. *) the pointer we were handed, so one cell serves the whole chain. *)
let chan = [ Aint (Lf f.xfer_off, Types.Ptr Types.Unit) ] in let chan = [ Aint (Lf f.xfer_off, Types.Ptr (Types.Mut, Types.Unit)) ] in
(* And the environment last of all, on exactly one kind of call: one through (* And the environment last of all, on exactly one kind of call: one through
a [(Fn ...)] value, which cannot know whether the body it reaches a [(Fn ...)] value, which cannot know whether the body it reaches
declared one. Every other call passes what it always passed — this is declared one. Every other call passes what it always passed — this is
@ -3103,7 +3103,7 @@ and call_native f ~sym ?(chan = false) ~(args : Tast.expr list) ~rty dst =
args args
in in
let flat = List.concat_map (fun (l, ty) -> classify_c l ty) vals in let flat = List.concat_map (fun (l, ty) -> classify_c l ty) vals in
let flat = if chan then flat @ [ Aint (Lf f.xfer_off, Types.Ptr Types.Unit) ] else flat in let flat = if chan then flat @ [ Aint (Lf f.xfer_off, Types.Ptr (Types.Mut, Types.Unit)) ] else flat in
let nsse = emit_args f flat in let nsse = emit_args f flat in
(* [al] is how many SSE registers were used, which a variadic callee reads. (* [al] is how many SSE registers were used, which a variadic callee reads.
Harmless on a fixed one, and a [declare] does not say which it is. *) Harmless on a fixed one, and a [declare] does not say which it is. *)
@ -3315,7 +3315,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst =
| Tast.Slice, [ a; lo; hi ] -> | Tast.Slice, [ a; lo; hi ] ->
let elem = let elem =
match a.Tast.ty with match a.Tast.ty with
| Types.Array (_, el) | Types.Slice el -> el | Types.Array (_, el) | Types.Slice (_, el) -> el
| Types.String -> Types.Int Types.U8 | Types.String -> Types.Int Types.U8
| ty -> unsupported "slice of %s" (Types.to_string ty) | ty -> unsupported "slice of %s" (Types.to_string ty)
in in

2
runtime/flan_dev.c
View File

@ -2325,7 +2325,7 @@ static void crash_handler(int sig, siginfo_t *si, void *uc) {
} }
{ {
static const char why[] = static const char why[] =
"\nflan: a write through a read-only slice (bytes-view of a literal), " "\nflan: a write into read-only memory, "
"a null, or a stack overflow\n"; "a null, or a stack overflow\n";
crash_puts(why, sizeof why - 1); crash_puts(why, sizeof why - 1);
} }

2
spike/x86/p4-convention.flan
View File

@ -13,7 +13,7 @@
(defn eight [a i64 b i64 c i64 d i64 e i64 f i64 g i64 h i64] i64 (defn eight [a i64 b i64 c i64 d i64 e i64 f i64 g i64 h i64] i64
(+ (+ (+ a b) (+ c d)) (+ (+ e f) (+ g h)))) (+ (+ (+ a b) (+ c d)) (+ (+ e f) (+ g h))))
(defn taglen [s [u8]] i64 (defn taglen [s [const u8]] i64
(i64 (length s))) (i64 (length s)))
(defn main [] i32 (defn main [] i32

31
spike/x86/survey.sh
View File

@ -94,30 +94,15 @@ forever="dev-loop dev-watch dev-chatty agent-auto"
# in the epilogue that every exit already went through. The five are in the # in the epilogue that every exit already went through. The five are in the
# sweep now and they are five of the MATCHes. # sweep now and they are five of the MATCHes.
# The ones whose whole point is a fault, and which therefore cannot be compared # The one whose whole point is a fault, and which therefore cannot be compared
# at this sweep's optimisation level. Both write through a bytes-view of a # at this sweep's optimisation level. dev-segv stores through a null pointer,
# string literal, which is a store into .rodata: measured here, LLVM exits 0 # which is undefined: what LLVM at -O2 does with it is its own business, and
# having printed the unmodified literal and this backend exits 139, because the # this backend has no optimiser and exits 139. That is not a lowering
# store is undefined and the optimiser deleted it on one side and there is no # disagreement. test_dev.ml builds it in a dev session,
# optimiser on the other. That is not a lowering disagreement. At -O0 the two # where the fault is the thing asserted. It also calls agent/start, so it
# agree exactly -- 139, no output, both backends -- and test_acceptance.ml's
# dies_segv rows pin precisely that, on both backends, which is the coverage
# this sweep would otherwise be duplicating at the one level where, as that
# file's own comment puts it, there is nothing left to pin but the UB.
#
# Excluded by name rather than by building these two at -O0 here, and the
# reason is the coverage and not the counts: a per-name -O0 list would move the
# counts exactly as much as this does, so that is no argument at all. The
# argument is that dies_segv already builds both of them at -O0, on both
# backends, and asserts the exit status and the empty output -- everything this
# sweep would check, in the file where the ruling is written down.
#
# One more thing about dev-segv, which is a reason to keep it out of the
# comparison rather than a reason for this list: it calls agent/start, so it
# leaves a socket in /tmp on both runs, and under SURVEY_FLAGS=--dev it parks # leaves a socket in /tmp on both runs, and under SURVEY_FLAGS=--dev it parks
# in the break loop instead of dying -- which is a forever-list problem, met # in the break loop instead of dying.
# here by a program that was never going to be compared anyway. faults="dev-segv"
faults="bytes-view-write dev-segv"
TIMEOUT=${TIMEOUT:-20} TIMEOUT=${TIMEOUT:-20}

2
test/programs/algorithms.flan
View File

@ -13,7 +13,7 @@
(print " ")) (print " "))
(println "")) (println ""))
(defn show-fields [s [[u8]]] () (defn show-fields [s [[const u8]]] ()
(dotimes [i (length s)] (dotimes [i (length s)]
(print (string (at s i))) (print (string (at s i)))
(print " ")) (print " "))

2
test/programs/bounds-condition.flan
View File

@ -85,7 +85,7 @@
(set frames (+ frames 1))) (set frames (+ frames 1)))
(continue [] (set skipped (+ skipped 1))))) (continue [] (set skipped (+ skipped 1)))))
(defn slice-frame [s [u8] lo i32 hi i32] () (defn slice-frame [s [const u8] lo i32 hi i32] ()
(restart-case (restart-case
(do (show "slice" (i64 (length (slice s lo hi)))) (do (show "slice" (i64 (length (slice s lo hi))))
(set frames (+ frames 1))) (set frames (+ frames 1)))

18
test/programs/bytes-view-write.flan
View File

@ -1,19 +1,11 @@
;;;; A store through (bytes-view "literal") lands in the string constant's ;;;; A store through (bytes-view "literal") is refused at compile time:
;;;; own storage, which both backends emit read-only — LLVM as a `constant` ;;;; bytes-view answers a [const u8], because a string literal's bytes are in
;;;; global, x86 in .rodata — so the write traps where it happens instead of ;;;; read-only memory, where the store would trap at -O0 and be deleted as
;;;; corrupting the literal. Pinned at -O0 on both backends, where the store ;;;; undefined at -O2. test_acceptance.ml asserts the refusal; nothing here is
;;;; is really emitted; at -O2 LLVM deletes it as undefined behaviour, which ;;;; ever built.
;;;; is why this program has no -O2 row. The trap itself (SIGSEGV on a
;;;; read-only page) is the defined consequence of the emission, not a bet on
;;;; anything further.
;;;;
;;;; If this ever exits 0, string data has become writable somewhere and the
;;;; read-only-by-convention story of bytes-view is silently gone.
(defn main [] i32 (defn main [] i32
(let [v (bytes-view "INSERTIONSORT")] (let [v (bytes-view "INSERTIONSORT")]
(set (at v 0) \Z) (set (at v 0) \Z)
;; Never reached: the store above traps. Printing anyway makes a failure
;; loud — output where none was expected.
(print (string v)) (print (string v))
0)) 0))

39
test/programs/const-owned.flan Normal file
View File

@ -0,0 +1,39 @@
;;;; A Vec reached through a [const (Vec T)] or a (Ptr const (Vec T)) is used
;;;; where it stands — indexed, measured, sliced, its address taken — and never
;;;; copied out as a value; (clone v) is the copy. The refusals are in
;;;; test_flan.ml; this is the half that compiles, on both backends.
(defstruct Bag [items (Vec i32) n i32])
(defn total [vs [const (Vec i32)]] i32
(let [t 0]
(dotimes [i (length vs)]
(dotimes [j (length (at vs i))]
(set t (+ t (at (at vs i) j)))))
t))
(defn first-len [p (Ptr const (Vec i32))] i32 (length (deref p)))
(defn bag-n [bs [const Bag]] i32 (+ (.n (at bs 0)) (length (.items (at bs 0)))))
(defn pick [c bool a $t b $t] $t (if c a b))
(defn main [] i32
(let [a (vec-new i32)
b (vec-new i32)]
(push a 1) (push a 2)
(push b 30)
(let [vs [a b]
cv (the-const (slice vs))
w (clone (at cv 0))
bags [(Bag {.items b .n 4})]]
(push w 99)
;; The shallow rule: the Vec's own buffer is writable through the view.
(set (at (at cv 1) 0) 31)
(println (total cv) (length w) (length (at cv 0)))
(println (first-len (addr (at cv 0))) (bag-n (slice bags)))
(println (length (pick true (bytes-view "abc") (bytes "de")))
(length (pick false (bytes "de") (bytes-view "abc"))))))
0)
(defn the-const [s [const (Vec i32)]] [const (Vec i32)] s)

65
test/programs/const-slice.flan Normal file
View File

@ -0,0 +1,65 @@
;;;; [const T]: a slice that can only be read. bytes-view answers one, a [T]
;;;; converts to one wherever one is wanted, and slicing one keeps it
;;;; read-only. Nothing about it exists at run time, so this prints the same
;;;; on every backend and at every level.
(defn total [s [const i32]] i64
(let [t (i64 0)]
(dotimes [i (length s)]
(set t (+ t (at s i))))
t))
;; A generic over a read-only slice takes a writable one too.
(defn first-of [s [const $t]] $t (at s 0))
(defn widths [parts [const [const u8]]] i32
(let [n 0]
(dotimes [i (length parts)]
(set n (+ n (length (at parts i)))))
n))
;; A (Ptr const T) is what the address of read-only storage is.
(defn peek [p (Ptr const u8)] u8 (deref p))
;; A function that only reads stands where one that may write is wanted, and
;; one returning a writable slice where a read-only one is wanted.
(defn rd [s [const u8]] i32 (length s))
(defn call-rd [f (Fn [[u8]] i32)] i32 (f (bytes "abc")))
(defn call-bare [f (CFn [[u8]] i32)] i32 (f (bytes "abcd")))
(defn mk [] [u8] (bytes "xy"))
(defn call-mk [f (Fn [] [const u8])] i32 (length (f)))
(defn main [] i32
(let [xs [3 1 2]
w (slice xs)
r (bytes-view "hello, world")
head (slice r 0 5)
tail (slice r 7)
names (vec-new [const u8])]
(sort w)
(println (total w) (total (slice w 1)))
(println (first-of w) (first-of (bytes-view "z")))
(println (string head) (string tail) (length head))
(println (bytes=? head (bytes-view "hello")) (starts-with? r head))
(push names head)
(push names tail)
(println (widths (slice names)))
;; A writable [[u8]] meets [const [const u8]] too: the outer view is
;; read-only, so nothing can put a read-only slice into it.
(let [a (bytes "ab")
b (bytes "cde")
both [a b]]
(println (widths (slice both)))
(set (at a 0) \A)
(println (string a)))
(let [f (split (bytes-view "b,a,c") \,)]
(sort-bytes (slice f))
(println (string (slice (join (slice f) (bytes-view "-"))))))
(println (at r 0))
(println (call-rd rd) (call-bare rd) (call-mk mk))
(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))))
(free names))
0)

30
test/programs/dev-segv.flan
View File

@ -1,17 +1,21 @@
;;;; The dogfooding crash, replayed on purpose: a write through a bytes-view ;;;; A hardware fault, taken on purpose: a store through a null pointer takes
;;;; of a string literal lands in read-only memory and takes SIGSEGV. In a ;;;; SIGSEGV. In a dev session that used to kill the whole process — daemon,
;;;; dev session that used to kill the whole process — daemon, compiler and ;;;; compiler and socket together, with no message at all. The dev build's
;;;; socket together, with no message at all. The dev build's crash handler ;;;; crash handler turns it into the same park the no-channel traps take: one
;;;; turns it into the same park the no-channel traps take: one line naming ;;;; line naming the address and the frame, then the break loop, with the
;;;; the address and the frame, then the break loop, with the daemon alive ;;;; daemon alive and answering behind it. There is no restart to list — a
;;;; and answering behind it. There is no restart to list — a faulting ;;;; faulting instruction has nowhere to resume at — which is the same
;;;; instruction has nowhere to resume at — which is the same empty-list ;;;; empty-list shape dev-trap-null-alloc.flan pins for free-all.
;;;; shape dev-trap-null-alloc.flan pins for free-all. ;;;;
;;;; The crash that first raised this was a write through a bytes-view of a
;;;; string literal, which no longer compiles; a zeroed pointer is the
;;;; surviving way to fault.
(import agent "vendor:agent") (import agent "vendor:agent")
(defonce nowhere (Ptr u8))
(defn main [] i32 (defn main [] i32
(agent/start "/tmp/flan-dev-segv-fallback.sock") (agent/start "/tmp/flan-dev-segv-fallback.sock")
(let [v (bytes-view "INSERTIONSORT")] (set (deref nowhere) \Z)
(set (at v 0) \Z) (println "not reached")
(print (string v)) 0)
0))

4
test/programs/edn.flan
View File

@ -70,11 +70,11 @@
;; ── The worked example: a struct read by hand ─────────────────────── ;; ── The worked example: a struct read by hand ───────────────────────
;; `name` is a [u8] and not a copy of one, so an Enemy is only valid while the ;; `name` is a [const u8] and not a copy of one, so an Enemy is only valid while the
;; buffer it was read out of is. That is the lifetime contract from the package ;; buffer it was read out of is. That is the lifetime contract from the package
;; header, and it is what a struct reader inherits by using slices. ;; header, and it is what a struct reader inherits by using slices.
(defstruct Enemy (defstruct Enemy
[name [u8] [name [const u8]
hp i32 hp i32
speed f32 speed f32
boss? bool]) boss? bool])

2
test/programs/pkg-return.flan
View File

@ -13,7 +13,7 @@
(defstruct Local [n i32]) (defstruct Local [n i32])
;;; The case that used to fail: a package struct as the declared return type. ;;; The case that used to fail: a package struct as the declared return type.
(defn fresh [src [u8]] edn/Cursor (edn/cursor src)) (defn fresh [src [const u8]] edn/Cursor (edn/cursor src))
;;; And the one that must keep working: a lowercase qualified name in the same ;;; And the one that must keep working: a lowercase qualified name in the same
;;; position is an expression, not a type. ;;; position is an expression, not a type.

4
test/programs/utf8.flan
View File

@ -50,7 +50,7 @@
;; code/width/ok, so a wrong answer names which of the three it got wrong ;; code/width/ok, so a wrong answer names which of the three it got wrong
;; rather than just failing. ;; rather than just failing.
(defn show-dec [s [u8]] () (defn show-dec [s [const u8]] ()
(let [r (decode-rune s)] (let [r (decode-rune s)]
(print (.code r)) (print "/") (print (.code r)) (print "/")
(print (.width r)) (print "/") (print (.width r)) (print "/")
@ -78,7 +78,7 @@
(print x) (print x)
(print " ")) (print " "))
(defn show-split [s [u8] sep u8] () (defn show-split [s [const u8] sep u8] ()
(let [it (split-on-byte s sep) (let [it (split-on-byte s sep)
going true] going true]
(while going (while going

2
test/programs/vec-new-shadow.flan
View File

@ -6,7 +6,7 @@
(defn main [] i32 (defn main [] i32
(let [x 7 (let [x 7
v (builtin/vec-new [u8])] v (builtin/vec-new [const u8])]
(println (vec-new [x])) (println (vec-new [x]))
(push v (bytes-view "ab")) (push v (bytes-view "ab"))
(println (length (at v 0))) (println (length (at v 0)))

4
test/programs/vec-new-type.flan
View File

@ -5,11 +5,11 @@
(defn main [] i32 (defn main [] i32
(let [a (arena-new 4096) (let [a (arena-new 4096)
words (vec-new [u8]) words (vec-new [const u8])
pairs (vec-new [2 i32]) pairs (vec-new [2 i32])
ptrs (vec-new (Ptr i32)) ptrs (vec-new (Ptr i32))
opts (vec-new (Option i64) a) opts (vec-new (Option i64) a)
m (map-new string [u8]) m (map-new string [const u8])
x (i32 7)] x (i32 7)]
(push words (bytes-view "ab")) (push words (bytes-view "ab"))
(push words (bytes-view "cde")) (push words (bytes-view "cde"))

47
test/test_acceptance.ml
View File

@ -889,26 +889,39 @@ let () =
"programs/bytes-copy.flan" bytes_copy_out; "programs/bytes-copy.flan" bytes_copy_out;
outputs ~x86:true "bytes copies, bytes-view aliases, --x86" outputs ~x86:true "bytes copies, bytes-view aliases, --x86"
"programs/bytes-copy.flan" bytes_copy_out; "programs/bytes-copy.flan" bytes_copy_out;
(* The other half of the same ruling: a store through a bytes-view of a (* The other half of the same ruling: a store through a bytes-view is
literal traps, identically on both backends, because both emit string refused before anything is built, because bytes-view answers a
data read-only. -O0 only — at -O2 LLVM deletes the store as UB, so [const u8]. It used to compile and trap at -O0 on both backends, and be
there is nothing there to pin except the UB itself. 139 is the shell's deleted as undefined at -O2. *)
128+SIGSEGV. *) (let path = "programs/bytes-view-write.flan" in
let dies_segv name path ~x86 = match
let exe = compile ~opt:"-O0" ~x86 path in Check.program (Load.program ~file:path (Reader.read_file path)).Load.decls
let code, text = run exe None in with
if code <> 139 || text <> "" then begin | _ ->
incr failures;
Printf.printf "FAIL a write through bytes-view is refused\n"
| exception Loc.Error { Loc.dmsg = m; _ } ->
if not (contains m "this writes through a [const u8]") then begin
incr failures; incr failures;
Printf.printf Printf.printf
"FAIL %s\n got: %S (exit %d)\n wanted: %S (exit 139)\n" "FAIL a write through bytes-view is refused\n said: %S\n" m
name text code "" end);
end; (* [const T]: the checker's alone, so the three builds agree and every
(try Sys.remove exe with Sys_error _ -> ()) row is about which values reach which parameters. *)
let const_slice_out =
"6 5\n1 122\nhello world 5\ntrue true\n10\n5\nAb\na-b-c\n104\n3 4 2\n101 99 113 world\n"
in in
dies_segv "a write through bytes-view traps, -O0" outputs "const slices" "programs/const-slice.flan" const_slice_out;
"programs/bytes-view-write.flan" ~x86:false; outputs ~opt:"-O0" "const slices, -O0" "programs/const-slice.flan"
dies_segv "a write through bytes-view traps, --x86" const_slice_out;
"programs/bytes-view-write.flan" ~x86:true; outputs ~x86:true "const slices, --x86" "programs/const-slice.flan"
const_slice_out;
let const_owned_out = "34 3 2\n2 5\n3 3\n" in
outputs "const owned" "programs/const-owned.flan" const_owned_out;
outputs ~opt:"-O0" "const owned, -O0" "programs/const-owned.flan"
const_owned_out;
outputs ~x86:true "const owned, --x86" "programs/const-owned.flan"
const_owned_out;
(* (string b). The conversion emits nothing — String and Slice _ are the (* (string b). The conversion emits nothing — String and Slice _ are the
same %slice — so the rows are about length and ownership rather than same %slice — so the rows are about length and ownership rather than
arithmetic: a number round-tripped, an empty slice, sub-views whose arithmetic: a number round-tripped, an empty slice, sub-views whose

8
test/test_dev.ml
View File

@ -442,7 +442,7 @@ let () =
[Rune] also pins the spelling — the types read exactly as [defs] [Rune] also pins the spelling — the types read exactly as [defs]
spells a signature, because both go through [Types.to_string]. *) spells a signature, because both go through [Types.to_string]. *)
let r = request c "(:op \"layout\" :type \"Split\")" in let r = request c "(:op \"layout\" :type \"Split\")" in
if fields r <> [ "rest [u8]"; "sep u8"; "more bool" ] then if fields r <> [ "rest [const u8]"; "sep u8"; "more bool" ] then
fail "Split's fields: %s" (String.concat ", " (fields r)); fail "Split's fields: %s" (String.concat ", " (fields r));
let r = request c "(:op \"layout\" :type \"Nonesuch\")" in let r = request c "(:op \"layout\" :type \"Nonesuch\")" in
@ -1922,7 +1922,7 @@ let () =
if refault then begin if refault then begin
let faulting = let faulting =
"(:op \"eval-expr\" :code \ "(:op \"eval-expr\" :code \
\"(let [v (bytes-view \\\"refault\\\")] (set (at v 0) 90) 1)\" \ \"(do (set (deref nowhere) 90) 1)\" \
:file \"/tmp/buf.flan\")" :file \"/tmp/buf.flan\")"
in in
(match ask faulting with _ -> () | exception _ -> ()); (match ask faulting with _ -> () | exception _ -> ());
@ -2028,8 +2028,8 @@ let () =
word. The dev build's crash handler (flan_dev_crash_enable) enters the word. The dev build's crash handler (flan_dev_crash_enable) enters the
same trap hook the six no-channel refusals use, so everything trap_park same trap hook the six no-channel refusals use, so everything trap_park
asserts for them holds here too: stopped and describable, an eval still asserts for them holds here too: stopped and describable, an eval still
answered, a resume refused. The program writes through bytes-view, answered, a resume refused. The program stores through a null
which is the surviving spelling of that crash. *) pointer: the bytes-view write that first crashed no longer compiles. *)
trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" []; trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" [];
(* ── The locals of a stopped frame ─────────────────────────────── *) (* ── The locals of a stopped frame ─────────────────────────────── *)

279
test/test_flan.ml
View File

@ -468,7 +468,23 @@ let () =
| { d = Defn { praw = Some [ Pname ("x", _); Ptype t ]; _ }; _ } -> t.t | { d = Defn { praw = Some [ Pname ("x", _); Ptype t ]; _ }; _ } -> t.t
| _ -> failwith "bad type test" | _ -> failwith "bad type test"
in in
(match ty "[u8]" with Tslice _ -> () | _ -> check "[T] is a slice" false); (match ty "[u8]" with
| Tslice (false, _) -> () | _ -> check "[T] is a slice" false);
(* [const] is reserved, so this is never [n T] with a length named const. *)
(match ty "[const u8]" with
| Tslice (true, { t = Tname "u8"; _ }) -> ()
| _ -> check "[const T] is a read-only slice" false);
(match ty "[const [const u8]]" with
| Tslice (true, { t = Tslice (true, _); _ }) -> ()
| _ -> check "[const [const T]] nests" false);
(match ty "[const]" with
| exception Loc.Error { Loc.dmsg; _ }
when contains dmsg "[const] names no element type" -> ()
| _ -> check "[const] alone is refused" false);
(match ty "[const 4 u8]" with
| exception Loc.Error { Loc.dmsg; _ }
when contains dmsg "has no read-only form" -> ()
| _ -> check "[const 4 u8] is refused" false);
(match ty "[4 f32]" with (match ty "[4 f32]" with
| Tarray (Lint 4L, _) -> () | _ -> check "[n T] is an array" false); | Tarray (Lint 4L, _) -> () | _ -> check "[n T] is an array" false);
(match ty "[rows [cols u32]]" with (match ty "[rows [cols u32]]" with
@ -568,7 +584,7 @@ let () =
(match (parse_decl "(defmacro m [& args] (at args 0))").d with (match (parse_decl "(defmacro m [& args] (at args 0))").d with
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } -> | Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
(match p.fty.t, r.t with (match p.fty.t, r.t with
| Tslice { t = Tname "Form"; _ }, Tname "Form" -> () | Tslice (false, { t = Tname "Form"; _ }), Tname "Form" -> ()
| _ -> check "defmacro is [Form] -> Form" false) | _ -> check "defmacro is [Form] -> Form" false)
| _ -> check "defmacro parses as a defn" false); | _ -> check "defmacro parses as a defn" false);
@ -578,7 +594,7 @@ let () =
(match (parse_decl "(defmacro m [[a b] c & rest] (at rest 0))").d with (match (parse_decl "(defmacro m [[a b] c & rest] (at rest 0))").d with
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } -> | Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
(match p.fty.t, r.t with (match p.fty.t, r.t with
| Tslice { t = Tname "Form"; _ }, Tname "Form" -> () | Tslice (false, { t = Tname "Form"; _ }), Tname "Form" -> ()
| _ -> check "a parameter list is still [Form] -> Form" false) | _ -> check "a parameter list is still [Form] -> Form" false)
| _ -> check "a macro with a parameter list parses as a defn" false); | _ -> check "a macro with a parameter list parses as a defn" false);
@ -1083,7 +1099,7 @@ let () =
runs no passes over it. *) runs no passes over it. *)
infers "array-fill of nothing" "(array-fill [0] 1)" "[0 i32]"; infers "array-fill of nothing" "(array-fill [0] 1)" "[0 i32]";
infers "bytes of a string" "(bytes \"hi\")" "[u8]"; infers "bytes of a string" "(bytes \"hi\")" "[u8]";
infers "bytes-view of a string" "(bytes-view \"hi\")" "[u8]"; infers "bytes-view of a string" "(bytes-view \"hi\")" "[const u8]";
infers "length is i32" "(length (bytes \"hi\"))" "i32"; infers "length is i32" "(length (bytes \"hi\"))" "i32";
infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]"; infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]";
infers "slice of the whole" "(slice (bytes \"hi\"))" "[u8]"; infers "slice of the whole" "(slice (bytes \"hi\"))" "[u8]";
@ -2226,18 +2242,247 @@ let () =
rejects_check "set through a string's slice" rejects_check "set through a string's slice"
"(defn f [s string] () (set (at (slice s 1) 0) 65))" "(defn f [s string] () (set (at (slice s 1) 0) 65))"
~needle:"not a place"; ~needle:"not a place";
(* The address of one is the same question and gets the same answer, so (* The address of one is a (Ptr const u8), so it is not a (Ptr u8). *)
the message has to fit a reader who asked for a pointer and not a rejects_check "the address of a string's byte is read-only"
store. *)
rejects_check "the address of a string's byte"
"(defn f [s string] (Ptr u8) (addr (at s 0)))" "(defn f [s string] (Ptr u8) (addr (at s 0)))"
~needle:"(at s i) is a value and not a place"; ~needle:"expected (Ptr u8), found (Ptr const u8)";
(* And a string is still not a [u8]: slicing one does not smuggle a byte (* And a string is still not a [u8]: slicing one does not smuggle a byte
slice out of it. *) slice out of it. *)
rejects_check "a string slice is not a byte slice" rejects_check "a string slice is not a byte slice"
"(defn g [b [u8]] i32 (length b)) (defn f [s string] i32 (g (slice s)))" "(defn g [b [u8]] i32 (length b)) (defn f [s string] i32 (g (slice s)))"
~needle:"expected [u8], found string"; ~needle:"expected [u8], found string";
(* [const T]: a view that can only be read. Every route to a store through
one is refused, and none of the reads is. *)
infers "a const slice slices to a const slice"
"(slice (bytes-view \"hello\") 1 3)" "[const u8]";
infers "vec-new reads [const u8] as a type" "(vec-new [const u8])"
"(Vec [const u8])";
infers "map-new reads [const u8] as a type" "(map-new string [const u8])"
"(Map string [const u8])";
rejects_check "set through a const slice"
"(defn f [s [const u8]] () (set (at s 0) 65))"
~needle:"this writes through a [const u8]";
rejects_check "set through bytes-view"
"(defn f [] () (let [v (bytes-view \"Hi\")] (set (at v 0) \\h)))"
~needle:"this writes through a [const u8]";
rejects_check "set through a const slice, two indices"
"(defn f [s [const [2 i32]]] () (set (at s 0 1) 5))"
~needle:"this writes through a [const [2 i32]]";
rejects_check "set through an array element of a const slice"
"(defn f [s [const [2 i32]]] () (set (at (at s 0) 1) 5))"
~needle:"this writes through a [const [2 i32]]";
rejects_check "replace an array element of a const slice whole"
"(defn f [s [const [2 i32]]] () (set (at s 0) [1 2]))"
~needle:"this writes through a [const [2 i32]]";
rejects_check "set a field of a const slice's element"
"(defstruct P [x i32]) (defn f [s [const P]] () (set (.x (at s 0)) 5))"
~needle:"this writes through a [const P]";
rejects_check "a const slice is not a writable one"
"(defn g [b [u8]] () (set (at b 0) 1)) (defn f [s [const u8]] () (g s))"
~needle:"expected [u8], found [const u8]";
rejects_check "and the refusal names the copy"
"(defn g [b [u8]] () (set (at b 0) 1)) (defn f [s [const u8]] () (g s))"
~needle:"(bytes (string v)) copies v";
rejects_check "a generic writer does not take a const slice"
"(defn f [s [const i32]] () (sort s))"
~needle:"sort takes a slice it may write through";
rejects_check "a const slice does not cross into dyn"
"(defn f [s [const i64]] dyn s)"
~needle:"a [const i64] can only be read";
rejects_check "no conversion under a writable slice"
"(defn g [p [[const u8]]] i32 0) (defn f [p [[u8]]] i32 (g p))"
~needle:"expected [[const u8]], found [[u8]]";
rejects_check "push through a const slice of Vecs"
"(defn f [s [const (Vec i32)]] () (push (at s 0) 5))"
~needle:"reached through a [const (Vec i32)]";
rejects_check "put through a const slice of maps"
"(defn f [s [const (Map string i32)]] () (put (at s 0) \"a\" 5))"
~needle:"reached through a [const (Map string i32)]";
rejects_check "map-remove through a const slice of maps"
"(defn f [s [const (Map string i32)]] bool (map-remove (at s 0) \"a\"))"
~needle:"reached through a [const (Map string i32)]";
rejects_check "reserve through a const slice of Vecs"
"(defn f [s [const (Vec i32)]] () (reserve (at s 0) 10))"
~needle:"reached through a [const (Vec i32)]";
rejects_check "free through a const slice of Vecs"
"(defn f [s [const (Vec i32)]] () (free (at s 0)))"
~needle:"reached through a [const (Vec i32)]";
rejects_check "push into a field reached through a const slice"
"(defstruct P [v (Vec i32)]) (defn f [s [const P]] () (push (.v (at s 0)) 1))"
~needle:"reached through a [const P]";
accepts "a Vec's own buffer is not the const slice's storage"
"(defn f [s [const (Vec i32)]] () (set (at (at s 0) 0) 5))";
accepts "a reading function where a writing one is wanted"
"(defn rd [s [const u8]] i32 0) (defn c [f (Fn [[u8]] i32)] i32 0) \
(defn m [] i32 (c rd))";
rejects_check "not a writing function where a reading one is wanted"
"(defn wr [s [u8]] i32 0) (defn c [f (Fn [[const u8]] i32)] i32 0) \
(defn m [] i32 (c wr))"
~needle:"expected (Fn [[const u8]] i32), found (CFn [[u8]] i32)";
rejects_check "nor a read-only result where a writable one is wanted"
"(defn mk [] [const u8] (bytes-view \"a\")) \
(defn c [f (Fn [] [u8])] i32 0) (defn m [] i32 (c mk))"
~needle:"expected (Fn [] [u8]), found (CFn [] [const u8])";
(* (Ptr const T): the pointer beside [const T]. *)
infers "the address of a const element" "(addr (at (bytes-view \"hi\") 0))"
"(Ptr const u8)";
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]";
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)";
rejects_check "a store through the address of a const element"
"(defn f [v [const u8]] () (set (deref (addr (at v 0))) 1))"
~needle:"this writes through a (Ptr const u8)";
rejects_check "a store through the address of a string's byte"
"(defn f [s string] () (set (deref (addr (at s 0))) 1))"
~needle:"this writes through a (Ptr const u8)";
rejects_check "a field store through a const pointer"
"(defstruct P [x i32]) (defn f [p (Ptr const P)] () (set (.x p) 1))"
~needle:"this writes through a (Ptr const P)";
rejects_check "a push through a const pointer"
"(defn f [p (Ptr const (Vec i32))] () (push (deref p) 1))"
~needle:"this changes a (Vec i32) reached through a (Ptr const (Vec i32))";
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))"
~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";
rejects_check "no conversion under a writable pointer"
"(defn f [p (Ptr (Ptr i32))] (Ptr (Ptr const i32)) p)"
~needle:"expected (Ptr (Ptr const i32)), found (Ptr (Ptr i32))";
accepts "a writable pointer is a const one"
"(defn f [p (Ptr i32)] (Ptr const i32) p)";
accepts "and under a const pointer, one level down"
"(defn f [p (Ptr (Ptr i32))] (Ptr const (Ptr const i32)) p)";
accepts "a generic const pointer binds from a writable one"
"(defn f [p (Ptr const $t)] $t (deref p)) (defn g [q (Ptr i32)] i32 (f q))";
accepts "vec-new reads (Ptr const u8) as a type"
"(defn f [] i32 (let [v (vec-new (Ptr const u8))] (length v)))";
(* Decision 81: a value that owns storage, reached through read-only
storage, is used where it stands and never copied out. Every route a
copy could take is refused at the copy. *)
let copied = "this copies a (Vec i32) out of a [const (Vec i32)]" in
List.iter
(fun (name, src) -> rejects_check ("no copy out: " ^ name) src ~needle:copied)
[ "let", "(defn f [cs [const (Vec i32)]] () (let [v (at cs 0)] (push v 1)))";
"loop binding",
"(defn f [cs [const (Vec i32)]] () (loop [v (at cs 0)] (push v 1)))";
"if value",
"(defn f [c bool cs [const (Vec i32)]] () \
(let [v (if c (at cs 0) (at cs 1))] (push v 1)))";
"do value",
"(defn f [cs [const (Vec i32)]] () (let [v (do (at cs 0))] (push v 1)))";
"set into a local",
"(defn f [cs [const (Vec i32)]] () \
(let [v (vec-new i32)] (set v (at cs 0)) (push v 1)))";
"match binding",
"(defn f [cs [const (Vec i32)]] i32 \
(match (Some (at cs 0)) (Some v) (do (push v 1) 0) None 0))";
"array destructure",
"(defn f [cs [const (Vec i32)]] () \
(let [[a b] [(at cs 0) (at cs 1)]] (push a 1)))";
"closure capture",
"(defn app [g (Fn [] ())] () (g)) (defn f [cs [const (Vec i32)]] () \
(let [v (at cs 0)] (app (fn [] (push v 1)))))";
"passed by value",
"(defn pusher [v (Vec i32)] () (push v 1)) \
(defn f [cs [const (Vec i32)]] () (pusher (at cs 0)))";
"returned by value",
"(defn g [cs [const (Vec i32)]] (Vec i32) (at cs 0))";
"through a generic",
"(defn id [x $t] $t x) (defn f [cs [const (Vec i32)]] () (push (id (at cs 0)) 1))" ];
rejects_check "no copy out through a const pointer"
"(defn f [p (Ptr const (Vec i32))] () (let [v (deref p)] (push v 1)))"
~needle:"this copies a (Vec i32) out of a (Ptr const (Vec i32))";
rejects_check "and the copy that is allowed is named"
"(defn f [cs [const (Vec i32)]] (Vec i32) (at cs 0))"
~needle:"(clone v) copies it into a (Vec i32) of its own";
rejects_check "a struct holding a Vec is not copied out either"
"(defstruct P [v (Vec i32)]) (defn f [cs [const P]] P (at cs 0))"
~needle:"(addr v) gives a (Ptr const P) to read it through";
rejects_check "nor an array of them"
"(defn f [cs [const [2 (Vec i32)]]] [2 (Vec i32)] (at cs 0))"
~needle:"this copies a [2 (Vec i32)] out of a [const [2 (Vec i32)]]";
rejects_check "nor an Option of one"
"(defn f [cs [const (Option (Vec i32))]] (Option (Vec i32)) (at cs 0))"
~needle:"this copies a (Option (Vec i32)) out";
rejects_check "nor a field that owns storage"
"(defstruct P [v (Vec i32)]) (defn f [cs [const P]] (Vec i32) (.v (at cs 0)))"
~needle:"this copies a (Vec i32) out of a [const P]";
accepts "used where it stands"
"(defstruct P [v (Vec i32) n i32]) \
(defn f [cs [const (Vec i32)] ps [const P] p (Ptr const (Vec i32))] i32 \
(+ (at (at cs 0) 1) (length (at cs 0)) (length (slice (at cs 0))) \
(.n (at ps 0)) (length (.v (at ps 0))) (length (deref p)) \
(length (deref (addr (at cs 0)))) (length (clone (at cs 0)))))";
accepts "a copy of a scalar element is still a copy"
"(defn f [cs [const i32]] i32 (let [x (at cs 0)] (set x 5) x))";
(* The header copy is suggested only for elements that own nothing. *)
rejects_check "no header copy suggested for an array of Vecs"
"(defn f [cs [const [2 (Vec i32)]]] () (set (at cs 0) (at cs 1)))"
~needle:"take it as a [[2 (Vec i32)]] instead";
rejects_check "nor for an Option of a Vec"
"(defn f [cs [const (Option (Vec i32))]] () (set (at cs 0) None))"
~needle:"take it as a [(Option (Vec i32))] instead";
(* Two arguments at one type variable meet at const, either order. *)
accepts "a generic's arguments join at const"
"(defn pick [c bool a $t b $t] $t (if c a b)) \
(defn f [c bool cs [const u8] ms [u8]] i32 (+ (length (pick c ms cs)) \
(length (pick c cs ms))))";
rejects_check "and the join is read-only"
"(defn pick [c bool a $t b $t] $t (if c a b)) \
(defn f [c bool cs [const u8] ms [u8]] () (set (at (pick c ms cs) 0) 1))"
~needle:"this writes through a [const u8]";
rejects_check "no copy of Vec headers is suggested"
"(defn f [cs [const (Vec i32)]] () (set (at cs 0) (vec-new i32)))"
~needle:"take it as a [(Vec i32)] instead";
(* A fixed array reached through read-only storage slices to a read-only
view. *)
rejects_check "slice of an array element of a const slice"
"(defn f [cs [const [4 u8]]] () (let [s (slice (at cs 0))] (set (at s 0) 9)))"
~needle:"this writes through a [const u8]";
rejects_check "slice of an array behind a const pointer"
"(defn f [p (Ptr const [4 u8])] () (let [s (slice (deref p))] (set (at s 0) 9)))"
~needle:"this writes through a [const u8]";
rejects_check "slice of an array field reached through a const slice"
"(defstruct B [buf [4 u8]]) \
(defn f [cs [const B]] () (let [s (slice (.buf (at cs 0)))] (set (at s 0) 9)))"
~needle:"this writes through a [const u8]";
infers "a local array still slices to a writable slice"
"(let [a [1 2]] (slice a))" "[i32]";
(* The branches of an if meet at the read-only type, in either order. *)
accepts "if: writable then read-only"
"(defn f [c bool cs [const u8] ms [u8]] i32 (length (if c ms cs)))";
accepts "if: read-only then writable"
"(defn f [c bool cs [const u8] ms [u8]] i32 (length (if c cs ms)))";
rejects_check "and the join is read-only"
"(defn f [c bool cs [const u8] ms [u8]] () (set (at (if c ms cs) 0) 1))"
~needle:"this writes through a [const u8]";
accepts "if over pointers joins the same way"
"(defn f [c bool a (Ptr const i32) b (Ptr i32)] i32 (deref (if c b a)))";
rejects_check "const is not a name a constant can have"
"(defconst const 4)" ~needle:"const cannot be declared";
(* The const is shallow: an element of a [const [u8]] is a writable [u8]. *)
accepts "store through an element of a const slice of slices"
"(defn f [s [const [u8]]] () (set (at (at s 0) 1) 5))";
accepts "a writable slice is a const one"
"(defn g [b [const u8]] u8 (at b 0)) (defn f [s [u8]] u8 (g s))";
accepts "and so is a string's bytes, at a prelude reader"
"(defn f [s string] bool (bytes=? (bytes-view s) (bytes-view \"x\")))";
accepts "under a const slice the element converts too"
"(defn g [p [const [const u8]]] i32 0) (defn f [p [[u8]]] i32 (g p))";
accepts "the address of a const element, for C"
"(defn f [s [const u8]] (Ptr const u8) (addr (at s 0)))";
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-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 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 what it does check is worth pinning: the argument really is a pointer, the
@ -4430,8 +4675,9 @@ let () =
something different in a parameter than it does anywhere else. *) something different in a parameter than it does anywhere else. *)
emits "const char * as a string parameter" emits "const char * as a string parameter"
"(declare-c name-length [text string] i32 \"name_length\")"; "(declare-c name-length [text string] i32 \"name_length\")";
emits "a pointer parameter" (* const int * is a pointer C promises not to write through. *)
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")"; emits "a const pointer parameter"
"(declare-c count-at [values (Ptr const i32) n i32] i32 \"count_at\")";
(* struct Pair is both Pair and Point in the header and the package (* struct Pair is both Pair and Point in the header and the package
describes it once, so both names have to land on the one defstruct — describes it once, so both names have to land on the one defstruct —
raylib does exactly this with Texture2D and TextureCubemap. *) raylib does exactly this with Texture2D and TextureCubemap. *)
@ -5067,6 +5313,10 @@ let () =
"(declare-c name-length [text string] i32 \"name_length\")"; "(declare-c name-length [text string] i32 \"name_length\")";
agreed "a pointer that matches the header exactly" agreed "a pointer that matches the header exactly"
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")"; "(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
agreed "a const pointer that matches the header exactly"
"(declare-c count-at [values (Ptr const i32) n i32] i32 \"count_at\")";
agreed "a const pointer where the header says const void *"
"(declare-c blit [dst (Ptr Pair) src (Ptr const Shade) n i32] \"blit\")";
(* void * is opaque about what it points at, so there is no element type in (* void * is opaque about what it points at, so there is no element type in
the header to disagree with — §A.2's LoadImageColors → UpdateTexture. *) the header to disagree with — §A.2's LoadImageColors → UpdateTexture. *)
agreed "any pointer where the header says void *" agreed "any pointer where the header says void *"
@ -5082,12 +5332,17 @@ let () =
name the disagreement. *) name the disagreement. *)
differs "a pointer to the wrong named type" differs "a pointer to the wrong named type"
"(declare-c pair-len-p [p (Ptr Shade)] f32 \"pair_len_p\")" "(declare-c pair-len-p [p (Ptr Shade)] f32 \"pair_len_p\")"
"parameter p is (Ptr Shade) and the header says (Ptr Pair)"; "parameter p is (Ptr Shade) and the header says (Ptr const Pair)";
differs "a pointer to the wrong width" differs "a pointer to the wrong width"
"(declare-c count-at [values (Ptr f64) n i32] i32 \"count_at\")" "(declare-c count-at [values (Ptr f64) n i32] i32 \"count_at\")"
"parameter values is (Ptr f64)"; "parameter values is (Ptr f64)";
(* void * gives up the element type and nothing else. It is still a pointer, (* void * gives up the element type and nothing else. It is still a pointer,
and a scalar declared against one is still a finding. *) and a scalar declared against one is still a finding. *)
(* A (Ptr const T) promises C will not write, and the header has to say so
too. *)
differs "a const pointer where the header may write"
"(declare-c blit [dst (Ptr const u8) src (Ptr u8) n i32] \"blit\")"
"parameter dst is (Ptr const u8)";
differs "a scalar where the header says void *" differs "a scalar where the header says void *"
"(declare-c blit [dst i64 src (Ptr u8) n i32] \"blit\")" "(declare-c blit [dst i64 src (Ptr u8) n i32] \"blit\")"
"parameter dst is i64"; "parameter dst is i64";

5
test/test_sanitize.ml
View File

@ -441,9 +441,8 @@ let dev_sweep () =
sanitized run must produce ASan's report and must NOT produce the sanitized run must produce ASan's report and must NOT produce the
handler's line, and that is the assertion. handler's line, and that is the assertion.
And it has to be built at -O0. At the sweep's -O2 the write through a And it has to be built at -O0. At the sweep's -O2 a store through a null
bytes-view of a string literal does not fault at all — measured, both pointer is undefined and need not fault — so a case that is about what happens
builds print the unmodified string — so a case that is about what happens
on a fault has to be compiled where the fault happens. Same family as the on a fault has to be compiled where the fault happens. Same family as the
-O0/-O2 split [unchecked_controls] records for bounds.flan. -O0/-O2 split [unchecked_controls] records for bounds.flan.

10
vendor/edn/edn.flan vendored
View File

@ -1,4 +1,4 @@
;;;; An EDN tokenizer, in Flan, over a [u8]. ;;;; An EDN tokenizer, in Flan, over a [const u8].
;;;; ;;;;
;;;; This is the bottom layer of a reader. It answers one question — "what is ;;;; This is the bottom layer of a reader. It answers one question — "what is
;;;; the next token, and where" — and it answers it without allocating ;;;; the next token, and where" — and it answers it without allocating
@ -161,7 +161,7 @@
;; usable underline position even though `text` is narrower than the token. ;; usable underline position even though `text` is narrower than the token.
(defstruct Token (defstruct Token
[kind i32 [kind i32
text [u8] text [const u8]
pos i32]) pos i32])
;; The cursor owns no storage either: `src` is the caller's buffer. ;; The cursor owns no storage either: `src` is the caller's buffer.
@ -171,7 +171,7 @@
;; left to a parser, because `[1 2}` is malformed in a way only the tokenizer ;; left to a parser, because `[1 2}` is malformed in a way only the tokenizer
;; has the position for. ;; has the position for.
(defstruct Cursor (defstruct Cursor
[src [u8] [src [const u8]
pos i32 pos i32
err i32 err i32
err-pos i32 err-pos i32
@ -180,7 +180,7 @@
;; ── Construction ──────────────────────────────────────────────────── ;; ── Construction ────────────────────────────────────────────────────
(defn cursor [src [u8]] Cursor (defn cursor [src [const u8]] Cursor
(Cursor {.src src .pos 0 .err err-none .err-pos 0 .depth 0})) (Cursor {.src src .pos 0 .err err-none .err-pos 0 .depth 0}))
(defn ok? [c (Ptr Cursor)] bool (defn ok? [c (Ptr Cursor)] bool
@ -266,7 +266,7 @@
;; text of their own — eof, error, and every delimiter. It is still a slice of ;; text of their own — eof, error, and every delimiter. It is still a slice of
;; the input rather than a slice of nothing, so `text` has one meaning for all ;; the input rather than a slice of nothing, so `text` has one meaning for all
;; token kinds. ;; token kinds.
(defn- empty-at [c (Ptr Cursor) p i32] [u8] (defn- empty-at [c (Ptr Cursor) p i32] [const u8]
(slice (.src c) p p)) (slice (.src c) p p))
(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token (defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token

20
vendor/edn/provide.flan vendored
View File

@ -80,7 +80,7 @@
;; buffer costs nothing to produce. A person reading a refusal wants a line and ;; buffer costs nothing to produce. A person reading a refusal wants a line and
;; a column, so the newlines before the offset are counted here — once per ;; a column, so the newlines before the offset are counted here — once per
;; refusal, which is as often as this is ever called. ;; refusal, which is as often as this is ever called.
(defn- where [src [u8] pos i32] string (defn- where [src [const u8] pos i32] string
(let [line (i64 1) (let [line (i64 1)
col (i64 1) col (i64 1)
i (i32 0)] i (i32 0)]
@ -212,7 +212,7 @@
;; One value, from the cursor's current position, consumed. `name` is what a ;; One value, from the cursor's current position, consumed. `name` is what a
;; struct here would be called; `src` is the whole buffer, for the positions a ;; struct here would be called; `src` is the whole buffer, for the positions a
;; refusal names. ;; refusal names.
(defn- derive [c (Ptr Cursor) name string src [u8]] Derived (defn- derive [c (Ptr Cursor) name string src [const u8]] Derived
(let [t (next c)] (let [t (next c)]
(when (not (ok? c)) (when (not (ok? c))
(return (derived-bad (return (derived-bad
@ -242,7 +242,7 @@
;; decides; every one after it is compared against that decision and both ;; decides; every one after it is compared against that decision and both
;; positions are named when they disagree, because "heterogeneous" without ;; positions are named when they disagree, because "heterogeneous" without
;; saying where sends someone to read the whole file. ;; saying where sends someone to read the whole file.
(defn- derive-vec [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (defn- derive-vec [c (Ptr Cursor) name string at-pos i32 src [const u8]] Derived
(when (at-byte? c \]) (when (at-byte? c \])
(return (derived-bad (return (derived-bad
(joined3 "the empty vector at " (where src at-pos) (joined3 "the empty vector at " (where src at-pos)
@ -291,7 +291,7 @@
;; A set becomes `(Map T bool)`, so its elements are map keys. `derive-key` is ;; A set becomes `(Map T bool)`, so its elements are map keys. `derive-key` is
;; where that constraint is enforced and said. ;; where that constraint is enforced and said.
(defn- derive-set [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (defn- derive-set [c (Ptr Cursor) name string at-pos i32 src [const u8]] Derived
(when (at-byte? c \}) (when (at-byte? c \})
(return (derived-bad (return (derived-bad
(joined3 "the empty set at " (where src at-pos) (joined3 "the empty set at " (where src at-pos)
@ -326,7 +326,7 @@
;; fixed array, which is one where a Vec is not; anything else is refused here ;; fixed array, which is one where a Vec is not; anything else is refused here
;; rather than at the `(Map ...)` the caller would build out of it, because a ;; rather than at the `(Map ...)` the caller would build out of it, because a
;; map-key refusal names a type nobody wrote. ;; map-key refusal names a type nobody wrote.
(defn- derive-key [c (Ptr Cursor) name string src [u8]] Derived (defn- derive-key [c (Ptr Cursor) name string src [const u8]] Derived
(when (at-byte? c \[) (when (at-byte? c \[)
(return (derive-array c name src))) (return (derive-array c name src)))
(let [d (derive c name src)] (let [d (derive c name src)]
@ -342,7 +342,7 @@
;; of the set has to be the same length as well as the same shape — which falls ;; of the set has to be the same length as well as the same shape — which falls
;; out of the type comparison the caller already makes, since the length is in ;; out of the type comparison the caller already makes, since the length is in
;; the type it compares. ;; the type it compares.
(defn- derive-array [c (Ptr Cursor) name string src [u8]] Derived (defn- derive-array [c (Ptr Cursor) name string src [const u8]] Derived
(let [open (next c)] (let [open (next c)]
(when (at-byte? c \]) (when (at-byte? c \])
(return (derived-bad (return (derived-bad
@ -379,7 +379,7 @@
(expect c tok-vec-close) (expect c tok-vec-close)
arr))))))) arr)))))))
(defn- disagreement [what string src [u8] at-pos i32 n i64 (defn- disagreement [what string src [const u8] at-pos i32 n i64
first Form second Form] string first Form second Form] string
(joined3 (joined3 "the " what " at ") (joined3 (joined3 "the " what " at ")
(where src at-pos) (where src at-pos)
@ -400,7 +400,7 @@
;; differently is the two arms a hand-written reader had no reason to have — a ;; differently is the two arms a hand-written reader had no reason to have — a
;; key that is not a field of the struct, and a field the file did not have. ;; key that is not a field of the struct, and a field the file did not have.
;; Both signal SchemaDrift. See the note over that type. ;; Both signal SchemaDrift. See the note over that type.
(defn- derive-map [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (defn- derive-map [c (Ptr Cursor) name string at-pos i32 src [const u8]] Derived
(when (at-byte? c \}) (when (at-byte? c \})
(return (derived-bad (return (derived-bad
(joined3 "the empty map at " (where src at-pos) (joined3 "the empty map at " (where src at-pos)
@ -543,7 +543,7 @@
_ (refuse "defedn's first argument is the name of the struct to declare, written as a name")) _ (refuse "defedn's first argument is the name of the struct to declare, written as a name"))
_ (refuse "defedn's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from")))) _ (refuse "defedn's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from"))))
(defn- provide [name string path string src [u8]] Form (defn- provide [name string path string src [const u8]] Form
(let [cur (cursor src) (let [cur (cursor src)
d (derive (addr cur) name src)] d (derive (addr cur) name src)]
(if (bad? d) (if (bad? d)
@ -560,7 +560,7 @@
;; fields are built in, because a string field is a copy and a Vec ;; fields are built in, because a string field is a copy and a Vec
;; field is an allocation — spec-memory's rule, and the reason the ;; field is an allocation — spec-memory's rule, and the reason the
;; destination is never implicit. ;; destination is never implicit.
(defn ~bname [b [u8] a Allocator] ~sname (defn ~bname [b [const u8] a Allocator] ~sname
(let [c (cursor b) (let [c (cursor b)
out (~rname (addr c) a)] out (~rname (addr c) a)]
;; The cursor is made and dropped here, so this is the only ;; The cursor is made and dropped here, so this is the only

4
vendor/edn/read.flan vendored
View File

@ -65,7 +65,7 @@
;; dropped here on purpose. Nothing individually owns a block in a region — ;; dropped here on purpose. Nothing individually owns a block in a region —
;; free-all owns all of them — so keeping the header around to free through ;; free-all owns all of them — so keeping the header around to free through
;; would be keeping a handle for an operation that never happens. ;; would be keeping a handle for an operation that never happens.
(defn copy-text [s [u8]] string (defn copy-text [s [const u8]] string
(let [b (vec-new u8)] (let [b (vec-new u8)]
(append (addr b) s) (append (addr b) s)
(string (slice b)))) (string (slice b))))
@ -136,7 +136,7 @@
;; The whole document, from a byte slice. nil when the input was malformed — ;; The whole document, from a byte slice. nil when the input was malformed —
;; the header says what that conflates and what to do when it matters. ;; the header says what that conflates and what to do when it matters.
(defn read [src [u8]] dyn (defn read [src [const u8]] dyn
(let [c (cursor src) (let [c (cursor src)
t (next (addr c)) t (next (addr c))
v (read-value (addr c) t)] v (read-value (addr c) t)]

10
vendor/json/json.flan vendored
View File

@ -1,4 +1,4 @@
;;;; A JSON tokenizer, in Flan, over a [u8]. ;;;; A JSON tokenizer, in Flan, over a [const u8].
;;;; ;;;;
;;;; The shape is vendor/edn's, deliberately: a Cursor over a caller's buffer, ;;;; The shape is vendor/edn's, deliberately: a Cursor over a caller's buffer,
;;;; one `next` that answers a Token, errors accumulated on the cursor with the ;;;; one `next` that answers a Token, errors accumulated on the cursor with the
@ -205,7 +205,7 @@
;; underline position even where `text` is narrower than the token. ;; underline position even where `text` is narrower than the token.
(defstruct Token (defstruct Token
[kind i32 [kind i32
text [u8] text [const u8]
pos i32]) pos i32])
;; The cursor owns no storage: `src` is the caller's buffer. ;; The cursor owns no storage: `src` is the caller's buffer.
@ -214,7 +214,7 @@
;; each one waits for, so that {"a": [1} fails at the brace with a position ;; each one waits for, so that {"a": [1} fails at the brace with a position
;; rather than confusing a reader two levels up. ;; rather than confusing a reader two levels up.
(defstruct Cursor (defstruct Cursor
[src [u8] [src [const u8]
pos i32 pos i32
err i32 err i32
err-pos i32 err-pos i32
@ -223,7 +223,7 @@
;; ── Construction ──────────────────────────────────────────────────── ;; ── Construction ────────────────────────────────────────────────────
(defn cursor [src [u8]] Cursor (defn cursor [src [const u8]] Cursor
(Cursor {.src src .pos 0 .err err-none .err-pos 0 .depth 0})) (Cursor {.src src .pos 0 .err err-none .err-pos 0 .depth 0}))
(defn ok? [c (Ptr Cursor)] bool (defn ok? [c (Ptr Cursor)] bool
@ -313,7 +313,7 @@
;; An empty slice of src, positioned at p. Used for the tokens that have no ;; An empty slice of src, positioned at p. Used for the tokens that have no
;; text of their own — eof, error, and every delimiter — so that `text` has one ;; text of their own — eof, error, and every delimiter — so that `text` has one
;; meaning for every token kind and not two. ;; meaning for every token kind and not two.
(defn- empty-at [c (Ptr Cursor) p i32] [u8] (defn- empty-at [c (Ptr Cursor) p i32] [const u8]
(slice (.src c) p p)) (slice (.src c) p p))
(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token (defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token

18
vendor/json/provide.flan vendored
View File

@ -63,7 +63,7 @@
;; The tokenizer answers byte offsets. A person reading a refusal wants a line ;; The tokenizer answers byte offsets. A person reading a refusal wants a line
;; and a column, so the newlines before the offset are counted here — once per ;; and a column, so the newlines before the offset are counted here — once per
;; refusal, which is as often as this is ever called. ;; refusal, which is as often as this is ever called.
(defn- where [src [u8] pos i32] string (defn- where [src [const u8] pos i32] string
(let [line (i64 1) (let [line (i64 1)
col (i64 1) col (i64 1)
i (i32 0)] i (i32 0)]
@ -173,7 +173,7 @@
;; ── Deriving ──────────────────────────────────────────────────────── ;; ── Deriving ────────────────────────────────────────────────────────
(defn- derive [c (Ptr Cursor) name string src [u8]] Derived (defn- derive [c (Ptr Cursor) name string src [const u8]] Derived
(let [t (next c)] (let [t (next c)]
(when (not (ok? c)) (when (not (ok? c))
(return (derived-bad (return (derived-bad
@ -202,7 +202,7 @@
;; every one after it is compared against that, and both positions are named ;; every one after it is compared against that, and both positions are named
;; when they disagree — "heterogeneous" on its own sends someone to read the ;; when they disagree — "heterogeneous" on its own sends someone to read the
;; whole file. ;; whole file.
(defn- derive-array [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (defn- derive-array [c (Ptr Cursor) name string at-pos i32 src [const u8]] Derived
(when (at-byte? c \]) (when (at-byte? c \])
(return (derived-bad (return (derived-bad
(joined3 "the empty array at " (where src at-pos) (joined3 "the empty array at " (where src at-pos)
@ -248,7 +248,7 @@
;; ── An object, which is a struct ──────────────────────────────────── ;; ── An object, which is a struct ────────────────────────────────────
(defn- derive-object [c (Ptr Cursor) name string at-pos i32 src [u8]] Derived (defn- derive-object [c (Ptr Cursor) name string at-pos i32 src [const u8]] Derived
(when (at-byte? c \}) (when (at-byte? c \})
(return (derived-bad (return (derived-bad
(joined3 "the empty object at " (where src at-pos) (joined3 "the empty object at " (where src at-pos)
@ -349,7 +349,7 @@
(defn key=? [t Token s string] bool (defn key=? [t Token s string] bool
(bytes=? (.text t) (bytes-view s))) (bytes=? (.text t) (bytes-view s)))
(defn- has-escape? [s [u8]] bool (defn- has-escape? [s [const u8]] bool
(dotimes [i (length s)] (dotimes [i (length s)]
(when (= (at s i) \\) (when (= (at s i) \\)
(return true))) (return true)))
@ -358,7 +358,7 @@
;; What a field name may be made of. Deliberately narrower than what the reader ;; What a field name may be made of. Deliberately narrower than what the reader
;; would accept: this is the set a *person* would recognise as a name, and a ;; would accept: this is the set a *person* would recognise as a name, and a
;; member called "a b" or "x.y" has no field it could become. ;; member called "a b" or "x.y" has no field it could become.
(defn- name-like? [s [u8]] bool (defn- name-like? [s [const u8]] bool
(when (= (length s) 0) (when (= (length s) 0)
(return false)) (return false))
(dotimes [i (length s)] (dotimes [i (length s)]
@ -372,7 +372,7 @@
;; A copy of a token's raw text as a string. The Vec header is dropped here on ;; A copy of a token's raw text as a string. The Vec header is dropped here on
;; purpose: this runs inside the compiler, where an expansion is bounded by the ;; purpose: this runs inside the compiler, where an expansion is bounded by the
;; size of the program being compiled. ;; size of the program being compiled.
(defn- copy-of [s [u8]] string (defn- copy-of [s [const u8]] string
(let [b (vec-new u8)] (let [b (vec-new u8)]
(append (addr b) s) (append (addr b) s)
(string (slice b)))) (string (slice b))))
@ -424,7 +424,7 @@
_ (refuse "defjson's first argument is the name of the struct to declare, written as a name")) _ (refuse "defjson's first argument is the name of the struct to declare, written as a name"))
_ (refuse "defjson's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from")))) _ (refuse "defjson's second argument is the path to the data file, written as a string literal — the file is read while this is being compiled, so there is nothing here to compute a path from"))))
(defn- provide [name string path string src [u8]] Form (defn- provide [name string path string src [const u8]] Form
(let [cur (cursor src) (let [cur (cursor src)
d (derive (addr cur) name src)] d (derive (addr cur) name src)]
(if (bad? d) (if (bad? d)
@ -441,7 +441,7 @@
;; built in: a string field is a copy and a Vec field is an ;; built in: a string field is a copy and a Vec field is an
;; allocation, and spec-memory's rule is that the destination is ;; allocation, and spec-memory's rule is that the destination is
;; never implicit. ;; never implicit.
(defn ~bname [b [u8] a Allocator] ~sname (defn ~bname [b [const u8] a Allocator] ~sname
(let [c (cursor b) (let [c (cursor b)
out (~rname (addr c) a)] out (~rname (addr c) a)]
;; The cursor is made and dropped here, so this is the only ;; The cursor is made and dropped here, so this is the only

54
vendor/raylib/generated.flan vendored
View File

@ -78,7 +78,7 @@
(declare-c load-file-data [file-name string data-size (Ptr i32)] (Ptr u8) "LoadFileData") (declare-c load-file-data [file-name string data-size (Ptr i32)] (Ptr u8) "LoadFileData")
(declare-c unload-file-data [data (Ptr u8)] "UnloadFileData") (declare-c unload-file-data [data (Ptr u8)] "UnloadFileData")
(declare-c save-file-data [file-name string data (Ptr u8) data-size i32] bool "SaveFileData") (declare-c save-file-data [file-name string data (Ptr u8) data-size i32] bool "SaveFileData")
(declare-c export-data-as-code [data (Ptr u8) data-size i32 file-name string] bool "ExportDataAsCode") (declare-c export-data-as-code [data (Ptr const u8) data-size i32 file-name string] bool "ExportDataAsCode")
(declare-c file-exists [file-name string] bool "FileExists") (declare-c file-exists [file-name string] bool "FileExists")
(declare-c directory-exists [dir-path string] bool "DirectoryExists") (declare-c directory-exists [dir-path string] bool "DirectoryExists")
(declare-c file-extension? [file-name string ext string] bool "IsFileExtension") (declare-c file-extension? [file-name string ext string] bool "IsFileExtension")
@ -95,9 +95,9 @@
(declare-c path-file? [path string] bool "IsPathFile") (declare-c path-file? [path string] bool "IsPathFile")
(declare-c file-name-valid? [file-name string] bool "IsFileNameValid") (declare-c file-name-valid? [file-name string] bool "IsFileNameValid")
(declare-c file-dropped? [] bool "IsFileDropped") (declare-c file-dropped? [] bool "IsFileDropped")
(declare-c compress-data [data (Ptr u8) data-size i32 comp-data-size (Ptr i32)] (Ptr u8) "CompressData") (declare-c compress-data [data (Ptr const u8) data-size i32 comp-data-size (Ptr i32)] (Ptr u8) "CompressData")
(declare-c decompress-data [comp-data (Ptr u8) comp-data-size i32 data-size (Ptr i32)] (Ptr u8) "DecompressData") (declare-c decompress-data [comp-data (Ptr const u8) comp-data-size i32 data-size (Ptr i32)] (Ptr u8) "DecompressData")
(declare-c decode-data-base-64 [data (Ptr u8) output-size (Ptr i32)] (Ptr u8) "DecodeDataBase64") (declare-c decode-data-base-64 [data (Ptr const u8) output-size (Ptr i32)] (Ptr u8) "DecodeDataBase64")
(declare-c compute-crc32 [data (Ptr u8) data-size i32] u32 "ComputeCRC32") (declare-c compute-crc32 [data (Ptr u8) data-size i32] u32 "ComputeCRC32")
(declare-c compute-md5 [data (Ptr u8) data-size i32] (Ptr u32) "ComputeMD5") (declare-c compute-md5 [data (Ptr u8) data-size i32] (Ptr u32) "ComputeMD5")
(declare-c compute-sha1 [data (Ptr u8) data-size i32] (Ptr u32) "ComputeSHA1") (declare-c compute-sha1 [data (Ptr u8) data-size i32] (Ptr u32) "ComputeSHA1")
@ -117,7 +117,7 @@
(declare-c set-mouse-scale [scale-x f32 scale-y f32] "SetMouseScale") (declare-c set-mouse-scale [scale-x f32 scale-y f32] "SetMouseScale")
(declare-c get-mouse-wheel-move-v [] Vector2 "GetMouseWheelMoveV") (declare-c get-mouse-wheel-move-v [] Vector2 "GetMouseWheelMoveV")
(declare-c update-camera-pro [camera (Ptr Camera3D) movement Vector3 rotation Vector3 zoom f32] "UpdateCameraPro") (declare-c update-camera-pro [camera (Ptr Camera3D) movement Vector3 rotation Vector3 zoom f32] "UpdateCameraPro")
(declare-c draw-line-strip-raw [points (Ptr Vector2) point-count i32 color Color] "DrawLineStrip") (declare-c draw-line-strip-raw [points (Ptr const Vector2) point-count i32 color Color] "DrawLineStrip")
(declare-c draw-line-bezier [start-pos Vector2 end-pos Vector2 thick f32 color Color] "DrawLineBezier") (declare-c draw-line-bezier [start-pos Vector2 end-pos Vector2 thick f32 color Color] "DrawLineBezier")
(declare-c draw-circle-sector [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSector") (declare-c draw-circle-sector [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSector")
(declare-c draw-circle-sector-lines [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSectorLines") (declare-c draw-circle-sector-lines [center Vector2 radius f32 start-angle f32 end-angle f32 segments i32 color Color] "DrawCircleSectorLines")
@ -126,16 +126,16 @@
(declare-c draw-rectangle-gradient-v [pos-x i32 pos-y i32 width i32 height i32 top Color bottom Color] "DrawRectangleGradientV") (declare-c draw-rectangle-gradient-v [pos-x i32 pos-y i32 width i32 height i32 top Color bottom Color] "DrawRectangleGradientV")
(declare-c draw-rectangle-gradient-h [pos-x i32 pos-y i32 width i32 height i32 left Color right Color] "DrawRectangleGradientH") (declare-c draw-rectangle-gradient-h [pos-x i32 pos-y i32 width i32 height i32 left Color right Color] "DrawRectangleGradientH")
(declare-c draw-rectangle-gradient-ex [rec Rectangle top-left Color bottom-left Color top-right Color bottom-right Color] "DrawRectangleGradientEx") (declare-c draw-rectangle-gradient-ex [rec Rectangle top-left Color bottom-left Color top-right Color bottom-right Color] "DrawRectangleGradientEx")
(declare-c draw-triangle-fan-raw [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleFan") (declare-c draw-triangle-fan-raw [points (Ptr const Vector2) point-count i32 color Color] "DrawTriangleFan")
(declare-c draw-triangle-strip-raw [points (Ptr Vector2) point-count i32 color Color] "DrawTriangleStrip") (declare-c draw-triangle-strip-raw [points (Ptr const Vector2) point-count i32 color Color] "DrawTriangleStrip")
(declare-c draw-poly [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPoly") (declare-c draw-poly [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPoly")
(declare-c draw-poly-lines [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPolyLines") (declare-c draw-poly-lines [center Vector2 sides i32 radius f32 rotation f32 color Color] "DrawPolyLines")
(declare-c draw-poly-lines-ex [center Vector2 sides i32 radius f32 rotation f32 line-thick f32 color Color] "DrawPolyLinesEx") (declare-c draw-poly-lines-ex [center Vector2 sides i32 radius f32 rotation f32 line-thick f32 color Color] "DrawPolyLinesEx")
(declare-c draw-spline-linear-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineLinear") (declare-c draw-spline-linear-raw [points (Ptr const Vector2) point-count i32 thick f32 color Color] "DrawSplineLinear")
(declare-c draw-spline-basis-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBasis") (declare-c draw-spline-basis-raw [points (Ptr const Vector2) point-count i32 thick f32 color Color] "DrawSplineBasis")
(declare-c draw-spline-catmull-rom-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineCatmullRom") (declare-c draw-spline-catmull-rom-raw [points (Ptr const Vector2) point-count i32 thick f32 color Color] "DrawSplineCatmullRom")
(declare-c draw-spline-bezier-quadratic-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierQuadratic") (declare-c draw-spline-bezier-quadratic-raw [points (Ptr const Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierQuadratic")
(declare-c draw-spline-bezier-cubic-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierCubic") (declare-c draw-spline-bezier-cubic-raw [points (Ptr const Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierCubic")
(declare-c draw-spline-segment-linear [p-1 Vector2 p-2 Vector2 thick f32 color Color] "DrawSplineSegmentLinear") (declare-c draw-spline-segment-linear [p-1 Vector2 p-2 Vector2 thick f32 color Color] "DrawSplineSegmentLinear")
(declare-c draw-spline-segment-basis [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentBasis") (declare-c draw-spline-segment-basis [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentBasis")
(declare-c draw-spline-segment-catmull-rom [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentCatmullRom") (declare-c draw-spline-segment-catmull-rom [p-1 Vector2 p-2 Vector2 p-3 Vector2 p-4 Vector2 thick f32 color Color] "DrawSplineSegmentCatmullRom")
@ -148,7 +148,7 @@
(declare-c get-spline-point-bezier-cubic [p-1 Vector2 c-2 Vector2 c-3 Vector2 p-4 Vector2 t f32] Vector2 "GetSplinePointBezierCubic") (declare-c get-spline-point-bezier-cubic [p-1 Vector2 c-2 Vector2 c-3 Vector2 p-4 Vector2 t f32] Vector2 "GetSplinePointBezierCubic")
(declare-c load-image-raw [file-name string width i32 height i32 format i32 header-size i32] Image "LoadImageRaw") (declare-c load-image-raw [file-name string width i32 height i32 format i32 header-size i32] Image "LoadImageRaw")
(declare-c load-image-anim [file-name string frames (Ptr i32)] Image "LoadImageAnim") (declare-c load-image-anim [file-name string frames (Ptr i32)] Image "LoadImageAnim")
(declare-c load-image-anim-from-memory [file-type string file-data (Ptr u8) data-size i32 frames (Ptr i32)] Image "LoadImageAnimFromMemory") (declare-c load-image-anim-from-memory [file-type string file-data (Ptr const u8) data-size i32 frames (Ptr i32)] Image "LoadImageAnimFromMemory")
(declare-c load-image-from-texture [texture Texture2D] Image "LoadImageFromTexture") (declare-c load-image-from-texture [texture Texture2D] Image "LoadImageFromTexture")
(declare-c load-image-from-screen [] Image "LoadImageFromScreen") (declare-c load-image-from-screen [] Image "LoadImageFromScreen")
(declare-c export-image-to-memory [image Image file-type string file-size (Ptr i32)] (Ptr u8) "ExportImageToMemory") (declare-c export-image-to-memory [image Image file-type string file-size (Ptr i32)] (Ptr u8) "ExportImageToMemory")
@ -171,7 +171,7 @@
(declare-c image-alpha-mask [image (Ptr Image) alpha-mask Image] "ImageAlphaMask") (declare-c image-alpha-mask [image (Ptr Image) alpha-mask Image] "ImageAlphaMask")
(declare-c image-alpha-premultiply [image (Ptr Image)] "ImageAlphaPremultiply") (declare-c image-alpha-premultiply [image (Ptr Image)] "ImageAlphaPremultiply")
(declare-c image-blur-gaussian [image (Ptr Image) blur-size i32] "ImageBlurGaussian") (declare-c image-blur-gaussian [image (Ptr Image) blur-size i32] "ImageBlurGaussian")
(declare-c image-kernel-convolution [image (Ptr Image) kernel (Ptr f32) kernel-size i32] "ImageKernelConvolution") (declare-c image-kernel-convolution [image (Ptr Image) kernel (Ptr const f32) kernel-size i32] "ImageKernelConvolution")
(declare-c image-resize-canvas [image (Ptr Image) new-width i32 new-height i32 offset-x i32 offset-y i32 fill Color] "ImageResizeCanvas") (declare-c image-resize-canvas [image (Ptr Image) new-width i32 new-height i32 offset-x i32 offset-y i32 fill Color] "ImageResizeCanvas")
(declare-c image-mipmaps [image (Ptr Image)] "ImageMipmaps") (declare-c image-mipmaps [image (Ptr Image)] "ImageMipmaps")
(declare-c image-dither [image (Ptr Image) r-bpp i32 g-bpp i32 b-bpp i32 a-bpp i32] "ImageDither") (declare-c image-dither [image (Ptr Image) r-bpp i32 g-bpp i32 b-bpp i32 a-bpp i32] "ImageDither")
@ -211,8 +211,8 @@
(declare-c image-draw-text [dst (Ptr Image) text string pos-x i32 pos-y i32 font-size i32 color Color] "ImageDrawText") (declare-c image-draw-text [dst (Ptr Image) text string pos-x i32 pos-y i32 font-size i32 color Color] "ImageDrawText")
(declare-c image-draw-text-ex [dst (Ptr Image) font Font text string position Vector2 font-size f32 spacing f32 tint Color] "ImageDrawTextEx") (declare-c image-draw-text-ex [dst (Ptr Image) font Font text string position Vector2 font-size f32 spacing f32 tint Color] "ImageDrawTextEx")
(declare-c load-texture-cubemap [image Image layout i32] Texture2D "LoadTextureCubemap") (declare-c load-texture-cubemap [image Image layout i32] Texture2D "LoadTextureCubemap")
(declare-c update-texture [texture Texture2D pixels (Ptr u8)] "UpdateTexture") (declare-c update-texture [texture Texture2D pixels (Ptr const u8)] "UpdateTexture")
(declare-c update-texture-rec [texture Texture2D rec Rectangle pixels (Ptr u8)] "UpdateTextureRec") (declare-c update-texture-rec [texture Texture2D rec Rectangle pixels (Ptr const u8)] "UpdateTextureRec")
(declare-c gen-texture-mipmaps [texture (Ptr Texture2D)] "GenTextureMipmaps") (declare-c gen-texture-mipmaps [texture (Ptr Texture2D)] "GenTextureMipmaps")
(declare-c set-texture-wrap [texture Texture2D wrap i32] "SetTextureWrap") (declare-c set-texture-wrap [texture Texture2D wrap i32] "SetTextureWrap")
(declare-c color-is-equal [col-1 Color col-2 Color] bool "ColorIsEqual") (declare-c color-is-equal [col-1 Color col-2 Color] bool "ColorIsEqual")
@ -229,13 +229,13 @@
(declare-c set-pixel-color [dst-ptr (Ptr u8) color Color format i32] "SetPixelColor") (declare-c set-pixel-color [dst-ptr (Ptr u8) color Color format i32] "SetPixelColor")
(declare-c get-pixel-data-size [width i32 height i32 format i32] i32 "GetPixelDataSize") (declare-c get-pixel-data-size [width i32 height i32 format i32] i32 "GetPixelDataSize")
(declare-c load-font-from-image [image Image key Color first-char i32] Font "LoadFontFromImage") (declare-c load-font-from-image [image Image key Color first-char i32] Font "LoadFontFromImage")
(declare-c load-font-from-memory [file-type string file-data (Ptr u8) data-size i32 font-size i32 codepoints (Ptr i32) codepoint-count i32] Font "LoadFontFromMemory") (declare-c load-font-from-memory [file-type string file-data (Ptr const u8) data-size i32 font-size i32 codepoints (Ptr i32) codepoint-count i32] Font "LoadFontFromMemory")
(declare-c load-font-data [file-data (Ptr u8) data-size i32 font-size i32 codepoints (Ptr i32) codepoint-count i32 type i32] (Ptr GlyphInfo) "LoadFontData") (declare-c load-font-data [file-data (Ptr const u8) data-size i32 font-size i32 codepoints (Ptr i32) codepoint-count i32 type i32] (Ptr GlyphInfo) "LoadFontData")
(declare-c gen-image-font-atlas [glyphs (Ptr GlyphInfo) glyph-recs (Ptr (Ptr Rectangle)) glyph-count i32 font-size i32 padding i32 pack-method i32] Image "GenImageFontAtlas") (declare-c gen-image-font-atlas [glyphs (Ptr const GlyphInfo) glyph-recs (Ptr (Ptr Rectangle)) glyph-count i32 font-size i32 padding i32 pack-method i32] Image "GenImageFontAtlas")
(declare-c unload-font-data [glyphs (Ptr GlyphInfo) glyph-count i32] "UnloadFontData") (declare-c unload-font-data [glyphs (Ptr GlyphInfo) glyph-count i32] "UnloadFontData")
(declare-c export-font-as-code [font Font file-name string] bool "ExportFontAsCode") (declare-c export-font-as-code [font Font file-name string] bool "ExportFontAsCode")
(declare-c draw-text-pro [font Font text string position Vector2 origin Vector2 rotation f32 font-size f32 spacing f32 tint Color] "DrawTextPro") (declare-c draw-text-pro [font Font text string position Vector2 origin Vector2 rotation f32 font-size f32 spacing f32 tint Color] "DrawTextPro")
(declare-c draw-text-codepoints [font Font codepoints (Ptr i32) codepoint-count i32 position Vector2 font-size f32 spacing f32 tint Color] "DrawTextCodepoints") (declare-c draw-text-codepoints [font Font codepoints (Ptr const i32) codepoint-count i32 position Vector2 font-size f32 spacing f32 tint Color] "DrawTextCodepoints")
(declare-c set-text-line-spacing [spacing i32] "SetTextLineSpacing") (declare-c set-text-line-spacing [spacing i32] "SetTextLineSpacing")
(declare-c load-codepoints [text string count (Ptr i32)] (Ptr i32) "LoadCodepoints") (declare-c load-codepoints [text string count (Ptr i32)] (Ptr i32) "LoadCodepoints")
(declare-c unload-codepoints [codepoints (Ptr i32)] "UnloadCodepoints") (declare-c unload-codepoints [codepoints (Ptr i32)] "UnloadCodepoints")
@ -246,7 +246,7 @@
(declare-c text-is-equal [text-1 string text-2 string] bool "TextIsEqual") (declare-c text-is-equal [text-1 string text-2 string] bool "TextIsEqual")
(declare-c text-length [text string] u32 "TextLength") (declare-c text-length [text string] u32 "TextLength")
(declare-c text-subtext [text string position i32 length i32] string "TextSubtext") (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-join [text-list (Ptr const (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-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-find-index [text string find string] i32 "TextFindIndex")
(declare-c text-to-upper [text string] string "TextToUpper") (declare-c text-to-upper [text string] string "TextToUpper")
@ -260,7 +260,7 @@
(declare-c draw-point-3d [position Vector3 color Color] "DrawPoint3D") (declare-c draw-point-3d [position Vector3 color Color] "DrawPoint3D")
(declare-c draw-circle-3d [center Vector3 radius f32 rotation-axis Vector3 rotation-angle f32 color Color] "DrawCircle3D") (declare-c draw-circle-3d [center Vector3 radius f32 rotation-axis Vector3 rotation-angle f32 color Color] "DrawCircle3D")
(declare-c draw-triangle-3d [v-1 Vector3 v-2 Vector3 v-3 Vector3 color Color] "DrawTriangle3D") (declare-c draw-triangle-3d [v-1 Vector3 v-2 Vector3 v-3 Vector3 color Color] "DrawTriangle3D")
(declare-c draw-triangle-strip-3d-raw [points (Ptr Vector3) point-count i32 color Color] "DrawTriangleStrip3D") (declare-c draw-triangle-strip-3d-raw [points (Ptr const Vector3) point-count i32 color Color] "DrawTriangleStrip3D")
(declare-c draw-cube-wires-v [position Vector3 size Vector3 color Color] "DrawCubeWiresV") (declare-c draw-cube-wires-v [position Vector3 size Vector3 color Color] "DrawCubeWiresV")
(declare-c draw-sphere-ex [center-pos Vector3 radius f32 rings i32 slices i32 color Color] "DrawSphereEx") (declare-c draw-sphere-ex [center-pos Vector3 radius f32 rings i32 slices i32 color Color] "DrawSphereEx")
(declare-c draw-cylinder [position Vector3 radius-top f32 radius-bottom f32 height f32 slices i32 color Color] "DrawCylinder") (declare-c draw-cylinder [position Vector3 radius-top f32 radius-bottom f32 height f32 slices i32 color Color] "DrawCylinder")
@ -286,7 +286,7 @@
(declare-c draw-billboard-rec [camera Camera3D texture Texture2D source Rectangle position Vector3 size Vector2 tint Color] "DrawBillboardRec") (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 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 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 update-mesh-buffer [mesh Mesh index i32 data (Ptr const u8) data-size i32 offset i32] "UpdateMeshBuffer")
(declare-c unload-mesh [mesh Mesh] "UnloadMesh") (declare-c unload-mesh [mesh Mesh] "UnloadMesh")
(declare-c get-mesh-bounding-box [mesh Mesh] BoundingBox "GetMeshBoundingBox") (declare-c get-mesh-bounding-box [mesh Mesh] BoundingBox "GetMeshBoundingBox")
(declare-c gen-mesh-tangents [mesh (Ptr Mesh)] "GenMeshTangents") (declare-c gen-mesh-tangents [mesh (Ptr Mesh)] "GenMeshTangents")
@ -312,14 +312,14 @@
(declare-c get-ray-collision-mesh [ray Ray mesh Mesh transform Matrix] RayCollision "GetRayCollisionMesh") (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-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 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") (declare-c load-wave-from-memory [file-type string file-data (Ptr const u8) data-size i32] Wave "LoadWaveFromMemory")
(declare-c update-sound [sound Sound data (Ptr u8) sample-count i32] "UpdateSound") (declare-c update-sound [sound Sound data (Ptr const u8) sample-count i32] "UpdateSound")
(declare-c export-wave-as-code [wave Wave file-name string] bool "ExportWaveAsCode") (declare-c export-wave-as-code [wave Wave file-name string] bool "ExportWaveAsCode")
(declare-c load-music-stream-from-memory [file-type string data (Ptr u8) data-size i32] Music "LoadMusicStreamFromMemory") (declare-c load-music-stream-from-memory [file-type string data (Ptr const u8) data-size i32] Music "LoadMusicStreamFromMemory")
(declare-c load-audio-stream [sample-rate u32 sample-size u32 channels u32] AudioStream "LoadAudioStream") (declare-c load-audio-stream [sample-rate u32 sample-size u32 channels u32] AudioStream "LoadAudioStream")
(declare-c audio-stream-valid? [stream AudioStream] bool "IsAudioStreamValid") (declare-c audio-stream-valid? [stream AudioStream] bool "IsAudioStreamValid")
(declare-c unload-audio-stream [stream AudioStream] "UnloadAudioStream") (declare-c unload-audio-stream [stream AudioStream] "UnloadAudioStream")
(declare-c update-audio-stream [stream AudioStream data (Ptr u8) frame-count i32] "UpdateAudioStream") (declare-c update-audio-stream [stream AudioStream data (Ptr const u8) frame-count i32] "UpdateAudioStream")
(declare-c audio-stream-processed? [stream AudioStream] bool "IsAudioStreamProcessed") (declare-c audio-stream-processed? [stream AudioStream] bool "IsAudioStreamProcessed")
(declare-c play-audio-stream [stream AudioStream] "PlayAudioStream") (declare-c play-audio-stream [stream AudioStream] "PlayAudioStream")
(declare-c pause-audio-stream [stream AudioStream] "PauseAudioStream") (declare-c pause-audio-stream [stream AudioStream] "PauseAudioStream")

30
vendor/raylib/raylib.flan vendored
View File

@ -582,10 +582,10 @@
;; out-of-bounds read, and raylib answers false for a polygon with no points ;; out-of-bounds read, and raylib answers false for a polygon with no points
;; anyway. ;; anyway.
(declare-c collision-point-poly?-raw (declare-c collision-point-poly?-raw
[point Vector2 points (Ptr Vector2) count i32] bool [point Vector2 points (Ptr const Vector2) count i32] bool
"CheckCollisionPointPoly") "CheckCollisionPointPoly")
(defn collision-point-poly? [point Vector2 points [Vector2]] bool (defn collision-point-poly? [point Vector2 points [const Vector2]] bool
(if (= (length points) 0) (if (= (length points) 0)
false false
(collision-point-poly?-raw point (addr (at points 0)) (length points)))) (collision-point-poly?-raw point (addr (at points 0)) (length points))))
@ -801,7 +801,7 @@
;; which integer type a C count parameter is. The Flan wrapper below takes the ;; which integer type a C count parameter is. The Flan wrapper below takes the
;; slice apart, which is where that idiom lives everywhere else in this file. ;; slice apart, which is where that idiom lives everywhere else in this file.
(declare-c load-image-from-memory-raw (declare-c load-image-from-memory-raw
[file-type string file-data (Ptr u8) data-size i32] Image [file-type string file-data (Ptr const u8) data-size i32] Image
"LoadImageFromMemory") "LoadImageFromMemory")
;; Empty is answered here rather than passed on, exactly as in ;; Empty is answered here rather than passed on, exactly as in
@ -811,7 +811,7 @@
;; false for it either way, so a caller that checks sees the same thing. ;; false for it either way, so a caller that checks sees the same thing.
(defonce no-image Image) (defonce no-image Image)
(defn load-image-from-memory [file-type string data [u8]] Image (defn load-image-from-memory [file-type string data [const u8]] Image
(if (= (length data) 0) (if (= (length data) 0)
no-image no-image
(load-image-from-memory-raw file-type (addr (at data 0)) (length data)))) (load-image-from-memory-raw file-type (addr (at data 0)) (length data))))
@ -1015,42 +1015,42 @@
;; Each -raw below is a generated declaration whose name moved aside; see the ;; Each -raw below is a generated declaration whose name moved aside; see the
;; `name` lines at the foot of `bindings`. ;; `name` lines at the foot of `bindings`.
(defn draw-line-strip [points [Vector2] color Color] () (defn draw-line-strip [points [const Vector2] color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-line-strip-raw (addr (at points 0)) (length points) color))) (draw-line-strip-raw (addr (at points 0)) (length points) color)))
(defn draw-triangle-fan [points [Vector2] color Color] () (defn draw-triangle-fan [points [const Vector2] color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-triangle-fan-raw (addr (at points 0)) (length points) color))) (draw-triangle-fan-raw (addr (at points 0)) (length points) color)))
(defn draw-triangle-strip [points [Vector2] color Color] () (defn draw-triangle-strip [points [const Vector2] color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-triangle-strip-raw (addr (at points 0)) (length points) color))) (draw-triangle-strip-raw (addr (at points 0)) (length points) color)))
(defn draw-triangle-strip-3d [points [Vector3] color Color] () (defn draw-triangle-strip-3d [points [const Vector3] color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-triangle-strip-3d-raw (addr (at points 0)) (length points) color))) (draw-triangle-strip-3d-raw (addr (at points 0)) (length points) color)))
;; The five spline drawers. raylib reads the same point array five different ;; The five spline drawers. raylib reads the same point array five different
;; ways; the only difference between these wrappers is which one it calls. ;; ways; the only difference between these wrappers is which one it calls.
(defn draw-spline-linear [points [Vector2] thick f32 color Color] () (defn draw-spline-linear [points [const Vector2] thick f32 color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-spline-linear-raw (addr (at points 0)) (length points) thick color))) (draw-spline-linear-raw (addr (at points 0)) (length points) thick color)))
(defn draw-spline-basis [points [Vector2] thick f32 color Color] () (defn draw-spline-basis [points [const Vector2] thick f32 color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-spline-basis-raw (addr (at points 0)) (length points) thick color))) (draw-spline-basis-raw (addr (at points 0)) (length points) thick color)))
(defn draw-spline-catmull-rom [points [Vector2] thick f32 color Color] () (defn draw-spline-catmull-rom [points [const Vector2] thick f32 color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-spline-catmull-rom-raw (addr (at points 0)) (length points) thick color))) (draw-spline-catmull-rom-raw (addr (at points 0)) (length points) thick color)))
(defn draw-spline-bezier-quadratic [points [Vector2] thick f32 color Color] () (defn draw-spline-bezier-quadratic [points [const Vector2] thick f32 color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-spline-bezier-quadratic-raw (draw-spline-bezier-quadratic-raw
(addr (at points 0)) (length points) thick color))) (addr (at points 0)) (length points) thick color)))
(defn draw-spline-bezier-cubic [points [Vector2] thick f32 color Color] () (defn draw-spline-bezier-cubic [points [const Vector2] thick f32 color Color] ()
(when (> (length points) 0) (when (> (length points) 0)
(draw-spline-bezier-cubic-raw (draw-spline-bezier-cubic-raw
(addr (at points 0)) (length points) thick color))) (addr (at points 0)) (length points) thick color)))
@ -1595,7 +1595,7 @@
;; half no longer carries the string-faced version at all — a binding that is ;; half no longer carries the string-faced version at all — a binding that is
;; wrong for the only direction it reads in is worse than no binding. ;; wrong for the only direction it reads in is worse than no binding.
(declare-c get-codepoint-previous-raw (declare-c get-codepoint-previous-raw
[text (Ptr u8) codepoint-size (Ptr i32)] i32 [text (Ptr const u8) codepoint-size (Ptr i32)] i32
"GetCodepointPrevious") "GetCodepointPrevious")
;; The face a caller wants: the bytes and an offset into them, rather than an ;; The face a caller wants: the bytes and an offset into them, rather than an
@ -1606,7 +1606,7 @@
;; before it and `codepoint-size` is that one's length in bytes, so the ;; before it and `codepoint-size` is that one's length in bytes, so the
;; previous offset is `offset` minus what comes back through the pointer. At ;; previous offset is `offset` minus what comes back through the pointer. At
;; offset 0 there is nothing behind it and raylib is not asked. ;; offset 0 there is nothing behind it and raylib is not asked.
(defn get-codepoint-previous [text [u8] offset i32 codepoint-size (Ptr i32)] i32 (defn get-codepoint-previous [text [const u8] offset i32 codepoint-size (Ptr i32)] i32
(if (<= offset 0) (if (<= offset 0)
(do (set (deref codepoint-size) 0) 0) (do (set (deref codepoint-size) 0) 0)
(get-codepoint-previous-raw (addr (at text offset)) codepoint-size))) (get-codepoint-previous-raw (addr (at text offset)) codepoint-size)))

2
web/examples/structs.flan
View File

@ -1,5 +1,5 @@
(defstruct Cursor (defstruct Cursor
[src [u8] ; a non-owning slice [src [const u8] ; a read-only, non-owning slice
pos i32]) ; no initialiser means zeroed pos i32]) ; no initialiser means zeroed
(defn peek [c (Ptr Cursor)] u8 (defn peek [c (Ptr Cursor)] u8

11
web/index.html
View File

@ -384,7 +384,8 @@ described.</p>
<li><strong>Fixed arrays are values.</strong> <code>[n T]</code> is inline storage <li><strong>Fixed arrays are values.</strong> <code>[n T]</code> is inline storage
and copies on assignment and on pass-by-value.</li> and copies on assignment and on pass-by-value.</li>
<li><strong>Slices are views.</strong> <code>[T]</code> is ptr+len and owns nothing. <li><strong>Slices are views.</strong> <code>[T]</code> is ptr+len and owns nothing.
Copying a slice copies the view, never the elements.</li> Copying a slice copies the view, never the elements. <code>[const T]</code> is the
same view with no stores through it.</li>
<li><strong>Pointers are visible.</strong> <code>(addr x)</code> takes the address of <li><strong>Pointers are visible.</strong> <code>(addr x)</code> takes the address of
any assignable place and gives <code>(Ptr T)</code>. It does not extend anything's any assignable place and gives <code>(Ptr T)</code>. It does not extend anything's
lifetime, and keeping one past its frame is your contract to honour — there is no lifetime, and keeping one past its frame is your contract to honour — there is no
@ -518,12 +519,14 @@ notation reads as exactly one data item.</p>
<tr><td><code>bool</code></td><td></td><td><code>i1</code></td></tr> <tr><td><code>bool</code></td><td></td><td><code>i1</code></td></tr>
<tr><td><code>string</code></td><td>a byte slice with no NUL</td><td>ptr + len</td></tr> <tr><td><code>string</code></td><td>a byte slice with no NUL</td><td>ptr + len</td></tr>
<tr><td><code>[T]</code></td><td>slice, non-owning</td><td>ptr + len</td></tr> <tr><td><code>[T]</code></td><td>slice, non-owning</td><td>ptr + len</td></tr>
<tr><td><code>[const T]</code></td><td>read-only slice: a <code>[T]</code> converts to one, never the reverse</td><td>ptr + len</td></tr>
<tr><td><code>[n T]</code></td><td>fixed array, a value</td><td>n inline items</td></tr> <tr><td><code>[n T]</code></td><td>fixed array, a value</td><td>n inline items</td></tr>
<tr><td><code>(Vec T)</code></td><td>growable, owning — copies as its header, so the copies alias one buffer</td><td>ptr + len + cap + its allocator</td></tr> <tr><td><code>(Vec T)</code></td><td>growable, owning — copies as its header, so the copies alias one buffer</td><td>ptr + len + cap + its allocator</td></tr>
<tr><td><code>(Map K V)</code></td><td>open addressing, owning, copies the same way. The only map spelling: braces in type position are not a type</td><td>data + len + log2cap + its allocator</td></tr> <tr><td><code>(Map K V)</code></td><td>open addressing, owning, copies the same way. The only map spelling: braces in type position are not a type</td><td>data + len + log2cap + its allocator</td></tr>
<tr><td><code>(Pool T)</code></td><td>generational slab storage, owning, copies the same way</td><td>items + slots + its allocator</td></tr> <tr><td><code>(Pool T)</code></td><td>generational slab storage, owning, copies the same way</td><td>items + slots + its allocator</td></tr>
<tr><td><code>(Handle T)</code></td><td>a reference into a pool that reports a dead referent</td><td>index and generation packed into an <code>i64</code></td></tr> <tr><td><code>(Handle T)</code></td><td>a reference into a pool that reports a dead referent</td><td>index and generation packed into an <code>i64</code></td></tr>
<tr><td><code>(Ptr T)</code></td><td>raw pointer</td><td>a pointer</td></tr> <tr><td><code>(Ptr T)</code></td><td>raw pointer</td><td>a pointer</td></tr>
<tr><td><code>(Ptr const T)</code></td><td>a pointer nothing is written through: the address of read-only storage, and what a C <code>const T *</code> takes. A <code>(Ptr T)</code> converts to one, never the reverse</td><td>a pointer</td></tr>
<tr><td><code>(Option T)</code></td><td><code>Some</code> / <code>None</code></td><td>tag byte + T</td></tr> <tr><td><code>(Option T)</code></td><td><code>Some</code> / <code>None</code></td><td>tag byte + T</td></tr>
<tr><td><code>(Fn [T ...] R)</code></td><td>a function value, which may have captured</td><td>a code address and an environment pointer</td></tr> <tr><td><code>(Fn [T ...] R)</code></td><td>a function value, which may have captured</td><td>a code address and an environment pointer</td></tr>
<tr><td><code>(CFn [T ...] R)</code></td><td>a function value that cannot capture — the <code>C</code> is what a C function pointer would need, not a way to reach C today</td><td>a pointer</td></tr> <tr><td><code>(CFn [T ...] R)</code></td><td>a function value that cannot capture — the <code>C</code> is what a C function pointer would need, not a way to reach C today</td><td>a pointer</td></tr>
@ -807,7 +810,7 @@ code on every target, which is what makes the collector work there.</p>
its fields, and omitted fields are zeroed.</p> its fields, and omitted fields are zeroed.</p>
<pre><code>(defstruct Cursor <pre><code>(defstruct Cursor
[src [u8] ; a non-owning slice [src [const u8] ; a read-only, non-owning slice
pos i32]) ; no initialiser means zeroed pos i32]) ; no initialiser means zeroed
(defn peek [c (Ptr Cursor)] u8 (defn peek [c (Ptr Cursor)] u8
@ -836,8 +839,8 @@ its bytes.</p>
<p>There are two ways to see a string's bytes and the difference is whether anything <p>There are two ways to see a string's bytes and the difference is whether anything
is allocated. <code>(bytes-view s)</code> is the string's own storage seen as a is allocated. <code>(bytes-view s)</code> is the string's own storage seen as a
<code>[u8]</code> and costs nothing; it aliases the string, so a literal's view points <code>[const u8]</code> and costs nothing; it aliases the string, and a store through
into <code>.rodata</code> and writing through it traps. <code>(bytes s)</code> and it is a compile error. <code>(bytes s)</code> and
<code>(bytes s allocator)</code> make a writable copy through the allocator — never a <code>(bytes s allocator)</code> make a writable copy through the allocator — never a
hidden <code>malloc</code>, which is the rule every allocating operation follows. The hidden <code>malloc</code>, which is the rule every allocating operation follows. The
example above wants a view and takes one.</p> example above wants a view and takes one.</p>