String is owned, growable, always-valid UTF-8 text over a (Vec u8), and the prelude's text builders return it.
This commit is contained in:
parent
ee6fa5297a
commit
db67ab19b4
6
TODO.org
6
TODO.org
@ -20,6 +20,12 @@ Dyn text stays immutable, with chars and text converting to and from a dyn
|
|||||||
vector of characters; length and indexing count characters on dyn text and bytes on
|
vector of characters; length and indexing count characters on dyn text and bytes on
|
||||||
str. Waits on the dyn-unless-annotated design.
|
str. Waits on the dyn-unless-annotated design.
|
||||||
|
|
||||||
|
** DONE String is a prelude struct over (Vec u8), kept valid by the checker
|
||||||
|
CLOSED: [2026-09-26]
|
||||||
|
Its field and constructor are refused outside the prelude; a str or a code point is checked at
|
||||||
|
run time at the append that stores it (literals at compile time), a [const u8] is refused for
|
||||||
|
(str b). Rules out a String type in the backends, s[i] = c, and a byte path that skips the check.
|
||||||
|
|
||||||
** DONE Any typed container crosses into dyn as a view
|
** DONE Any typed container crosses into dyn as a view
|
||||||
CLOSED: [2026-09-26]
|
CLOSED: [2026-09-26]
|
||||||
A str element reads as a copy and is never written, an aggregate element is written
|
A str element reads as a copy and is never written, an aggregate element is written
|
||||||
|
|||||||
@ -7522,3 +7522,25 @@ struct literal's field, an array literal's element, a runtime call's argument (d
|
|||||||
sibling, a whole struct passed by value, a struct nested in a literal, a call through a function value, and an array
|
sibling, a whole struct passed by value, a struct nested in a literal, a call through a function value, and an array
|
||||||
literal indexed while the index runs, directly and through a struct literal's field. Without the pins every line
|
literal indexed while the index runs, directly and through a struct literal's field. Without the pins every line
|
||||||
prints freed memory.
|
prints freed memory.
|
||||||
|
|
||||||
|
## String is a prelude struct, and the checker is its wall
|
||||||
|
|
||||||
|
`String` is `(defstruct String [bytes (Vec u8)])` in `lib/prelude.ml`, so its
|
||||||
|
allocator, free, retry on exhaustion and dev-registry notes are the Vec's and
|
||||||
|
neither backend has a String of its own. What makes it always valid UTF-8 is
|
||||||
|
`lib/check.ml`'s String section: outside the prelude the field and the
|
||||||
|
constructor are refused, `(at s i)` and `(set (at s i) c)` are refused, and every
|
||||||
|
byte arrives through `string-new`, `append`, `insert` or `bytes->string`. Text
|
||||||
|
the checker cannot prove valid — any str, since `(str b)` does not check — is
|
||||||
|
checked by `flan_utf8_check` at the site that stores it; a code point by
|
||||||
|
`flan_rune_check` inside `flan_string_put_rune`. Literals are checked at compile
|
||||||
|
time. The prelude's builders end in `(bytes->string b)`, so a builder given bytes
|
||||||
|
that are not UTF-8 stops at the prelude's line, not the caller's.
|
||||||
|
|
||||||
|
Positions are characters: `flan_string_index` walks to one and signals
|
||||||
|
BoundsError with the character count as the length, which is why it joins
|
||||||
|
`flan_vec_at` in both backends' `rt_signals`. `flan_vec_append` and
|
||||||
|
`flan_vec_insert` find a source inside the Vec's own block before growing it, so
|
||||||
|
`(append s s)` and `(append s (str s))` read the bytes they meant to. `render.ml`
|
||||||
|
and `inspect.ml` print a String as its text; `box` copies it into dyn text with
|
||||||
|
`flan_dyn_from_string`.
|
||||||
|
|||||||
@ -1771,7 +1771,7 @@ lambda or a `Fn(...)' type, and not after a match arm's."
|
|||||||
(flan-fln--return-type-matcher 1 font-lock-type-face)
|
(flan-fln--return-type-matcher 1 font-lock-type-face)
|
||||||
;; The package half of a qualified name, as `flan-mode' draws it.
|
;; The package half of a qualified name, as `flan-mode' draws it.
|
||||||
("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face)
|
("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face)
|
||||||
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
|
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
|
||||||
. font-lock-type-face)
|
. font-lock-type-face)
|
||||||
("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face)
|
("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face)
|
||||||
;; A character literal, `\c' or `\space'.
|
;; A character literal, `\c' or `\space'.
|
||||||
|
|||||||
@ -164,6 +164,8 @@ face says.")
|
|||||||
"alloc-live-blocks" "with-allocator"
|
"alloc-live-blocks" "with-allocator"
|
||||||
;; Vec
|
;; Vec
|
||||||
"vec-new" "push" "reserve" "free" "clone"
|
"vec-new" "push" "reserve" "free" "clone"
|
||||||
|
;; String
|
||||||
|
"string-new" "bytes->string" "append" "insert" "remove" "runes" "rune-count"
|
||||||
;; Map
|
;; Map
|
||||||
"map-new" "put" "get" "map-remove" "map-next" "has-key?"
|
"map-new" "put" "get" "map-remove" "map-next" "has-key?"
|
||||||
;; dyn
|
;; dyn
|
||||||
@ -253,7 +255,7 @@ reason and is the odd one — it is legal only as the last item of a `def' or a
|
|||||||
;; word outright — unit is spelled `()'. Drawing it as a valid type would
|
;; word outright — unit is spelled `()'. Drawing it as a valid type would
|
||||||
;; advertise a spelling the parser rejects, which is the same reason
|
;; advertise a spelling the parser rejects, which is the same reason
|
||||||
;; `find-restart' and `await' are left out of `flan--special'.
|
;; `find-restart' and `await' are left out of `flan--special'.
|
||||||
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|const\\|int\\|float\\|Never\\|Allocator\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
|
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|const\\|int\\|float\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
|
||||||
. font-lock-type-face)
|
. font-lock-type-face)
|
||||||
;; A type variable, `$t', which is what a generic `defn' names its
|
;; A type variable, `$t', which is what a generic `defn' names its
|
||||||
;; parameter types with and what `{:where (ordered? $t)}' constrains.
|
;; parameter types with and what `{:where (ordered? $t)}' constrains.
|
||||||
|
|||||||
527
lib/check.ml
527
lib/check.ml
@ -4046,6 +4046,30 @@ let refuse_frame_escapes (f : Tast.fn) =
|
|||||||
if returns then
|
if returns then
|
||||||
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
||||||
|
|
||||||
|
(* ── String, the prelude's owned text ────────────────────────────────
|
||||||
|
A (defstruct String [bytes (Vec u8)]) in the prelude, kept valid UTF-8 by
|
||||||
|
the arms in [named_call] that are the only way to change one — see
|
||||||
|
[string_call]. Every run-time operation reaches the Vec, which is the
|
||||||
|
struct's one field: the backends see a struct holding a Vec and nothing
|
||||||
|
else, which is why neither has a String of its own. *)
|
||||||
|
let string_ty = Types.Named "String"
|
||||||
|
let is_string_ty t = Types.equal t string_ty
|
||||||
|
let string_vec_ty = Types.Vec (Types.Int Types.U8)
|
||||||
|
let u8_ty = Types.Int Types.U8
|
||||||
|
let string_or_ptr t =
|
||||||
|
match t with
|
||||||
|
| Types.Ptr (_, t) -> is_string_ty t
|
||||||
|
| t -> is_string_ty t
|
||||||
|
|
||||||
|
(* The String's (Vec u8), through a pointer to one too. *)
|
||||||
|
let string_vec loc (s : Tast.expr) =
|
||||||
|
let s =
|
||||||
|
match s.Tast.ty with
|
||||||
|
| Types.Ptr (_, t) when is_string_ty t -> mk loc t (Tast.Deref s)
|
||||||
|
| _ -> s
|
||||||
|
in
|
||||||
|
mk loc string_vec_ty (Tast.Field (s, 0))
|
||||||
|
|
||||||
let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
||||||
let dyn sym args = rt loc Types.Dyn sym args in
|
let dyn sym args = rt loc Types.Dyn sym args in
|
||||||
let structs =
|
let structs =
|
||||||
@ -4053,6 +4077,9 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
|||||||
in
|
in
|
||||||
match e.Tast.ty with
|
match e.Tast.ty with
|
||||||
| Types.Dyn -> e
|
| Types.Dyn -> e
|
||||||
|
(* Dyn text is immutable and a String is not, so a String crosses as a copy
|
||||||
|
of its bytes rather than as the view any other struct would be. *)
|
||||||
|
| t when is_string_ty t -> dyn "flan_dyn_from_string" [ string_vec loc e ]
|
||||||
| Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
|
| Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
|
||||||
| Types.Float _ -> dyn "flan_dyn_from_f64" [ widen loc dyn_f64 e ]
|
| Types.Float _ -> dyn "flan_dyn_from_f64" [ widen loc dyn_f64 e ]
|
||||||
(* The ABI takes an [int32_t], because a C signature that says [_Bool] is a
|
(* The ABI takes an [int32_t], because a C signature that says [_Bool] is a
|
||||||
@ -8021,6 +8048,7 @@ and generic_ctor ctx ~want loc name given =
|
|||||||
field it did not reach, and points at the spelling that does mean "zero the
|
field it did not reach, and points at the spelling that does mean "zero the
|
||||||
rest". Odin's positional literal takes the same line. *)
|
rest". Odin's positional literal takes the same line. *)
|
||||||
and positional_struct ctx ~want loc name args =
|
and positional_struct ctx ~want loc name args =
|
||||||
|
if String.equal name "String" then refuse_string_inside loc;
|
||||||
let s = Hashtbl.find ctx.env.structs name in
|
let s = Hashtbl.find ctx.env.structs name in
|
||||||
let fields = s.Tast.fields in
|
let fields = s.Tast.fields in
|
||||||
let n = List.length fields in
|
let n = List.length fields in
|
||||||
@ -8134,6 +8162,7 @@ and check_bare ctx ~want loc kvs =
|
|||||||
only in what is built at the end. Deciding here rather than in the parser is
|
only in what is built at the end. Deciding here rather than in the parser is
|
||||||
what lets the decision be made against the tables, exactly. *)
|
what lets the decision be made against the tables, exactly. *)
|
||||||
and check_struct ctx ~want loc name kvs =
|
and check_struct ctx ~want loc name kvs =
|
||||||
|
if String.equal name "String" then refuse_string_inside loc;
|
||||||
match Hashtbl.find_opt ctx.env.structs name with
|
match Hashtbl.find_opt ctx.env.structs name with
|
||||||
| None when Hashtbl.mem ctx.env.gstructs name ->
|
| None when Hashtbl.mem ctx.env.gstructs name ->
|
||||||
check_struct ctx ~want loc
|
check_struct ctx ~want loc
|
||||||
@ -9637,6 +9666,10 @@ and fields_named env n : Tast.structure option =
|
|||||||
looks first for a dyn, whose [.name] is a map entry and not a field. *)
|
looks first for a dyn, whose [.name] is a map entry and not a field. *)
|
||||||
and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string =
|
and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string =
|
||||||
let has n = fields_named ctx.env n <> None in
|
let has n = fields_named ctx.env n <> None in
|
||||||
|
(match t.Tast.ty with
|
||||||
|
| Types.Named "String" | Types.Ptr (_, Types.Named "String") ->
|
||||||
|
refuse_string_inside target.Ast.loc
|
||||||
|
| _ -> ());
|
||||||
match t.Tast.ty with
|
match t.Tast.ty with
|
||||||
| Types.Named n when has n -> t, n
|
| Types.Named n when has n -> t, n
|
||||||
| Types.Ptr (_, (Types.Named n)) when has n ->
|
| Types.Ptr (_, (Types.Named n)) when has n ->
|
||||||
@ -9894,6 +9927,8 @@ and indexed ?place ?(store = true) ctx (target : Tast.expr) (idx : Ast.expr list
|
|||||||
| Types.String ->
|
| Types.String ->
|
||||||
if store then Option.iter (fun l -> refuse_string_place l ty) place;
|
if store then Option.iter (fun l -> refuse_string_place l ty) place;
|
||||||
Types.Int Types.U8
|
Types.Int Types.U8
|
||||||
|
| Types.Named "String" ->
|
||||||
|
refuse_string_index i.Ast.loc ~store:(store && place <> None)
|
||||||
| other ->
|
| other ->
|
||||||
fail i.Ast.loc "%s cannot be indexed" (tyname i.Ast.loc other)
|
fail i.Ast.loc "%s cannot be indexed" (tyname i.Ast.loc other)
|
||||||
in
|
in
|
||||||
@ -10691,6 +10726,26 @@ and dup_elems ctx loc elem (src : Tast.expr) (a : Tast.expr) =
|
|||||||
checked first. Both the value form [(at v i)] and the place form
|
checked first. Both the value form [(at v i)] and the place form
|
||||||
[(set (at v i) x)] come through here, so they cannot drift apart — which is
|
[(set (at v i) x)] come through here, so they cannot drift apart — which is
|
||||||
the asymmetry [nth] was removed for. *)
|
the asymmetry [nth] was removed for. *)
|
||||||
|
(* A new, empty (Vec elem) from the opened allocator [a]: (vec-new)'s lowering,
|
||||||
|
which (string-new) shares for the Vec under a String. *)
|
||||||
|
and vec_init ?note ctx loc elem (a : Tast.expr) =
|
||||||
|
let note = Option.value note ~default:elem in
|
||||||
|
let v = fresh_slot ctx (Types.Vec elem) in
|
||||||
|
let attempt =
|
||||||
|
rt loc (Types.Int Types.I8) "flan_vec_init"
|
||||||
|
[ mk loc (Types.Vec elem) (Tast.Local v); a; i64_at loc 0L;
|
||||||
|
size_of loc elem; align_of loc elem; here loc ]
|
||||||
|
in
|
||||||
|
mk loc (Types.Vec elem)
|
||||||
|
(Tast.Let ([ (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ],
|
||||||
|
[ with_note loc (alloc_guard ctx loc attempt)
|
||||||
|
(reg_note loc "flan_dev_reg_note_vec"
|
||||||
|
(mk loc (Types.Vec elem) (Tast.Local v))
|
||||||
|
[ size_of loc elem ] note);
|
||||||
|
region_check ctx.env loc
|
||||||
|
(mk loc (Types.Vec elem) (Tast.Local v))
|
||||||
|
(mk loc (Types.Vec elem) (Tast.Local v)) ]))
|
||||||
|
|
||||||
and vec_at ctx loc (target : Tast.expr) (idx : Ast.expr list) =
|
and vec_at ctx loc (target : Tast.expr) (idx : Ast.expr list) =
|
||||||
let elem = vec_elem loc "at" target.Tast.ty in
|
let elem = vec_elem loc "at" target.Tast.ty in
|
||||||
match idx with
|
match idx with
|
||||||
@ -10782,6 +10837,344 @@ and vec_slice ctx ~want loc (target : Tast.expr) elem (bounds : Ast.expr list) =
|
|||||||
(Tast.Zero (Types.Slice (Types.Mut, elem)))) ],
|
(Tast.Zero (Types.Slice (Types.Mut, elem)))) ],
|
||||||
[ fill; mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out) ])))
|
[ fill; mk loc (Types.Slice (Types.Mut, elem)) (Tast.Local out) ])))
|
||||||
|
|
||||||
|
(* ── String ───────────────────────────────────────────────────────────
|
||||||
|
The prelude's (defstruct String [bytes (Vec u8)]) is valid UTF-8 because
|
||||||
|
nothing outside the prelude can reach the Vec: its field cannot be named
|
||||||
|
and the struct cannot be built ([refuse_string_inside]), and it is not
|
||||||
|
indexed ([refuse_string_index]). Every byte arrives through an arm below.
|
||||||
|
|
||||||
|
Text the checker cannot prove valid is checked at run time, at the site
|
||||||
|
that stores it, and a bad byte stops the program there (flan_utf8_check,
|
||||||
|
flan_rune_check) — a str may hold any bytes, since (str b) does not check.
|
||||||
|
A string literal and an integer literal are checked here instead, so text
|
||||||
|
written in the source costs nothing at run time. A [const u8] is refused
|
||||||
|
rather than checked: bytes become text through (str b) or (bytes->string
|
||||||
|
v), which says at the call that a check is wanted.
|
||||||
|
|
||||||
|
Positions are characters and lengths are bytes, the rule str has. The
|
||||||
|
character index is found by a walk (flan_string_index), which signals
|
||||||
|
BoundsError with the character count as the length. *)
|
||||||
|
and refuse_string_inside loc =
|
||||||
|
if not (String.equal loc.Loc.file Prelude.file) then begin
|
||||||
|
let fln = fln_source loc in
|
||||||
|
Loc.failk "check/string-private" loc
|
||||||
|
"a String keeps its bytes to itself, which is how they stay valid \
|
||||||
|
UTF-8. Make one with %s, read it with %s or %s, and change it with \
|
||||||
|
append, insert and remove"
|
||||||
|
(if fln then "string-new(text)" else "(string-new text)")
|
||||||
|
(if fln then "str(s)" else "(str s)")
|
||||||
|
(if fln then "bytes-view(s)" else "(bytes-view s)")
|
||||||
|
end
|
||||||
|
|
||||||
|
and refuse_string_index loc ~store =
|
||||||
|
let fln = fln_source loc in
|
||||||
|
if store then
|
||||||
|
Loc.failk "check/string-set-index" loc
|
||||||
|
"a String cannot be changed one byte at a time. A character in UTF-8 \
|
||||||
|
is one to four bytes, so writing a single byte can leave text that is \
|
||||||
|
not valid. Change it by character position instead: %s, then %s"
|
||||||
|
(if fln then "remove(s, i)" else "(remove s i)")
|
||||||
|
(if fln then "insert(s, i, c)" else "(insert s i c)")
|
||||||
|
else
|
||||||
|
Loc.failk "check/string-index" loc
|
||||||
|
"a String is not indexed, because in UTF-8 a byte position and a \
|
||||||
|
character position are different numbers. Read byte i with %s, or \
|
||||||
|
walk the characters with %s"
|
||||||
|
(if fln then "str(s)[i]" else "(at (str s) i)")
|
||||||
|
(if fln then "runes(s)" else "(runes s)")
|
||||||
|
|
||||||
|
(* An argument that may be a String: checked with no expectation when its
|
||||||
|
type does not depend on one — a name, a call, a field — and against
|
||||||
|
[otherwise] when it does, as the builtin always checked it. *)
|
||||||
|
and maybe_string ctx ~otherwise (x : Ast.expr) =
|
||||||
|
match x.Ast.e with
|
||||||
|
| Ast.Var _ | Ast.Call _ | Ast.Field _ ->
|
||||||
|
let e = check ctx x in
|
||||||
|
if string_or_ptr e.Tast.ty then e
|
||||||
|
else expect ctx x.Ast.loc ~want:(Some otherwise) e
|
||||||
|
| _ -> check ctx ~want:otherwise x
|
||||||
|
|
||||||
|
(* A String's bytes as a [const u8]: a view of the Vec, costing nothing, and
|
||||||
|
good until the String next grows — (slice v)'s contract. *)
|
||||||
|
and string_bytes ctx loc (s : Tast.expr) =
|
||||||
|
let v = vec_slice ctx ~want:None loc (string_vec loc s) u8_ty [] in
|
||||||
|
{ v with Tast.ty = Types.Slice (Types.Const, u8_ty) }
|
||||||
|
|
||||||
|
(* A str, a String or a [const u8], as a [const u8]: what rune-count and
|
||||||
|
runes read. *)
|
||||||
|
and text_bytes ctx what (x : Ast.expr) =
|
||||||
|
let e =
|
||||||
|
match x.Ast.e with
|
||||||
|
| Ast.Str _ -> check ctx ~want:Types.String x
|
||||||
|
| _ -> check ctx x
|
||||||
|
in
|
||||||
|
let loc = x.Ast.loc in
|
||||||
|
match e.Tast.ty with
|
||||||
|
| Types.String ->
|
||||||
|
mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ]))
|
||||||
|
| t when string_or_ptr t -> string_bytes ctx loc e
|
||||||
|
| Types.Slice (_, Types.Int Types.U8) ->
|
||||||
|
{ e with Tast.ty = Types.Slice (Types.Const, u8_ty) }
|
||||||
|
| other ->
|
||||||
|
fail loc "%s takes a str, a String or a [const u8], found %s" what
|
||||||
|
(tyname loc other)
|
||||||
|
|
||||||
|
(* The String an operation changes, written as the String or a pointer to
|
||||||
|
one, and refused when it is reached through something read-only. *)
|
||||||
|
and string_target ctx loc what (t : Tast.expr) =
|
||||||
|
let t =
|
||||||
|
match t.Tast.ty with
|
||||||
|
| Types.Ptr (_, ty) when is_string_ty ty -> mk loc ty (Tast.Deref t)
|
||||||
|
| ty when is_string_ty ty -> t
|
||||||
|
| other ->
|
||||||
|
fail loc "%s takes a String to change, found %s" what (tyname loc other)
|
||||||
|
in
|
||||||
|
refuse_const_change ctx loc t;
|
||||||
|
t
|
||||||
|
|
||||||
|
(* What append and insert were given to store: text, as a [const u8] and
|
||||||
|
whether it is known valid, or a code point. *)
|
||||||
|
and string_piece ctx what (x : Ast.expr) =
|
||||||
|
let loc = x.Ast.loc in
|
||||||
|
let rune e =
|
||||||
|
(match literal e with
|
||||||
|
| Some c when c < 0L || c > 0x10ffffL || (c >= 0xd800L && c <= 0xdfffL) ->
|
||||||
|
fail loc
|
||||||
|
"%Ld is not a Unicode scalar value, so it has no UTF-8 encoding and \
|
||||||
|
a String cannot hold it" c
|
||||||
|
| _ -> ());
|
||||||
|
`Rune e
|
||||||
|
in
|
||||||
|
match x.Ast.e with
|
||||||
|
| Ast.Str lit ->
|
||||||
|
if not (String.is_valid_utf_8 lit) then
|
||||||
|
fail loc
|
||||||
|
"this text is not valid UTF-8, and a String holds only valid UTF-8";
|
||||||
|
let e = check ctx ~want:Types.String x in
|
||||||
|
`Text (mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ])),
|
||||||
|
true)
|
||||||
|
| Ast.Int _ | Ast.Byte _ -> rune (check ctx ~want:(Types.Int Types.I32) x)
|
||||||
|
| _ ->
|
||||||
|
let e = check ctx x in
|
||||||
|
match e.Tast.ty with
|
||||||
|
| Types.String ->
|
||||||
|
`Text (mk loc (Types.Slice (Types.Const, u8_ty)) (Tast.Prim (Tast.Bytes, [ e ])),
|
||||||
|
false)
|
||||||
|
| t when string_or_ptr t -> `Text (string_bytes ctx loc e, true)
|
||||||
|
| Types.Int Types.I32 -> rune e
|
||||||
|
| Types.Int k when Types.widens_to ~from:(Types.Int k) ~into:(Types.Int Types.I32) ->
|
||||||
|
rune (widen loc (Types.Int Types.I32) e)
|
||||||
|
| Types.Int _ ->
|
||||||
|
fail loc
|
||||||
|
"a code point is an i32, and this is %s. Write %s"
|
||||||
|
(tyname loc e.Tast.ty)
|
||||||
|
(if fln_source loc then "i32(c)" else "(i32 c)")
|
||||||
|
| Types.Slice (_, Types.Int Types.U8) ->
|
||||||
|
fail loc
|
||||||
|
"%s takes text, and bytes are not text until they are checked. \
|
||||||
|
Write %s, which is checked when it is stored"
|
||||||
|
what (if fln_source loc then "str(b)" else "(str b)")
|
||||||
|
| other ->
|
||||||
|
fail loc "%s takes a str, a String or a code point, found %s" what
|
||||||
|
(tyname loc other)
|
||||||
|
|
||||||
|
(* One allocating store into a String's Vec, under the retry guard, with the
|
||||||
|
dev registry told of the block it ends up in — push's shape. Every argument
|
||||||
|
is bound to a slot before the loop, so a retry re-attempts only the call. *)
|
||||||
|
and string_store ctx loc (v : Tast.expr) (binds : (int * Tast.expr) list)
|
||||||
|
(checks : Tast.expr list) (attempt : Tast.expr) =
|
||||||
|
mk loc Types.Unit
|
||||||
|
(Tast.Let
|
||||||
|
(binds,
|
||||||
|
checks
|
||||||
|
@ [ region_check ctx.env loc v
|
||||||
|
(with_note loc (alloc_guard ctx loc attempt)
|
||||||
|
(reg_note loc "flan_dev_reg_note_vec" v [ size_of loc u8_ty ]
|
||||||
|
string_ty)) ]))
|
||||||
|
|
||||||
|
(* A text piece or a code point stored at byte offset [off] of the String's
|
||||||
|
Vec [v], -1 for the end. *)
|
||||||
|
and string_put ctx loc (v : Tast.expr) (off : Tast.expr) piece =
|
||||||
|
let i64 = Types.Int Types.I64 in
|
||||||
|
let o = fresh_slot ctx i64 in
|
||||||
|
let ov = mk loc i64 (Tast.Local o) in
|
||||||
|
let at_end = match off.Tast.e with Tast.Int (-1L, _) -> true | _ -> false in
|
||||||
|
match piece with
|
||||||
|
| `Rune c ->
|
||||||
|
let r = fresh_slot ctx (Types.Int Types.I32) in
|
||||||
|
string_store ctx loc v [ (r, c); (o, off) ] []
|
||||||
|
(rt loc (Types.Int Types.I8) "flan_string_put_rune"
|
||||||
|
[ v; ov; mk loc (Types.Int Types.I32) (Tast.Local r); here loc ])
|
||||||
|
| `Text (b, valid) ->
|
||||||
|
let bty = Types.Slice (Types.Const, u8_ty) in
|
||||||
|
let bs = fresh_slot ctx bty in
|
||||||
|
let bv = mk loc bty (Tast.Local bs) in
|
||||||
|
let checks =
|
||||||
|
if valid then [] else [ rt loc Types.Unit "flan_utf8_check" [ bv; here loc ] ]
|
||||||
|
in
|
||||||
|
string_store ctx loc v [ (bs, b); (o, off) ] checks
|
||||||
|
(if at_end then
|
||||||
|
rt loc (Types.Int Types.I8) "flan_vec_append"
|
||||||
|
[ v; bv; size_of loc u8_ty; align_of loc u8_ty; here loc ]
|
||||||
|
else
|
||||||
|
rt loc (Types.Int Types.I8) "flan_vec_insert"
|
||||||
|
[ v; ov; bv; size_of loc u8_ty; align_of loc u8_ty; here loc ])
|
||||||
|
|
||||||
|
(* A character position as a byte offset, signalling BoundsError when it is
|
||||||
|
not one. [past_end] admits the position after the last character. *)
|
||||||
|
and string_index ctx loc (v : Tast.expr) (i : Ast.expr) ~past_end =
|
||||||
|
let i = index_expr ctx i in
|
||||||
|
rt loc (Types.Int Types.I64) "flan_string_index"
|
||||||
|
[ v; i; mk loc (Types.Int Types.I32)
|
||||||
|
(Tast.Int ((if past_end then 1L else 0L), Types.I32));
|
||||||
|
here loc ]
|
||||||
|
|
||||||
|
(* A prelude function by the name it was written under, which a program's
|
||||||
|
own function of that name moves aside (see [shadow_prelude]). *)
|
||||||
|
and prelude_fn ctx name =
|
||||||
|
let moved = "prelude~/" ^ name in
|
||||||
|
if Hashtbl.mem ctx.env.fns moved then moved else name
|
||||||
|
|
||||||
|
and string_call ctx ~want loc name args =
|
||||||
|
let i64 n = mk loc (Types.Int Types.I64) (Tast.Int (n, Types.I64)) in
|
||||||
|
match name, args with
|
||||||
|
(* (string-new), (string-new text), (string-new a), (string-new text a):
|
||||||
|
vec-new's shape, the text copied in — checked at run time when it is a
|
||||||
|
str, since a str may hold any bytes. *)
|
||||||
|
| "string-new", ([] | [ _ ] | [ _; _ ]) ->
|
||||||
|
let text, a =
|
||||||
|
match args with
|
||||||
|
| [] -> None, allocator_arg ctx loc []
|
||||||
|
| [ x ] ->
|
||||||
|
(match x.Ast.e with
|
||||||
|
| Ast.Str _ -> Some (string_piece ctx name x), allocator_arg ctx loc []
|
||||||
|
| _ ->
|
||||||
|
let e = check ctx x in
|
||||||
|
if Types.equal e.Tast.ty Types.Alloc then None, use_alloc ctx loc e
|
||||||
|
else
|
||||||
|
(* Checked already, so classified from what it turned out to be
|
||||||
|
and never checked a second time. *)
|
||||||
|
let piece =
|
||||||
|
match e.Tast.ty with
|
||||||
|
| Types.String ->
|
||||||
|
`Text (mk loc (Types.Slice (Types.Const, u8_ty))
|
||||||
|
(Tast.Prim (Tast.Bytes, [ e ])), false)
|
||||||
|
| t when string_or_ptr t -> `Text (string_bytes ctx loc e, true)
|
||||||
|
| other ->
|
||||||
|
fail x.Ast.loc
|
||||||
|
"string-new takes a str or a String to copy, an allocator, \
|
||||||
|
or both, found %s" (tyname loc other)
|
||||||
|
in
|
||||||
|
Some piece, allocator_arg ctx loc [])
|
||||||
|
| [ x; a ] ->
|
||||||
|
let piece =
|
||||||
|
match string_piece ctx name x with
|
||||||
|
| `Rune _ ->
|
||||||
|
fail x.Ast.loc "string-new copies a str or a String, not a code point"
|
||||||
|
| p -> p
|
||||||
|
in
|
||||||
|
Some piece, allocator_arg ctx loc [ a ]
|
||||||
|
| _ -> assert false
|
||||||
|
in
|
||||||
|
let sl = fresh_slot ctx string_ty in
|
||||||
|
let s = mk loc string_ty (Tast.Local sl) in
|
||||||
|
let v = vec_init ~note:string_ty ctx loc u8_ty a in
|
||||||
|
let fill =
|
||||||
|
match text with
|
||||||
|
| None -> []
|
||||||
|
| Some p -> [ string_put ctx loc (string_vec loc s) (i64 (-1L)) p ]
|
||||||
|
in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc string_ty
|
||||||
|
(Tast.Let ([ (sl, mk loc string_ty (Tast.Make ("String", [ v ]))) ],
|
||||||
|
fill @ [ s ])))
|
||||||
|
| "string-new", _ ->
|
||||||
|
fail loc "string-new is (string-new), (string-new text), (string-new a) \
|
||||||
|
or (string-new text a)"
|
||||||
|
(* (bytes->string v): the (Vec u8) becomes the String — the same block, no
|
||||||
|
copy — once its bytes are checked, here. *)
|
||||||
|
| "bytes->string", [ x ] ->
|
||||||
|
let v = check ctx ~want:string_vec_ty x in
|
||||||
|
let sl = fresh_slot ctx string_vec_ty in
|
||||||
|
let vv = mk loc string_vec_ty (Tast.Local sl) in
|
||||||
|
let view = vec_slice ctx ~want:None loc vv u8_ty [] in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc string_ty
|
||||||
|
(Tast.Let ([ (sl, v) ],
|
||||||
|
[ rt loc Types.Unit "flan_utf8_check" [ view; here loc ];
|
||||||
|
mk loc string_ty (Tast.Make ("String", [ vv ])) ])))
|
||||||
|
| "bytes->string", _ -> fail loc "bytes->string is (bytes->string v), over a (Vec u8)"
|
||||||
|
| "append", [ target; x ] ->
|
||||||
|
let t = check_target ctx target in
|
||||||
|
(match t.Tast.ty with
|
||||||
|
(* A run of bytes onto a (Vec u8), or through a pointer to one: the
|
||||||
|
prelude's builders' tool, and raw bytes, so nothing is checked. The
|
||||||
|
runtime finds a run that lies inside the Vec's own block before it
|
||||||
|
grows it, so (append (addr b) (slice b)) reads what it meant to. *)
|
||||||
|
| Types.Vec (Types.Int Types.U8)
|
||||||
|
| Types.Ptr (_, Types.Vec (Types.Int Types.U8)) ->
|
||||||
|
let v =
|
||||||
|
match t.Tast.ty with
|
||||||
|
| Types.Ptr (_, ty) -> mk loc ty (Tast.Deref t)
|
||||||
|
| _ -> t
|
||||||
|
in
|
||||||
|
refuse_const_change ctx loc v;
|
||||||
|
note_grown ctx "append" loc v;
|
||||||
|
let bty = Types.Slice (Types.Const, u8_ty) in
|
||||||
|
let b = check ctx ~want:bty x in
|
||||||
|
let bs = fresh_slot ctx bty in
|
||||||
|
let attempt =
|
||||||
|
rt loc (Types.Int Types.I8) "flan_vec_append"
|
||||||
|
[ v; mk loc bty (Tast.Local bs); size_of loc u8_ty;
|
||||||
|
align_of loc u8_ty; here loc ]
|
||||||
|
in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc Types.Unit
|
||||||
|
(Tast.Let
|
||||||
|
([ (bs, b) ],
|
||||||
|
[ region_check ctx.env loc v
|
||||||
|
(with_note loc (alloc_guard ctx loc attempt)
|
||||||
|
(reg_note loc "flan_dev_reg_note_vec" v
|
||||||
|
[ size_of loc u8_ty ] u8_ty)) ])))
|
||||||
|
| ty when string_or_ptr ty ->
|
||||||
|
let s = string_target ctx loc name t in
|
||||||
|
let piece = string_piece ctx name x in
|
||||||
|
expect ctx loc ~want (string_put ctx loc (string_vec loc s) (i64 (-1L)) piece)
|
||||||
|
| other ->
|
||||||
|
fail loc "append takes a String, or a (Vec u8) to add bytes to, found %s"
|
||||||
|
(tyname loc other))
|
||||||
|
| "insert", [ target; i; x ] ->
|
||||||
|
let s = string_target ctx loc name (check_target ctx target) in
|
||||||
|
let v = string_vec loc s in
|
||||||
|
let piece = string_piece ctx name x in
|
||||||
|
let off = string_index ctx loc v i ~past_end:true in
|
||||||
|
expect ctx loc ~want (string_put ctx loc v off piece)
|
||||||
|
| "remove", [ target; i ] ->
|
||||||
|
let s = string_target ctx loc name (check_target ctx target) in
|
||||||
|
let v = string_vec loc s in
|
||||||
|
let off = string_index ctx loc v i ~past_end:false in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(rt loc (Types.Int Types.I32) "flan_string_remove" [ v; off; here loc ])
|
||||||
|
| "runes", [ x ] ->
|
||||||
|
let b = text_bytes ctx name x in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc (Types.Named "Runes") (Tast.Make ("Runes", [ b ])))
|
||||||
|
| "rune-count", [ x ] ->
|
||||||
|
let b = text_bytes ctx name x in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc (Types.Int Types.I32) (Tast.Call (prelude_fn ctx "rune-count", [ b ])))
|
||||||
|
| ("append" | "insert" | "remove" | "runes" | "rune-count"), _ ->
|
||||||
|
let shape =
|
||||||
|
match name with
|
||||||
|
| "append" -> "(append s x)"
|
||||||
|
| "insert" -> "(insert s i x)"
|
||||||
|
| "remove" -> "(remove s i)"
|
||||||
|
| "runes" -> "(runes s)"
|
||||||
|
| _ -> "(rune-count s)"
|
||||||
|
in
|
||||||
|
fail loc "%s is %s" name shape
|
||||||
|
| _ -> assert false
|
||||||
|
|
||||||
(* Every arm below is a name an editor can be asked about and no program ever
|
(* Every arm below is a name an editor can be asked about and no program ever
|
||||||
wrote down, so each one needs a line in [builtins] further down this file.
|
wrote down, so each one needs a line in [builtins] further down this file.
|
||||||
A new arm without an entry fails the build — test_flan reads both. *)
|
A new arm without an entry fails the build — test_flan reads both. *)
|
||||||
@ -11490,25 +11883,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
"(vec-new dyn) takes no allocator — its storage is the dyn \
|
"(vec-new dyn) takes no allocator — its storage is the dyn \
|
||||||
runtime's";
|
runtime's";
|
||||||
expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_vec_new" [])
|
expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_vec_new" [])
|
||||||
end else begin
|
end else
|
||||||
let a = allocator_arg ctx loc args in
|
expect ctx loc ~want (vec_init ctx loc elem (allocator_arg ctx loc args))
|
||||||
let v = fresh_slot ctx (Types.Vec elem) in
|
|
||||||
let attempt =
|
|
||||||
rt loc (Types.Int Types.I8) "flan_vec_init"
|
|
||||||
[ mk loc (Types.Vec elem) (Tast.Local v); a; i64_at loc 0L;
|
|
||||||
size_of loc elem; align_of loc elem; here loc ]
|
|
||||||
in
|
|
||||||
expect ctx loc ~want
|
|
||||||
(mk loc (Types.Vec elem)
|
|
||||||
(Tast.Let ([ (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ],
|
|
||||||
[ with_note loc (alloc_guard ctx loc attempt)
|
|
||||||
(reg_note loc "flan_dev_reg_note_vec"
|
|
||||||
(mk loc (Types.Vec elem) (Tast.Local v))
|
|
||||||
[ size_of loc elem ] elem);
|
|
||||||
region_check ctx.env loc
|
|
||||||
(mk loc (Types.Vec elem) (Tast.Local v))
|
|
||||||
(mk loc (Types.Vec elem) (Tast.Local v)) ])))
|
|
||||||
end
|
|
||||||
(* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
|
(* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
|
||||||
| "push" ->
|
| "push" ->
|
||||||
arity ctx loc name 2 args;
|
arity ctx loc name 2 args;
|
||||||
@ -11636,6 +12012,19 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
container is region-allocated or it does not exist, so there is always a
|
container is region-allocated or it does not exist, so there is always a
|
||||||
[free-all] to point at. *)
|
[free-all] to point at. *)
|
||||||
(match target.Tast.ty with
|
(match target.Tast.ty with
|
||||||
|
| t when is_string_ty t ->
|
||||||
|
(match args with
|
||||||
|
| [ _; _ ] ->
|
||||||
|
fail loc
|
||||||
|
"a String knows the allocator it came from, so free takes only \
|
||||||
|
the String. Write %s"
|
||||||
|
(if fln_source loc then "free(" ^ spell_arg "s" (List.hd args) ^ ")"
|
||||||
|
else "(free " ^ spell_arg "s" (List.hd args) ^ ")")
|
||||||
|
| _ -> ());
|
||||||
|
expect ctx loc ~want
|
||||||
|
(rt loc Types.Unit "flan_vec_free"
|
||||||
|
[ string_vec loc target; size_of loc u8_ty; align_of loc u8_ty;
|
||||||
|
here loc ])
|
||||||
| (Types.Vec _ | Types.Map _)
|
| (Types.Vec _ | Types.Map _)
|
||||||
when region_only ctx.env target.Tast.ty ->
|
when region_only ctx.env target.Tast.ty ->
|
||||||
fail loc
|
fail loc
|
||||||
@ -11749,6 +12138,26 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
let target = check_target ctx target in
|
let target = check_target ctx target in
|
||||||
let a = allocator_arg ctx loc rest in
|
let a = allocator_arg ctx loc rest in
|
||||||
(match target.Tast.ty with
|
(match target.Tast.ty with
|
||||||
|
(* A String's copy is a copy of its bytes, which are valid already. *)
|
||||||
|
| t when is_string_ty t ->
|
||||||
|
let v = string_vec loc target in
|
||||||
|
let d = fresh_slot ctx string_vec_ty in
|
||||||
|
let attempt =
|
||||||
|
rt loc (Types.Int Types.I8) "flan_vec_clone"
|
||||||
|
[ mk loc string_vec_ty (Tast.Local d); v; a;
|
||||||
|
size_of loc u8_ty; align_of loc u8_ty; here loc ]
|
||||||
|
in
|
||||||
|
expect ctx loc ~want
|
||||||
|
(mk loc string_ty
|
||||||
|
(Tast.Make
|
||||||
|
("String",
|
||||||
|
[ mk loc string_vec_ty
|
||||||
|
(Tast.Let ([ (d, mk loc string_vec_ty (Tast.Zero string_vec_ty)) ],
|
||||||
|
[ with_note loc (alloc_guard ctx loc attempt)
|
||||||
|
(reg_note loc "flan_dev_reg_note_vec"
|
||||||
|
(mk loc string_vec_ty (Tast.Local d))
|
||||||
|
[ size_of loc u8_ty ] string_ty);
|
||||||
|
mk loc string_vec_ty (Tast.Local d) ])) ])))
|
||||||
(* The refusal that did *not* come down with the type-level ones, and
|
(* The refusal that did *not* come down with the type-level ones, and
|
||||||
the distinction is worth being exact about, because the sentence
|
the distinction is worth being exact about, because the sentence
|
||||||
they all used to share bundled two different failures: that a clone
|
they all used to share bundled two different failures: that a clone
|
||||||
@ -11842,6 +12251,13 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
mk loc (Types.Vec elem) (Tast.Local d) ]))))
|
mk loc (Types.Vec elem) (Tast.Local d) ]))))
|
||||||
| _ -> fail loc "clone is (clone v) or (clone v allocator)")
|
| _ -> fail loc "clone is (clone v) or (clone v allocator)")
|
||||||
|
|
||||||
|
(* ── String, the prelude's owned text ─────────────────────────────
|
||||||
|
Each is [string_call]'s, which says what each one checks. *)
|
||||||
|
| "string-new" | "bytes->string" | "append" | "insert" | "remove" ->
|
||||||
|
string_call ctx ~want loc name args
|
||||||
|
| "runes" | "rune-count" ->
|
||||||
|
string_call ctx ~want loc name args
|
||||||
|
|
||||||
(* ── (Map K V), spec-memory.md ─────────────────────────────────── *)
|
(* ── (Map K V), spec-memory.md ─────────────────────────────────── *)
|
||||||
(* Every one of these is a named call over the same type-erased runtime the
|
(* Every one of these is a named call over the same type-erased runtime the
|
||||||
Vec uses, with the two sizes and the key's hash and equality pair produced
|
Vec uses, with the two sizes and the key's hash and equality pair produced
|
||||||
@ -12422,6 +12838,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
| Types.Vec _ ->
|
| Types.Vec _ ->
|
||||||
let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ a; here loc ] in
|
let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ a; here loc ] in
|
||||||
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
||||||
|
(* Bytes, as on a str (decision 107); rune-count counts characters. *)
|
||||||
|
| t when is_string_ty t ->
|
||||||
|
let n =
|
||||||
|
rt loc (Types.Int Types.I64) "flan_vec_len" [ string_vec loc a; here loc ]
|
||||||
|
in
|
||||||
|
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
||||||
(* Extended rather than given a name of its own, for the reason [at] and
|
(* Extended rather than given a name of its own, for the reason [at] and
|
||||||
[length] were extended over Vec: one question, one word. *)
|
[length] were extended over Vec: one question, one word. *)
|
||||||
| Types.Map _ ->
|
| Types.Map _ ->
|
||||||
@ -12437,7 +12859,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
||||||
| other ->
|
| other ->
|
||||||
fail loc
|
fail loc
|
||||||
"length takes an array, a slice, a string, a Vec or a Map, found %s"
|
"length takes an array, a slice, a str, a String, a Vec or a Map, \
|
||||||
|
found %s"
|
||||||
(tyname loc other))
|
(tyname loc other))
|
||||||
| "at" ->
|
| "at" ->
|
||||||
(match args with
|
(match args with
|
||||||
@ -12751,8 +13174,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
every other comparison walks a string's bytes without copying them. *)
|
every other comparison walks a string's bytes without copying them. *)
|
||||||
| "bytes-view" ->
|
| "bytes-view" ->
|
||||||
arity ctx loc name 1 args;
|
arity ctx loc name 1 args;
|
||||||
prim Tast.Bytes (Types.Slice (Types.Const, Types.Int Types.U8))
|
let a = maybe_string ctx ~otherwise:Types.String (List.hd args) in
|
||||||
[ check ctx ~want:Types.String (List.hd args) ]
|
if string_or_ptr a.Tast.ty then expect ctx loc ~want (string_bytes ctx loc a)
|
||||||
|
else prim Tast.Bytes (Types.Slice (Types.Const, Types.Int Types.U8)) [ a ]
|
||||||
|
|
||||||
(* (bytes s) / (bytes s a): a *writable copy* of the string's bytes, from
|
(* (bytes s) / (bytes s a): a *writable copy* of the string's bytes, from
|
||||||
the context allocator or one named — never a hidden malloc, which is
|
the context allocator or one named — never a hidden malloc, which is
|
||||||
@ -12805,7 +13229,15 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
kept past the frame is cloned first. *)
|
kept past the frame is cloned first. *)
|
||||||
| "str" ->
|
| "str" ->
|
||||||
arity ctx loc name 1 args;
|
arity ctx loc name 1 args;
|
||||||
prim Tast.StrOfBytes Types.String [ byte_slice ctx (List.hd args) ]
|
(* A String's str is a view of its bytes, as (str (slice v)) is of a
|
||||||
|
Vec's: it costs nothing and lasts until the String next grows. *)
|
||||||
|
let a =
|
||||||
|
maybe_string ctx ~otherwise:(Types.Slice (Types.Const, Types.Int Types.U8))
|
||||||
|
(List.hd args)
|
||||||
|
in
|
||||||
|
if string_or_ptr a.Tast.ty then
|
||||||
|
prim Tast.StrOfBytes Types.String [ string_bytes ctx loc a ]
|
||||||
|
else prim Tast.StrOfBytes Types.String [ a ]
|
||||||
| "bytes->f64" ->
|
| "bytes->f64" ->
|
||||||
arity ctx loc name 1 args;
|
arity ctx loc name 1 args;
|
||||||
prim Tast.BytesToF64 (Types.Float Types.F64) [ byte_slice ctx (List.hd args) ]
|
prim Tast.BytesToF64 (Types.Float Types.F64) [ byte_slice ctx (List.hd args) ]
|
||||||
@ -12965,6 +13397,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
|||||||
match a.Tast.ty with
|
match a.Tast.ty with
|
||||||
| Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
|
| Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
|
||||||
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
|
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
|
||||||
|
(* A String prints as its text, raw at the top as a str does. *)
|
||||||
|
| t when is_string_ty t ->
|
||||||
|
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ string_bytes ctx loc a ]))) ]
|
||||||
(* The walk names the value once per piece it reads — an option's tag
|
(* The walk names the value once per piece it reads — an option's tag
|
||||||
and then its payload, each field of a struct — so anything but a
|
and then its payload, each field of a struct — so anything but a
|
||||||
plain variable is bound to a slot first, or [(println (pop! s))]
|
plain variable is bound to a slot first, or [(println (pop! s))]
|
||||||
@ -14566,13 +15001,13 @@ let builtins : (string * string * string) list =
|
|||||||
"Makes room for n more. For a map the number is entries rather than \
|
"Makes room for n more. For a map the number is entries rather than \
|
||||||
slots — the block is sized so that n still sits under the load \
|
slots — the block is sized so that n still sits under the load \
|
||||||
factor.");
|
factor.");
|
||||||
("free", "free [(Vec T)|(Map K V)|[T] Allocator?] ()",
|
("free", "free [(Vec T)|(Map K V)|String|[T] Allocator?] ()",
|
||||||
"Releases the container's block. It does not recurse into elements that \
|
"Releases the container's block. It does not recurse into elements that \
|
||||||
own storage — such a container is refused here, and releasing its \
|
own storage — such a container is refused here, and releasing its \
|
||||||
region with free-all is the answer. A slice (bytes s) or (clone xs) \
|
region with free-all is the answer. A slice (bytes s) or (clone xs) \
|
||||||
made goes back to the current allocator, or the one named; a dev build \
|
made goes back to the current allocator, or the one named; a dev build \
|
||||||
traps on a slice from another allocator or not from one at all.");
|
traps on a slice from another allocator or not from one at all.");
|
||||||
("clone", "clone [(Vec T)|(Map K V)|[T] Allocator?] (Vec T)|(Map K V)|[T]",
|
("clone", "clone [(Vec T)|(Map K V)|String|[T] Allocator?] (Vec T)|(Map K V)|String|[T]",
|
||||||
"A deep, independent copy, from the current allocator or one named. \
|
"A deep, independent copy, from the current allocator or one named. \
|
||||||
A slice's copy is a slice over a new block, released by (free s) or by \
|
A slice's copy is a slice over a new block, released by (free s) or by \
|
||||||
its allocator's free-all. Refused for elements that own \
|
its allocator's free-all. Refused for elements that own \
|
||||||
@ -14583,6 +15018,36 @@ let builtins : (string * string * string) list =
|
|||||||
elements own storage, because pushing them as they stand would share \
|
elements own storage, because pushing them as they stand would share \
|
||||||
their blocks. Not meant to be written by hand.");
|
their blocks. Not meant to be written by hand.");
|
||||||
|
|
||||||
|
(* String *)
|
||||||
|
("string-new", "string-new [(str|String)? Allocator?] String",
|
||||||
|
"A String: owned, growable text that is always valid UTF-8. Empty, or \
|
||||||
|
a copy of the text given; from the current allocator or one named, and \
|
||||||
|
released by (free s). A str is checked as it is copied in.");
|
||||||
|
("bytes->string", "bytes->string [(Vec u8)] String",
|
||||||
|
"The Vec becomes a String over the same storage, once its bytes are \
|
||||||
|
checked to be UTF-8 — here, at run time. Bytes that are not stop the \
|
||||||
|
program at this call.");
|
||||||
|
("append", "append [String str|String|i32] () append [(Vec u8) [const u8]] ()",
|
||||||
|
"Adds text or one code point to the end of a String. A str is checked \
|
||||||
|
to be UTF-8 as it is stored and a code point to be a Unicode scalar \
|
||||||
|
value; a literal is checked when the program is compiled. Onto a \
|
||||||
|
(Vec u8), or a pointer to one, it adds raw bytes.");
|
||||||
|
("insert", "insert [String i32 str|String|i32] ()",
|
||||||
|
"Stores text or a code point before the character at position i, \
|
||||||
|
counting characters and not bytes; i may be the character count, \
|
||||||
|
which is the end. Checked as append checks, and a position past the \
|
||||||
|
end signals BoundsError.");
|
||||||
|
("remove", "remove [String i32] i32",
|
||||||
|
"Takes out the character at position i, counting characters, and \
|
||||||
|
answers its code point. A position past the end signals BoundsError.");
|
||||||
|
("runes", "runes [str|String|[const u8]] Runes",
|
||||||
|
"A cursor over the text's code points: (runes-next (addr it)) answers \
|
||||||
|
the next one, or None at the end. A malformed byte in a str comes back \
|
||||||
|
as U+FFFD.");
|
||||||
|
("rune-count", "rune-count [str|String|[const u8]] i32",
|
||||||
|
"How many characters — code points — the text holds, where length \
|
||||||
|
counts bytes. A malformed byte counts as one.");
|
||||||
|
|
||||||
(* (Map K V) *)
|
(* (Map K V) *)
|
||||||
("map-new", "map-new [K? V? Allocator?] (Map K V)",
|
("map-new", "map-new [K? V? Allocator?] (Map K V)",
|
||||||
"An empty map. The key and value types are written at the call — \
|
"An empty map. The key and value types are written at the call — \
|
||||||
@ -14657,9 +15122,10 @@ let builtins : (string * string * string) list =
|
|||||||
the direction a handler can act on.");
|
the direction a handler can act on.");
|
||||||
|
|
||||||
(* containers *)
|
(* containers *)
|
||||||
("length", "length [[n T]|[T]|str|(Vec T)|(Map K V)] i32",
|
("length", "length [[n T]|[T]|str|String|(Vec T)|(Map K V)] i32",
|
||||||
"How many elements. One question and one word across an array, a slice, \
|
"How many elements. One question and one word across an array, a slice, \
|
||||||
a string, a Vec and a Map.");
|
a string, a Vec and a Map. A str and a String count bytes; rune-count \
|
||||||
|
counts characters.");
|
||||||
("at", "at [collection i32 ...] T",
|
("at", "at [collection i32 ...] T",
|
||||||
"The element at an index, bounds-checked — and for a Vec with the \
|
"The element at an index, bounds-checked — and for a Vec with the \
|
||||||
allocator's epoch checked first. On a string it is the byte, a u8. It \
|
allocator's epoch checked first. On a string it is the byte, a u8. It \
|
||||||
@ -14696,13 +15162,14 @@ let builtins : (string * string * string) list =
|
|||||||
StorageExhausted with retry — and (free b) releases it, through the \
|
StorageExhausted with retry — and (free b) releases it, through the \
|
||||||
current allocator or (free b a) through the one it came from. For reading without a copy, \
|
current allocator or (free b a) through the one it came from. For reading without a copy, \
|
||||||
bytes-view.");
|
bytes-view.");
|
||||||
("bytes-view", "bytes-view [str] [const u8]",
|
("bytes-view", "bytes-view [str|String] [const u8]",
|
||||||
"The string's own storage seen as a read-only byte slice. It costs \
|
"The string's own storage seen as a read-only byte slice. It costs \
|
||||||
nothing — both are a ptr and a length at run time — and it decodes \
|
nothing — both are a ptr and a length at run time — and it decodes \
|
||||||
nothing. A store through it is a compile error; bytes is the writable \
|
nothing. A store through it is a compile error; bytes is the writable \
|
||||||
copy.");
|
copy.");
|
||||||
("str", "str [[const u8]] str",
|
("str", "str [[const u8]|String] str",
|
||||||
"A byte slice seen as a str, and free at run time. It does not check \
|
"A byte slice, or a String's text, seen as a str, and free at run time. \
|
||||||
|
A String's str lasts until the String next changes. It does not check \
|
||||||
UTF-8, because `str` does not claim UTF-8 — valid-utf8? is an \
|
UTF-8, because `str` does not claim UTF-8 — valid-utf8? is an \
|
||||||
ordinary function you call when you care.");
|
ordinary function you call when you care.");
|
||||||
("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes.");
|
("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes.");
|
||||||
|
|||||||
12
lib/emit.ml
12
lib/emit.ml
@ -4061,6 +4061,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
|
|||||||
this is where (at v i) gets what (at arr i) gets from [check_at]. *)
|
this is where (at v i) gets what (at arr i) gets from [check_at]. *)
|
||||||
let signals =
|
let signals =
|
||||||
String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice"
|
String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice"
|
||||||
|
|| String.equal sym "flan_string_index"
|
||||||
in
|
in
|
||||||
let vs = if signals then vs @ [ "ptr " ^ xfer_param ] else vs in
|
let vs = if signals then vs @ [ "ptr " ^ xfer_param ] else vs in
|
||||||
let args' = String.concat ", " vs in
|
let args' = String.concat ", " vs in
|
||||||
@ -5007,6 +5008,7 @@ declare i64 @flan_dyn_from_i64(i64)
|
|||||||
declare i64 @flan_dyn_from_f64(double)
|
declare i64 @flan_dyn_from_f64(double)
|
||||||
declare i64 @flan_dyn_from_bool(i32)
|
declare i64 @flan_dyn_from_bool(i32)
|
||||||
declare i64 @flan_dyn_from_bytes(ptr, i64)
|
declare i64 @flan_dyn_from_bytes(ptr, i64)
|
||||||
|
declare i64 @flan_dyn_from_string(ptr)
|
||||||
declare i64 @flan_dyn_vec_new()
|
declare i64 @flan_dyn_vec_new()
|
||||||
declare i64 @flan_dyn_map_new()
|
declare i64 @flan_dyn_map_new()
|
||||||
declare i64 @flan_dyn_map_new_class(i64, ptr, i64)
|
declare i64 @flan_dyn_map_new_class(i64, ptr, i64)
|
||||||
@ -5109,6 +5111,16 @@ declare i64 @flan_vec_len(ptr, ptr, i64)
|
|||||||
declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64, ptr)
|
declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64, ptr)
|
||||||
declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64, ptr)
|
declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64, ptr)
|
||||||
declare void @flan_vec_free(ptr, i64, i64, ptr, i64)
|
declare void @flan_vec_free(ptr, i64, i64, ptr, i64)
|
||||||
|
declare i8 @flan_vec_append(ptr, ptr, i64, i64, i64, ptr, i64)
|
||||||
|
declare i8 @flan_vec_insert(ptr, i64, ptr, i64, i64, i64, ptr, i64)
|
||||||
|
declare void @flan_vec_remove_range(ptr, i64, i64, i64, ptr, i64)
|
||||||
|
declare i64 @flan_string_index(ptr, i32, i32, ptr, i64, ptr)
|
||||||
|
declare i32 @flan_string_remove(ptr, i64, ptr, i64)
|
||||||
|
declare i8 @flan_string_put_rune(ptr, i64, i32, ptr, i64)
|
||||||
|
; String's run-time checks: a text or a code point the checker could not prove
|
||||||
|
; valid, checked at the site of the append that stores it.
|
||||||
|
declare void @flan_utf8_check(ptr, i64, ptr, i64)
|
||||||
|
declare void @flan_rune_check(i32, ptr, i64)
|
||||||
; (Map K V). The two ptr arguments before the location on put/get/clone are the
|
; (Map K V). The two ptr arguments before the location on put/get/clone are the
|
||||||
; hash and equality pair, which the checker emits per key type and passes here
|
; hash and equality pair, which the checker emits per key type and passes here
|
||||||
; the way Odin hangs them off Map_Info.
|
; the way Odin hangs them off Map_Info.
|
||||||
|
|||||||
@ -221,7 +221,9 @@ let rec walk c b depth addr (ty : Types.t) =
|
|||||||
(* An [i1] in memory is a byte, and a load keeps its low bit. *)
|
(* An [i1] in memory is a byte, and a load keeps its low bit. *)
|
||||||
| Types.Bool -> put b (if u8 c addr land 1 <> 0 then "true" else "false")
|
| Types.Bool -> put b (if u8 c addr land 1 <> 0 then "true" else "false")
|
||||||
| Types.Unit -> put b "()"
|
| Types.Unit -> put b "()"
|
||||||
| Types.String | Types.Slice (_, Types.Int Types.U8) ->
|
(* The prelude's String is a (Vec u8), whose header starts with the same
|
||||||
|
pointer and length a str is. *)
|
||||||
|
| Types.String | Types.Slice (_, Types.Int Types.U8) | Types.Named "String" ->
|
||||||
let p = ptr c addr and n = Int64.to_int (i64 c (addr + 8)) in
|
let p = ptr c addr and n = Int64.to_int (i64 c (addr + 8)) in
|
||||||
(* Enough bytes to overrun the cap once quoted, and no more: a string of
|
(* Enough bytes to overrun the cap once quoted, and no more: a string of
|
||||||
a million bytes is shown as its first few thousand either way. *)
|
a million bytes is shown as its first few thousand either way. *)
|
||||||
|
|||||||
@ -1705,7 +1705,7 @@ let source = {flan|
|
|||||||
;; rules that hold for all of it.
|
;; rules that hold for all of it.
|
||||||
;;
|
;;
|
||||||
;; **The result is owned and the caller frees it.** Each of these hands back a
|
;; **The result is owned and the caller frees it.** Each of these hands back a
|
||||||
;; (Vec u8) or a (Vec [u8]), which is move-only: it goes with the call that
|
;; String — or, for split, a (Vec [const u8]) — which is move-only: it goes with the call that
|
||||||
;; takes it, and nothing is released at scope exit — not at the end of a let,
|
;; takes it, and nothing is released at scope exit — not at the end of a let,
|
||||||
;; not at the end of a function (spec-memory.md, "When storage is released").
|
;; not at the end of a function (spec-memory.md, "When storage is released").
|
||||||
;; A caller writes (free v) or lets a (free-all a) take the whole region.
|
;; A caller writes (free v) or lets a (free-all a) take the whole region.
|
||||||
@ -1724,18 +1724,36 @@ let source = {flan|
|
|||||||
;; (spec-memory.md, "Allocation failure"), so these signatures say what they
|
;; (spec-memory.md, "Allocation failure"), so these signatures say what they
|
||||||
;; produce and nothing about how they might fail.
|
;; produce and nothing about how they might fail.
|
||||||
|
|
||||||
;; The builder. It is not a type: strings.Builder in Odin is a struct wrapping
|
;; String: owned, growable, always valid UTF-8. The bytes live in a (Vec u8),
|
||||||
;; a [dynamic]u8, and here the (Vec u8) *is* that, with push already on it — a
|
;; so the allocator, the free, the retry on exhaustion and the dev build's
|
||||||
;; wrapper would be a move-only struct owning a Vec whose only method is the
|
;; registry are all the Vec's. What the struct adds is the promise, and the
|
||||||
;; one the Vec already has. What was actually missing is appending a run of
|
;; checker keeps it (check.ml, [string_call]): outside this file the field
|
||||||
;; bytes rather than one, and that is this.
|
;; cannot be named and the struct cannot be built, so every byte arrives
|
||||||
|
;; through append, insert, string-new or bytes->string, each of which
|
||||||
|
;; checks text it cannot prove valid at the site that stores it.
|
||||||
;;
|
;;
|
||||||
;; It takes a (Ptr (Vec u8)) and not a (Vec u8), and the difference is not
|
;; A zeroed String is the empty one: a zeroed Vec adopts the context
|
||||||
;; style: a Vec parameter *moves*, so (append b s) taking one by value would
|
;; allocator on its first append.
|
||||||
;; consume the caller's builder on the first call and refuse the second.
|
(defstruct String [bytes (Vec u8)])
|
||||||
(defn append [b (Ptr (Vec u8)) s [const u8]] ()
|
|
||||||
(dotimes [i (length s)]
|
;; A cursor over the code points of some UTF-8 bytes, which owns nothing: the
|
||||||
(push (deref b) (at s i))))
|
;; shape split-on-byte has. (runes s) makes one over a str, a String or a
|
||||||
|
;; [const u8], and runes-next hands back one code point at a time. A
|
||||||
|
;; malformed byte in a str or a [const u8] comes back as U+FFFD and counts
|
||||||
|
;; as one, as rune-count counts it; a String has none.
|
||||||
|
(defstruct Runes [rest [const u8]])
|
||||||
|
|
||||||
|
(defn runes-next [it (Ptr Runes)] (Option i32)
|
||||||
|
(if (= (length (.rest it)) 0)
|
||||||
|
None
|
||||||
|
(let [r (decode-rune (.rest it))]
|
||||||
|
(set (.rest it) (slice (.rest it) (.width r) (length (.rest it))))
|
||||||
|
(Some (if (.ok r) (.code r) 0xfffd)))))
|
||||||
|
|
||||||
|
;; append — onto a String, or a run of bytes onto a (Vec u8) — is the
|
||||||
|
;; checker's (check.ml, "append"), because what it takes decides what it
|
||||||
|
;; does: a str, a String or a code point onto a String, a [const u8] onto a
|
||||||
|
;; (Vec u8).
|
||||||
|
|
||||||
;; The two number appends. Outside the prelude i64->bytes and f64->bytes copy
|
;; The two number appends. Outside the prelude i64->bytes and f64->bytes copy
|
||||||
;; their text into the temp allocator; inside it they answer a view of the
|
;; their text into the temp allocator; inside it they answer a view of the
|
||||||
@ -1755,43 +1773,43 @@ let source = {flan|
|
|||||||
;; join with an empty separator is concat, and concat is here anyway because
|
;; join with an empty separator is concat, and concat is here anyway because
|
||||||
;; the empty (bytes-view "") a caller would have to write is the kind of argument
|
;; the empty (bytes-view "") a caller would have to write is the kind of argument
|
||||||
;; that reads like a mistake at the call site.
|
;; that reads like a mistake at the call site.
|
||||||
(defn concat [parts [const [const u8]]] (Vec u8)
|
(defn concat [parts [const [const u8]]] String
|
||||||
(let [b (vec-new u8)]
|
(let [b (vec-new u8)]
|
||||||
(dotimes [i (length parts)]
|
(dotimes [i (length parts)]
|
||||||
(append (addr b) (at parts i)))
|
(append (addr b) (at parts i)))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
;; n parts yield n-1 separators, and the empty slice of parts yields the empty
|
;; n parts yield n-1 separators, and the empty slice of parts yields the empty
|
||||||
;; result rather than a leading separator — which is the off-by-one a join
|
;; result rather than a leading separator — which is the off-by-one a join
|
||||||
;; written as "append part then separator, then chop the tail" gets wrong on
|
;; written as "append part then separator, then chop the tail" gets wrong on
|
||||||
;; exactly that input, because there is no tail to chop.
|
;; exactly that input, because there is no tail to chop.
|
||||||
(defn join [parts [const [const u8]] sep [const u8]] (Vec u8)
|
(defn join [parts [const [const u8]] sep [const u8]] String
|
||||||
(let [b (vec-new u8)]
|
(let [b (vec-new u8)]
|
||||||
(dotimes [i (length parts)]
|
(dotimes [i (length parts)]
|
||||||
(when (> i 0)
|
(when (> i 0)
|
||||||
(append (addr b) sep))
|
(append (addr b) sep))
|
||||||
(append (addr b) (at parts i)))
|
(append (addr b) (at parts i)))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
(defn repeat-bytes [s [const u8] n i32] (Vec u8)
|
(defn repeat-bytes [s [const u8] n i32] String
|
||||||
(let [b (vec-new u8)]
|
(let [b (vec-new u8)]
|
||||||
(dotimes [i n]
|
(dotimes [i n]
|
||||||
(append (addr b) s))
|
(append (addr b) s))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
;; The allocating halves of the ASCII case pair. The note above lower-ascii
|
;; The allocating halves of the ASCII case pair. The note above lower-ascii
|
||||||
;; says why there is no in-place one; these write only bytes of their own.
|
;; says why there is no in-place one; these write only bytes of their own.
|
||||||
(defn to-lower [s [const u8]] (Vec u8)
|
(defn to-lower [s [const u8]] String
|
||||||
(let [b (vec-new u8)]
|
(let [b (vec-new u8)]
|
||||||
(dotimes [i (length s)]
|
(dotimes [i (length s)]
|
||||||
(push b (lower-ascii (at s i))))
|
(push b (lower-ascii (at s i))))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
(defn to-upper [s [const u8]] (Vec u8)
|
(defn to-upper [s [const u8]] String
|
||||||
(let [b (vec-new u8)]
|
(let [b (vec-new u8)]
|
||||||
(dotimes [i (length s)]
|
(dotimes [i (length s)]
|
||||||
(push b (upper-ascii (at s i))))
|
(push b (upper-ascii (at s i))))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
;; Every non-overlapping occurrence, left to right, which is the rule that
|
;; Every non-overlapping occurrence, left to right, which is the rule that
|
||||||
;; makes (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b")) answer "ba" and
|
;; makes (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b")) answer "ba" and
|
||||||
@ -1806,7 +1824,7 @@ let source = {flan|
|
|||||||
;; choice: returning a Vec *moves* it, and the move analysis is a dead set over
|
;; choice: returning a Vec *moves* it, and the move analysis is a dead set over
|
||||||
;; the whole function, so a `return b` on one branch kills the binding for the
|
;; the whole function, so a `return b` on one branch kills the binding for the
|
||||||
;; `b` at the foot of the other. One exit, one move.
|
;; `b` at the foot of the other. One exit, one move.
|
||||||
(defn replace-bytes [s [const u8] from [const u8] to [const u8]] (Vec u8)
|
(defn replace-bytes [s [const u8] from [const u8] to [const u8]] String
|
||||||
(let [b (vec-new u8)
|
(let [b (vec-new u8)
|
||||||
i 0]
|
i 0]
|
||||||
(if (= (length from) 0)
|
(if (= (length from) 0)
|
||||||
@ -1822,7 +1840,7 @@ let source = {flan|
|
|||||||
(do
|
(do
|
||||||
(append (addr b) (slice s i (length s)))
|
(append (addr b) (slice s i (length s)))
|
||||||
(set i (length s))))))
|
(set i (length s))))))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
;; A (Vec [u8]) cannot be written at a let, and this one-line function is where
|
;; A (Vec [u8]) cannot be written at a let, and this one-line function is where
|
||||||
;; the type is said instead. (vec-new) takes its element type as a *bare
|
;; the type is said instead. (vec-new) takes its element type as a *bare
|
||||||
@ -1895,7 +1913,7 @@ let source = {flan|
|
|||||||
;;
|
;;
|
||||||
;; -0.0 prints as "0.00": the sign test is (< x 0.0), which -0.0 fails. A
|
;; -0.0 prints as "0.00": the sign test is (< x 0.0), which -0.0 fails. A
|
||||||
;; caller that needs the sign of a zero should not be reading it out of text.
|
;; caller that needs the sign of a zero should not be reading it out of text.
|
||||||
(defn format-f64 [x f64 prec i32] (Vec u8)
|
(defn format-f64 [x f64 prec i32] String
|
||||||
(let [b (vec-new u8)
|
(let [b (vec-new u8)
|
||||||
p (clamp prec 0 9)]
|
p (clamp prec 0 9)]
|
||||||
(cond
|
(cond
|
||||||
@ -1942,7 +1960,7 @@ let source = {flan|
|
|||||||
(dotimes [i (- p (length d))]
|
(dotimes [i (- p (length d))]
|
||||||
(push b \0))
|
(push b \0))
|
||||||
(append (addr b) d))))))))
|
(append (addr b) d))))))))
|
||||||
b))
|
(bytes->string b)))
|
||||||
|
|
||||||
;; ── Still refused, and what the reason is now ─────────────────────────
|
;; ── Still refused, and what the reason is now ─────────────────────────
|
||||||
;;
|
;;
|
||||||
@ -1950,9 +1968,9 @@ let source = {flan|
|
|||||||
;; that did not exist in its input, and there was no allocator. That sentence
|
;; that did not exist in its input, and there was no allocator. That sentence
|
||||||
;; stopped being true when `Vec` landed, and most of the list has moved up into
|
;; stopped being true when `Vec` landed, and most of the list has moved up into
|
||||||
;; the building section above: join, concat, split, to-lower, to-upper, repeat
|
;; the building section above: join, concat, split, to-lower, to-upper, repeat
|
||||||
;; and replace are all written now, and `string-from-bytes` turned out to be
|
;; and replace are all written now. Bytes become text two ways: (str (slice v))
|
||||||
;; the `str` builtin all along — (str (slice v)) is the round trip,
|
;; views them, free and unchecked, and (bytes->string v) takes the Vec over
|
||||||
;; and the layouts being identical is exactly why it is free.
|
;; as a String once it has checked the bytes are UTF-8.
|
||||||
;;
|
;;
|
||||||
;; What is left is refused for four *different* reasons, which is why they are
|
;; What is left is refused for four *different* reasons, which is why they are
|
||||||
;; named separately rather than under one heading.
|
;; named separately rather than under one heading.
|
||||||
@ -1975,12 +1993,7 @@ let source = {flan|
|
|||||||
;; per *ordered pair* of types rather than per type,
|
;; per *ordered pair* of types rather than per type,
|
||||||
;; which is where a per-type family stops being honest.
|
;; which is where a per-type family stops being honest.
|
||||||
;;
|
;;
|
||||||
;; Builder Not refused — declined. strings.Builder in Odin
|
;; Builder A String is one: append onto it.
|
||||||
;; wraps a [dynamic]u8; here the (Vec u8) *is* that and
|
|
||||||
;; already has push, so the struct would be a move-only
|
|
||||||
;; wrapper whose only method is the one it wraps. What
|
|
||||||
;; was missing was appending a run of bytes, and
|
|
||||||
;; `append` above is that.
|
|
||||||
;; ── Files: embedding, slurp and barf ──────────────────────────────────
|
;; ── Files: embedding, slurp and barf ──────────────────────────────────
|
||||||
;;
|
;;
|
||||||
;; One entry per file in an (embed-dir "...") — Odin's Load_Directory_File
|
;; One entry per file in an (embed-dir "...") — Odin's Load_Directory_File
|
||||||
|
|||||||
@ -320,6 +320,29 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
|
|||||||
when List.exists (fun (u : Tast.structure) -> String.equal u.Tast.sname n)
|
when List.exists (fun (u : Tast.structure) -> String.equal u.Tast.sname n)
|
||||||
c.unions ->
|
c.unions ->
|
||||||
[ lit ("<" ^ n ^ " union>") ]
|
[ lit ("<" ^ n ^ " union>") ]
|
||||||
|
(* The prelude's String prints as the text it holds, quoted as a str is
|
||||||
|
inside a structure, rather than as the Vec its one field is. The view
|
||||||
|
is flan_vec_as_slice's, into a slot of the caller's frame. *)
|
||||||
|
| Types.Named "String" ->
|
||||||
|
let u8 = Types.Int Types.U8 in
|
||||||
|
let bty = Types.Slice (Types.Mut, u8) in
|
||||||
|
let out = c.alloc bty in
|
||||||
|
let outv = { Tast.e = Tast.Local out; ty = bty; loc } in
|
||||||
|
let i64 p = { Tast.e = Tast.Prim (p, []); ty = Types.Int Types.I64; loc } in
|
||||||
|
let fill =
|
||||||
|
{ Tast.e =
|
||||||
|
Tast.Prim
|
||||||
|
(Tast.Rt "flan_vec_as_slice",
|
||||||
|
[ { Tast.e = Tast.Field (e, 0); ty = Types.Vec u8; loc };
|
||||||
|
{ Tast.e = Tast.Prim (Tast.AddrOf, [ outv ]);
|
||||||
|
ty = Types.Ptr (Types.Mut, bty); loc };
|
||||||
|
i32 0; i32 (-1); i64 (Tast.SizeOf u8);
|
||||||
|
{ Tast.e = Tast.Str (Loc.to_string loc); ty = Types.String; loc } ]);
|
||||||
|
ty = Types.Unit; loc }
|
||||||
|
in
|
||||||
|
[ unit_
|
||||||
|
(Tast.Let ([ (out, { Tast.e = Tast.Zero bty; ty = bty; loc }) ],
|
||||||
|
[ fill; c.emit.estr outv ])) ]
|
||||||
| Types.Named n ->
|
| Types.Named n ->
|
||||||
(match
|
(match
|
||||||
List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n)
|
List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n)
|
||||||
|
|||||||
@ -3170,6 +3170,7 @@ and clear_at f =
|
|||||||
is where [(at v i)] gets what [(at arr i)] gets from [check_at]. *)
|
is where [(at v i)] gets what [(at arr i)] gets from [check_at]. *)
|
||||||
and rt_signals sym =
|
and rt_signals sym =
|
||||||
String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice"
|
String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice"
|
||||||
|
|| String.equal sym "flan_string_index"
|
||||||
|
|
||||||
and call_rt f ~sym ~args ~rty dst =
|
and call_rt f ~sym ~args ~rty dst =
|
||||||
call_native f ~sym ~chan:(rt_signals sym) ~args ~rty dst;
|
call_native f ~sym ~chan:(rt_signals sym) ~args ~rty dst;
|
||||||
|
|||||||
@ -1673,6 +1673,13 @@ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) {
|
|||||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* A String crossing into dyn: its (Vec u8), by address, copied into dyn text.
|
||||||
|
* A copy and not a view, because dyn text is immutable and a String is not. */
|
||||||
|
flan_dyn flan_dyn_from_string(const void *vec) {
|
||||||
|
const flan_dyn_vec_hdr *v = (const flan_dyn_vec_hdr *)vec;
|
||||||
|
return flan_dyn_from_bytes((const uint8_t *)v->ptr, v->len);
|
||||||
|
}
|
||||||
|
|
||||||
flan_dyn flan_dyn_vec_new(void) {
|
flan_dyn flan_dyn_vec_new(void) {
|
||||||
flan_obj *o = gc_alloc(OBJ_VEC, 0);
|
flan_obj *o = gc_alloc(OBJ_VEC, 0);
|
||||||
o->len = 0;
|
o->len = 0;
|
||||||
|
|||||||
@ -94,6 +94,8 @@ flan_dyn flan_dyn_from_bool(uint8_t b);
|
|||||||
* anywhere — a literal in .rodata, a frame slot, a slice the caller is about
|
* anywhere — a literal in .rodata, a frame slot, a slice the caller is about
|
||||||
* to drop — because the bytes are copied before this returns. */
|
* to drop — because the bytes are copied before this returns. */
|
||||||
flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n);
|
flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n);
|
||||||
|
/* A String's (Vec u8), by address, copied into dyn text. */
|
||||||
|
flan_dyn flan_dyn_from_string(const void *vec);
|
||||||
|
|
||||||
flan_dyn flan_dyn_vec_new(void);
|
flan_dyn flan_dyn_vec_new(void);
|
||||||
flan_dyn flan_dyn_map_new(void);
|
flan_dyn flan_dyn_map_new(void);
|
||||||
|
|||||||
@ -2796,6 +2796,208 @@ void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi,
|
|||||||
memcpy(out, &s, sizeof s);
|
memcpy(out, &s, sizeof s);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* ── String: the prelude's owned text, always valid UTF-8 ──────────────
|
||||||
|
*
|
||||||
|
* A String is a (Vec u8) the checker keeps valid (check.ml, [string_call]).
|
||||||
|
* These are the run-time halves of that: a text or a code point that could
|
||||||
|
* not be proved valid when the program was compiled is checked here, at the
|
||||||
|
* site of the append that would have stored it, and a bad one stops the
|
||||||
|
* program there. A trap and not a condition: nothing a handler could do
|
||||||
|
* makes the bytes valid, and storing them anyway is the one outcome the type
|
||||||
|
* exists to rule out. */
|
||||||
|
|
||||||
|
/* The index of the first byte that does not begin a well-formed UTF-8
|
||||||
|
* sequence, or -1. The rules are the prelude's decode-rune's: no overlong
|
||||||
|
* forms, no surrogates, nothing past U+10FFFF. */
|
||||||
|
static int64_t utf8_bad_at(const uint8_t *p, int64_t n) {
|
||||||
|
int64_t i = 0;
|
||||||
|
while (i < n) {
|
||||||
|
uint8_t b0 = p[i];
|
||||||
|
int size;
|
||||||
|
uint8_t lo = 0x80, hi = 0xbf;
|
||||||
|
if (b0 < 0x80) { i++; continue; }
|
||||||
|
if (b0 < 0xc2) return i;
|
||||||
|
else if (b0 <= 0xdf) size = 2;
|
||||||
|
else if (b0 == 0xe0) { size = 3; lo = 0xa0; }
|
||||||
|
else if (b0 <= 0xec) size = 3;
|
||||||
|
else if (b0 == 0xed) { size = 3; hi = 0x9f; }
|
||||||
|
else if (b0 <= 0xef) size = 3;
|
||||||
|
else if (b0 == 0xf0) { size = 4; lo = 0x90; }
|
||||||
|
else if (b0 <= 0xf3) size = 4;
|
||||||
|
else if (b0 == 0xf4) { size = 4; hi = 0x8f; }
|
||||||
|
else return i;
|
||||||
|
if (i + size > n) return i;
|
||||||
|
if (p[i + 1] < lo || p[i + 1] > hi) return i;
|
||||||
|
if (size > 2 && (p[i + 2] < 0x80 || p[i + 2] > 0xbf)) return i;
|
||||||
|
if (size > 3 && (p[i + 3] < 0x80 || p[i + 3] > 0xbf)) return i;
|
||||||
|
i += size;
|
||||||
|
}
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void flan_utf8_check(const uint8_t *p, int64_t n, const uint8_t *loc,
|
||||||
|
int64_t loclen) {
|
||||||
|
int64_t at = utf8_bad_at(p, n);
|
||||||
|
if (at < 0) return;
|
||||||
|
flan_say(loc, loclen,
|
||||||
|
"this text is not valid UTF-8 — byte %lld is 0x%02x — and a String "
|
||||||
|
"holds only valid UTF-8",
|
||||||
|
(long long)at, (unsigned)p[at]);
|
||||||
|
rt_trap((const uint8_t *)"InvalidUtf8", 11);
|
||||||
|
}
|
||||||
|
|
||||||
|
void flan_rune_check(int32_t c, const uint8_t *loc, int64_t loclen) {
|
||||||
|
if (c >= 0 && c <= 0x10ffff && !(c >= 0xd800 && c <= 0xdfff)) return;
|
||||||
|
flan_say(loc, loclen,
|
||||||
|
"%lld is not a Unicode scalar value, so it has no UTF-8 encoding "
|
||||||
|
"and a String cannot hold it",
|
||||||
|
(long long)c);
|
||||||
|
rt_trap((const uint8_t *)"InvalidRune", 11);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* [n] elements from [src] onto the end of a Vec, growing it once. [src] may
|
||||||
|
* point into the Vec's own block — (append s (str s)) — so where it lies is
|
||||||
|
* found before the grow and read again after it: the grow frees the old
|
||||||
|
* block. 1 when it fit, 0 when the allocator refused, as flan_vec_push. */
|
||||||
|
int8_t flan_vec_append(flan_vec *v, const void *src, int64_t n, int64_t size,
|
||||||
|
int64_t align, const uint8_t *loc, int64_t loclen) {
|
||||||
|
flan_vec_check(v, loc, loclen);
|
||||||
|
if (n <= 0) return 1;
|
||||||
|
if (v->len + n > v->cap) {
|
||||||
|
uintptr_t base = (uintptr_t)v->ptr, at = (uintptr_t)src;
|
||||||
|
int inside = v->ptr != NULL && at >= base
|
||||||
|
&& at < base + (uintptr_t)(v->cap * size);
|
||||||
|
uintptr_t off = at - base;
|
||||||
|
if (!flan_vec_grow(v, v->len + n, size, align)) return 0;
|
||||||
|
if (inside) src = (uint8_t *)v->ptr + off;
|
||||||
|
}
|
||||||
|
memmove((uint8_t *)v->ptr + v->len * size, src, (size_t)(n * size));
|
||||||
|
v->len += n;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void rt_reverse(uint8_t *p, int64_t n) {
|
||||||
|
int64_t i = 0, j = n - 1;
|
||||||
|
while (i < j) {
|
||||||
|
uint8_t t = p[i];
|
||||||
|
p[i++] = p[j];
|
||||||
|
p[j--] = t;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The same, stored at element [at] with the tail moved up. Appended and then
|
||||||
|
* rotated into place, three reversals, so a [src] inside the Vec's own block
|
||||||
|
* is never read after it has been moved. */
|
||||||
|
int8_t flan_vec_insert(flan_vec *v, int64_t at, const void *src, int64_t n,
|
||||||
|
int64_t size, int64_t align, const uint8_t *loc,
|
||||||
|
int64_t loclen) {
|
||||||
|
int64_t old;
|
||||||
|
uint8_t *b;
|
||||||
|
flan_vec_check(v, loc, loclen);
|
||||||
|
if (at < 0 || at > v->len) at = v->len;
|
||||||
|
old = v->len;
|
||||||
|
if (!flan_vec_append(v, src, n, size, align, loc, loclen)) return 0;
|
||||||
|
if (n <= 0 || at == old) return 1;
|
||||||
|
b = (uint8_t *)v->ptr + at * size;
|
||||||
|
rt_reverse(b, (old - at) * size);
|
||||||
|
rt_reverse(b + (old - at) * size, n * size);
|
||||||
|
rt_reverse(b, (old - at + n) * size);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* [n] elements from [at] out of a Vec, the rest moved down over them. Nothing
|
||||||
|
* is allocated, so nothing can fail but the stale-allocator check. */
|
||||||
|
void flan_vec_remove_range(flan_vec *v, int64_t at, int64_t n, int64_t size,
|
||||||
|
const uint8_t *loc, int64_t loclen) {
|
||||||
|
flan_vec_check(v, loc, loclen);
|
||||||
|
if (at < 0 || n <= 0 || at >= v->len) return;
|
||||||
|
if (n > v->len - at) n = v->len - at;
|
||||||
|
memmove((uint8_t *)v->ptr + at * size, (uint8_t *)v->ptr + (at + n) * size,
|
||||||
|
(size_t)((v->len - at - n) * size));
|
||||||
|
v->len -= n;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The width of the sequence a lead byte begins, for bytes already known to
|
||||||
|
* be valid UTF-8. */
|
||||||
|
static int64_t utf8_width(uint8_t b) {
|
||||||
|
return b < 0x80 ? 1 : b < 0xe0 ? 2 : b < 0xf0 ? 3 : 4;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* A character position in a String, as a byte offset. [past_end] says
|
||||||
|
* whether the position one past the last character is one — it is for an
|
||||||
|
* insert and not for a remove. Out of range signals BoundsError with the
|
||||||
|
* character count as the length, which is what the position was counted
|
||||||
|
* against, and with [xfer] for the caller's guard; with nothing answering it
|
||||||
|
* the program stops here. */
|
||||||
|
int64_t flan_string_index(flan_vec *v, int32_t i, int32_t past_end,
|
||||||
|
const uint8_t *loc, int64_t loclen, void *xfer) {
|
||||||
|
const uint8_t *p = (const uint8_t *)v->ptr;
|
||||||
|
int64_t off = 0, count = 0, want = i, found = -1;
|
||||||
|
flan_vec_check(v, loc, loclen);
|
||||||
|
while (off < v->len) {
|
||||||
|
if (count == want) found = off;
|
||||||
|
off += utf8_width(p[off]);
|
||||||
|
count++;
|
||||||
|
}
|
||||||
|
if (want == count && past_end) found = v->len;
|
||||||
|
if (want < 0 || found < 0) {
|
||||||
|
if (flan_bounds_signal(loc, loclen, xfer, BOUNDS_AT, want, want, count))
|
||||||
|
return 0;
|
||||||
|
flan_vec_bounds_fail(loc, loclen, want, count);
|
||||||
|
}
|
||||||
|
return found;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The code point at byte [off] of a String, removed. [off] came from
|
||||||
|
* flan_string_index, so it begins a sequence and the bytes are valid. */
|
||||||
|
int32_t flan_string_remove(flan_vec *v, int64_t off, const uint8_t *loc,
|
||||||
|
int64_t loclen) {
|
||||||
|
const uint8_t *p;
|
||||||
|
int64_t w;
|
||||||
|
int32_t c;
|
||||||
|
flan_vec_check(v, loc, loclen);
|
||||||
|
if (off < 0 || off >= v->len) return 0;
|
||||||
|
p = (const uint8_t *)v->ptr + off;
|
||||||
|
w = utf8_width(p[0]);
|
||||||
|
if (w == 1) c = p[0];
|
||||||
|
else if (w == 2) c = ((p[0] & 0x1f) << 6) | (p[1] & 0x3f);
|
||||||
|
else if (w == 3)
|
||||||
|
c = ((p[0] & 0x0f) << 12) | ((p[1] & 0x3f) << 6) | (p[2] & 0x3f);
|
||||||
|
else
|
||||||
|
c = ((p[0] & 0x07) << 18) | ((p[1] & 0x3f) << 12) | ((p[2] & 0x3f) << 6)
|
||||||
|
| (p[3] & 0x3f);
|
||||||
|
flan_vec_remove_range(v, off, w, 1, loc, loclen);
|
||||||
|
return c;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* A code point into a String at byte [off], -1 for the end: checked, encoded
|
||||||
|
* and stored. 1 when it fit, 0 when the allocator refused. */
|
||||||
|
int8_t flan_string_put_rune(flan_vec *v, int64_t off, int32_t c,
|
||||||
|
const uint8_t *loc, int64_t loclen) {
|
||||||
|
uint8_t b[4];
|
||||||
|
int64_t n;
|
||||||
|
flan_rune_check(c, loc, loclen);
|
||||||
|
if (c < 0x80) { b[0] = (uint8_t)c; n = 1; }
|
||||||
|
else if (c < 0x800) {
|
||||||
|
b[0] = (uint8_t)(0xc0 | (c >> 6));
|
||||||
|
b[1] = (uint8_t)(0x80 | (c & 0x3f));
|
||||||
|
n = 2;
|
||||||
|
} else if (c < 0x10000) {
|
||||||
|
b[0] = (uint8_t)(0xe0 | (c >> 12));
|
||||||
|
b[1] = (uint8_t)(0x80 | ((c >> 6) & 0x3f));
|
||||||
|
b[2] = (uint8_t)(0x80 | (c & 0x3f));
|
||||||
|
n = 3;
|
||||||
|
} else {
|
||||||
|
b[0] = (uint8_t)(0xf0 | (c >> 18));
|
||||||
|
b[1] = (uint8_t)(0x80 | ((c >> 12) & 0x3f));
|
||||||
|
b[2] = (uint8_t)(0x80 | ((c >> 6) & 0x3f));
|
||||||
|
b[3] = (uint8_t)(0x80 | (c & 0x3f));
|
||||||
|
n = 4;
|
||||||
|
}
|
||||||
|
if (off < 0) return flan_vec_append(v, b, n, 1, 1, loc, loclen);
|
||||||
|
return flan_vec_insert(v, off, b, n, 1, 1, loc, loclen);
|
||||||
|
}
|
||||||
|
|
||||||
/* spec-memory.md's first release point. The Vec is left zeroed rather than
|
/* spec-memory.md's first release point. The Vec is left zeroed rather than
|
||||||
* dangling: a later use of it is then a null deref rather than a
|
* dangling: a later use of it is then a null deref rather than a
|
||||||
* use-after-free, and a slice taken of it before the free is the dev
|
* use-after-free, and a slice taken of it before the free is the dev
|
||||||
|
|||||||
@ -114,7 +114,7 @@
|
|||||||
(let [f (split (bytes-view "delta,alpha,charlie,bravo") \,)]
|
(let [f (split (bytes-view "delta,alpha,charlie,bravo") \,)]
|
||||||
(sort-bytes (slice f))
|
(sort-bytes (slice f))
|
||||||
(let [j (join (slice f) (bytes-view " < "))]
|
(let [j (join (slice f) (bytes-view " < "))]
|
||||||
(println (str (slice j))) ; alpha < bravo < charlie < delta
|
(println j) ; alpha < bravo < charlie < delta
|
||||||
(free j))
|
(free j))
|
||||||
(free f))
|
(free f))
|
||||||
0)
|
0)
|
||||||
|
|||||||
@ -54,7 +54,7 @@
|
|||||||
(println (str a)))
|
(println (str a)))
|
||||||
(let [f (split (bytes-view "b,a,c") \,)]
|
(let [f (split (bytes-view "b,a,c") \,)]
|
||||||
(sort-bytes (slice f))
|
(sort-bytes (slice f))
|
||||||
(println (str (slice (join (slice f) (bytes-view "-"))))))
|
(println (join (slice f) (bytes-view "-"))))
|
||||||
(println (at r 0))
|
(println (at r 0))
|
||||||
(println (call-rd rd) (call-bare rd) (call-mk mk))
|
(println (call-rd rd) (call-bare rd) (call-mk mk))
|
||||||
(let [b (bytes "q")]
|
(let [b (bytes "q")]
|
||||||
|
|||||||
@ -11,7 +11,7 @@
|
|||||||
|
|
||||||
(defn show [x f64 p i32] ()
|
(defn show [x f64 p i32] ()
|
||||||
(let [v (format-f64 x p)]
|
(let [v (format-f64 x p)]
|
||||||
(println (str (slice v)))
|
(println v)
|
||||||
(free v)))
|
(free v)))
|
||||||
|
|
||||||
(defn main [] i32
|
(defn main [] i32
|
||||||
@ -86,15 +86,14 @@
|
|||||||
;; And the thing it is for: a formatted number inside a built string, which
|
;; And the thing it is for: a formatted number inside a built string, which
|
||||||
;; needs the integer part copied out before the fraction is rendered, because
|
;; needs the integer part copied out before the fraction is rendered, because
|
||||||
;; both come through the runtime's one shared scratch buffer.
|
;; both come through the runtime's one shared scratch buffer.
|
||||||
(let [b (vec-new u8)]
|
(let [b (string-new "fps ")]
|
||||||
(append (addr b) (bytes-view "fps "))
|
|
||||||
(let [f (format-f64 59.94 1)]
|
(let [f (format-f64 59.94 1)]
|
||||||
(append (addr b) (slice f))
|
(append b f)
|
||||||
(free f))
|
(free f))
|
||||||
(append (addr b) (bytes-view " / frame "))
|
(append b " / frame ")
|
||||||
(let [f (format-f64 0.0166667 4)]
|
(let [f (format-f64 0.0166667 4)]
|
||||||
(append (addr b) (slice f))
|
(append b f)
|
||||||
(free f))
|
(free f))
|
||||||
(println (str (slice b))) ; fps 59.9 / frame 0.0167
|
(println b) ; fps 59.9 / frame 0.0167
|
||||||
(free b))
|
(free b))
|
||||||
0)
|
0)
|
||||||
|
|||||||
@ -22,7 +22,7 @@
|
|||||||
;; fire -- what answers here is the byte loop, or the length check first
|
;; fire -- what answers here is the byte loop, or the length check first
|
||||||
;; ruling nothing out since both are three bytes.
|
;; ruling nothing out since both are three bytes.
|
||||||
(let [heap (to-lower (bytes-view "ABC"))]
|
(let [heap (to-lower (bytes-view "ABC"))]
|
||||||
(let [h (str (slice heap))]
|
(let [h (str heap)]
|
||||||
(println (= "abc" h)) ; true
|
(println (= "abc" h)) ; true
|
||||||
(println (!= "abc" h)))
|
(println (!= "abc" h)))
|
||||||
(free heap))
|
(free heap))
|
||||||
|
|||||||
9
test/programs/string-leak.flan
Normal file
9
test/programs/string-leak.flan
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
;;;; A dev build's registry names a String's block by its type: the one freed
|
||||||
|
;;;; is gone from the report at exit, the one kept is listed under String.
|
||||||
|
(defn main [] i32
|
||||||
|
(let [kept (string-new "kept")
|
||||||
|
gone (string-new "gone")]
|
||||||
|
(append kept " for good")
|
||||||
|
(free gone)
|
||||||
|
(println kept))
|
||||||
|
0)
|
||||||
64
test/programs/string-owned.flan
Normal file
64
test/programs/string-owned.flan
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
;;;; String: owned, growable, always valid UTF-8. Multi-byte append, insert
|
||||||
|
;;;; and remove by character position, iteration by runes, the byte length
|
||||||
|
;;;; beside the character count, a copy, printing inside a structure, and a
|
||||||
|
;;;; String crossing into dyn as a copy of its text.
|
||||||
|
|
||||||
|
(defstruct Named [label String n i32])
|
||||||
|
|
||||||
|
(defn as-dyn [d] dyn d)
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(let [s (string-new "héllo")]
|
||||||
|
(append s " wörld")
|
||||||
|
(append s 0x65e5) ; 日, three bytes
|
||||||
|
(append s \!)
|
||||||
|
(println s)
|
||||||
|
(println (length s) (rune-count s))
|
||||||
|
;; Positions are characters: 1 is after the h, whatever é takes.
|
||||||
|
(insert s 1 "→")
|
||||||
|
(insert s 0 0x1f600) ; four bytes at the front
|
||||||
|
(println s)
|
||||||
|
(println (remove s 2)) ; the → that was inserted, as a code point
|
||||||
|
(println (remove s 0)) ; the emoji
|
||||||
|
(println s)
|
||||||
|
;; Appending a String to itself reads the bytes it had before growing.
|
||||||
|
(let [t (string-new "ab")]
|
||||||
|
(append t t)
|
||||||
|
(append t t)
|
||||||
|
(println t (length t))
|
||||||
|
(free t))
|
||||||
|
;; Iteration by runes.
|
||||||
|
(let [it (runes s)
|
||||||
|
going true
|
||||||
|
n 0]
|
||||||
|
(while going
|
||||||
|
(match (runes-next (addr it))
|
||||||
|
(Some c) (do (when (> c 127) (print c "")) (set n (+ n 1)))
|
||||||
|
None (set going false)))
|
||||||
|
(println n))
|
||||||
|
;; A copy is independent of the original.
|
||||||
|
(let [c (clone s)]
|
||||||
|
(append c "?")
|
||||||
|
(println (length s) (length c))
|
||||||
|
(free c))
|
||||||
|
;; The str view and the byte view cost nothing.
|
||||||
|
(println (= (str s) "héllo wörld日!"))
|
||||||
|
(println (length (bytes-view s)))
|
||||||
|
;; Inside a structure it prints quoted, as a str field does.
|
||||||
|
(let [m (Named {.label (string-new "x") .n 3})]
|
||||||
|
(println m)
|
||||||
|
(free (.label m)))
|
||||||
|
;; Crossing into dyn copies the text, which the dyn side then owns.
|
||||||
|
(let [d (as-dyn s)]
|
||||||
|
(append s "tail")
|
||||||
|
(println d)
|
||||||
|
(println (type-of d)))
|
||||||
|
;; The builders answer Strings.
|
||||||
|
(let [j (join (slice [(bytes-view "a") (bytes-view "b")]) (bytes-view "-"))]
|
||||||
|
(println j)
|
||||||
|
(free j))
|
||||||
|
(let [e (string-new)]
|
||||||
|
(println (length e) (rune-count e))
|
||||||
|
(free e))
|
||||||
|
(free s))
|
||||||
|
0)
|
||||||
21
test/programs/string-traps.flan
Normal file
21
test/programs/string-traps.flan
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
;;;; What a String refuses at run time, one per run: the argument chooses.
|
||||||
|
;;;; Bytes that are not UTF-8, reached through a str, stop the program at the
|
||||||
|
;;;; append; so does a code point with no encoding; a character position past
|
||||||
|
;;;; the end signals BoundsError counted in characters. The test asserts the
|
||||||
|
;;;; line and column of each.
|
||||||
|
(defonce bad [2 u8])
|
||||||
|
|
||||||
|
(defn main [args [str]] i32
|
||||||
|
(let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0)
|
||||||
|
s (string-new "日本")]
|
||||||
|
(set (at bad 0) 0xc3)
|
||||||
|
(set (at bad 1) 0x28)
|
||||||
|
(println "before")
|
||||||
|
(cond
|
||||||
|
(= which 0) (append s (str (slice bad)))
|
||||||
|
(= which 1) (append s (+ 0xd800 which -1))
|
||||||
|
(= which 2) (insert s 3 "x")
|
||||||
|
(= which 3) (println (remove s 2))
|
||||||
|
:else (append s (bytes->string (let [v (vec-new u8)] (push v 0xff) v))))
|
||||||
|
(println s))
|
||||||
|
0)
|
||||||
@ -2,7 +2,8 @@
|
|||||||
;;;;
|
;;;;
|
||||||
;;;; Every one of these was refused by name in prelude.ml until there was an
|
;;;; Every one of these was refused by name in prelude.ml until there was an
|
||||||
;;;; allocator to return a Vec from, and this file is the corpus that says the
|
;;;; allocator to return a Vec from, and this file is the corpus that says the
|
||||||
;;;; refusals are lifted. The cases are chosen the way the slice-algorithm
|
;;;; refusals are lifted. The text builders answer a String; the builder at
|
||||||
|
;;;; the top is a (Vec u8) of raw bytes. The cases are chosen the way the slice-algorithm
|
||||||
;;;; tests were: each is an input a plausible wrong version gets wrong.
|
;;;; tests were: each is an input a plausible wrong version gets wrong.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Everything allocated here is freed, even though leaking is defined
|
;;;; Everything allocated here is freed, even though leaking is defined
|
||||||
@ -30,7 +31,7 @@
|
|||||||
;; trap.
|
;; trap.
|
||||||
(let [parts [(bytes-view "one") (bytes-view "") (bytes-view "two")]]
|
(let [parts [(bytes-view "one") (bytes-view "") (bytes-view "two")]]
|
||||||
(let [c (concat (slice parts 0 3))]
|
(let [c (concat (slice parts 0 3))]
|
||||||
(show (addr c)) ; onetwo
|
(println c) ; onetwo
|
||||||
(free c)))
|
(free c)))
|
||||||
(let [parts [(bytes-view "unused")]]
|
(let [parts [(bytes-view "unused")]]
|
||||||
(let [c (concat (slice parts 0 0))]
|
(let [c (concat (slice parts 0 0))]
|
||||||
@ -42,22 +43,22 @@
|
|||||||
;; chop the tail" join gets wrong because there is no tail.
|
;; chop the tail" join gets wrong because there is no tail.
|
||||||
(let [parts [(bytes-view "a") (bytes-view "b") (bytes-view "c")]]
|
(let [parts [(bytes-view "a") (bytes-view "b") (bytes-view "c")]]
|
||||||
(let [j (join (slice parts 0 3) (bytes-view ", "))]
|
(let [j (join (slice parts 0 3) (bytes-view ", "))]
|
||||||
(show (addr j)) ; a, b, c
|
(println j) ; a, b, c
|
||||||
(free j))
|
(free j))
|
||||||
(let [j (join (slice parts 0 1) (bytes-view ", "))]
|
(let [j (join (slice parts 0 1) (bytes-view ", "))]
|
||||||
(show (addr j)) ; a
|
(println j) ; a
|
||||||
(free j))
|
(free j))
|
||||||
(let [j (join (slice parts 0 0) (bytes-view ", "))]
|
(let [j (join (slice parts 0 0) (bytes-view ", "))]
|
||||||
(println (length j)) ; 0
|
(println (length j)) ; 0
|
||||||
(free j))
|
(free j))
|
||||||
;; An empty separator is concat.
|
;; An empty separator is concat.
|
||||||
(let [j (join (slice parts 0 3) (bytes-view ""))]
|
(let [j (join (slice parts 0 3) (bytes-view ""))]
|
||||||
(show (addr j)) ; abc
|
(println j) ; abc
|
||||||
(free j)))
|
(free j)))
|
||||||
|
|
||||||
;; repeat, including zero times.
|
;; repeat, including zero times.
|
||||||
(let [r (repeat-bytes (bytes-view "ab") 3)]
|
(let [r (repeat-bytes (bytes-view "ab") 3)]
|
||||||
(show (addr r)) ; ababab
|
(println r) ; ababab
|
||||||
(free r))
|
(free r))
|
||||||
(let [r (repeat-bytes (bytes-view "ab") 0)]
|
(let [r (repeat-bytes (bytes-view "ab") 0)]
|
||||||
(println (length r)) ; 0
|
(println (length r)) ; 0
|
||||||
@ -69,31 +70,31 @@
|
|||||||
;; through untouched, which is the range check a table-free version gets
|
;; through untouched, which is the range check a table-free version gets
|
||||||
;; wrong by shifting every byte.
|
;; wrong by shifting every byte.
|
||||||
(let [l (to-lower (bytes-view "Hello, World 42!"))]
|
(let [l (to-lower (bytes-view "Hello, World 42!"))]
|
||||||
(show (addr l)) ; hello, world 42!
|
(println l) ; hello, world 42!
|
||||||
(free l))
|
(free l))
|
||||||
(let [u (to-upper (bytes-view "Hello, World 42!"))]
|
(let [u (to-upper (bytes-view "Hello, World 42!"))]
|
||||||
(show (addr u)) ; HELLO, WORLD 42!
|
(println u) ; HELLO, WORLD 42!
|
||||||
(free u))
|
(free u))
|
||||||
|
|
||||||
;; replace. "aaa" with "aa" -> "b" is the non-overlapping rule: the answer is
|
;; replace. "aaa" with "aa" -> "b" is the non-overlapping rule: the answer is
|
||||||
;; "ba", because the match consumes both a's and the scan resumes after them.
|
;; "ba", because the match consumes both a's and the scan resumes after them.
|
||||||
(let [r (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b"))]
|
(let [r (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b"))]
|
||||||
(show (addr r)) ; ba
|
(println r) ; ba
|
||||||
(free r))
|
(free r))
|
||||||
;; A replacement longer than what it replaces, and one that is empty.
|
;; A replacement longer than what it replaces, and one that is empty.
|
||||||
(let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view " -- "))]
|
(let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view " -- "))]
|
||||||
(show (addr r)) ; a -- b -- c
|
(println r) ; a -- b -- c
|
||||||
(free r))
|
(free r))
|
||||||
(let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view ""))]
|
(let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view ""))]
|
||||||
(show (addr r)) ; abc
|
(println r) ; abc
|
||||||
(free r))
|
(free r))
|
||||||
;; No occurrence is a copy, and an empty `from` is a copy -- the reading
|
;; No occurrence is a copy, and an empty `from` is a copy -- the reading
|
||||||
;; where it matches everywhere is an infinite loop.
|
;; where it matches everywhere is an infinite loop.
|
||||||
(let [r (replace-bytes (bytes-view "abc") (bytes-view "z") (bytes-view "!"))]
|
(let [r (replace-bytes (bytes-view "abc") (bytes-view "z") (bytes-view "!"))]
|
||||||
(show (addr r)) ; abc
|
(println r) ; abc
|
||||||
(free r))
|
(free r))
|
||||||
(let [r (replace-bytes (bytes-view "abc") (bytes-view "") (bytes-view "!"))]
|
(let [r (replace-bytes (bytes-view "abc") (bytes-view "") (bytes-view "!"))]
|
||||||
(show (addr r)) ; abc
|
(println r) ; abc
|
||||||
(free r))
|
(free r))
|
||||||
|
|
||||||
;; split. n separators, n+1 fields, always -- so the trailing empty field is
|
;; split. n separators, n+1 fields, always -- so the trailing empty field is
|
||||||
@ -128,7 +129,7 @@
|
|||||||
;; would print the original string.
|
;; would print the original string.
|
||||||
(let [f (split (bytes-view "a,b,c") \,)]
|
(let [f (split (bytes-view "a,b,c") \,)]
|
||||||
(let [j (join (slice f) (bytes-view "/"))]
|
(let [j (join (slice f) (bytes-view "/"))]
|
||||||
(show (addr j)) ; a/b/c
|
(println j) ; a/b/c
|
||||||
(free j))
|
(free j))
|
||||||
(free f))
|
(free f))
|
||||||
|
|
||||||
@ -140,7 +141,7 @@
|
|||||||
(with-allocator a
|
(with-allocator a
|
||||||
(let [parts [(bytes-view "in") (bytes-view "arena")]]
|
(let [parts [(bytes-view "in") (bytes-view "arena")]]
|
||||||
(let [j (join (slice parts 0 2) (bytes-view "-"))]
|
(let [j (join (slice parts 0 2) (bytes-view "-"))]
|
||||||
(show (addr j)) ; in-arena
|
(println j) ; in-arena
|
||||||
;; The free is written because the binding is dead after it either
|
;; The free is written because the binding is dead after it either
|
||||||
;; way, and it keeps the block: an arena cannot release one, which
|
;; way, and it keeps the block: an arena cannot release one, which
|
||||||
;; is the difference the capability set exists to state. free-all
|
;; is the difference the capability set exists to state. free-all
|
||||||
|
|||||||
@ -18,7 +18,8 @@ fn letter?(c: u8) -> bool
|
|||||||
; The words of text, lowercased, in order.
|
; The words of text, lowercased, in order.
|
||||||
fn words(text: [const u8]) -> Vec([const u8])
|
fn words(text: [const u8]) -> Vec([const u8])
|
||||||
let out = vec-new([const u8])
|
let out = vec-new([const u8])
|
||||||
let lower = to-lower(text)
|
let lowered = to-lower(text)
|
||||||
|
let lower = bytes-view(lowered)
|
||||||
let i = 0
|
let i = 0
|
||||||
let n = length(lower)
|
let n = length(lower)
|
||||||
while :scan i < n
|
while :scan i < n
|
||||||
|
|||||||
@ -1942,6 +1942,74 @@ let () =
|
|||||||
strings_out;
|
strings_out;
|
||||||
outputs ~dev:true "string building, dev" "programs/strings.flan"
|
outputs ~dev:true "string building, dev" "programs/strings.flan"
|
||||||
strings_out;
|
strings_out;
|
||||||
|
(* String, the owned text: multi-byte append, insert and remove by
|
||||||
|
character position, runes, a copy, printing inside a struct, and the
|
||||||
|
crossing into dyn as a copy — the dyn value keeps the text it was given
|
||||||
|
while the String goes on growing. Every row prints the same bytes. *)
|
||||||
|
let owned_out =
|
||||||
|
"héllo wörld日!\n17 13\n😀h→éllo wörld日!\n8594\n128512\n\
|
||||||
|
héllo wörld日!\nabababab 8\n233 246 26085 13\n17 18\ntrue\n17\n\
|
||||||
|
(Named {.label \"x\" .n 3})\nhéllo wörld日!\n:text\na-b\n0 0\n"
|
||||||
|
in
|
||||||
|
outputs "an owned String" "programs/string-owned.flan" owned_out;
|
||||||
|
outputs ~opt:"-O0" "an owned String, -O0" "programs/string-owned.flan"
|
||||||
|
owned_out;
|
||||||
|
outputs ~x86:true "an owned String, --x86" "programs/string-owned.flan"
|
||||||
|
owned_out;
|
||||||
|
outputs ~dev:true "an owned String, dev" "programs/string-owned.flan"
|
||||||
|
owned_out;
|
||||||
|
(* What a String stops on at run time, at the site that would have stored
|
||||||
|
it: bytes that are not UTF-8 through a str and through bytes->string, a
|
||||||
|
code point with no encoding, and a character position past the end,
|
||||||
|
which is a BoundsError counted in characters. *)
|
||||||
|
let string_trap ?x86 () =
|
||||||
|
let exe = compile ?x86 "programs/string-traps.flan" in
|
||||||
|
List.iter
|
||||||
|
(fun (arg, want) ->
|
||||||
|
let code, text = run exe (Some arg) in
|
||||||
|
if code <> 134 || not (contains text want) then begin
|
||||||
|
incr failures;
|
||||||
|
Printf.printf
|
||||||
|
"FAIL a String's run-time refusal %s%s\n got: %S (exit \
|
||||||
|
%d)\n wanted: %S (exit 134)\n"
|
||||||
|
arg (match x86 with Some true -> ", --x86" | _ -> "")
|
||||||
|
text code want
|
||||||
|
end)
|
||||||
|
[ ("0", "string-traps.flan:15:19: this text is not valid UTF-8 — byte 0 \
|
||||||
|
is 0xc3");
|
||||||
|
("1", "string-traps.flan:16:19: 55296 is not a Unicode scalar value");
|
||||||
|
("2", "string-traps.flan:17:19: index 3 is out of bounds for length 2");
|
||||||
|
("3", "string-traps.flan:18:28: index 2 is out of bounds for length 2");
|
||||||
|
("4", "string-traps.flan:19:23: this text is not valid UTF-8 — byte 0 \
|
||||||
|
is 0xff") ];
|
||||||
|
(try Sys.remove exe with Sys_error _ -> ())
|
||||||
|
in
|
||||||
|
string_trap ();
|
||||||
|
string_trap ~x86:true ();
|
||||||
|
(* A dev build's registry reports a String kept to the end under its own
|
||||||
|
name, and the one freed not at all. *)
|
||||||
|
let string_leak ?x86 () =
|
||||||
|
let exe = compile ~dev:true ?x86 "programs/string-leak.flan" in
|
||||||
|
let out = exe ^ ".out" in
|
||||||
|
let code =
|
||||||
|
Sys.command
|
||||||
|
(Printf.sprintf "FLAN_DEV_LEAKS=1 %s > %s 2>&1" (Filename.quote exe)
|
||||||
|
(Filename.quote out))
|
||||||
|
in
|
||||||
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
||||||
|
(try Sys.remove out; Sys.remove exe with Sys_error _ -> ());
|
||||||
|
let want =
|
||||||
|
"kept for good\nflan: 1 block still held at exit, 16 bytes\n\
|
||||||
|
flan: 1 16 String\n"
|
||||||
|
in
|
||||||
|
if code <> 0 || text <> want then begin
|
||||||
|
incr failures;
|
||||||
|
Printf.printf "FAIL a String's leak report%s\n got: %S\n wanted: %S\n"
|
||||||
|
(match x86 with Some true -> ", --x86" | _ -> "") text want
|
||||||
|
end
|
||||||
|
in
|
||||||
|
string_leak ();
|
||||||
|
string_leak ~x86:true ();
|
||||||
(* Typed = and != on strings -- M2 queue item 5. Bytewise, with a
|
(* Typed = and != on strings -- M2 queue item 5. Bytewise, with a
|
||||||
length-mismatch fast path and a same-pointer fast path ahead of the
|
length-mismatch fast path and a same-pointer fast path ahead of the
|
||||||
byte loop (runtime/flan_rt.c, flan_str_eq), on both backends. Ordering
|
byte loop (runtime/flan_rt.c, flan_str_eq), on both backends. Ordering
|
||||||
|
|||||||
@ -2245,6 +2245,33 @@ let () =
|
|||||||
"(defn g [b [u8]] i32 (length b)) (defn f [s str] i32 (g (slice s)))"
|
"(defn g [b [u8]] i32 (length b)) (defn f [s str] i32 (g (slice s)))"
|
||||||
~needle:"expected [u8], found str";
|
~needle:"expected [u8], found str";
|
||||||
|
|
||||||
|
(* String keeps its bytes valid UTF-8, so every route to one byte of it is
|
||||||
|
refused, and each refusal names the character-position operations. *)
|
||||||
|
rejects_check "a String is not set by index"
|
||||||
|
"(defn f [s String] () (set (at s 0) 65))"
|
||||||
|
~needle:"a String cannot be changed one byte at a time";
|
||||||
|
rejects_check "a String's set by index names remove and insert"
|
||||||
|
"(defn f [s String] () (set (at s 0) 65))"
|
||||||
|
~needle:"(remove s i), then (insert s i c)";
|
||||||
|
rejects_check "a String is not read by index"
|
||||||
|
"(defn f [s String] u8 (at s 0))" ~needle:"(at (str s) i)";
|
||||||
|
rejects_check "a String's field is not reachable"
|
||||||
|
"(defn f [s String] i32 (length (.bytes s)))"
|
||||||
|
~needle:"a String keeps its bytes to itself";
|
||||||
|
rejects_check "a String is not built as a struct"
|
||||||
|
"(defn f [v (Vec u8)] String (String {.bytes v}))"
|
||||||
|
~needle:"a String keeps its bytes to itself";
|
||||||
|
rejects_check "bytes are not appended to a String unchecked"
|
||||||
|
"(defn f [s String b [u8]] () (append s b))" ~needle:"Write (str b)";
|
||||||
|
rejects_check "a literal surrogate is not a code point"
|
||||||
|
"(defn f [s String] () (append s 0xd800))"
|
||||||
|
~needle:"55296 is not a Unicode scalar value";
|
||||||
|
rejects_check "a String through a const pointer is not changed"
|
||||||
|
"(defn f [s (Ptr const String)] () (append s \"x\"))"
|
||||||
|
~needle:"can only be read";
|
||||||
|
accepts "a String through a pointer is changed"
|
||||||
|
"(defn f [s (Ptr String)] () (append s \"x\") (insert s 0 \\a))";
|
||||||
|
|
||||||
(* [const T]: a view that can only be read. Every route to a store through
|
(* [const T]: a view that can only be read. Every route to a store through
|
||||||
one is refused, and none of the reads is. *)
|
one is refused, and none of the reads is. *)
|
||||||
infers "a const slice slices to a const slice"
|
infers "a const slice slices to a const slice"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user