A slice or pointer can be read-only, and what it reaches cannot be written through it
This commit is contained in:
commit
b2eb81f7bf
22
TODO.org
22
TODO.org
@ -955,20 +955,9 @@ CLOSED: [2026-09-25]
|
||||
=(the T expr)= gives any expression its want and =let= stays a flat list of
|
||||
pairs. Rules out a type slot in =let=.
|
||||
|
||||
** NEXT 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=.
|
||||
=bytes-view= is read-only by convention only — the type system cannot say a =[u8]=
|
||||
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.
|
||||
** DONE A read-only slice type
|
||||
CLOSED: [2026-09-25]
|
||||
=[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.
|
||||
|
||||
** 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
|
||||
@ -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
|
||||
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
|
||||
|
||||
** DONE The x86 backend tracks LLVM at -O0
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
;; ── one by pointer. `addr` takes the address of a local; the pointer never
|
||||
;; ── outlives the frame, so no allocator is involved.
|
||||
(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
|
||||
|
||||
(defn peek [c (Ptr Cursor)] u8
|
||||
@ -105,7 +105,7 @@
|
||||
(Some lhs)))
|
||||
|
||||
;; ── 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 [v (some (parse-expr (addr c) 1))]
|
||||
(skip-spaces (addr c))
|
||||
|
||||
@ -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
|
||||
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
|
||||
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.
|
||||
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.
|
||||
@ -3001,7 +3001,7 @@ fires.
|
||||
| `(clone v)` / `(clone v a)` | the only copy; assignment moves |
|
||||
| `(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-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
|
||||
|
||||
@ -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
|
||||
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
|
||||
**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
|
||||
`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
|
||||
*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.
|
||||
@ -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
|
||||
|
||||
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
|
||||
(`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
|
||||
@ -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
|
||||
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
|
||||
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`.
|
||||
|
||||
**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
|
||||
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
|
||||
@ -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`.
|
||||
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
|
||||
`-O0` and is deleted as undefined behaviour at `-O2` — the same trap the prelude's ASCII-case note measures for
|
||||
`(bytes "Hi")`, and the same one TODO.org tracks as "Writing through a string literal". Nothing here makes it worse and
|
||||
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.
|
||||
**Read-only, and the type says so.** The slice points into `.rodata`, where a store would segfault at `-O0` and be
|
||||
deleted as undefined behaviour at `-O2`, so it is a `[const u8]` and a store through it is refused at compile time.
|
||||
To decode an asset in place, copy the bytes into a `Vec` first.
|
||||
|
||||
**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
|
||||
|
||||
@ -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
|
||||
;; lowercase on purpose — it is a primitive beside `i64' and `bool', not
|
||||
;; 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.
|
||||
;; 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
|
||||
;; advertise a spelling the parser rejects, which is the same reason
|
||||
;; `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)
|
||||
;; A type variable, `$t', which is what a generic `defn' names its
|
||||
;; parameter types with and what `{:where (ordered? $t)}' constrains.
|
||||
|
||||
@ -491,6 +491,8 @@
|
||||
"a package alias")
|
||||
("(defn f [x int] float 1.0)" "int" font-lock-type-face
|
||||
"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.
|
||||
("(set done true)" "true" font-lock-constant-face "true")
|
||||
("(= o None)" "None" font-lock-constant-face "None")
|
||||
|
||||
@ -63,7 +63,7 @@
|
||||
;; from here they are ordinary slices, bounds-checked like any other, and the
|
||||
;; index comes from raylib's own get-glyph-index so it is in range by
|
||||
;; construction.
|
||||
(defn draw-text-boxed [font rl/Font text [u8] rec rl/Rectangle
|
||||
(defn draw-text-boxed [font rl/Font text [const u8] rec rl/Rectangle
|
||||
font-size f32 spacing f32 word-wrap? bool
|
||||
tint rl/Color] ()
|
||||
(let [glyphs (rl/font-glyphs font)
|
||||
|
||||
@ -14,7 +14,7 @@ type texpr = { t : texpr_kind; tloc : Loc.t }
|
||||
|
||||
and texpr_kind =
|
||||
| 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]] *)
|
||||
| Tmap of texpr * texpr (* (Map string i32) *)
|
||||
| Tapp of string * texpr list (* (Ptr Cursor) (Option f64) *)
|
||||
|
||||
614
lib/check.ml
614
lib/check.ml
File diff suppressed because it is too large
Load Diff
@ -407,7 +407,8 @@ let rec ty_source (t : Ast.texpr) =
|
||||
| Ast.Tname n -> n
|
||||
| Ast.Tapp (n, 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.Lname n, e) -> Printf.sprintf "[%s %s]" n (ty_source e)
|
||||
| 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 \
|
||||
as a NUL-terminated copy — the writes would be lost. const char * is \
|
||||
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
|
||||
end
|
||||
else value_ty env s
|
||||
@ -948,33 +956,41 @@ let c_pointee (s : string) : string option =
|
||||
Some (String.trim (String.sub s 0 (String.length s - 1)))
|
||||
else None
|
||||
|
||||
let ptr_agrees_elem env ~inner (elem : Ast.texpr) =
|
||||
(* [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
|
||||
is the whole of what the spelling means — so there is no element type in
|
||||
the header to disagree with, and a check that reported one would be
|
||||
reporting [value_ty]'s guess of [u8] back at the author as if the header
|
||||
had said it. What is *not* given up is that it is a pointer at all: the
|
||||
match above requires [(Ptr _)] on the Flan side, so an [i32] or a
|
||||
[string] declared against a [void *] is still a finding. That
|
||||
asymmetry is the point — raylib spells thirty-odd parameters [void *]
|
||||
and none of them is a scalar. *)
|
||||
let b = bare inner in
|
||||
if String.equal b "void" then true
|
||||
else (
|
||||
match (try Some (value_ty env inner) with Refused _ -> None) with
|
||||
| None ->
|
||||
(* A pointee this cannot render says nothing, exactly as an
|
||||
unrenderable field type says nothing in [check_structs]. *)
|
||||
false
|
||||
| Some want ->
|
||||
let a = ty_source want and b = ty_source elem in
|
||||
(* [agrees] and not [String.equal], so a [(Ptr Key)] against 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. *)
|
||||
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
|
||||
| Some inner, Ast.Tapp ("Ptr", [ elem ]) ->
|
||||
(* [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
|
||||
is the whole of what the spelling means — so there is no element type in
|
||||
the header to disagree with, and a check that reported one would be
|
||||
reporting [value_ty]'s guess of [u8] back at the author as if the header
|
||||
had said it. What is *not* given up is that it is a pointer at all: the
|
||||
match above requires [(Ptr _)] on the Flan side, so an [i32] or a
|
||||
[string] declared against a [void *] is still a finding. That
|
||||
asymmetry is the point — raylib spells thirty-odd parameters [void *]
|
||||
and none of them is a scalar. *)
|
||||
let b = bare inner in
|
||||
if String.equal b "void" then true
|
||||
else (
|
||||
match (try Some (value_ty env inner) with Refused _ -> None) with
|
||||
| None ->
|
||||
(* A pointee this cannot render says nothing, exactly as an
|
||||
unrenderable field type says nothing in [check_structs]. *)
|
||||
false
|
||||
| Some want ->
|
||||
let a = ty_source want and b = ty_source elem in
|
||||
(* [agrees] and not [String.equal], so a [(Ptr Key)] against 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. *)
|
||||
agrees env want elem || (byte a && byte b))
|
||||
(* 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
|
||||
|
||||
(* The two together, for the one caller that still has the C spelling. A
|
||||
|
||||
@ -2742,7 +2742,7 @@ let type_of_spelling t spelling : (Types.t, string) result =
|
||||
let addr_extern : Tast.extern =
|
||||
{ Tast.ename = "flan/dev-addr"; esym = "flan_dev_reg_addr";
|
||||
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.
|
||||
|
||||
@ -2777,7 +2777,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
|
||||
extra := ty :: !extra;
|
||||
i) }
|
||||
in
|
||||
let pty = Types.Ptr ty in
|
||||
let pty = Types.Ptr (Types.Mut, ty) in
|
||||
let root =
|
||||
{ Tast.e =
|
||||
Tast.Prim
|
||||
@ -2787,7 +2787,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
|
||||
("flan/dev-addr",
|
||||
[ { Tast.e = Tast.Int (Int64.of_int addr, Types.I64);
|
||||
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 }
|
||||
in
|
||||
match Render.render c 0 root with
|
||||
@ -2951,7 +2951,7 @@ let inspect_addr t ~addr ~want_type =
|
||||
| Ok v ->
|
||||
ok
|
||||
([ 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 ]
|
||||
@ told @ where))))))
|
||||
|
||||
|
||||
32
lib/emit.ml
32
lib/emit.ml
@ -1009,7 +1009,7 @@ let rec dty m d (t : Types.t) : int =
|
||||
| Types.Bool -> basic "bool" 8 "DW_ATE_boolean"
|
||||
| Types.Enum e -> basic e 32 "DW_ATE_signed"
|
||||
| Types.Unit | Types.Never -> composite (Types.to_string t) []
|
||||
| Types.Ptr e ->
|
||||
| Types.Ptr (_, e) ->
|
||||
let id = dalloc d in
|
||||
Hashtbl.replace d.dtys key id;
|
||||
(* [(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. *)
|
||||
| Types.String ->
|
||||
composite "string"
|
||||
[ ("ptr", Types.Ptr (Types.Int Types.U8)); ("len", Types.Int Types.I64) ]
|
||||
| Types.Slice e ->
|
||||
[ ("ptr", Types.Ptr (Types.Mut, (Types.Int Types.U8))); ("len", Types.Int Types.I64) ]
|
||||
| Types.Slice (_, e) ->
|
||||
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 ->
|
||||
composite (Types.to_string t)
|
||||
[ ("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. *)
|
||||
| Types.Vec e ->
|
||||
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);
|
||||
("epoch", Types.Int Types.I64) ]
|
||||
(* 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. *)
|
||||
| Types.Map (k, v) ->
|
||||
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);
|
||||
("allocator", Types.Alloc); ("epoch", Types.Int Types.I64) ]
|
||||
|> 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. *)
|
||||
| Types.Fn _ ->
|
||||
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
|
||||
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
|
||||
@ -2831,7 +2831,7 @@ and element_addr f (target : Tast.expr) idx =
|
||||
same way, bounds check included. *)
|
||||
| Types.Slice _ | Types.String ->
|
||||
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. *)
|
||||
let s = load f ptr ty 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.Pderef target ->
|
||||
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
|
||||
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"
|
||||
p (ll target.Tast.ty) a lo64;
|
||||
p
|
||||
| Types.Slice elem ->
|
||||
| Types.Slice (_, elem) ->
|
||||
let v = value f target in
|
||||
let q = fresh f in
|
||||
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";
|
||||
"zeroinitializer"
|
||||
| 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;
|
||||
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
|
||||
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. *)
|
||||
@ -3926,17 +3926,17 @@ and shim_in f name ret x =
|
||||
and shim_out f name (x : Tast.expr) (buf : Tast.expr) =
|
||||
let v = value f x 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;
|
||||
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
|
||||
a shim that transforms bytes into bytes is neither. *)
|
||||
and shim_in_out f name (x : Tast.expr) =
|
||||
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;
|
||||
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 =
|
||||
let v = value f x in
|
||||
|
||||
@ -219,7 +219,7 @@ let rec refuse_ty loc (t : Types.t) =
|
||||
match t with
|
||||
| Types.Int _ | Types.Float _ | Types.Bool | Types.String | Types.Unit
|
||||
| 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.Fn (ps, r) | Types.CFn (ps, 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) =
|
||||
match t with
|
||||
| Types.Slice e | Types.Array (_, e) -> e
|
||||
| Types.Slice (_, e) | Types.Array (_, e) -> e
|
||||
| Types.String -> Types.Int Types.U8
|
||||
| t -> at loc "indexing %s is not in the JS dialect" (Types.to_string t)
|
||||
|
||||
|
||||
@ -198,7 +198,7 @@ let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr =
|
||||
match t.Ast.t with
|
||||
| Ast.Tname n when List.mem n owned -> Ast.Tname (qualify alias n)
|
||||
| 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
|
||||
compile-time constant of the package, not part of the type syntax. *)
|
||||
| Ast.Tarray (l, e) ->
|
||||
@ -786,7 +786,7 @@ let exported n = not (String.equal n "main")
|
||||
let rec texpr_uses acc (t : Ast.texpr) =
|
||||
match t.Ast.t with
|
||||
| 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) ->
|
||||
(match l with Ast.Lname n -> acc := (n, t.Ast.tloc) :: !acc | Ast.Lint _ -> ());
|
||||
texpr_uses acc e
|
||||
|
||||
19
lib/parse.ml
19
lib/parse.ml
@ -89,10 +89,23 @@ let rec texpr (f : Form.t) : Ast.texpr =
|
||||
emitter go on speaking. *)
|
||||
| Sym "Unit" -> fail f "unit is written (), not Unit"
|
||||
| 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 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 _ ->
|
||||
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
|
||||
resolved to the same thing; the brace spelling is withdrawn, and the
|
||||
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
|
||||
every name the author might bind. Same trick as [gensym]. *)
|
||||
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 } ];
|
||||
(* Written out, not deferred: a macro takes [[Form]] and
|
||||
returns a [Form], and neither half of that is the user's to
|
||||
|
||||
117
lib/prelude.ml
117
lib/prelude.ml
@ -295,7 +295,7 @@ let source = {flan|
|
||||
;; 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
|
||||
;; 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
|
||||
;; 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
|
||||
;; 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)}
|
||||
(dotimes [i (length s)]
|
||||
(when (= (at s i) x)
|
||||
@ -428,7 +428,7 @@ let source = {flan|
|
||||
;; either. These reduce a slice, which is a different operation with a
|
||||
;; 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).
|
||||
(defn min-of [s [$t]] (Option $t)
|
||||
(defn min-of [s [const $t]] (Option $t)
|
||||
{:where (ordered? $t)}
|
||||
(if (= (length s) 0)
|
||||
None
|
||||
@ -437,7 +437,7 @@ let source = {flan|
|
||||
(set m (min m (at s i))))
|
||||
(Some m))))
|
||||
|
||||
(defn max-of [s [$t]] (Option $t)
|
||||
(defn max-of [s [const $t]] (Option $t)
|
||||
{:where (ordered? $t)}
|
||||
(if (= (length s) 0)
|
||||
None
|
||||
@ -522,7 +522,7 @@ let source = {flan|
|
||||
;; 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
|
||||
;; 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]
|
||||
(dotimes [i (length s)]
|
||||
(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
|
||||
;; runtime needed no change at all, because SizeOf and AlignOf are computed at
|
||||
;; 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)]
|
||||
(dotimes [i (length s)]
|
||||
(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;
|
||||
;; it is written to keep the accumulator's type visible at the line that feeds
|
||||
;; it.
|
||||
(defn sum-i32 [s [i32]] i64
|
||||
(defn sum-i32 [s [const i32]] i64
|
||||
(let [t (i64 0)]
|
||||
(dotimes [i (length s)]
|
||||
(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
|
||||
;; more bits of mantissa and pushes that failure out of reach of any array a
|
||||
;; game holds.
|
||||
(defn sum-f32 [s [f32]] f64
|
||||
(defn sum-f32 [s [const f32]] f64
|
||||
(let [t 0.0]
|
||||
(dotimes [i (length s)]
|
||||
(set t (+ t (f64 (at s i)))))
|
||||
@ -620,12 +620,12 @@ let source = {flan|
|
||||
|
||||
;; ── Bytes ─────────────────────────────────────────────────────────────
|
||||
;;
|
||||
;; Over [u8] and not over string, so (bytes-view s) is what a caller writes and one
|
||||
;; copy of each serves strings and byte slices both — which is as close to a
|
||||
;; Over [const u8] and not over string, so (bytes-view s) is what a caller writes
|
||||
;; 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
|
||||
;; 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))
|
||||
false
|
||||
(do
|
||||
@ -637,11 +637,11 @@ let source = {flan|
|
||||
;; 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
|
||||
;; 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))
|
||||
(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))
|
||||
(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
|
||||
;; wasm32 as on native for the same reason rand does.
|
||||
;; 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
|
||||
n (i64 0)
|
||||
neg false]
|
||||
@ -1243,7 +1243,7 @@ let source = {flan|
|
||||
;;
|
||||
;; 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.
|
||||
(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))
|
||||
(return None))
|
||||
(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
|
||||
;; 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.
|
||||
(defn trim [s [u8]] [u8]
|
||||
(defn trim [s [const u8]] [const u8]
|
||||
(let [lo 0
|
||||
hi (length s)]
|
||||
(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
|
||||
;; validator that said yes to 600 digits would be approving a different
|
||||
;; number than the one strtod reads.
|
||||
(defn parse-f64 [s [u8]] (Option f64)
|
||||
(defn parse-f64 [s [const u8]] (Option f64)
|
||||
(let [i 0
|
||||
digits 0]
|
||||
(when (or (= (length s) 0) (> (length s) 511))
|
||||
@ -1372,7 +1372,7 @@ let source = {flan|
|
||||
(defn rune-start? [b u8] bool
|
||||
(!= (bit-and b 0xc0) 0x80))
|
||||
|
||||
(defn decode-rune [s [u8]] Rune
|
||||
(defn decode-rune [s [const u8]] Rune
|
||||
(when (= (length s) 0)
|
||||
(return (Rune {.code 0 .width 0 .ok false})))
|
||||
(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
|
||||
;; 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.
|
||||
(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)))
|
||||
None
|
||||
(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
|
||||
;; 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
|
||||
n 0]
|
||||
(while (< i (length s))
|
||||
@ -1450,7 +1450,7 @@ let source = {flan|
|
||||
(set n (+ n 1))))
|
||||
n))
|
||||
|
||||
(defn valid-utf8? [s [u8]] bool
|
||||
(defn valid-utf8? [s [const u8]] bool
|
||||
(let [i 0]
|
||||
(while (< 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
|
||||
;; is the rule you can state without exceptions, and the one a caller counting
|
||||
;; 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}))
|
||||
|
||||
(defn split-next [it (Ptr Split)] (Option [u8])
|
||||
(defn split-next [it (Ptr Split)] (Option [const u8])
|
||||
(when (not (.more it))
|
||||
(return None))
|
||||
(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
|
||||
;; 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*
|
||||
;; on offer is the third shape, lowering a [u8] in place, and it is worth
|
||||
;; saying why rather than shipping it. A string
|
||||
;; literal is emitted `private unnamed_addr constant` (emit.ml), so (bytes-view
|
||||
;; "Hello") is a [u8] pointing straight into read-only memory. An in-place
|
||||
;; lower-ascii type checks against that slice, and what happens next depends
|
||||
;; 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.
|
||||
;; on offer is the third shape, lowering a [u8] in place: the text a caller
|
||||
;; has is most often a (bytes-view s), which is a [const u8] because a string
|
||||
;; literal's bytes are in read-only memory, and an in-place lower could not
|
||||
;; take it. (bytes s) is the writable copy; a caller that owns its buffer
|
||||
;; writes the two-line loop itself.
|
||||
;;
|
||||
;; 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 (ß
|
||||
@ -1589,7 +1575,7 @@ let source = {flan|
|
||||
;; 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
|
||||
;; 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))
|
||||
false
|
||||
(do
|
||||
@ -1601,7 +1587,7 @@ let source = {flan|
|
||||
;; ── Ordering byte slices, and sorting them ────────────────────────────
|
||||
;;
|
||||
;; 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
|
||||
;; 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
|
||||
;; 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.
|
||||
(defn bytes<? [a [u8] b [u8]] bool
|
||||
(defn bytes<? [a [const u8] b [const u8]] bool
|
||||
(let [n (min (length a) (length b))]
|
||||
(dotimes [i n]
|
||||
(when (!= (at a i) (at b i))
|
||||
@ -1626,7 +1612,7 @@ let source = {flan|
|
||||
(< (length a) (length b))))
|
||||
|
||||
;; 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
|
||||
;; 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.
|
||||
@ -1637,7 +1623,7 @@ let source = {flan|
|
||||
;; 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
|
||||
;; primitive: pass it in.
|
||||
(defn sort-bytes [s [[u8]]] ()
|
||||
(defn sort-bytes [s [[const u8]]] ()
|
||||
(sort-by s (fn [a b] (bytes<? a b))))
|
||||
|
||||
;; ── 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
|
||||
;; 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.
|
||||
(defn append [b (Ptr (Vec u8)) s [u8]] ()
|
||||
(defn append [b (Ptr (Vec u8)) s [const u8]] ()
|
||||
(dotimes [i (length s)]
|
||||
(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
|
||||
;; 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
|
||||
;; the empty (bytes-view "") a caller would have to write is the kind of argument
|
||||
;; 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)]
|
||||
(dotimes [i (length parts)]
|
||||
(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
|
||||
;; written as "append part then separator, then chop the tail" gets wrong on
|
||||
;; 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)]
|
||||
(dotimes [i (length parts)]
|
||||
(when (> i 0)
|
||||
@ -1718,24 +1705,21 @@ let source = {flan|
|
||||
(append (addr b) (at parts i)))
|
||||
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)]
|
||||
(dotimes [i n]
|
||||
(append (addr b) s))
|
||||
b))
|
||||
|
||||
;; 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
|
||||
;; emitted into .rodata, so the store either segfaults at -O0 or is deleted at
|
||||
;; -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)
|
||||
;; says why there is no in-place one; these write only bytes of their own.
|
||||
(defn to-lower [s [const u8]] (Vec u8)
|
||||
(let [b (vec-new u8)]
|
||||
(dotimes [i (length s)]
|
||||
(push b (lower-ascii (at s i))))
|
||||
b))
|
||||
|
||||
(defn to-upper [s [u8]] (Vec u8)
|
||||
(defn to-upper [s [const u8]] (Vec u8)
|
||||
(let [b (vec-new u8)]
|
||||
(dotimes [i (length s)]
|
||||
(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
|
||||
;; 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.
|
||||
(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)
|
||||
i 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
|
||||
;; a language decision, and it is written down in TODO.org, "(vec-new [u8]) is
|
||||
;; 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
|
||||
;; 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
|
||||
;; trailing separator yields a trailing empty one. That is Odin's allocating
|
||||
;; 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)
|
||||
it (split-on-byte s sep)
|
||||
going true]
|
||||
@ -1951,10 +1935,9 @@ let source = {flan|
|
||||
;;
|
||||
;; `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
|
||||
;; also read-only, and the same trap the ASCII-case note above measures applies
|
||||
;; here: a store through it either segfaults at -O0 or is deleted at -O2. To
|
||||
;; get a mutable copy, clone the bytes into a Vec.
|
||||
(defstruct EmbedFile [name string data [u8]])
|
||||
;; also read-only, so `data` is a [const u8] and a store through it is refused
|
||||
;; at compile time. To get a writable copy, copy the bytes into a Vec.
|
||||
(defstruct EmbedFile [name string data [const u8]])
|
||||
|
||||
;; 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
|
||||
@ -1965,7 +1948,7 @@ let source = {flan|
|
||||
;; 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
|
||||
;; (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)]
|
||||
(when (bytes=? (bytes-view (.name (at files i))) (bytes-view name))
|
||||
(return (Some (.data (at files i))))))
|
||||
|
||||
@ -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 bytes_of s =
|
||||
{ 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
|
||||
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
|
||||
@ -152,10 +152,10 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
|
||||
| Types.String ->
|
||||
[ c.emit.estr
|
||||
{ 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
|
||||
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
|
||||
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
|
||||
@ -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
|
||||
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. *)
|
||||
| Types.Ptr t ->
|
||||
| Types.Ptr (_, t) ->
|
||||
(match c.ptrs with
|
||||
| None -> [ lit "<ptr>" ]
|
||||
| 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
|
||||
that needs a loop. The slice goes into a slot first: the expression it
|
||||
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 local i ty = { Tast.e = Tast.Local i; ty; loc } in
|
||||
let len =
|
||||
|
||||
@ -1206,8 +1206,8 @@ let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
|
||||
|
||||
type emitter = { ename : string; ety : Types.t }
|
||||
|
||||
let emit_bytes = { ename = "flan/dev-emit"; ety = Types.Slice (Types.Int Types.U8) }
|
||||
let emit_str = { ename = "flan/dev-emit-str"; 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.Mut, (Types.Int Types.U8)) }
|
||||
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_f64 = { ename = "flan/dev-emit-f64"; ety = Types.Float Types.F64 }
|
||||
@ -1229,12 +1229,12 @@ let externs : Tast.extern list =
|
||||
is. See [render_locals]. *)
|
||||
{ Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot";
|
||||
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
|
||||
resolves it against the snapshot on top when the thunk runs, and NULL
|
||||
when there is none. See [render_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 };
|
||||
(* The character beside a rendered byte. See [Render.pointers]. *)
|
||||
{ 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
|
||||
never saw. *)
|
||||
{ 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 };
|
||||
{ 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 } ]
|
||||
|
||||
(* 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 loc = p.Tast.loc in
|
||||
let byte =
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Int Types.U8)), [ p ]);
|
||||
ty = Types.Ptr (Types.Int Types.U8); loc }
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, (Types.Int Types.U8))), [ p ]);
|
||||
ty = Types.Ptr (Types.Mut, (Types.Int Types.U8)); loc }
|
||||
in
|
||||
{ Tast.e = Tast.Call (name, [ byte ]); ty = i32; loc }
|
||||
in
|
||||
@ -1421,7 +1421,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
|
||||
let bytes_of str =
|
||||
{ Tast.e =
|
||||
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
|
||||
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
|
||||
let refused = ref [] in
|
||||
@ -1432,11 +1432,11 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
|
||||
in
|
||||
let address =
|
||||
{ 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
|
||||
let typed =
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
|
||||
ty = Types.Ptr ty; loc }
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
|
||||
ty = Types.Ptr (Types.Mut, ty); loc }
|
||||
in
|
||||
let v = { Tast.e = Tast.Deref typed; ty; loc } in
|
||||
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 =
|
||||
{ Tast.e =
|
||||
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
|
||||
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
|
||||
let refused = ref [] in
|
||||
let cty = Types.Named st.Tast.sname in
|
||||
let address =
|
||||
{ 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
|
||||
let typed =
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr cty), [ address ]);
|
||||
ty = Types.Ptr cty; loc }
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, cty)), [ address ]);
|
||||
ty = Types.Ptr (Types.Mut, cty); loc }
|
||||
in
|
||||
let root = { Tast.e = Tast.Deref typed; ty = cty; loc } in
|
||||
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);
|
||||
ty = Types.Int Types.I32; 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
|
||||
range cannot be settled here. It is checked in the program, like
|
||||
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 address =
|
||||
{ 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
|
||||
let typed =
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
|
||||
ty = Types.Ptr ty; loc }
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
|
||||
ty = Types.Ptr (Types.Mut, ty); loc }
|
||||
in
|
||||
let root = { Tast.e = Tast.Deref typed; ty; loc } in
|
||||
let rec walk v = function
|
||||
@ -1832,7 +1832,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
||||
Tast.Prim
|
||||
(Tast.Cast (Types.Int Types.I64),
|
||||
[ { 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 }
|
||||
in
|
||||
let newline =
|
||||
@ -1840,7 +1840,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
||||
Tast.Prim
|
||||
(Tast.Bytes,
|
||||
[ { 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
|
||||
dev_emitter.Render.ei64 addr :: dev_emitter.Render.ebytes newline
|
||||
:: 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 address =
|
||||
{ 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
|
||||
let typed =
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
|
||||
ty = Types.Ptr ty; loc }
|
||||
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Mut, ty)), [ address ]);
|
||||
ty = Types.Ptr (Types.Mut, ty); loc }
|
||||
in
|
||||
let root = { Tast.e = Tast.Deref typed; ty; loc } in
|
||||
let rec walk v = function
|
||||
@ -2194,7 +2194,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
|
||||
let bytes_of str =
|
||||
{ Tast.e =
|
||||
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
|
||||
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
|
||||
|
||||
@ -221,6 +221,8 @@ let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string =
|
||||
else
|
||||
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", [ { Ast.t = Ast.Tname "const"; _ }; e ]) ->
|
||||
"const " ^ cty env ~needed ~loc ~what e ^ " *"
|
||||
| Ast.Tapp ("Option", _) ->
|
||||
fail loc
|
||||
"%s is an Option, which C has no shape for — declare what C returns and \
|
||||
|
||||
64
lib/types.ml
64
lib/types.ml
@ -18,6 +18,17 @@ type ikind = I8 | I16 | I32 | I64 | U8 | U16 | U32 | U64
|
||||
|
||||
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 =
|
||||
| Int of ikind
|
||||
| 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
|
||||
site has something to resolve against and a plain integer does not fit. *)
|
||||
| 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 *)
|
||||
| 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
|
||||
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
|
||||
@ -179,10 +190,10 @@ let rec equal a b =
|
||||
one dyn type the way there is one string type. *)
|
||||
| Bool, Bool | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true
|
||||
| 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
|
||||
| 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
|
||||
| Vec x, Vec y -> equal x y
|
||||
| Option x, Option y -> equal x y
|
||||
@ -204,10 +215,12 @@ let rec to_string = function
|
||||
| Unit -> "()"
|
||||
| Never -> "Never"
|
||||
| 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)
|
||||
| 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"
|
||||
| Vec t -> "(Vec " ^ 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:b ~into:a then Some a
|
||||
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
20
lib/x86.ml
@ -1557,7 +1557,7 @@ type arg =
|
||||
move-only container by address. *)
|
||||
let classify_c (l : loc) (t : Types.t) =
|
||||
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.Vec _ | Types.Map _ -> [ Aptr l ]
|
||||
(* 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
|
||||
| Some (`Made p) -> load_int f.b ~dst:rax ~mm:(Frame p) ~size:8 ~signed:false
|
||||
| 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
|
||||
| Tast.FnAddr 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 env =
|
||||
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
|
||||
in
|
||||
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
|
||||
| Some ev ->
|
||||
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);
|
||||
store_int f.b ~src:rax ~mm:(Frame (slot + h_env)) ~size:8;
|
||||
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 =
|
||||
match ty with
|
||||
| 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)
|
||||
| Types.String | Types.Slice _ -> shift base (if i = 0 then 0 else 8)
|
||||
| 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 ->
|
||||
let elem =
|
||||
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
|
||||
| t -> unsupported "index into %s" (Types.to_string t)
|
||||
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 =
|
||||
let elem =
|
||||
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
|
||||
| t -> unsupported "index into %s" (Types.to_string t)
|
||||
in
|
||||
@ -2995,7 +2995,7 @@ and call_flan f ?env ~target ~args ~rty dst =
|
||||
in
|
||||
(* 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. *)
|
||||
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
|
||||
a [(Fn ...)] value, which cannot know whether the body it reaches
|
||||
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
|
||||
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
|
||||
(* [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. *)
|
||||
@ -3315,7 +3315,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst =
|
||||
| Tast.Slice, [ a; lo; hi ] ->
|
||||
let elem =
|
||||
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
|
||||
| ty -> unsupported "slice of %s" (Types.to_string ty)
|
||||
in
|
||||
|
||||
@ -2325,7 +2325,7 @@ static void crash_handler(int sig, siginfo_t *si, void *uc) {
|
||||
}
|
||||
{
|
||||
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";
|
||||
crash_puts(why, sizeof why - 1);
|
||||
}
|
||||
|
||||
@ -13,7 +13,7 @@
|
||||
(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))))
|
||||
|
||||
(defn taglen [s [u8]] i64
|
||||
(defn taglen [s [const u8]] i64
|
||||
(i64 (length s)))
|
||||
|
||||
(defn main [] i32
|
||||
|
||||
@ -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
|
||||
# sweep now and they are five of the MATCHes.
|
||||
|
||||
# The ones 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
|
||||
# string literal, which is a store into .rodata: measured here, LLVM exits 0
|
||||
# having printed the unmodified literal and this backend exits 139, because the
|
||||
# store is undefined and the optimiser deleted it on one side and there is no
|
||||
# optimiser on the other. That is not a lowering disagreement. At -O0 the two
|
||||
# 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
|
||||
# The one whose whole point is a fault, and which therefore cannot be compared
|
||||
# at this sweep's optimisation level. dev-segv stores through a null pointer,
|
||||
# which is undefined: what LLVM at -O2 does with it is its own business, and
|
||||
# this backend has no optimiser and exits 139. That is not a lowering
|
||||
# disagreement. test_dev.ml builds it in a dev session,
|
||||
# where the fault is the thing asserted. It also calls agent/start, so it
|
||||
# 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
|
||||
# here by a program that was never going to be compared anyway.
|
||||
faults="bytes-view-write dev-segv"
|
||||
# in the break loop instead of dying.
|
||||
faults="dev-segv"
|
||||
|
||||
TIMEOUT=${TIMEOUT:-20}
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@
|
||||
(print " "))
|
||||
(println ""))
|
||||
|
||||
(defn show-fields [s [[u8]]] ()
|
||||
(defn show-fields [s [[const u8]]] ()
|
||||
(dotimes [i (length s)]
|
||||
(print (string (at s i)))
|
||||
(print " "))
|
||||
|
||||
@ -85,7 +85,7 @@
|
||||
(set frames (+ frames 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
|
||||
(do (show "slice" (i64 (length (slice s lo hi))))
|
||||
(set frames (+ frames 1)))
|
||||
|
||||
@ -1,19 +1,11 @@
|
||||
;;;; A store through (bytes-view "literal") lands in the string constant's
|
||||
;;;; own storage, which both backends emit read-only — LLVM as a `constant`
|
||||
;;;; global, x86 in .rodata — so the write traps where it happens instead of
|
||||
;;;; corrupting the literal. Pinned at -O0 on both backends, where the store
|
||||
;;;; is really emitted; at -O2 LLVM deletes it as undefined behaviour, which
|
||||
;;;; 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.
|
||||
;;;; A store through (bytes-view "literal") is refused at compile time:
|
||||
;;;; bytes-view answers a [const u8], because a string literal's bytes are in
|
||||
;;;; read-only memory, where the store would trap at -O0 and be deleted as
|
||||
;;;; undefined at -O2. test_acceptance.ml asserts the refusal; nothing here is
|
||||
;;;; ever built.
|
||||
|
||||
(defn main [] i32
|
||||
(let [v (bytes-view "INSERTIONSORT")]
|
||||
(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))
|
||||
0))
|
||||
|
||||
39
test/programs/const-owned.flan
Normal file
39
test/programs/const-owned.flan
Normal 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
65
test/programs/const-slice.flan
Normal 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)
|
||||
@ -1,17 +1,21 @@
|
||||
;;;; The dogfooding crash, replayed on purpose: a write through a bytes-view
|
||||
;;;; of a string literal lands in read-only memory and takes SIGSEGV. In a
|
||||
;;;; dev session that used to kill the whole process — daemon, compiler and
|
||||
;;;; socket together, with no message at all. The dev build's crash handler
|
||||
;;;; turns it into the same park the no-channel traps take: one line naming
|
||||
;;;; the address and the frame, then the break loop, with the daemon alive
|
||||
;;;; and answering behind it. There is no restart to list — a faulting
|
||||
;;;; instruction has nowhere to resume at — which is the same empty-list
|
||||
;;;; shape dev-trap-null-alloc.flan pins for free-all.
|
||||
;;;; A hardware fault, taken on purpose: a store through a null pointer takes
|
||||
;;;; SIGSEGV. In a dev session that used to kill the whole process — daemon,
|
||||
;;;; compiler and socket together, with no message at all. The dev build's
|
||||
;;;; crash handler turns it into the same park the no-channel traps take: one
|
||||
;;;; line naming the address and the frame, then the break loop, with the
|
||||
;;;; daemon alive and answering behind it. There is no restart to list — a
|
||||
;;;; faulting instruction has nowhere to resume at — which is the same
|
||||
;;;; empty-list 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")
|
||||
|
||||
(defonce nowhere (Ptr u8))
|
||||
|
||||
(defn main [] i32
|
||||
(agent/start "/tmp/flan-dev-segv-fallback.sock")
|
||||
(let [v (bytes-view "INSERTIONSORT")]
|
||||
(set (at v 0) \Z)
|
||||
(print (string v))
|
||||
0))
|
||||
(set (deref nowhere) \Z)
|
||||
(println "not reached")
|
||||
0)
|
||||
|
||||
@ -70,11 +70,11 @@
|
||||
|
||||
;; ── 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
|
||||
;; header, and it is what a struct reader inherits by using slices.
|
||||
(defstruct Enemy
|
||||
[name [u8]
|
||||
[name [const u8]
|
||||
hp i32
|
||||
speed f32
|
||||
boss? bool])
|
||||
|
||||
@ -13,7 +13,7 @@
|
||||
(defstruct Local [n i32])
|
||||
|
||||
;;; 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
|
||||
;;; position is an expression, not a type.
|
||||
|
||||
@ -50,7 +50,7 @@
|
||||
|
||||
;; code/width/ok, so a wrong answer names which of the three it got wrong
|
||||
;; rather than just failing.
|
||||
(defn show-dec [s [u8]] ()
|
||||
(defn show-dec [s [const u8]] ()
|
||||
(let [r (decode-rune s)]
|
||||
(print (.code r)) (print "/")
|
||||
(print (.width r)) (print "/")
|
||||
@ -78,7 +78,7 @@
|
||||
(print x)
|
||||
(print " "))
|
||||
|
||||
(defn show-split [s [u8] sep u8] ()
|
||||
(defn show-split [s [const u8] sep u8] ()
|
||||
(let [it (split-on-byte s sep)
|
||||
going true]
|
||||
(while going
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
(defn main [] i32
|
||||
(let [x 7
|
||||
v (builtin/vec-new [u8])]
|
||||
v (builtin/vec-new [const u8])]
|
||||
(println (vec-new [x]))
|
||||
(push v (bytes-view "ab"))
|
||||
(println (length (at v 0)))
|
||||
|
||||
@ -5,11 +5,11 @@
|
||||
|
||||
(defn main [] i32
|
||||
(let [a (arena-new 4096)
|
||||
words (vec-new [u8])
|
||||
words (vec-new [const u8])
|
||||
pairs (vec-new [2 i32])
|
||||
ptrs (vec-new (Ptr i32))
|
||||
opts (vec-new (Option i64) a)
|
||||
m (map-new string [u8])
|
||||
m (map-new string [const u8])
|
||||
x (i32 7)]
|
||||
(push words (bytes-view "ab"))
|
||||
(push words (bytes-view "cde"))
|
||||
|
||||
@ -889,26 +889,39 @@ let () =
|
||||
"programs/bytes-copy.flan" bytes_copy_out;
|
||||
outputs ~x86:true "bytes copies, bytes-view aliases, --x86"
|
||||
"programs/bytes-copy.flan" bytes_copy_out;
|
||||
(* The other half of the same ruling: a store through a bytes-view of a
|
||||
literal traps, identically on both backends, because both emit string
|
||||
data read-only. -O0 only — at -O2 LLVM deletes the store as UB, so
|
||||
there is nothing there to pin except the UB itself. 139 is the shell's
|
||||
128+SIGSEGV. *)
|
||||
let dies_segv name path ~x86 =
|
||||
let exe = compile ~opt:"-O0" ~x86 path in
|
||||
let code, text = run exe None in
|
||||
if code <> 139 || text <> "" then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s\n got: %S (exit %d)\n wanted: %S (exit 139)\n"
|
||||
name text code ""
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ())
|
||||
(* The other half of the same ruling: a store through a bytes-view is
|
||||
refused before anything is built, because bytes-view answers a
|
||||
[const u8]. It used to compile and trap at -O0 on both backends, and be
|
||||
deleted as undefined at -O2. *)
|
||||
(let path = "programs/bytes-view-write.flan" in
|
||||
match
|
||||
Check.program (Load.program ~file:path (Reader.read_file path)).Load.decls
|
||||
with
|
||||
| _ ->
|
||||
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;
|
||||
Printf.printf
|
||||
"FAIL a write through bytes-view is refused\n said: %S\n" m
|
||||
end);
|
||||
(* [const T]: the checker's alone, so the three builds agree and every
|
||||
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
|
||||
dies_segv "a write through bytes-view traps, -O0"
|
||||
"programs/bytes-view-write.flan" ~x86:false;
|
||||
dies_segv "a write through bytes-view traps, --x86"
|
||||
"programs/bytes-view-write.flan" ~x86:true;
|
||||
outputs "const slices" "programs/const-slice.flan" const_slice_out;
|
||||
outputs ~opt:"-O0" "const slices, -O0" "programs/const-slice.flan"
|
||||
const_slice_out;
|
||||
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
|
||||
same %slice — so the rows are about length and ownership rather than
|
||||
arithmetic: a number round-tripped, an empty slice, sub-views whose
|
||||
|
||||
@ -442,7 +442,7 @@ let () =
|
||||
[Rune] also pins the spelling — the types read exactly as [defs]
|
||||
spells a signature, because both go through [Types.to_string]. *)
|
||||
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));
|
||||
|
||||
let r = request c "(:op \"layout\" :type \"Nonesuch\")" in
|
||||
@ -1922,7 +1922,7 @@ let () =
|
||||
if refault then begin
|
||||
let faulting =
|
||||
"(: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\")"
|
||||
in
|
||||
(match ask faulting with _ -> () | exception _ -> ());
|
||||
@ -2028,8 +2028,8 @@ let () =
|
||||
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
|
||||
asserts for them holds here too: stopped and describable, an eval still
|
||||
answered, a resume refused. The program writes through bytes-view,
|
||||
which is the surviving spelling of that crash. *)
|
||||
answered, a resume refused. The program stores through a null
|
||||
pointer: the bytes-view write that first crashed no longer compiles. *)
|
||||
trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" [];
|
||||
|
||||
(* ── The locals of a stopped frame ─────────────────────────────── *)
|
||||
|
||||
@ -468,7 +468,23 @@ let () =
|
||||
| { d = Defn { praw = Some [ Pname ("x", _); Ptype t ]; _ }; _ } -> t.t
|
||||
| _ -> failwith "bad type test"
|
||||
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
|
||||
| Tarray (Lint 4L, _) -> () | _ -> check "[n T] is an array" false);
|
||||
(match ty "[rows [cols u32]]" with
|
||||
@ -568,7 +584,7 @@ let () =
|
||||
(match (parse_decl "(defmacro m [& args] (at args 0))").d with
|
||||
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
|
||||
(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 parses as a defn" false);
|
||||
|
||||
@ -578,7 +594,7 @@ let () =
|
||||
(match (parse_decl "(defmacro m [[a b] c & rest] (at rest 0))").d with
|
||||
| Defn { name = "m"; params = [ p ]; ret = Some r; _ } ->
|
||||
(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 macro with a parameter list parses as a defn" false);
|
||||
|
||||
@ -1083,7 +1099,7 @@ let () =
|
||||
runs no passes over it. *)
|
||||
infers "array-fill of nothing" "(array-fill [0] 1)" "[0 i32]";
|
||||
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 "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]";
|
||||
infers "slice of the whole" "(slice (bytes \"hi\"))" "[u8]";
|
||||
@ -2226,18 +2242,247 @@ let () =
|
||||
rejects_check "set through a string's slice"
|
||||
"(defn f [s string] () (set (at (slice s 1) 0) 65))"
|
||||
~needle:"not a place";
|
||||
(* The address of one is the same question and gets the same answer, so
|
||||
the message has to fit a reader who asked for a pointer and not a
|
||||
store. *)
|
||||
rejects_check "the address of a string's byte"
|
||||
(* The address of one is a (Ptr const u8), so it is not a (Ptr u8). *)
|
||||
rejects_check "the address of a string's byte is read-only"
|
||||
"(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
|
||||
slice out of it. *)
|
||||
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)))"
|
||||
~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
|
||||
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
|
||||
@ -4430,8 +4675,9 @@ let () =
|
||||
something different in a parameter than it does anywhere else. *)
|
||||
emits "const char * as a string parameter"
|
||||
"(declare-c name-length [text string] i32 \"name_length\")";
|
||||
emits "a pointer parameter"
|
||||
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
|
||||
(* const int * is a pointer C promises not to write through. *)
|
||||
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
|
||||
describes it once, so both names have to land on the one defstruct —
|
||||
raylib does exactly this with Texture2D and TextureCubemap. *)
|
||||
@ -5067,6 +5313,10 @@ let () =
|
||||
"(declare-c name-length [text string] i32 \"name_length\")";
|
||||
agreed "a pointer that matches the header exactly"
|
||||
"(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
|
||||
the header to disagree with — §A.2's LoadImageColors → UpdateTexture. *)
|
||||
agreed "any pointer where the header says void *"
|
||||
@ -5082,12 +5332,17 @@ let () =
|
||||
name the disagreement. *)
|
||||
differs "a pointer to the wrong named type"
|
||||
"(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"
|
||||
"(declare-c count-at [values (Ptr f64) n i32] i32 \"count_at\")"
|
||||
"parameter values is (Ptr f64)";
|
||||
(* void * gives up the element type and nothing else. It is still a pointer,
|
||||
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 *"
|
||||
"(declare-c blit [dst i64 src (Ptr u8) n i32] \"blit\")"
|
||||
"parameter dst is i64";
|
||||
|
||||
@ -441,9 +441,8 @@ let dev_sweep () =
|
||||
sanitized run must produce ASan's report and must NOT produce the
|
||||
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
|
||||
bytes-view of a string literal does not fault at all — measured, both
|
||||
builds print the unmodified string — so a case that is about what happens
|
||||
And it has to be built at -O0. At the sweep's -O2 a store through a null
|
||||
pointer is undefined and need not fault — so a case that is about what happens
|
||||
on a fault has to be compiled where the fault happens. Same family as the
|
||||
-O0/-O2 split [unchecked_controls] records for bounds.flan.
|
||||
|
||||
|
||||
10
vendor/edn/edn.flan
vendored
10
vendor/edn/edn.flan
vendored
@ -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
|
||||
;;;; 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.
|
||||
(defstruct Token
|
||||
[kind i32
|
||||
text [u8]
|
||||
text [const u8]
|
||||
pos i32])
|
||||
|
||||
;; 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
|
||||
;; has the position for.
|
||||
(defstruct Cursor
|
||||
[src [u8]
|
||||
[src [const u8]
|
||||
pos i32
|
||||
err i32
|
||||
err-pos i32
|
||||
@ -180,7 +180,7 @@
|
||||
|
||||
;; ── 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}))
|
||||
|
||||
(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
|
||||
;; the input rather than a slice of nothing, so `text` has one meaning for all
|
||||
;; 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))
|
||||
|
||||
(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token
|
||||
|
||||
20
vendor/edn/provide.flan
vendored
20
vendor/edn/provide.flan
vendored
@ -80,7 +80,7 @@
|
||||
;; 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
|
||||
;; 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)
|
||||
col (i64 1)
|
||||
i (i32 0)]
|
||||
@ -212,7 +212,7 @@
|
||||
;; 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
|
||||
;; 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)]
|
||||
(when (not (ok? c))
|
||||
(return (derived-bad
|
||||
@ -242,7 +242,7 @@
|
||||
;; decides; every one after it is compared against that decision and both
|
||||
;; positions are named when they disagree, because "heterogeneous" without
|
||||
;; 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 \])
|
||||
(return (derived-bad
|
||||
(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
|
||||
;; 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 \})
|
||||
(return (derived-bad
|
||||
(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
|
||||
;; rather than at the `(Map ...)` the caller would build out of it, because a
|
||||
;; 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 \[)
|
||||
(return (derive-array 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
|
||||
;; out of the type comparison the caller already makes, since the length is in
|
||||
;; 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)]
|
||||
(when (at-byte? c \])
|
||||
(return (derived-bad
|
||||
@ -379,7 +379,7 @@
|
||||
(expect c tok-vec-close)
|
||||
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
|
||||
(joined3 (joined3 "the " what " at ")
|
||||
(where src at-pos)
|
||||
@ -400,7 +400,7 @@
|
||||
;; 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.
|
||||
;; 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 \})
|
||||
(return (derived-bad
|
||||
(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 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)
|
||||
d (derive (addr cur) name src)]
|
||||
(if (bad? d)
|
||||
@ -560,7 +560,7 @@
|
||||
;; 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
|
||||
;; destination is never implicit.
|
||||
(defn ~bname [b [u8] a Allocator] ~sname
|
||||
(defn ~bname [b [const u8] a Allocator] ~sname
|
||||
(let [c (cursor b)
|
||||
out (~rname (addr c) a)]
|
||||
;; The cursor is made and dropped here, so this is the only
|
||||
|
||||
4
vendor/edn/read.flan
vendored
4
vendor/edn/read.flan
vendored
@ -65,7 +65,7 @@
|
||||
;; 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
|
||||
;; 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)]
|
||||
(append (addr b) s)
|
||||
(string (slice b))))
|
||||
@ -136,7 +136,7 @@
|
||||
|
||||
;; 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.
|
||||
(defn read [src [u8]] dyn
|
||||
(defn read [src [const u8]] dyn
|
||||
(let [c (cursor src)
|
||||
t (next (addr c))
|
||||
v (read-value (addr c) t)]
|
||||
|
||||
10
vendor/json/json.flan
vendored
10
vendor/json/json.flan
vendored
@ -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,
|
||||
;;;; 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.
|
||||
(defstruct Token
|
||||
[kind i32
|
||||
text [u8]
|
||||
text [const u8]
|
||||
pos i32])
|
||||
|
||||
;; 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
|
||||
;; rather than confusing a reader two levels up.
|
||||
(defstruct Cursor
|
||||
[src [u8]
|
||||
[src [const u8]
|
||||
pos i32
|
||||
err i32
|
||||
err-pos i32
|
||||
@ -223,7 +223,7 @@
|
||||
|
||||
;; ── 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}))
|
||||
|
||||
(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
|
||||
;; text of their own — eof, error, and every delimiter — so that `text` has one
|
||||
;; 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))
|
||||
|
||||
(defn- token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token
|
||||
|
||||
18
vendor/json/provide.flan
vendored
18
vendor/json/provide.flan
vendored
@ -63,7 +63,7 @@
|
||||
;; 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
|
||||
;; 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)
|
||||
col (i64 1)
|
||||
i (i32 0)]
|
||||
@ -173,7 +173,7 @@
|
||||
|
||||
;; ── 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)]
|
||||
(when (not (ok? c))
|
||||
(return (derived-bad
|
||||
@ -202,7 +202,7 @@
|
||||
;; 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
|
||||
;; 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 \])
|
||||
(return (derived-bad
|
||||
(joined3 "the empty array at " (where src at-pos)
|
||||
@ -248,7 +248,7 @@
|
||||
|
||||
;; ── 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 \})
|
||||
(return (derived-bad
|
||||
(joined3 "the empty object at " (where src at-pos)
|
||||
@ -349,7 +349,7 @@
|
||||
(defn key=? [t Token s string] bool
|
||||
(bytes=? (.text t) (bytes-view s)))
|
||||
|
||||
(defn- has-escape? [s [u8]] bool
|
||||
(defn- has-escape? [s [const u8]] bool
|
||||
(dotimes [i (length s)]
|
||||
(when (= (at s i) \\)
|
||||
(return true)))
|
||||
@ -358,7 +358,7 @@
|
||||
;; 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
|
||||
;; 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)
|
||||
(return false))
|
||||
(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
|
||||
;; purpose: this runs inside the compiler, where an expansion is bounded by the
|
||||
;; size of the program being compiled.
|
||||
(defn- copy-of [s [u8]] string
|
||||
(defn- copy-of [s [const u8]] string
|
||||
(let [b (vec-new u8)]
|
||||
(append (addr b) s)
|
||||
(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 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)
|
||||
d (derive (addr cur) name src)]
|
||||
(if (bad? d)
|
||||
@ -441,7 +441,7 @@
|
||||
;; 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
|
||||
;; never implicit.
|
||||
(defn ~bname [b [u8] a Allocator] ~sname
|
||||
(defn ~bname [b [const u8] a Allocator] ~sname
|
||||
(let [c (cursor b)
|
||||
out (~rname (addr c) a)]
|
||||
;; The cursor is made and dropped here, so this is the only
|
||||
|
||||
54
vendor/raylib/generated.flan
vendored
54
vendor/raylib/generated.flan
vendored
@ -78,7 +78,7 @@
|
||||
(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 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 directory-exists [dir-path string] bool "DirectoryExists")
|
||||
(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 file-name-valid? [file-name string] bool "IsFileNameValid")
|
||||
(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 decompress-data [comp-data (Ptr 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 compress-data [data (Ptr const u8) data-size i32 comp-data-size (Ptr i32)] (Ptr u8) "CompressData")
|
||||
(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 const u8) output-size (Ptr i32)] (Ptr u8) "DecodeDataBase64")
|
||||
(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-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 get-mouse-wheel-move-v [] Vector2 "GetMouseWheelMoveV")
|
||||
(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-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")
|
||||
@ -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-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-triangle-fan-raw [points (Ptr 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-fan-raw [points (Ptr const Vector2) point-count i32 color Color] "DrawTriangleFan")
|
||||
(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-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-spline-linear-raw [points (Ptr 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-catmull-rom-raw [points (Ptr 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-cubic-raw [points (Ptr Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierCubic")
|
||||
(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 const Vector2) point-count i32 thick f32 color Color] "DrawSplineBasis")
|
||||
(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 const Vector2) point-count i32 thick f32 color Color] "DrawSplineBezierQuadratic")
|
||||
(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-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")
|
||||
@ -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 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-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-screen [] Image "LoadImageFromScreen")
|
||||
(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-premultiply [image (Ptr Image)] "ImageAlphaPremultiply")
|
||||
(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-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")
|
||||
@ -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-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 update-texture [texture Texture2D pixels (Ptr u8)] "UpdateTexture")
|
||||
(declare-c update-texture-rec [texture Texture2D rec Rectangle pixels (Ptr u8)] "UpdateTextureRec")
|
||||
(declare-c update-texture [texture Texture2D pixels (Ptr const u8)] "UpdateTexture")
|
||||
(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 set-texture-wrap [texture Texture2D wrap i32] "SetTextureWrap")
|
||||
(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 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-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-data [file-data (Ptr 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 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 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 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 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-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 load-codepoints [text string count (Ptr i32)] (Ptr i32) "LoadCodepoints")
|
||||
(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-length [text string] u32 "TextLength")
|
||||
(declare-c text-subtext [text string position i32 length i32] string "TextSubtext")
|
||||
(declare-c text-join [text-list (Ptr (Ptr i8)) count i32 delimiter string] string "TextJoin")
|
||||
(declare-c text-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-find-index [text string find string] i32 "TextFindIndex")
|
||||
(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-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-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-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")
|
||||
@ -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-pro [camera Camera3D texture Texture2D source Rectangle position Vector3 up Vector3 size Vector2 origin Vector2 rotation f32 tint Color] "DrawBillboardPro")
|
||||
(declare-c upload-mesh [mesh (Ptr Mesh) dynamic bool] "UploadMesh")
|
||||
(declare-c update-mesh-buffer [mesh Mesh index i32 data (Ptr u8) data-size i32 offset i32] "UpdateMeshBuffer")
|
||||
(declare-c 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 get-mesh-bounding-box [mesh Mesh] BoundingBox "GetMeshBoundingBox")
|
||||
(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-triangle [ray Ray p-1 Vector3 p-2 Vector3 p-3 Vector3] RayCollision "GetRayCollisionTriangle")
|
||||
(declare-c get-ray-collision-quad [ray Ray p-1 Vector3 p-2 Vector3 p-3 Vector3 p-4 Vector3] RayCollision "GetRayCollisionQuad")
|
||||
(declare-c load-wave-from-memory [file-type string file-data (Ptr u8) data-size i32] Wave "LoadWaveFromMemory")
|
||||
(declare-c update-sound [sound Sound data (Ptr u8) sample-count i32] "UpdateSound")
|
||||
(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 const u8) sample-count i32] "UpdateSound")
|
||||
(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 audio-stream-valid? [stream AudioStream] bool "IsAudioStreamValid")
|
||||
(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 play-audio-stream [stream AudioStream] "PlayAudioStream")
|
||||
(declare-c pause-audio-stream [stream AudioStream] "PauseAudioStream")
|
||||
|
||||
30
vendor/raylib/raylib.flan
vendored
30
vendor/raylib/raylib.flan
vendored
@ -582,10 +582,10 @@
|
||||
;; out-of-bounds read, and raylib answers false for a polygon with no points
|
||||
;; anyway.
|
||||
(declare-c collision-point-poly?-raw
|
||||
[point Vector2 points (Ptr Vector2) count i32] bool
|
||||
[point Vector2 points (Ptr const Vector2) count i32] bool
|
||||
"CheckCollisionPointPoly")
|
||||
|
||||
(defn collision-point-poly? [point Vector2 points [Vector2]] bool
|
||||
(defn collision-point-poly? [point Vector2 points [const Vector2]] bool
|
||||
(if (= (length points) 0)
|
||||
false
|
||||
(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
|
||||
;; slice apart, which is where that idiom lives everywhere else in this file.
|
||||
(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")
|
||||
|
||||
;; 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.
|
||||
(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)
|
||||
no-image
|
||||
(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
|
||||
;; `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)
|
||||
(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)
|
||||
(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)
|
||||
(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)
|
||||
(draw-triangle-strip-3d-raw (addr (at points 0)) (length points) color)))
|
||||
|
||||
;; The five spline drawers. raylib reads the same point array five different
|
||||
;; 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)
|
||||
(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)
|
||||
(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)
|
||||
(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)
|
||||
(draw-spline-bezier-quadratic-raw
|
||||
(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)
|
||||
(draw-spline-bezier-cubic-raw
|
||||
(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
|
||||
;; wrong for the only direction it reads in is worse than no binding.
|
||||
(declare-c get-codepoint-previous-raw
|
||||
[text (Ptr u8) codepoint-size (Ptr i32)] i32
|
||||
[text (Ptr const u8) codepoint-size (Ptr i32)] i32
|
||||
"GetCodepointPrevious")
|
||||
|
||||
;; 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
|
||||
;; previous offset is `offset` minus what comes back through the pointer. At
|
||||
;; 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)
|
||||
(do (set (deref codepoint-size) 0) 0)
|
||||
(get-codepoint-previous-raw (addr (at text offset)) codepoint-size)))
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
(defstruct Cursor
|
||||
[src [u8] ; a non-owning slice
|
||||
[src [const u8] ; a read-only, non-owning slice
|
||||
pos i32]) ; no initialiser means zeroed
|
||||
|
||||
(defn peek [c (Ptr Cursor)] u8
|
||||
|
||||
@ -384,7 +384,8 @@ described.</p>
|
||||
<li><strong>Fixed arrays are values.</strong> <code>[n T]</code> is inline storage
|
||||
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.
|
||||
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
|
||||
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
|
||||
@ -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>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>[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>(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>(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>(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>(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>
|
||||
@ -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>
|
||||
|
||||
<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
|
||||
|
||||
(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
|
||||
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
|
||||
into <code>.rodata</code> and writing through it traps. <code>(bytes s)</code> and
|
||||
<code>[const u8]</code> and costs nothing; it aliases the string, and a store through
|
||||
it is a compile error. <code>(bytes s)</code> and
|
||||
<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
|
||||
example above wants a view and takes one.</p>
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user