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

String is owned, growable, always-valid UTF-8 text over a (Vec u8), and the prelude's text builders return it.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 12:07:11 +07:00
parent ee6fa5297a
commit db67ab19b4
24 changed files with 1043 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO.org
View File

@ -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
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
CLOSED: [2026-09-26]
A str element reads as a copy and is never written, an aggregate element is written

22
docs/BUILT.md
View File

@ -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
literal indexed while the index runs, directly and through a struct literal's field. Without the pins every line
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`.

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

@ -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)
;; The package half of a qualified name, as `flan-mode' draws it.
("\\_<\\([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)
("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face)
;; A character literal, `\c' or `\space'.

4
emacs/flan-mode.el
View File

@ -164,6 +164,8 @@ face says.")
"alloc-live-blocks" "with-allocator"
;; Vec
"vec-new" "push" "reserve" "free" "clone"
;; String
"string-new" "bytes->string" "append" "insert" "remove" "runes" "rune-count"
;; Map
"map-new" "put" "get" "map-remove" "map-next" "has-key?"
;; 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
;; advertise a spelling the parser rejects, which is the same reason
;; `find-restart' and `await' are left out of `flan--special'.
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|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)
;; A type variable, `$t', which is what a generic `defn' names its
;; parameter types with and what `{:where (ordered? $t)}' constrains.

527
lib/check.ml
View File

@ -4046,6 +4046,30 @@ let refuse_frame_escapes (f : Tast.fn) =
if returns then
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 dyn sym args = rt loc Types.Dyn sym args in
let structs =
@ -4053,6 +4077,9 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr =
in
match e.Tast.ty with
| 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.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
@ -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
rest". Odin's positional literal takes the same line. *)
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 fields = s.Tast.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
what lets the decision be made against the tables, exactly. *)
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
| None when Hashtbl.mem ctx.env.gstructs name ->
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. *)
and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string =
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
| Types.Named n when has n -> t, 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 ->
if store then Option.iter (fun l -> refuse_string_place l ty) place;
Types.Int Types.U8
| Types.Named "String" ->
refuse_string_index i.Ast.loc ~store:(store && place <> None)
| other ->
fail i.Ast.loc "%s cannot be indexed" (tyname i.Ast.loc other)
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
[(set (at v i) x)] come through here, so they cannot drift apart — which is
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) =
let elem = vec_elem loc "at" target.Tast.ty in
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)))) ],
[ 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
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. *)
@ -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 \
runtime's";
expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_vec_new" [])
end else begin
let a = allocator_arg ctx loc args 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
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
end else
expect ctx loc ~want (vec_init ctx loc elem (allocator_arg ctx loc args))
(* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
| "push" ->
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
[free-all] to point at. *)
(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 _)
when region_only ctx.env target.Tast.ty ->
fail loc
@ -11749,6 +12138,26 @@ and named_call ?(qualified = false) ctx ~want loc name args =
let target = check_target ctx target in
let a = allocator_arg ctx loc rest in
(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 distinction is worth being exact about, because the sentence
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) ]))))
| _ -> 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 ─────────────────────────────────── *)
(* 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
@ -12422,6 +12838,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
| Types.Vec _ ->
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 ])))
(* 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
[length] were extended over Vec: one question, one word. *)
| 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 ])))
| other ->
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))
| "at" ->
(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. *)
| "bytes-view" ->
arity ctx loc name 1 args;
prim Tast.Bytes (Types.Slice (Types.Const, Types.Int Types.U8))
[ check ctx ~want:Types.String (List.hd args) ]
let a = maybe_string ctx ~otherwise:Types.String (List.hd args) in
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
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. *)
| "str" ->
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" ->
arity ctx loc name 1 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
| Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
[ 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
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))]
@ -14566,13 +15001,13 @@ let builtins : (string * string * string) list =
"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 \
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 \
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) \
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.");
("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 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 \
@ -14583,6 +15018,36 @@ let builtins : (string * string * string) list =
elements own storage, because pushing them as they stand would share \
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-new", "map-new [K? V? Allocator?] (Map K V)",
"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.");
(* 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, \
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",
"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 \
@ -14696,13 +15162,14 @@ let builtins : (string * string * string) list =
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, \
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 \
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 \
copy.");
("str", "str [[const u8]] str",
"A byte slice seen as a str, and free at run time. It does not check \
("str", "str [[const u8]|String] str",
"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 \
ordinary function you call when you care.");
("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes.");

12
lib/emit.ml
View File

@ -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]. *)
let signals =
String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice"
|| String.equal sym "flan_string_index"
in
let vs = if signals then vs @ [ "ptr " ^ xfer_param ] else 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_bool(i32)
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_map_new()
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 void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64, ptr)
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
; hash and equality pair, which the checker emits per key type and passes here
; the way Odin hangs them off Map_Info.

4
lib/inspect.ml
View File

@ -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. *)
| Types.Bool -> put b (if u8 c addr land 1 <> 0 then "true" else "false")
| 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
(* 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. *)

83
lib/prelude.ml
View File

@ -1705,7 +1705,7 @@ let source = {flan|
;; rules that hold for all of it.
;;
;; **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,
;; 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.
@ -1724,18 +1724,36 @@ let source = {flan|
;; (spec-memory.md, "Allocation failure"), so these signatures say what they
;; produce and nothing about how they might fail.
;; The builder. It is not a type: strings.Builder in Odin is a struct wrapping
;; a [dynamic]u8, and here the (Vec u8) *is* that, with push already on it — a
;; wrapper would be a move-only struct owning a Vec whose only method is the
;; one the Vec already has. What was actually missing is appending a run of
;; bytes rather than one, and that is this.
;; String: owned, growable, always valid UTF-8. The bytes live in a (Vec u8),
;; so the allocator, the free, the retry on exhaustion and the dev build's
;; registry are all the Vec's. What the struct adds is the promise, and the
;; checker keeps it (check.ml, [string_call]): outside this file the field
;; 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
;; style: a Vec parameter *moves*, so (append b s) taking one by value would
;; consume the caller's builder on the first call and refuse the second.
(defn append [b (Ptr (Vec u8)) s [const u8]] ()
(dotimes [i (length s)]
(push (deref b) (at s i))))
;; A zeroed String is the empty one: a zeroed Vec adopts the context
;; allocator on its first append.
(defstruct String [bytes (Vec u8)])
;; A cursor over the code points of some UTF-8 bytes, which owns nothing: the
;; 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
;; 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
;; the empty (bytes-view "") a caller would have to write is the kind of argument
;; that reads like a mistake at the call site.
(defn concat [parts [const [const u8]]] (Vec u8)
(defn concat [parts [const [const u8]]] String
(let [b (vec-new u8)]
(dotimes [i (length parts)]
(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
;; result rather than a leading separator — which is the off-by-one a join
;; written as "append part then separator, then chop the tail" gets wrong on
;; exactly that input, because there is no tail to chop.
(defn join [parts [const [const u8]] sep [const u8]] (Vec u8)
(defn join [parts [const [const u8]] sep [const u8]] String
(let [b (vec-new u8)]
(dotimes [i (length parts)]
(when (> i 0)
(append (addr b) sep))
(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)]
(dotimes [i n]
(append (addr b) s))
b))
(bytes->string b)))
;; 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.
(defn to-lower [s [const u8]] (Vec u8)
(defn to-lower [s [const u8]] String
(let [b (vec-new u8)]
(dotimes [i (length s)]
(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)]
(dotimes [i (length s)]
(push b (upper-ascii (at s i))))
b))
(bytes->string b)))
;; 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
@ -1806,7 +1824,7 @@ let source = {flan|
;; choice: returning a Vec *moves* it, and the move analysis is a dead set over
;; the whole function, so a `return b` on one branch kills the binding for the
;; `b` at the foot of the other. One exit, one move.
(defn replace-bytes [s [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)
i 0]
(if (= (length from) 0)
@ -1822,7 +1840,7 @@ let source = {flan|
(do
(append (addr b) (slice s 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
;; 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
;; 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)
p (clamp prec 0 9)]
(cond
@ -1942,7 +1960,7 @@ let source = {flan|
(dotimes [i (- p (length d))]
(push b \0))
(append (addr b) d))))))))
b))
(bytes->string b)))
;; ── 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
;; 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
;; and replace are all written now, and `string-from-bytes` turned out to be
;; the `str` builtin all along — (str (slice v)) is the round trip,
;; and the layouts being identical is exactly why it is free.
;; and replace are all written now. Bytes become text two ways: (str (slice v))
;; views them, free and unchecked, and (bytes->string v) takes the Vec over
;; 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
;; named separately rather than under one heading.
@ -1975,12 +1993,7 @@ let source = {flan|
;; per *ordered pair* of types rather than per type,
;; which is where a per-type family stops being honest.
;;
;; Builder Not refused — declined. strings.Builder in Odin
;; 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.
;; Builder A String is one: append onto it.
;; ── Files: embedding, slurp and barf ──────────────────────────────────
;;
;; One entry per file in an (embed-dir "...") — Odin's Load_Directory_File

23
lib/render.ml
View 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)
c.unions ->
[ 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 ->
(match
List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname n)

1
lib/x86.ml
View File

@ -3170,6 +3170,7 @@ and clear_at f =
is where [(at v i)] gets what [(at arr i)] gets from [check_at]. *)
and rt_signals sym =
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 =
call_native f ~sym ~chan:(rt_signals sym) ~args ~rty dst;

7
runtime/flan_dyn.c
View File

@ -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);
}
/* 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_obj *o = gc_alloc(OBJ_VEC, 0);
o->len = 0;

2
runtime/flan_dyn.h
View File

@ -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
* to drop — because the bytes are copied before this returns. */
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_map_new(void);

202
runtime/flan_rt.c
View File

@ -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);
}
/* ── 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
* 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

2
test/programs/algorithms.flan
View File

@ -114,7 +114,7 @@
(let [f (split (bytes-view "delta,alpha,charlie,bravo") \,)]
(sort-bytes (slice f))
(let [j (join (slice f) (bytes-view " < "))]
(println (str (slice j))) ; alpha < bravo < charlie < delta
(println j) ; alpha < bravo < charlie < delta
(free j))
(free f))
0)

2
test/programs/const-slice.flan
View File

@ -54,7 +54,7 @@
(println (str a)))
(let [f (split (bytes-view "b,a,c") \,)]
(sort-bytes (slice f))
(println (str (slice (join (slice f) (bytes-view "-"))))))
(println (join (slice f) (bytes-view "-"))))
(println (at r 0))
(println (call-rd rd) (call-bare rd) (call-mk mk))
(let [b (bytes "q")]

13
test/programs/format.flan
View File

@ -11,7 +11,7 @@
(defn show [x f64 p i32] ()
(let [v (format-f64 x p)]
(println (str (slice v)))
(println v)
(free v)))
(defn main [] i32
@ -86,15 +86,14 @@
;; 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
;; both come through the runtime's one shared scratch buffer.
(let [b (vec-new u8)]
(append (addr b) (bytes-view "fps "))
(let [b (string-new "fps ")]
(let [f (format-f64 59.94 1)]
(append (addr b) (slice f))
(append b f)
(free f))
(append (addr b) (bytes-view " / frame "))
(append b " / frame ")
(let [f (format-f64 0.0166667 4)]
(append (addr b) (slice f))
(append b f)
(free f))
(println (str (slice b))) ; fps 59.9 / frame 0.0167
(println b) ; fps 59.9 / frame 0.0167
(free b))
0)

2
test/programs/string-eq.flan
View File

@ -22,7 +22,7 @@
;; fire -- what answers here is the byte loop, or the length check first
;; ruling nothing out since both are three bytes.
(let [heap (to-lower (bytes-view "ABC"))]
(let [h (str (slice heap))]
(let [h (str heap)]
(println (= "abc" h)) ; true
(println (!= "abc" h)))
(free heap))

9
test/programs/string-leak.flan Normal file
View 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
View 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
View 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)

31
test/programs/strings.flan
View File

@ -2,7 +2,8 @@
;;;;
;;;; 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
;;;; 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.
;;;;
;;;; Everything allocated here is freed, even though leaking is defined
@ -30,7 +31,7 @@
;; trap.
(let [parts [(bytes-view "one") (bytes-view "") (bytes-view "two")]]
(let [c (concat (slice parts 0 3))]
(show (addr c)) ; onetwo
(println c) ; onetwo
(free c)))
(let [parts [(bytes-view "unused")]]
(let [c (concat (slice parts 0 0))]
@ -42,22 +43,22 @@
;; chop the tail" join gets wrong because there is no tail.
(let [parts [(bytes-view "a") (bytes-view "b") (bytes-view "c")]]
(let [j (join (slice parts 0 3) (bytes-view ", "))]
(show (addr j)) ; a, b, c
(println j) ; a, b, c
(free j))
(let [j (join (slice parts 0 1) (bytes-view ", "))]
(show (addr j)) ; a
(println j) ; a
(free j))
(let [j (join (slice parts 0 0) (bytes-view ", "))]
(println (length j)) ; 0
(free j))
;; An empty separator is concat.
(let [j (join (slice parts 0 3) (bytes-view ""))]
(show (addr j)) ; abc
(println j) ; abc
(free j)))
;; repeat, including zero times.
(let [r (repeat-bytes (bytes-view "ab") 3)]
(show (addr r)) ; ababab
(println r) ; ababab
(free r))
(let [r (repeat-bytes (bytes-view "ab") 0)]
(println (length r)) ; 0
@ -69,31 +70,31 @@
;; through untouched, which is the range check a table-free version gets
;; wrong by shifting every byte.
(let [l (to-lower (bytes-view "Hello, World 42!"))]
(show (addr l)) ; hello, world 42!
(println l) ; hello, world 42!
(free l))
(let [u (to-upper (bytes-view "Hello, World 42!"))]
(show (addr u)) ; HELLO, WORLD 42!
(println u) ; HELLO, WORLD 42!
(free u))
;; 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.
(let [r (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b"))]
(show (addr r)) ; ba
(println r) ; ba
(free r))
;; 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 " -- "))]
(show (addr r)) ; a -- b -- c
(println r) ; a -- b -- c
(free r))
(let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view ""))]
(show (addr r)) ; abc
(println r) ; abc
(free r))
;; No occurrence is a copy, and an empty `from` is a copy -- the reading
;; where it matches everywhere is an infinite loop.
(let [r (replace-bytes (bytes-view "abc") (bytes-view "z") (bytes-view "!"))]
(show (addr r)) ; abc
(println r) ; abc
(free r))
(let [r (replace-bytes (bytes-view "abc") (bytes-view "") (bytes-view "!"))]
(show (addr r)) ; abc
(println r) ; abc
(free r))
;; split. n separators, n+1 fields, always -- so the trailing empty field is
@ -128,7 +129,7 @@
;; would print the original string.
(let [f (split (bytes-view "a,b,c") \,)]
(let [j (join (slice f) (bytes-view "/"))]
(show (addr j)) ; a/b/c
(println j) ; a/b/c
(free j))
(free f))
@ -140,7 +141,7 @@
(with-allocator a
(let [parts [(bytes-view "in") (bytes-view "arena")]]
(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
;; way, and it keeps the block: an arena cannot release one, which
;; is the difference the capability set exists to state. free-all

3
test/syntax/handwritten/words.fln
View File

@ -18,7 +18,8 @@ fn letter?(c: u8) -> bool
; The words of text, lowercased, in order.
fn words(text: [const u8]) -> Vec([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 n = length(lower)
while :scan i < n

68
test/test_acceptance.ml
View File

@ -1942,6 +1942,74 @@ let () =
strings_out;
outputs ~dev:true "string building, dev" "programs/strings.flan"
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
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

27
test/test_flan.ml
View File

@ -2245,6 +2245,33 @@ let () =
"(defn g [b [u8]] i32 (length b)) (defn f [s str] i32 (g (slice s)))"
~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
one is refused, and none of the reads is. *)
infers "a const slice slices to a const slice"