Merge branch 'master' into worktree-agent-a5e429a5bd331edd4
This commit is contained in:
commit
aa6a007c7e
23
TODO.org
23
TODO.org
@ -30,10 +30,25 @@ index out of range (negative included), one index per dimension. Both typed and
|
||||
Decided 2026-09-25: the typed read-only text is =str= (the rename from =string= is
|
||||
done; =string= is refused with the fix); =String= is new, owned, growable, always valid UTF-8, through an allocator. The prelude's text
|
||||
builders return =String=; =(Vec u8)= stays for raw bytes. Text is UTF-8 everywhere and
|
||||
a character is a code point; dyn gets a character tag, so \\I prints as \\I.
|
||||
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.
|
||||
a character is a code point; length and indexing count bytes on str. Waits on the
|
||||
dyn-unless-annotated design.
|
||||
|
||||
** DONE Dyn has a char, and dyn text counts characters
|
||||
CLOSED: [2026-09-26]
|
||||
Only a char literal, =at= on a text and =chars= make one, and it prints as its
|
||||
literal, bare too, a control character as \\uXXXX. Into any integer width it gives its
|
||||
code point where that fits, into a byte only when ASCII; a dyn int into any width is
|
||||
range-checked, while a cast on either wraps as a typed cast does. length, at and slice
|
||||
on dyn text count code points, a malformed byte counting as one U+FFFD. A non-ASCII
|
||||
literal defaults to i32 and is refused where a byte is wanted. Rules out char
|
||||
arithmetic, a typed code point turning into a char, and byte offsets on dyn text.
|
||||
|
||||
** 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); a prelude builder's String is checked at the caller's call. = and != compare bytes.
|
||||
Rules out a String type in the backends, s[i] = c, a String map key, and a byte path that skips the check.
|
||||
|
||||
** DONE Any typed container crosses into dyn as a view
|
||||
CLOSED: [2026-09-26]
|
||||
|
||||
@ -7524,3 +7524,30 @@ 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. A direct call to a prelude function that answers a String has its text
|
||||
arguments checked before the call, at the caller's line (`prechecked_call`);
|
||||
each builder still ends in `(bytes->string b)`, the backstop for one reached
|
||||
through a function value, which stops at the prelude's line.
|
||||
`=` and `!=` compare a String with a String or a str through their str views;
|
||||
`peeks_string` decides that from the operands' declared types without checking
|
||||
them twice. Ordering and map keys are refused with the fix named.
|
||||
|
||||
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`.
|
||||
|
||||
@ -1888,7 +1888,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'.
|
||||
|
||||
@ -165,6 +165,10 @@ reply without a daemon behind them, and so that this file names
|
||||
(defun flan-inspect--read-atom (s i)
|
||||
"Read a bare token at I: a number, a keyword, `true', `none', `...'."
|
||||
(let ((start i))
|
||||
;; A char, \x: the character after the backslash is taken whatever it
|
||||
;; is, so \) and \] do not close the sequence they sit in.
|
||||
(when (and (eq (aref s i) ?\\) (< (1+ i) (length s)))
|
||||
(setq i (+ i 2)))
|
||||
(while (and (< i (length s))
|
||||
(not (memq (aref s i) '(?\s ?\n ?\t ?\) ?\] ?\}))))
|
||||
(setq i (1+ i)))
|
||||
|
||||
@ -166,6 +166,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
|
||||
@ -255,7 +257,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.
|
||||
|
||||
@ -98,6 +98,14 @@
|
||||
(test-flan--check "indexed from zero"
|
||||
(equal (mapcar #'car (plist-get n :children)) '(0 1 2))))
|
||||
|
||||
;; A dyn vec of chars, as runtime/flan_dyn.c's [char_spell] writes one: \)
|
||||
;; and \] are chars, not closers.
|
||||
(let ((n (flan-inspect-parse "[\\a \\) \\] \\日 \\space]")))
|
||||
(test-flan--check "a char is one element, whatever follows the backslash"
|
||||
(equal (mapcar (lambda (k) (plist-get (cdr k) :text))
|
||||
(plist-get n :children))
|
||||
'("\\a" "\\)" "\\]" "\\日" "\\space"))))
|
||||
|
||||
;; [[0 0] [1 ...] ...] — span truncation at both levels, which is what
|
||||
;; sand's [100 [100 u32]] actually produces.
|
||||
(let* ((n (flan-inspect-parse "[[0 0] [1 ...] ...]"))
|
||||
|
||||
792
lib/check.ml
792
lib/check.ml
File diff suppressed because it is too large
Load Diff
19
lib/emit.ml
19
lib/emit.ml
@ -4089,6 +4089,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
|
||||
@ -5055,6 +5056,10 @@ 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_char(i32)
|
||||
declare i64 @flan_dyn_chars(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_text(i64, 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)
|
||||
@ -5125,6 +5130,9 @@ declare ptr @flan_dev_literal(ptr, i64)
|
||||
declare i64 @flan_dyn_need_i64(i64)
|
||||
declare double @flan_dyn_need_f64(i64)
|
||||
declare i32 @flan_dyn_need_bool(i64)
|
||||
declare i32 @flan_dyn_need_i32(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_need_int(i64, i32, ptr, i64)
|
||||
declare i64 @flan_dyn_int_of(i64)
|
||||
; A numeric cast written on a dyn answers which numeric tag the box holds;
|
||||
; check.ml's [cast_dyn] branches on it and each arm is an ordinary need plus
|
||||
; the ordinary cast. The two slices are the site's location and the target's
|
||||
@ -5169,6 +5177,17 @@ 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_utf8_check_parts(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.
|
||||
|
||||
@ -191,7 +191,10 @@ let rec unmarshal ~(sites : sites) ~loc (p : Dynload.addr) : Form.t =
|
||||
| _ -> Form.make (Form.Int i) loc)
|
||||
| TFloat -> Form.make (Form.Float (Dynload.peek_f64 p payload)) loc
|
||||
| TByte ->
|
||||
Form.make (Form.Byte (Int32.to_int (Dynload.peek_i32 p payload) land 0xff)) loc
|
||||
(* A char is a code point; anything that is not a scalar value keeps the
|
||||
byte it always was. *)
|
||||
let b = Int32.to_int (Dynload.peek_i32 p payload) in
|
||||
Form.make (Form.Byte (if Uchar.is_valid b then b else b land 0xff)) loc
|
||||
| TSym -> Form.make (Form.Sym (str ())) (here ())
|
||||
| TKw -> Form.make (Form.Kw (str ())) (here ())
|
||||
| TStr -> Form.make (Form.Str (str ())) (here ())
|
||||
|
||||
51
lib/form.ml
51
lib/form.ml
@ -18,7 +18,7 @@ and value =
|
||||
| UInt of int64 * string
|
||||
| Float of float (* 0.05 *)
|
||||
| Str of string (* "SAND" *)
|
||||
| Byte of int (* \space \0 \( (0..255) *)
|
||||
| Byte of int (* \space \0 \( \é a code point, a char *)
|
||||
| List of t list (* (f x) *)
|
||||
| Vec of t list (* [1 2 3] and every binding/type bracket *)
|
||||
| Map of t list (* {.field v} a struct value, and a defn's
|
||||
@ -28,6 +28,29 @@ and value =
|
||||
|
||||
let make v loc = { v; loc }
|
||||
|
||||
(* A code point's UTF-8 bytes. *)
|
||||
let utf8 b =
|
||||
let buf = Buffer.create 4 in
|
||||
Buffer.add_utf_8_uchar buf (Uchar.of_int b);
|
||||
Buffer.contents buf
|
||||
|
||||
(* A char's spelling, the one [Reader.read_byte] reads back as the same code
|
||||
point: a name where the reader has one, Clojure's \uXXXX for every other
|
||||
control character (C0, DEL and C1), and the character itself otherwise.
|
||||
runtime/flan_dyn.c's [char_spell] writes the same table. *)
|
||||
let byte_repr b =
|
||||
match b with
|
||||
| 32 -> "\\space"
|
||||
| 9 -> "\\tab"
|
||||
| 10 -> "\\newline"
|
||||
| 13 -> "\\return"
|
||||
| 0 -> "\\nul"
|
||||
| 8 -> "\\backspace"
|
||||
| 12 -> "\\formfeed"
|
||||
| b when b < 32 || (b >= 127 && b <= 0x9F) -> Printf.sprintf "\\u%04X" b
|
||||
| b when b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
|
||||
| b -> "\\" ^ utf8 b
|
||||
|
||||
let rec to_string f =
|
||||
let seq l = String.concat " " (List.map to_string l) in
|
||||
match f.v with
|
||||
@ -37,12 +60,7 @@ let rec to_string f =
|
||||
| UInt (_, s) -> s
|
||||
| Float x -> Printf.sprintf "%g" x
|
||||
| Str s -> Printf.sprintf "%S" s
|
||||
| Byte b ->
|
||||
(match Char.chr b with
|
||||
| ' ' -> "\\space"
|
||||
| '\t' -> "\\tab"
|
||||
| '\n' -> "\\newline"
|
||||
| c -> Printf.sprintf "\\%c" c)
|
||||
| Byte b -> byte_repr b
|
||||
| List l -> "(" ^ seq l ^ ")"
|
||||
| Vec l -> "[" ^ seq l ^ "]"
|
||||
| Map l -> "{" ^ seq l ^ "}"
|
||||
@ -70,9 +88,8 @@ let rec to_string f =
|
||||
- [%S] is OCaml's escaping. The reader takes exactly six escapes — newline,
|
||||
tab, return, backslash, quote and nul — and every other byte literally,
|
||||
so the three-digit decimal escape [%S] writes would not read back.
|
||||
- [Byte] falls through to \<char>, which spells 0 and 13 as a NUL and a
|
||||
carriage return sitting in the middle of the source. The reader has names
|
||||
for those and this uses them. *)
|
||||
- A control character written as itself is a raw byte in the middle of
|
||||
the source. [byte_repr] names it, or writes \uXXXX. *)
|
||||
|
||||
let escape s =
|
||||
let b = Buffer.create (String.length s + 2) in
|
||||
@ -110,20 +127,6 @@ let float_repr x =
|
||||
in
|
||||
if plain then s ^ ".0" else s
|
||||
|
||||
let byte_repr b =
|
||||
match b with
|
||||
| 32 -> "\\space"
|
||||
| 9 -> "\\tab"
|
||||
| 10 -> "\\newline"
|
||||
| 13 -> "\\return"
|
||||
| 0 -> "\\nul"
|
||||
(* Printable ASCII is written as itself. Anything else has no spelling in
|
||||
the reader at all — [read_byte] takes a name or a single character — so
|
||||
it is written as the decimal the reader would have to grow, rather than
|
||||
as a byte that would corrupt the line it is on. *)
|
||||
| b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
|
||||
| b -> Printf.sprintf "\\%d" b
|
||||
|
||||
(** One line, and a reader reads it back. *)
|
||||
let rec to_source f =
|
||||
let seq l = String.concat " " (List.map to_source l) in
|
||||
|
||||
@ -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. *)
|
||||
|
||||
@ -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.
|
||||
@ -1719,23 +1719,47 @@ let source = {flan|
|
||||
;; writes (with-allocator a (join parts sep)) and the Vec records the arena, so
|
||||
;; the free and the clone never need it named again.
|
||||
;;
|
||||
;; **The text builders check what they answer**, with (bytes->string b), and
|
||||
;; that check stops the program at this file's line. A call the program writes
|
||||
;; is checked first, at its own line, on the text it passes (check.ml,
|
||||
;; [prechecked_call]); the check here is for a builder reached through a
|
||||
;; function value, which has no call site to check at.
|
||||
;;
|
||||
;; **No Result, anywhere.** Running out of storage signals StorageExhausted
|
||||
;; under a `retry` restart and no allocating operation returns an error
|
||||
;; (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 +1779,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 +1830,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 +1846,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 +1919,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 +1966,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 +1974,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 +1999,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
|
||||
|
||||
@ -113,7 +113,8 @@ let read_string st =
|
||||
go ();
|
||||
spanned st loc (Form.Str (Buffer.contents buf))
|
||||
|
||||
(* \space \tab \newline \return \nul, or \<any single char> *)
|
||||
(* \space \tab \newline \return \nul \backspace \formfeed, Clojure's \uXXXX
|
||||
(four hex digits), or \<any single char> *)
|
||||
let read_byte st =
|
||||
let loc = here st in
|
||||
advance st; (* backslash *)
|
||||
@ -128,7 +129,23 @@ let read_byte st =
|
||||
| "newline" -> 10
|
||||
| "return" -> 13
|
||||
| "nul" -> 0
|
||||
| "backspace" -> 8
|
||||
| "formfeed" -> 12
|
||||
| n when String.length n = 1 -> Char.code n.[0]
|
||||
| n when String.length n = 5 && n.[0] = 'u'
|
||||
&& String.for_all
|
||||
(function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false)
|
||||
(String.sub n 1 4) ->
|
||||
let c = int_of_string ("0x" ^ String.sub n 1 4) in
|
||||
if not (Uchar.is_valid c) then
|
||||
Loc.failk "reader/unknown-character" loc
|
||||
"\\%s is a surrogate, which is not a character" n;
|
||||
c
|
||||
(* One code point written as itself, UTF-8 in the source: \é \日. *)
|
||||
| n when (let d = String.get_utf_8_uchar n 0 in
|
||||
Uchar.utf_decode_is_valid d
|
||||
&& Uchar.utf_decode_length d = String.length n) ->
|
||||
Uchar.to_int (Uchar.utf_decode_uchar (String.get_utf_8_uchar n 0))
|
||||
| n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n
|
||||
in
|
||||
spanned st loc (Form.Byte code)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -3196,6 +3196,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;
|
||||
|
||||
@ -211,6 +211,9 @@ typedef struct flan_desc {
|
||||
* name are the same word, so equality is the identity compare [dyn_equal]
|
||||
* already opens with, never a memcmp. */
|
||||
#define BOX_KW 4u
|
||||
/* A character: the payload is its code point, a Unicode scalar value, so two
|
||||
* equal chars are the same word and nothing about one is ever allocated. */
|
||||
#define BOX_CHAR 5u
|
||||
|
||||
/* Restated from flan_dyn.h — a view's element kind. */
|
||||
#define FLAN_VIEW_I64 0
|
||||
@ -526,7 +529,8 @@ static unsigned ring_at;
|
||||
* somebody can act on and "tag 2 and tag 4" is a puzzle. */
|
||||
|
||||
static const char *const tag_words[] = { "nil", "bool", "int", "float",
|
||||
"text", "vec", "keyword", "map" };
|
||||
"text", "vec", "keyword", "map",
|
||||
"char" };
|
||||
|
||||
#define FLAN_DYN_TAG_NIL 0
|
||||
#define FLAN_DYN_TAG_BOOL 1
|
||||
@ -536,6 +540,8 @@ static const char *const tag_words[] = { "nil", "bool", "int", "float",
|
||||
#define FLAN_DYN_TAG_VEC 5
|
||||
#define FLAN_DYN_TAG_KEYWORD 6
|
||||
#define FLAN_DYN_TAG_MAP 7
|
||||
#define FLAN_DYN_TAG_CHAR 8
|
||||
#define FLAN_DYN_TAG_LAST FLAN_DYN_TAG_CHAR
|
||||
|
||||
static inline flan_obj *dyn_obj(flan_dyn v) {
|
||||
return (flan_obj *)(uintptr_t)dyn_payload(v);
|
||||
@ -562,6 +568,7 @@ int32_t flan_dyn_tag(flan_dyn v) {
|
||||
case BOX_BOOL: return FLAN_DYN_TAG_BOOL;
|
||||
case BOX_INT: return FLAN_DYN_TAG_INT;
|
||||
case BOX_KW: return FLAN_DYN_TAG_KEYWORD;
|
||||
case BOX_CHAR: return FLAN_DYN_TAG_CHAR;
|
||||
default: {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
if (o == NULL) return FLAN_DYN_TAG_NIL;
|
||||
@ -582,7 +589,7 @@ int32_t flan_dyn_tag(flan_dyn v) {
|
||||
}
|
||||
|
||||
const char *flan_dyn_tag_name(int32_t tag) {
|
||||
if (tag < 0 || tag > FLAN_DYN_TAG_MAP) return "?";
|
||||
if (tag < 0 || tag > FLAN_DYN_TAG_LAST) return "?";
|
||||
return tag_words[tag];
|
||||
}
|
||||
|
||||
@ -677,6 +684,119 @@ static void emit_escaped(dyn_sink w, const uint8_t *p, int64_t n) {
|
||||
emit(w, "\"");
|
||||
}
|
||||
|
||||
/* ── Characters ────────────────────────────────────────────────────────
|
||||
*
|
||||
* Text is UTF-8 and a char is one code point. A text's length and its
|
||||
* indices count code points, so a byte that does not start a well-formed
|
||||
* sequence — possible, because a text can be made from any typed bytes —
|
||||
* counts as one char and reads as U+FFFD: the prelude's decode-rune refusal,
|
||||
* width 1, given the replacement character as its value. */
|
||||
|
||||
static int utf8_encode(uint32_t cp, uint8_t out[4]) {
|
||||
if (cp < 0x80) { out[0] = (uint8_t)cp; return 1; }
|
||||
if (cp < 0x800) {
|
||||
out[0] = (uint8_t)(0xC0 | (cp >> 6));
|
||||
out[1] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 2;
|
||||
}
|
||||
if (cp < 0x10000) {
|
||||
out[0] = (uint8_t)(0xE0 | (cp >> 12));
|
||||
out[1] = (uint8_t)(0x80 | ((cp >> 6) & 0x3F));
|
||||
out[2] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 3;
|
||||
}
|
||||
out[0] = (uint8_t)(0xF0 | (cp >> 18));
|
||||
out[1] = (uint8_t)(0x80 | ((cp >> 12) & 0x3F));
|
||||
out[2] = (uint8_t)(0x80 | ((cp >> 6) & 0x3F));
|
||||
out[3] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 4;
|
||||
}
|
||||
|
||||
/* The code point at [p], of the [n] bytes left, and its width. Overlong
|
||||
* forms, surrogates and anything past U+10FFFF are malformed. */
|
||||
static uint32_t utf8_decode(const uint8_t *p, int64_t n, int *w) {
|
||||
uint32_t c = p[0], cp;
|
||||
int k, i;
|
||||
*w = 1;
|
||||
if (c < 0x80) return c;
|
||||
if (c >= 0xC2 && c <= 0xDF) { k = 2; cp = c & 0x1F; }
|
||||
else if (c >= 0xE0 && c <= 0xEF) { k = 3; cp = c & 0x0F; }
|
||||
else if (c >= 0xF0 && c <= 0xF4) { k = 4; cp = c & 0x07; }
|
||||
else return 0xFFFD;
|
||||
if (n < k) return 0xFFFD;
|
||||
for (i = 1; i < k; i++) {
|
||||
if ((p[i] & 0xC0) != 0x80) return 0xFFFD;
|
||||
cp = (cp << 6) | (p[i] & 0x3F);
|
||||
}
|
||||
if ((k == 3 && cp < 0x800) || (k == 4 && cp < 0x10000) || cp > 0x10FFFF ||
|
||||
(cp >= 0xD800 && cp <= 0xDFFF))
|
||||
return 0xFFFD;
|
||||
*w = k;
|
||||
return cp;
|
||||
}
|
||||
|
||||
static int is_scalar(int64_t cp) {
|
||||
return cp >= 0 && cp <= 0x10FFFF && !(cp >= 0xD800 && cp <= 0xDFFF);
|
||||
}
|
||||
|
||||
/* A char's spelling, as lib/reader.ml's [read_byte] reads it back and
|
||||
* lib/form.ml's [byte_repr] writes it: a name where there is one, \uXXXX
|
||||
* for every other control character (C0, DEL and C1), the character itself after the
|
||||
* backslash otherwise. */
|
||||
static void char_spell(uint32_t cp, char buf[16]) {
|
||||
uint8_t u[4];
|
||||
int n, i;
|
||||
switch (cp) {
|
||||
case 32: strcpy(buf, "\\space"); return;
|
||||
case 9: strcpy(buf, "\\tab"); return;
|
||||
case 10: strcpy(buf, "\\newline"); return;
|
||||
case 13: strcpy(buf, "\\return"); return;
|
||||
case 0: strcpy(buf, "\\nul"); return;
|
||||
case 8: strcpy(buf, "\\backspace"); return;
|
||||
case 12: strcpy(buf, "\\formfeed"); return;
|
||||
default: break;
|
||||
}
|
||||
if (cp < 32 || (cp >= 127 && cp <= 0x9F)) {
|
||||
snprintf(buf, 16, "\\u%04X", (unsigned)cp);
|
||||
return;
|
||||
}
|
||||
n = utf8_encode(cp, u);
|
||||
buf[0] = '\\';
|
||||
for (i = 0; i < n; i++) buf[1 + i] = (char)u[i];
|
||||
buf[1 + n] = '\0';
|
||||
}
|
||||
|
||||
/* A text is immutable, so its char count is taken once, when it is made, and
|
||||
* kept in the header's [u.i], which a text does not otherwise use. A count
|
||||
* equal to the byte length means every byte is ASCII, and an index is then a
|
||||
* byte offset. [gen] is not touched: on a text it is [pin_text]'s stamp. */
|
||||
static void text_measure(flan_obj *o) {
|
||||
const uint8_t *p = obj_text_bytes(o);
|
||||
int64_t i = 0, n = 0;
|
||||
int w;
|
||||
while (i < o->len) {
|
||||
if (p[i] < 0x80) { i++; n++; continue; }
|
||||
utf8_decode(p + i, o->len - i, &w);
|
||||
i += w;
|
||||
n++;
|
||||
}
|
||||
o->u.i = n;
|
||||
}
|
||||
|
||||
/* The byte offset of char [k], 0 <= k <= the char count. */
|
||||
static int64_t text_offset(flan_obj *o, int64_t k) {
|
||||
const uint8_t *p = obj_text_bytes(o);
|
||||
int64_t i = 0;
|
||||
int w;
|
||||
if (o->u.i == o->len) return k;
|
||||
while (k > 0 && i < o->len) {
|
||||
utf8_decode(p + i, o->len - i, &w);
|
||||
i += w;
|
||||
k--;
|
||||
}
|
||||
return i;
|
||||
}
|
||||
|
||||
static int64_t dyn_int_value(flan_dyn v); /* forward: both int shapes */
|
||||
static double dyn_num_value(flan_dyn v);
|
||||
|
||||
@ -735,6 +855,11 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
else emit_n(w, obj_text_bytes(o), o->len);
|
||||
return;
|
||||
}
|
||||
/* A char prints as the literal that reads back as it, at every depth. */
|
||||
case FLAN_DYN_TAG_CHAR:
|
||||
char_spell((uint32_t)dyn_payload(v), buf);
|
||||
emit(w, buf);
|
||||
return;
|
||||
/* A keyword prints with its colon, bare, at every depth: :a is its own
|
||||
* spelling the way true is, and quoting it would make it a text. */
|
||||
case FLAN_DYN_TAG_KEYWORD: {
|
||||
@ -866,6 +991,9 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
if (d != d) snprintf(buf, sizeof buf, "nan");
|
||||
else snprintf(buf, sizeof buf, "%g", d);
|
||||
say_puts(s, buf);
|
||||
/* A trap's sentence says 2.0 for a float of 2, so it cannot be read as
|
||||
the int 2; inf and an exponent already say float. */
|
||||
if (strspn(buf, "-0123456789") == strlen(buf)) say_puts(s, ".0");
|
||||
return;
|
||||
}
|
||||
case FLAN_DYN_TAG_TEXT: {
|
||||
@ -882,6 +1010,10 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
say_puts(s, i < o->len ? "...\"" : "\"");
|
||||
return;
|
||||
}
|
||||
case FLAN_DYN_TAG_CHAR:
|
||||
char_spell((uint32_t)dyn_payload(v), buf);
|
||||
say_puts(s, buf);
|
||||
return;
|
||||
case FLAN_DYN_TAG_KEYWORD: {
|
||||
kw_entry *k = dyn_kw(v);
|
||||
int64_t i;
|
||||
@ -1546,8 +1678,9 @@ static void mark_desc(char *base, const flan_desc *d) {
|
||||
* allocator put there next.
|
||||
*
|
||||
* A text is pinned once per stamp, however often it crosses: the stamp's
|
||||
* number is written into the text's [gen], which nothing else reads for a
|
||||
* text, so a program that never calls free-temp and passes the same texts
|
||||
* number is written into the text's [gen], which nothing else reads or
|
||||
* writes for a text — its char count is in [u.i], and whether it is ASCII is
|
||||
* that count against its length ([text_measure]) — so a program that never calls free-temp and passes the same texts
|
||||
* in a loop keeps a flat list. Distinct texts cost one pointer each here,
|
||||
* and each keeps its own object alive until the stamp ends — heavier than
|
||||
* i64->bytes's few bytes of arena, since the object has a header. The pins
|
||||
@ -1790,9 +1923,26 @@ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) {
|
||||
o = gc_alloc(OBJ_TEXT, n);
|
||||
o->len = n;
|
||||
if (n > 0) memcpy(obj_text_bytes(o), p, (size_t)n);
|
||||
text_measure(o);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
/* Only a scalar value is a char; the reader and [chars] make nothing else,
|
||||
* so a refusal here is a compiler bug and not a program's. */
|
||||
flan_dyn flan_dyn_from_char(int32_t cp) {
|
||||
if (!is_scalar(cp))
|
||||
trap1(NULL, 0, TYPE_TRAP, "char", "a char is a Unicode scalar value",
|
||||
flan_dyn_from_i64(cp));
|
||||
return dyn_make(BOX_CHAR, (uint64_t)(uint32_t)cp);
|
||||
}
|
||||
|
||||
/* 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;
|
||||
@ -2524,17 +2674,15 @@ flan_dyn flan_dyn_class_of(flan_dyn v) {
|
||||
/* The kind of a value as a keyword named by [tag_words], or a class instance's
|
||||
* class name as [flan_dyn_class_of] answers it. A class may not be named like
|
||||
* a kind (the parser refuses it), so :map always means a plain map. Keywords
|
||||
* are immortal, so each kind's keyword is interned once and kept. When dyn
|
||||
* gains a char, its tag gets a word in [tag_words] and :char falls out here
|
||||
* with no change to this function. */
|
||||
* are immortal, so each kind's keyword is interned once and kept. */
|
||||
flan_dyn flan_dyn_type_of(flan_dyn v) {
|
||||
static flan_dyn kinds[FLAN_DYN_TAG_MAP + 1];
|
||||
static flan_dyn kinds[FLAN_DYN_TAG_LAST + 1];
|
||||
static int interned;
|
||||
int32_t t = flan_dyn_tag(v);
|
||||
if (t == FLAN_DYN_TAG_MAP && dyn_obj(v)->u.v.klass != NULL)
|
||||
return flan_dyn_class_of(v);
|
||||
if (!interned) {
|
||||
for (int i = 0; i <= FLAN_DYN_TAG_MAP; i++)
|
||||
for (int i = 0; i <= FLAN_DYN_TAG_LAST; i++)
|
||||
kinds[i] = flan_dyn_kw((const uint8_t *)tag_words[i],
|
||||
(int64_t)strlen(tag_words[i]));
|
||||
interned = 1;
|
||||
@ -2652,6 +2800,81 @@ double flan_dyn_need_f64(flan_dyn v) {
|
||||
return dyn_num_value(v);
|
||||
}
|
||||
|
||||
static const char *an(const char *w); /* forward: "a" or "an" */
|
||||
|
||||
/* A dyn into a typed integer of width [kind] — 0..7 for i8 u8 i16 u16 i32
|
||||
* u32 i64 u64, check.ml's [unbox] — answered as an i64 the caller narrows:
|
||||
* an int in the width's range, or a char's code point where it fits. A byte
|
||||
* takes only an ASCII char, because a byte past ASCII is not that char in
|
||||
* UTF-8. A dyn int is an i64, so a u64 takes 0 up to the largest i64. The
|
||||
* sentence names what was found and what would do, and no call: the site in
|
||||
* front of it is the one that failed. */
|
||||
static const char *const int_names[8] = { "i8", "u8", "i16", "u16",
|
||||
"i32", "u32", "i64", "u64" };
|
||||
|
||||
int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
static const int64_t lo[8] = { -128, 0, -32768, 0, INT32_MIN, 0, INT64_MIN, 0 };
|
||||
static const int64_t hi[8] = { 127, 255, 32767, 65535, INT32_MAX,
|
||||
4294967295LL, INT64_MAX, INT64_MAX };
|
||||
int32_t t = flan_dyn_tag(v);
|
||||
const char *name;
|
||||
char sv[SAY_MAX];
|
||||
if (kind < 0 || kind > 7) kind = 6;
|
||||
name = int_names[kind];
|
||||
if (t == FLAN_DYN_TAG_CHAR) {
|
||||
int64_t cp = (int64_t)dyn_payload(v);
|
||||
int64_t top = kind <= 1 ? 127 : hi[kind];
|
||||
char cs[16];
|
||||
if (cp <= top) return cp;
|
||||
char_spell((uint32_t)cp, cs);
|
||||
if (kind <= 1)
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the char %s is more than one "
|
||||
"byte in UTF-8. Take its code point as an i32",
|
||||
an(name), name, cs);
|
||||
else
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the char %s, code point %lld, "
|
||||
"is outside %s %s's range", an(name), name, cs, (long long)cp,
|
||||
an(name), name);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (t == FLAN_DYN_TAG_INT) {
|
||||
int64_t x = dyn_int_value(v);
|
||||
if (x >= lo[kind] && x <= hi[kind]) return x;
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the int %lld is outside %s %s's "
|
||||
"range", an(name), name, (long long)x, an(name), name);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (t == FLAN_DYN_TAG_NIL) sv[0] = '\0';
|
||||
else say(sv, SAY_MAX, v);
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and this is %s%s%s%s%s. %s %s takes an "
|
||||
"int or a char's code point%s%s%s",
|
||||
an(name), name, t == FLAN_DYN_TAG_NIL ? "" : an(tag_of(v)),
|
||||
t == FLAN_DYN_TAG_NIL ? "" : " ", tag_of(v), t == FLAN_DYN_TAG_NIL ? "" : ", ", sv,
|
||||
name[0] == 'i' ? "An" : "A", name,
|
||||
t == FLAN_DYN_TAG_FLOAT ? "; convert a float with (" : "",
|
||||
t == FLAN_DYN_TAG_FLOAT ? name : "",
|
||||
t == FLAN_DYN_TAG_FLOAT ? " x)" : "");
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
|
||||
int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
return (int32_t)flan_dyn_need_int(v, 4, loc, loclen);
|
||||
}
|
||||
|
||||
/* The int arm of a numeric cast written on a dyn ([check.ml]'s [cast_dyn]),
|
||||
* reached once [flan_dyn_cast_kind] has said the box is not a float: an
|
||||
* int's value, or a char's code point, so (i32 c) is the code point the
|
||||
* implicit crossing into an i32 gives. */
|
||||
int64_t flan_dyn_int_of(flan_dyn v) {
|
||||
if (flan_dyn_tag(v) == FLAN_DYN_TAG_CHAR) return (int64_t)dyn_payload(v);
|
||||
return flan_dyn_need_i64(v);
|
||||
}
|
||||
|
||||
uint8_t flan_dyn_need_bool(flan_dyn v) {
|
||||
if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL)
|
||||
trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v);
|
||||
@ -2741,6 +2964,19 @@ int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len,
|
||||
const uint8_t *target, int64_t target_len,
|
||||
int32_t want_float) {
|
||||
int32_t tag = flan_dyn_tag(v);
|
||||
/* A char casts as its code point, an int: the arm after this reads it
|
||||
through [flan_dyn_int_of], so (i32 c) is what passing c to an i32 is. */
|
||||
if (tag == FLAN_DYN_TAG_CHAR) {
|
||||
if (want_float && site_first_time(loc, loc_len)) {
|
||||
fflush(stdout);
|
||||
fprintf(stderr,
|
||||
"%.*s: (%.*s x) found a dyn holding a char, and converted its "
|
||||
"code point to %.*s — warned once for this site\n",
|
||||
(int)loc_len, (const char *)loc, (int)target_len,
|
||||
(const char *)target, (int)target_len, (const char *)target);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
if (tag != FLAN_DYN_TAG_INT && tag != FLAN_DYN_TAG_FLOAT) {
|
||||
/* [trap1] takes the operation as a C string and the target is a Flan
|
||||
* slice, so it is copied out. Every cast name is two or three bytes; the
|
||||
@ -3055,8 +3291,14 @@ static int order(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
if (c != 0) return c < 0 ? -1 : 1;
|
||||
return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0);
|
||||
}
|
||||
if (flan_dyn_tag(a) == FLAN_DYN_TAG_CHAR &&
|
||||
flan_dyn_tag(b) == FLAN_DYN_TAG_CHAR) {
|
||||
uint64_t x = dyn_payload(a), y = dyn_payload(b);
|
||||
return x < y ? -1 : (x > y ? 1 : 0);
|
||||
}
|
||||
trap2(loc, loclen, TYPE_TRAP, op,
|
||||
"it compares two numbers or two texts, and these are neither", a, b);
|
||||
"it compares two numbers, two texts or two chars, and these are "
|
||||
"neither", a, b);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
@ -3830,6 +4072,27 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
/* A char is written as its code point where it fits, [into_put]'s rule:
|
||||
into a byte only when ASCII, since a byte past ASCII is not that char
|
||||
in UTF-8. */
|
||||
if (flan_dyn_tag(x) == FLAN_DYN_TAG_CHAR) {
|
||||
char cs[16];
|
||||
int byte = *d == 'b' || *d == 'B';
|
||||
n = (int64_t)dyn_payload(x);
|
||||
if (n <= (byte ? 127 : hi)) goto store;
|
||||
char_spell((uint32_t)n, cs);
|
||||
if (byte)
|
||||
snprintf(why, sizeof why, ", and the char %s is more than one byte in "
|
||||
"UTF-8. Take its code point as an i32", cs);
|
||||
else
|
||||
snprintf(why, sizeof why, ", which holds %lld to %lld, and the char "
|
||||
"%s, code point %lld, does not fit", (long long)lo,
|
||||
(long long)hi, cs, (long long)n);
|
||||
if (field) field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why);
|
||||
flan_say(loc, loclen, "dyn %s: this element is %s %s%s", op, an(ty), ty,
|
||||
why);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) {
|
||||
if (field) {
|
||||
value_is(why, sizeof why, x);
|
||||
@ -3861,6 +4124,7 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
(long long)hi);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
store:
|
||||
switch (*d) {
|
||||
case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; }
|
||||
case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; }
|
||||
@ -4302,6 +4566,23 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
int64_t lo, hi;
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
/* A char goes in as its code point where it fits, as it does into a
|
||||
typed parameter ([flan_dyn_need_int]): into a byte only when ASCII,
|
||||
since a byte past ASCII is not that char in UTF-8. */
|
||||
if (flan_dyn_tag(x) == FLAN_DYN_TAG_CHAR) {
|
||||
char cs[16];
|
||||
n = (int64_t)dyn_payload(x);
|
||||
if (n <= ((*d == 'b' || *d == 'B') ? 127 : hi)) goto store;
|
||||
char_spell((uint32_t)n, cs);
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (*d == 'b' || *d == 'B')
|
||||
into_trap(s, "DynRange", "%s is the char %s, which is more than one "
|
||||
"byte in UTF-8, so it is not %s %s. Take its code point as "
|
||||
"an i32", into_who(s), cs, an(ty), ty);
|
||||
into_trap(s, "DynRange", "%s is the char %s, code point %lld, and %s %s "
|
||||
"holds %lld to %lld", into_who(s), cs, (long long)n, an(ty),
|
||||
ty, (long long)lo, (long long)hi);
|
||||
}
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) {
|
||||
into_wanted(why, sizeof why, d);
|
||||
into_wrong(s, x, why);
|
||||
@ -4316,6 +4597,7 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
into_who(s), (long long)n, an(ty), ty, (long long)lo,
|
||||
(long long)hi);
|
||||
}
|
||||
store:
|
||||
switch (*d) {
|
||||
case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; }
|
||||
case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; }
|
||||
@ -4578,7 +4860,7 @@ void flan_dyn_need_as(flan_dyn v, const uint8_t *want, int64_t wantlen,
|
||||
}
|
||||
|
||||
static flan_dyn len_walk(flan_dyn v) {
|
||||
if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len);
|
||||
if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->u.i);
|
||||
/* A map's length is its slot count, so a stale instance would answer the
|
||||
count of a definition that no longer exists. Migrated first for the same
|
||||
reason [get] is. */
|
||||
@ -4607,9 +4889,8 @@ static int64_t need_index(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
return dyn_int_value(i);
|
||||
}
|
||||
|
||||
/* A text answers a byte, as an int. That is what [(at s i)] on a
|
||||
* [(Slice u8)] does in the typed language, and a text is a run of bytes in
|
||||
* both. Codepoints are utf8's job and stay there. */
|
||||
/* A text answers its [i]th char, counting code points: O(1) on an ASCII
|
||||
* text, a walk from the front on any other. A typed str counts bytes. */
|
||||
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
int64_t k;
|
||||
@ -4635,8 +4916,15 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
}
|
||||
}
|
||||
}
|
||||
if (o->kind == OBJ_TEXT) {
|
||||
int64_t off;
|
||||
int w;
|
||||
if (k < 0 || k >= o->u.i) trap_range(loc, loclen, "at", v, k, o->u.i);
|
||||
off = text_offset(o, k);
|
||||
return dyn_make(BOX_CHAR,
|
||||
utf8_decode(obj_text_bytes(o) + off, o->len - off, &w));
|
||||
}
|
||||
if (k < 0 || k >= o->len) trap_range(loc, loclen, "at", v, k, o->len);
|
||||
if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
|
||||
return o->u.v.items[k];
|
||||
}
|
||||
|
||||
@ -4652,7 +4940,8 @@ flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
if (!is_text(v))
|
||||
trap2(loc, loclen, TYPE_TRAP, "slice", "only a text is sliced", v, lo);
|
||||
o = dyn_obj(v);
|
||||
len = o->len;
|
||||
/* The bounds count chars, as [length] and [at] do. */
|
||||
len = o->u.i;
|
||||
a = need_index(loc, loclen, "slice", v, lo);
|
||||
b = flan_dyn_tag(hi) == FLAN_DYN_TAG_NIL
|
||||
? len : need_index(loc, loclen, "slice", v, hi);
|
||||
@ -4664,9 +4953,67 @@ flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
"— %s", (long long)a, (long long)b, (long long)len, sv);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
a = text_offset(o, a);
|
||||
b = text_offset(o, b);
|
||||
return flan_dyn_from_bytes(obj_text_bytes(o) + a, b - a);
|
||||
}
|
||||
|
||||
/* (chars t): a text's chars, a fresh vec of them. */
|
||||
flan_dyn flan_dyn_chars(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
flan_obj *o;
|
||||
flan_dyn out;
|
||||
int64_t i = 0;
|
||||
int w;
|
||||
if (!is_text(v))
|
||||
trap1(loc, loclen, TYPE_TRAP, "chars", "only a text has chars", v);
|
||||
out = flan_dyn_vec_new();
|
||||
o = dyn_obj(v);
|
||||
while (i < o->len) {
|
||||
uint32_t cp = utf8_decode(obj_text_bytes(o) + i, o->len - i, &w);
|
||||
flan_dyn_push(out, dyn_make(BOX_CHAR, cp), loc, loclen);
|
||||
i += w;
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
/* (text x): a vec of chars, or one char, as a text — [chars] undone. */
|
||||
flan_dyn flan_dyn_text(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
uint8_t u[4];
|
||||
int64_t i, n, total = 0;
|
||||
flan_obj *src, *o;
|
||||
if (flan_dyn_tag(v) == FLAN_DYN_TAG_CHAR) {
|
||||
int k = utf8_encode((uint32_t)dyn_payload(v), u);
|
||||
return flan_dyn_from_bytes(u, k);
|
||||
}
|
||||
if (!is_vec(v))
|
||||
trap1(loc, loclen, TYPE_TRAP, "text",
|
||||
"text is made from a vec of chars or from one char", v);
|
||||
src = dyn_obj(v);
|
||||
n = vecish_len(src);
|
||||
for (i = 0; i < n; i++) {
|
||||
flan_dyn c = vecish_at(src, i);
|
||||
if (flan_dyn_tag(c) != FLAN_DYN_TAG_CHAR) {
|
||||
char sc[SAY_MAX];
|
||||
say(sc, SAY_MAX, c);
|
||||
flan_say(loc, loclen,
|
||||
"dyn text: element %lld is %s %s, and text is made from chars "
|
||||
"only", (long long)i, an(tag_of(c)), sc);
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
total += utf8_encode((uint32_t)dyn_payload(c), u);
|
||||
}
|
||||
o = gc_alloc(OBJ_TEXT, total);
|
||||
o->len = total;
|
||||
total = 0;
|
||||
for (i = 0; i < n; i++) {
|
||||
int k = utf8_encode((uint32_t)dyn_payload(vecish_at(src, i)), u);
|
||||
memcpy(obj_text_bytes(o) + total, u, (size_t)k);
|
||||
total += k;
|
||||
}
|
||||
text_measure(o);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
int64_t k;
|
||||
|
||||
@ -94,6 +94,11 @@ 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);
|
||||
|
||||
/* A char, by its code point. Anything but a Unicode scalar value traps. */
|
||||
flan_dyn flan_dyn_from_char(int32_t cp);
|
||||
|
||||
flan_dyn flan_dyn_vec_new(void);
|
||||
flan_dyn flan_dyn_map_new(void);
|
||||
@ -134,7 +139,7 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
|
||||
flan_dyn flan_dyn_class_of(flan_dyn v);
|
||||
|
||||
/* The value's kind as a keyword — :nil :bool :int :float :text :vec :keyword
|
||||
* :map — or, for a class instance, its class name as [flan_dyn_class_of]
|
||||
* :map :char — or, for a class instance, its class name as [flan_dyn_class_of]
|
||||
* answers it. Never traps. */
|
||||
flan_dyn flan_dyn_type_of(flan_dyn v);
|
||||
|
||||
@ -219,8 +224,8 @@ flan_dyn flan_dyn_popcount(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_clz(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_ctz(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* Answer a bool dyn. Numbers compare as numbers and text compares bytewise;
|
||||
* a mixture of the two, or anything else, traps. */
|
||||
/* Answer a bool dyn. Numbers compare as numbers and text compares bytewise,
|
||||
* chars by code point; a mixture, or anything else, traps. */
|
||||
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
@ -230,20 +235,26 @@ flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen)
|
||||
* of unrelated tags are not an error, they are unequal. */
|
||||
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b);
|
||||
|
||||
/* Bytes of a text, elements of a vec. Anything else traps. */
|
||||
/* Chars of a text, elements of a vec. Anything else traps. */
|
||||
flan_dyn flan_dyn_len(flan_dyn v);
|
||||
|
||||
/* Element of a vec, or the byte of a text as an int. Out of range traps.
|
||||
/* Element of a vec, or the char of a text. A text counts code points. Out of
|
||||
* range traps.
|
||||
* [loc] is where the call was written, printed ahead of a trap's sentence; NULL
|
||||
* prints none. The same pair [flan_dyn_add] takes. */
|
||||
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
|
||||
/* A copy of the text's bytes [lo, hi); nil for [hi] is the length. A vec, or
|
||||
/* A copy of the text's chars [lo, hi); nil for [hi] is the length. A vec, or
|
||||
* any other value, traps: see the definition. */
|
||||
flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* (chars t): a new vec of the text's chars. (text x): the text a vec of
|
||||
* chars, or one char, spells. Anything else traps at [loc]. */
|
||||
flan_dyn flan_dyn_chars(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_text(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* Vec only — a text is immutable and says so rather than being copied. */
|
||||
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
@ -284,6 +295,15 @@ void flan_dyn_emit_watch(flan_dyn v);
|
||||
int64_t flan_dyn_need_i64(flan_dyn v);
|
||||
double flan_dyn_need_f64(flan_dyn v);
|
||||
uint8_t flan_dyn_need_bool(flan_dyn v);
|
||||
/* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64
|
||||
* u64: an int in range, or a char's code point where it fits (ASCII only
|
||||
* into a byte), as an i64 the caller narrows. Anything else traps at [loc].
|
||||
* [flan_dyn_need_i32] is kind 4. */
|
||||
int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
/* A numeric cast's int arm: an int's value or a char's code point. */
|
||||
int64_t flan_dyn_int_of(flan_dyn v);
|
||||
|
||||
/* A numeric cast written on a dyn — [(f64 d)], [(u32 d)] — TODO.org,
|
||||
* "A numeric cast opens a dyn box". Unlike the parameter boundary above this
|
||||
@ -516,6 +536,7 @@ void flan_dyn_root_globals_end(void);
|
||||
#define FLAN_DYN_TAG_VEC 5
|
||||
#define FLAN_DYN_TAG_KEYWORD 6
|
||||
#define FLAN_DYN_TAG_MAP 7
|
||||
#define FLAN_DYN_TAG_CHAR 8
|
||||
|
||||
int32_t flan_dyn_tag(flan_dyn v);
|
||||
const char *flan_dyn_tag_name(int32_t tag);
|
||||
|
||||
@ -2908,6 +2908,230 @@ 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);
|
||||
}
|
||||
|
||||
/* The same over a slice of byte slices, each a (ptr, len) pair: the parts a
|
||||
* join or a concat is handed. */
|
||||
void flan_utf8_check_parts(const void *parts, int64_t n, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
const struct { const uint8_t *p; int64_t n; } *ps = parts;
|
||||
int64_t i;
|
||||
for (i = 0; i < n; i++) flan_utf8_check(ps[i].p, ps[i].n, loc, loclen);
|
||||
}
|
||||
|
||||
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);
|
||||
/* Stops at the position, so an insert near the front costs what it walks
|
||||
* and not the whole text. The count is finished only for the message. A
|
||||
* width that would run past the end is taken as 1, so a String whose bytes
|
||||
* were ever wrong is never read beyond its length. */
|
||||
while (off < v->len) {
|
||||
int64_t w;
|
||||
if (count == want) { found = off; break; }
|
||||
w = utf8_width(p[off]);
|
||||
off += (w <= v->len - off) ? w : 1;
|
||||
count++;
|
||||
}
|
||||
if (found < 0 && want == count && past_end) found = v->len;
|
||||
if (want < 0 || found < 0) {
|
||||
while (off < v->len) {
|
||||
int64_t w = utf8_width(p[off]);
|
||||
off += (w <= v->len - off) ? w : 1;
|
||||
count++;
|
||||
}
|
||||
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]);
|
||||
/* Never past the length, however the bytes came to be what they are. */
|
||||
if (w > v->len - off) w = 1;
|
||||
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
|
||||
|
||||
@ -435,14 +435,44 @@ static int race(void) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* A String's character walk over bytes that are not valid UTF-8, which no
|
||||
* Flan program can make: a lead byte promising three bytes where the length
|
||||
* leaves one. The header is flan_rt.c's flan_vec, restated; a null allocator
|
||||
* skips the epoch check. The bytes past the length are valid continuation
|
||||
* bytes, so a walk that read past the end would count and decode them. */
|
||||
typedef struct {
|
||||
void *ptr;
|
||||
int64_t len, cap;
|
||||
void *alloc;
|
||||
int64_t epoch;
|
||||
} limits_vec;
|
||||
int64_t flan_string_index(void *v, int32_t i, int32_t past_end,
|
||||
const uint8_t *loc, int64_t loclen, void *xfer);
|
||||
int32_t flan_string_remove(void *v, int64_t off, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
|
||||
static int string_walk(void) {
|
||||
static uint8_t lead_last[4] = { 0x61, 0xe6, 0x80, 0x80 };
|
||||
static uint8_t lead_first[4] = { 0xe6, 0x61, 0x80, 0x80 };
|
||||
limits_vec a = { lead_last, 2, 4, NULL, 0 };
|
||||
limits_vec b = { lead_first, 2, 4, NULL, 0 };
|
||||
const uint8_t *loc = (const uint8_t *)"dev_limits.c";
|
||||
printf("index %lld\n", (long long)flan_string_index(&b, 1, 0, loc, 12, NULL));
|
||||
printf("end %lld\n", (long long)flan_string_index(&a, 2, 1, loc, 12, NULL));
|
||||
printf("removed %d len %lld\n", flan_string_remove(&a, 1, loc, 12),
|
||||
(long long)a.len);
|
||||
return 0;
|
||||
}
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
flan_rt_init(argc, argv);
|
||||
if (argc < 2) {
|
||||
fprintf(stderr,
|
||||
"usage: %s cap|race|names|regfull|regchurn|regrace|regoverflow\n",
|
||||
"usage: %s cap|race|string|names|regfull|regchurn|regrace|regoverflow\n",
|
||||
argv[0]);
|
||||
return 2;
|
||||
}
|
||||
if (strcmp(argv[1], "string") == 0) return string_walk();
|
||||
if (strcmp(argv[1], "cap") == 0) return cap();
|
||||
if (strcmp(argv[1], "race") == 0) return race();
|
||||
if (strcmp(argv[1], "names") == 0) return names();
|
||||
|
||||
@ -139,6 +139,28 @@ static void ops(void) {
|
||||
check(flan_dyn_tag(flan_dyn_from_f64(1.5)) == FLAN_DYN_TAG_FLOAT, "tag float");
|
||||
check(flan_dyn_tag(text("x")) == FLAN_DYN_TAG_TEXT, "tag text");
|
||||
check(flan_dyn_tag(flan_dyn_vec_new()) == FLAN_DYN_TAG_VEC, "tag vec");
|
||||
check(flan_dyn_tag(flan_dyn_from_char(0x65E5)) == FLAN_DYN_TAG_CHAR, "tag char");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_CHAR), "char") == 0, "word char");
|
||||
check(flan_dyn_need_i32(flan_dyn_from_char(0x1F600), NULL, 0) == 0x1F600,
|
||||
"need-i32 answers a char's code point");
|
||||
check(flan_dyn_need_i32(flan_dyn_from_i64(-7), NULL, 0) == -7,
|
||||
"need-i32 answers an int that fits");
|
||||
check(flan_dyn_int_of(flan_dyn_from_char('a')) == 97,
|
||||
"a cast's int arm reads a char's code point");
|
||||
{
|
||||
/* "é日😀" is 2 + 3 + 4 bytes and three chars, and chars/text round-trip. */
|
||||
flan_dyn t = text("\xC3\xA9\xE6\x97\xA5\xF0\x9F\x98\x80");
|
||||
check(num(flan_dyn_len(t)) == 3, "len counts chars");
|
||||
check(flan_dyn_need_i32(FDYN_at(t, flan_dyn_from_i64(1)), NULL, 0) == 0x65E5,
|
||||
"at answers a char");
|
||||
check(truth(flan_dyn_eq(flan_dyn_text(flan_dyn_chars(t, NULL, 0), NULL, 0), t)),
|
||||
"text undoes chars");
|
||||
check(truth(flan_dyn_lt(flan_dyn_from_char('a'), flan_dyn_from_char(0xE9),
|
||||
NULL, 0)),
|
||||
"chars order by code point");
|
||||
check(!truth(flan_dyn_eq(flan_dyn_from_char('a'), flan_dyn_from_i64('a'))),
|
||||
"a char is not an int");
|
||||
}
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_NIL), "nil") == 0, "word nil");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_BOOL), "bool") == 0, "word bool");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_INT), "int") == 0, "word int");
|
||||
@ -249,14 +271,14 @@ static void ops(void) {
|
||||
check(!truth(flan_dyn_eq(a, c)), "= text sees the last byte");
|
||||
check(truth(flan_dyn_eq(a, a)), "= text against itself");
|
||||
check(num(flan_dyn_len(a)) == 5, "len text");
|
||||
check(num(FDYN_at(a, flan_dyn_from_i64(0))) == 'h', "at text");
|
||||
check(num(FDYN_at(a, flan_dyn_from_i64(4))) == 'o', "at text last");
|
||||
check(flan_dyn_need_i32(FDYN_at(a, flan_dyn_from_i64(0)), NULL, 0) == 'h', "at text");
|
||||
check(flan_dyn_need_i32(FDYN_at(a, flan_dyn_from_i64(4)), NULL, 0) == 'o', "at text last");
|
||||
{
|
||||
/* Embedded NUL, because a length-prefixed text is the claim and strlen is
|
||||
how that claim gets quietly broken. */
|
||||
flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3);
|
||||
check(num(flan_dyn_len(z)) == 3, "len counts past a NUL");
|
||||
check(num(FDYN_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL");
|
||||
check(flan_dyn_need_i32(FDYN_at(z, flan_dyn_from_i64(2)), NULL, 0) == 'b', "at past a NUL");
|
||||
check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL");
|
||||
}
|
||||
{
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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")]
|
||||
|
||||
25
test/programs/dyn-char-pinned.flan
Normal file
25
test/programs/dyn-char-pinned.flan
Normal file
@ -0,0 +1,25 @@
|
||||
;;;; A non-ASCII text that has crossed into a str still counts characters,
|
||||
;;;; however many times it crosses; and a char is written through a dyn view of
|
||||
;;;; typed storage as its code point where it fits. With an argument, \é
|
||||
;;;; written into a view of bytes traps.
|
||||
|
||||
(defn byte-len [s str] i32 (length s))
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(let [t (the dyn "é日😀")]
|
||||
(dotimes [i 3] (println (byte-len t)))
|
||||
(println (length t))
|
||||
(println (at t 1))
|
||||
(println (slice t 0 2)))
|
||||
(let [a (the [3 i32] [1 2 3])
|
||||
v (the dyn a)]
|
||||
(set (at v 0) \z)
|
||||
(set (at v 1) \日)
|
||||
(println (at a 0) (at a 1) (at a 2)))
|
||||
(let [b (the [2 u8] [1 2])
|
||||
w (the dyn b)]
|
||||
(set (at w 0) \a)
|
||||
(println (at b 0) (at b 1))
|
||||
(when (> (length args) 1)
|
||||
(set (at w 1) \é)))
|
||||
0)
|
||||
19
test/programs/dyn-char-spell.flan
Normal file
19
test/programs/dyn-char-spell.flan
Normal file
@ -0,0 +1,19 @@
|
||||
;;;; Every ASCII code point, the C1 controls, and a few past them, as dyn chars printed one per
|
||||
;;;; line. The test reads each line back with the reader and wants the same
|
||||
;;;; code point, so what a char prints as is what reads as it.
|
||||
|
||||
(defn main [] i32
|
||||
(let [v (vec-new u8)]
|
||||
(dotimes [i 128] (push v (u8 i)))
|
||||
(let [t (the dyn (str (slice v)))]
|
||||
(dotimes [i (length t)] (println (at t i))))
|
||||
;; the C1 controls, U+0080 to U+009F, and U+00A0, each C2 then one byte
|
||||
(let [w (vec-new u8)]
|
||||
(dotimes [i 33] (push w (u8 0xC2)) (push w (u8 (+ 0x80 i))))
|
||||
(let [c1 (the dyn (str (slice w)))]
|
||||
(dotimes [i (length c1)] (println (at c1 i))))
|
||||
(free w))
|
||||
(let [u (the dyn "é日😀")]
|
||||
(dotimes [i (length u)] (println (at u i))))
|
||||
(free v))
|
||||
0)
|
||||
23
test/programs/dyn-char-string.flan
Normal file
23
test/programs/dyn-char-string.flan
Normal file
@ -0,0 +1,23 @@
|
||||
;;;; A String, and a str made from one, crossing into dyn: the dyn text counts
|
||||
;;;; characters and indexes by them, ASCII or not. A char literal appends to a
|
||||
;;;; String as its code point.
|
||||
|
||||
(defn as-dyn [d] dyn d)
|
||||
|
||||
(defn main [] i32
|
||||
(let [s (string-new "ab")
|
||||
u (string-new "é")]
|
||||
(append u \日)
|
||||
(append u \😀)
|
||||
(append u \!)
|
||||
(let [a (as-dyn s)
|
||||
d (as-dyn u)
|
||||
e (as-dyn (str u))]
|
||||
(println a (length a) (at a 1))
|
||||
(println d (length d) (at d 1) (at d 3))
|
||||
(println (slice d 1 3) (chars d))
|
||||
(println e (length e) (at e 2) (= d e)))
|
||||
(println (length u) (rune-count u))
|
||||
(free s)
|
||||
(free u))
|
||||
0)
|
||||
51
test/programs/dyn-char.flan
Normal file
51
test/programs/dyn-char.flan
Normal file
@ -0,0 +1,51 @@
|
||||
;;;; Dyn chars: a char literal that ends up dyn is a char and prints as its
|
||||
;;;; literal; a dyn text counts characters, not bytes; chars and text convert
|
||||
;;;; between a text and a vec of chars. With an argument, a dyn text handed to
|
||||
;;;; an i32 traps at the call, and with "big" an int past an i32's range does.
|
||||
|
||||
(defn show [x] () (println x))
|
||||
(defn code-point [c i32] i32 c)
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(let [t (the dyn "é日😀 ok")
|
||||
cs (chars t)]
|
||||
;; literals, printed
|
||||
(show \I)
|
||||
(show \é)
|
||||
(show \日)
|
||||
(show \😀)
|
||||
(show [\a \space \( \newline])
|
||||
(show (type-of \é))
|
||||
;; length and indexing count characters
|
||||
(show (length t))
|
||||
(show (at t 0))
|
||||
(show (at t 1))
|
||||
(show (at t 2))
|
||||
(show (at t 4))
|
||||
(show (slice t 1 3))
|
||||
;; chars and text
|
||||
(show cs)
|
||||
(show (length cs))
|
||||
(show (text cs))
|
||||
(show (= (text cs) t))
|
||||
(show (text \日))
|
||||
(show (text [\o \k]))
|
||||
;; equality, ordering, and a char as a map key
|
||||
(show (= (at t 1) \日))
|
||||
(show (= (at t 0) \e))
|
||||
(show (= (at t 4) (the dyn "o")))
|
||||
(show (= (at t 4) (the dyn 111)))
|
||||
(show (< (at t 0) (at t 1)))
|
||||
(show (> (at t 1) (at t 2)))
|
||||
(show (< (at t 4) \é))
|
||||
(show (get {\é 1 \日 2} (at t 1)))
|
||||
;; into typed code: the code point
|
||||
(show (code-point (at t 2)))
|
||||
;; an int that fits goes in too, and a cast agrees with the crossing
|
||||
(show (code-point (the dyn 5)))
|
||||
(show (i32 (the dyn \a)))
|
||||
(when (> (length args) 1)
|
||||
(if (= (at args 1) "big")
|
||||
(show (code-point (the dyn 5000000000)))
|
||||
(show (code-point (the dyn "x"))))))
|
||||
0)
|
||||
66
test/programs/dyn-int-widths.flan
Normal file
66
test/programs/dyn-int-widths.flan
Normal file
@ -0,0 +1,66 @@
|
||||
;;;; A dyn into a typed integer of every width: an int in the width's range
|
||||
;;;; passes, and so does a char's code point where it fits (ASCII only into a
|
||||
;;;; byte). A cast on a dyn is the typed cast after an unbox, so it takes a
|
||||
;;;; char too and wraps as a typed cast does. With an argument, one crossing
|
||||
;;;; out of range traps at its call.
|
||||
|
||||
(defn to-i8 [x i8] i64 (i64 x))
|
||||
(defn to-u8 [x u8] i64 (i64 x))
|
||||
(defn to-i16 [x i16] i64 (i64 x))
|
||||
(defn to-u16 [x u16] i64 (i64 x))
|
||||
(defn to-i32 [x i32] i64 (i64 x))
|
||||
(defn to-u32 [x u32] i64 (i64 x))
|
||||
(defn to-i64 [x i64] i64 x)
|
||||
(defn to-u64 [x u64] u64 x)
|
||||
|
||||
(defn d [x] dyn x)
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(do
|
||||
;; the edges of each width, both ends, and a char at each
|
||||
(println (to-i8 (d -128)) (to-i8 (d 127)) (to-i8 (d \a)))
|
||||
(println (to-u8 (d 0)) (to-u8 (d 255)) (to-u8 (d \a)))
|
||||
(println (to-i16 (d -32768)) (to-i16 (d 32767)) (to-i16 (d \é)))
|
||||
(println (to-u16 (d 0)) (to-u16 (d 65535)) (to-u16 (d \日)))
|
||||
(println (to-i32 (d -2147483648)) (to-i32 (d 2147483647)) (to-i32 (d \😀)))
|
||||
(println (to-u32 (d 0)) (to-u32 (d 4294967295)) (to-u32 (d \😀)))
|
||||
(println (to-i64 (d -9223372036854775807)) (to-i64 (d 9223372036854775807))
|
||||
(to-i64 (d \😀)))
|
||||
(println (to-u64 (d 0)) (to-u64 (d 9223372036854775807)) (to-u64 (d \😀)))
|
||||
;; casts: a char at every width, and the typed cast's wrap
|
||||
(println (i8 (d \a)) (u8 (d \a)) (i16 (d \a)) (u16 (d \a))
|
||||
(i32 (d \a)) (u32 (d \a)) (i64 (d \a)) (u64 (d \a)))
|
||||
(println (u32 (d -1)) (u32 (the i64 -1)) (u8 (d 256)) (u8 (the i64 256)))
|
||||
;; into a typed array and a struct, chars by the same rule
|
||||
(println (sum (d [\a \b])) (pair-sum (d {:a \a :b \日})))
|
||||
(when (> (length args) 1)
|
||||
(let [w (at args 1)]
|
||||
(cond
|
||||
(= w "u8-256") (println (to-u8 (d 256)))
|
||||
(= w "u8-neg") (println (to-u8 (d -1)))
|
||||
(= w "i8-128") (println (to-i8 (d 128)))
|
||||
(= w "i16-big") (println (to-i16 (d 32768)))
|
||||
(= w "u16-big") (println (to-u16 (d 65536)))
|
||||
(= w "i32-big") (println (to-i32 (d 2147483648)))
|
||||
(= w "u32-neg") (println (to-u32 (d -1)))
|
||||
(= w "u64-neg") (println (to-u64 (d -1)))
|
||||
(= w "u8-char") (println (to-u8 (d \é)))
|
||||
(= w "u16-char") (println (to-u16 (d \😀)))
|
||||
(= w "float") (println (to-i64 (d 2.0)))
|
||||
(= w "elem-char") (println (bytes-sum (d [\a \é])))
|
||||
(= w "field-char") (println (pair-sum (d {:a \é :b 1})))
|
||||
:else (println (to-i64 (d "x")))))))
|
||||
0)
|
||||
|
||||
(defn sum [xs [const i32]] i64
|
||||
(let [t (the i64 0)]
|
||||
(dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
|
||||
t))
|
||||
|
||||
(defn bytes-sum [xs [const u8]] i64
|
||||
(let [t (the i64 0)]
|
||||
(dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
|
||||
t))
|
||||
|
||||
(defstruct Pair [a u8 b i32])
|
||||
(defn pair-sum [p Pair] i64 (+ (i64 (.a p)) (i64 (.b p))))
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
16
test/programs/string-leak.flan
Normal file
16
test/programs/string-leak.flan
Normal file
@ -0,0 +1,16 @@
|
||||
;;;; A dev build's registry names a String's block by its type: the one freed
|
||||
;;;; is gone from the report at exit, and the ones kept — made by string-new, by
|
||||
;;;; a prelude builder and by bytes->string — are listed under String.
|
||||
(defn main [] i32
|
||||
(let [kept (string-new "kept")
|
||||
gone (string-new "gone")]
|
||||
(append kept " for good")
|
||||
(free gone)
|
||||
(println kept)
|
||||
;; A builder's answer and a checked copy are Strings in the report too.
|
||||
(println (to-upper (bytes-view "loud")))
|
||||
(let [v (vec-new u8)]
|
||||
(push v 0x61)
|
||||
(println (bytes->string v))
|
||||
(free v)))
|
||||
0)
|
||||
90
test/programs/string-owned.flan
Normal file
90
test/programs/string-owned.flan
Normal file
@ -0,0 +1,90 @@
|
||||
;;;; 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))
|
||||
;; = and != compare bytes, against a String or a str, either side first.
|
||||
(let [a (string-new "日本")
|
||||
b (string-new "日")]
|
||||
(append b 0x672c)
|
||||
(println (= a b) (!= a b) (= a "日本") (= "日本" a) (= a "日") (!= b "x"))
|
||||
(println (= a b (to-upper (bytes-view "日本"))))
|
||||
(free a)
|
||||
(free b))
|
||||
;; bytes->string copies: a write through the Vec afterwards, or through a
|
||||
;; slice taken of it before, does not reach the String.
|
||||
(let [v (vec-new u8)]
|
||||
(push v 0xc3)
|
||||
(push v 0xa9)
|
||||
(let [early (slice v)
|
||||
t (bytes->string v)]
|
||||
(set (at v 0) 0xff)
|
||||
(set (at early 1) 0xe6)
|
||||
(println t (length t) (rune-count t))
|
||||
(free t))
|
||||
(free v))
|
||||
;; A remove near the front and an insert at the front, on a long text.
|
||||
(let [long (string-new "é")]
|
||||
(dotimes [i 1000] (append long "ab"))
|
||||
(insert long 0 "x")
|
||||
(println (remove long 1) (length long))
|
||||
(free long))
|
||||
(let [e (string-new)]
|
||||
(println (length e) (rune-count e))
|
||||
(free e))
|
||||
(free s))
|
||||
0)
|
||||
25
test/programs/string-traps.flan
Normal file
25
test/programs/string-traps.flan
Normal file
@ -0,0 +1,25 @@
|
||||
;;;; 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; and a text builder
|
||||
;;;; given bytes that are not UTF-8 stops at the call that asked for it, or,
|
||||
;;;; called through a function value, at its own check in the prelude. 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))
|
||||
(= which 5) (println (to-lower (slice bad)))
|
||||
(= which 6) (let [f to-lower] (println (f (slice bad))))
|
||||
: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
|
||||
;;;; 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
|
||||
|
||||
@ -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])
|
||||
lower = to-lower(text)
|
||||
lowered = to-lower(text)
|
||||
lower = bytes-view(lowered)
|
||||
i = 0
|
||||
n = length(lower)
|
||||
while :scan i < n
|
||||
|
||||
@ -2029,6 +2029,85 @@ 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\n\
|
||||
true false true true false true\ntrue\né 2 1\n233 2001\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:17:19: this text is not valid UTF-8 — byte 0 \
|
||||
is 0xc3");
|
||||
("1", "string-traps.flan:18:19: 55296 is not a Unicode scalar value");
|
||||
("2", "string-traps.flan:19:19: index 3 is out of bounds for length 2");
|
||||
("3", "string-traps.flan:20:28: index 2 is out of bounds for length 2");
|
||||
(* A builder called by name is checked at the call, before it runs. *)
|
||||
("5", "string-traps.flan:21:28: this text is not valid UTF-8 — byte 0 \
|
||||
is 0xc3");
|
||||
(* Called through a function value, it has no call site to check at,
|
||||
and its own check in the prelude stops it: the site is the
|
||||
prelude's, and the line is not pinned here so that editing the
|
||||
prelude does not move this row. *)
|
||||
("6", "<prelude>:");
|
||||
("6", ": this text is not valid UTF-8 — byte 0 is 0xc3");
|
||||
("4", "string-traps.flan:23: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 — string-new's, a builder's and bytes->string's alike — 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\nLOUD\na\nflan: 3 blocks still held at exit, 24 bytes\n\
|
||||
flan: 3 24 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
|
||||
@ -5433,6 +5512,167 @@ level "1"
|
||||
"programs/dyn-type-of.flan" dyn_type_of_out;
|
||||
outputs ~x86:true "dyn: type-of, --x86"
|
||||
"programs/dyn-type-of.flan" dyn_type_of_out;
|
||||
(* Dyn chars: literals printed as literals, non-ASCII included; a text's
|
||||
length, at and slice counting characters; chars and text round trips;
|
||||
equality and ordering by code point; a char as a map key; a char's
|
||||
code point in a typed i32. With an argument, a dyn int at the i32
|
||||
traps at the call. *)
|
||||
let dyn_char_out =
|
||||
"\\I\n\\é\n\\日\n\\😀\n[\\a \\space \\( \\newline]\n:char\n\
|
||||
6\n\\é\n\\日\n\\😀\n\\o\n日😀\n\
|
||||
[\\é \\日 \\😀 \\space \\o \\k]\n6\né日😀 ok\ntrue\n日\nok\n\
|
||||
true\nfalse\nfalse\nfalse\ntrue\nfalse\ntrue\n2\n128512\n5\n97\n"
|
||||
in
|
||||
outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out;
|
||||
outputs ~opt:"-O0" "dyn: chars, -O0" "programs/dyn-char.flan" dyn_char_out;
|
||||
outputs ~x86:true "dyn: chars, --x86" "programs/dyn-char.flan" dyn_char_out;
|
||||
(* A String, and a str made from one, cross into dyn as text measured
|
||||
like any other: characters counted, ASCII or not. *)
|
||||
let string_char_out =
|
||||
"ab 2 \\b\né日😀! 4 \\日 \\!\n日😀 [\\é \\日 \\😀 \\!]\n\
|
||||
é日😀! 4 \\😀 true\n10 4\n"
|
||||
in
|
||||
outputs "dyn: a String crossing counts chars"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
outputs ~opt:"-O0" "dyn: a String crossing counts chars, -O0"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
outputs ~x86:true "dyn: a String crossing counts chars, --x86"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
(* A text pinned by crossing into a str keeps counting characters (the
|
||||
pin's stamp and the text's measure live in different header fields),
|
||||
and a char writes through a view of typed storage. *)
|
||||
let pinned_out = "9\n9\n9\n3\n\\日\né日\n122 26085 3\n97 2\n" in
|
||||
outputs "dyn: a pinned text counts chars" "programs/dyn-char-pinned.flan"
|
||||
pinned_out;
|
||||
outputs ~opt:"-O0" "dyn: a pinned text counts chars, -O0"
|
||||
"programs/dyn-char-pinned.flan" pinned_out;
|
||||
outputs ~x86:true "dyn: a pinned text counts chars, --x86"
|
||||
"programs/dyn-char-pinned.flan" pinned_out;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char-pinned.flan" in
|
||||
let code, text = run exe (Some "x") in
|
||||
let want = "programs/dyn-char-pinned.flan:24:7: dyn set-at: this \
|
||||
element is a u8, and the char \\é is more than one byte" in
|
||||
if code <> 134 || not (contains text want) then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL dyn: \\é into a byte view traps%s\n \
|
||||
got: %S (exit %d)\n"
|
||||
(if x86 then ", --x86" else "") text code
|
||||
end)
|
||||
[ false; true ];
|
||||
(* A dyn into every integer width: both edges pass, a char passes where
|
||||
it fits, a cast takes a char and wraps as the typed cast beside it
|
||||
does; then one trap per width past its range, a char too wide, and a
|
||||
text, each at its own call. *)
|
||||
let widths_out =
|
||||
"-128 127 97\n0 255 97\n-32768 32767 233\n0 65535 26085\n\
|
||||
-2147483648 2147483647 128512\n0 4294967295 128512\n\
|
||||
-9223372036854775807 9223372036854775807 128512\n\
|
||||
0 9223372036854775807 128512\n97 97 97 97 97 97 97 97\n\
|
||||
4294967295 4294967295 0 0\n195 26182\n"
|
||||
in
|
||||
outputs "dyn: every integer width" "programs/dyn-int-widths.flan" widths_out;
|
||||
outputs ~opt:"-O0" "dyn: every integer width, -O0"
|
||||
"programs/dyn-int-widths.flan" widths_out;
|
||||
outputs ~x86:true "dyn: every integer width, --x86"
|
||||
"programs/dyn-int-widths.flan" widths_out;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-int-widths.flan" in
|
||||
List.iter
|
||||
(fun (arg, want) ->
|
||||
let want = "programs/dyn-int-widths.flan:" ^ want in
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134 || not (contains text want) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL dyn: %s traps%s\n got: %S (exit %d)\n \
|
||||
wanted: %S (exit 134)\n"
|
||||
arg (if x86 then ", --x86" else "") text code want
|
||||
end)
|
||||
[ ("u8-256", "39:42: dyn: a u8 is wanted here, and the int 256 is \
|
||||
outside a u8's range");
|
||||
("u8-neg", "40:42: dyn: a u8 is wanted here, and the int -1 is \
|
||||
outside a u8's range");
|
||||
("i8-128", "41:42: dyn: an i8 is wanted here, and the int 128 is \
|
||||
outside an i8's range");
|
||||
("i16-big", "42:44: dyn: an i16 is wanted here, and the int 32768");
|
||||
("u16-big", "43:44: dyn: a u16 is wanted here, and the int 65536");
|
||||
("i32-big", "44:44: dyn: an i32 is wanted here, and the int \
|
||||
2147483648");
|
||||
("u32-neg", "45:44: dyn: a u32 is wanted here, and the int -1 is \
|
||||
outside a u32's range");
|
||||
("u64-neg", "46:44: dyn: a u64 is wanted here, and the int -1");
|
||||
("u8-char", "47:43: dyn: a u8 is wanted here, and the char \\é is \
|
||||
more than one byte in UTF-8");
|
||||
("u16-char", "48:45: dyn: a u16 is wanted here, and the char \
|
||||
\\😀, code point 128512, is outside a u16's range");
|
||||
("float", "49:42: dyn: an i64 is wanted here, and this is a \
|
||||
float, 2.0.");
|
||||
("elem-char", "50:49: dyn into [const u8]: element 1 is the \
|
||||
char \\é, which is more than one byte in UTF-8");
|
||||
("field-char", "51:49: dyn into Pair: field :a is the char \\é, \
|
||||
which is more than one byte in UTF-8");
|
||||
("x", "52:34: dyn: an i64 is wanted here, and this is a text, \
|
||||
\"x\". An i64 takes an int or a char's code point") ])
|
||||
[ false; true ];
|
||||
(* Print, then read: each char dyn-char-spell.flan prints — every ASCII
|
||||
code point, the C1 controls, then four past them — reads back as the code point it was,
|
||||
and so does the compiler's own spelling of the same literal, which is
|
||||
what flan convert writes. *)
|
||||
let spelled =
|
||||
List.init 128 Fun.id @ List.init 32 (fun i -> 0x80 + i)
|
||||
@ [ 0xA0; 0xE9; 0x65E5; 0x1F600 ]
|
||||
in
|
||||
let read_char s =
|
||||
match Reader.read_all ~file:"<char>" s with
|
||||
| [ { Form.v = Form.Byte b; _ } ] -> Some b
|
||||
| _ | (exception Loc.Error _) -> None
|
||||
in
|
||||
List.iter
|
||||
(fun cp ->
|
||||
let s = Form.byte_repr cp in
|
||||
if read_char s <> Some cp then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL char %d is written %S, which does not read \
|
||||
back as it\n" cp s
|
||||
end)
|
||||
spelled;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char-spell.flan" in
|
||||
let code, text = run exe None in
|
||||
let lines = String.split_on_char '\n' text in
|
||||
let lines = List.filteri (fun i _ -> i < List.length spelled) lines in
|
||||
let got = List.map read_char lines in
|
||||
if code <> 0 || got <> List.map Option.some spelled then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL dyn chars read back as printed%s\n \
|
||||
got: %S (exit %d)\n"
|
||||
(if x86 then ", --x86" else "") text code
|
||||
end)
|
||||
[ false; true ];
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char.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 dyn: a dyn %s at an i32 traps%s\n got: %S \
|
||||
(exit %d)\n wanted: %S (exit 134)\n"
|
||||
arg (if x86 then ", --x86" else "") text code want
|
||||
end)
|
||||
[ ("x", "programs/dyn-char.flan:50:27: dyn: an i32 is wanted \
|
||||
here, and this is a text, \"x\". An i32 takes an int or \
|
||||
a char's code point");
|
||||
("big", "programs/dyn-char.flan:49:27: dyn: an i32 is wanted \
|
||||
here, and the int 5000000000 is outside an i32's \
|
||||
range") ])
|
||||
[ false; true ];
|
||||
(* (watch "name" v) with nothing arming the table: a struct, an array, a
|
||||
slice, a dyn map and a string all compile against flan_dev.c's watch
|
||||
entry points on both backends, write nothing, and evaluate the value
|
||||
@ -5584,7 +5824,7 @@ level "1"
|
||||
Matched on the half that carries the meaning rather than on the
|
||||
whole sentence, so the row is about the trap being reached with
|
||||
the right two things in hand and not about punctuation. *)
|
||||
|| not (contains text "float, and an int was wanted")
|
||||
|| not (contains text "an i64 is wanted here, and this is a float, 1.5")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
@ -5632,7 +5872,7 @@ level "1"
|
||||
in
|
||||
if code <> 134
|
||||
|| not (contains text nil_option_out)
|
||||
|| not (contains text "int was wanted")
|
||||
|| not (contains text "an i64 is wanted here, and this is nil.")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
|
||||
@ -253,6 +253,9 @@ let eval_in_frame_checks ~backend ask =
|
||||
expect "(+ n 1)" "4";
|
||||
expect "(.y p)" "2.5";
|
||||
expect "label" "\"inner\"";
|
||||
(* A dyn char answers as the literal that reads back as it. *)
|
||||
expect "(at (chars \"a b\") 1)" "\\space";
|
||||
expect "[\\x (at (chars \"hi\") 1)]" "[\\x \\i]";
|
||||
expect "(do (set flag false) flag)" "false";
|
||||
(match
|
||||
Wire.field (ask "(:op \"locals\" :frame 0)") "locals"
|
||||
|
||||
@ -113,6 +113,10 @@ let () =
|
||||
reads "byte named" "\\space" "\\space";
|
||||
reads "byte digit" "\\0" "\\0";
|
||||
reads "byte paren" "\\(" "\\(";
|
||||
reads "char by \\uXXXX" "\\u0041" "\\A";
|
||||
reads "control char" "\\u0007" "\\u0007";
|
||||
reads "char named" "\\backspace" "\\backspace";
|
||||
reads "non-ASCII char" "\\日" "\\日";
|
||||
reads "byte dot" "\\." "\\.";
|
||||
|
||||
(* ── Sequences ─────────────────────────────────────────────────── *)
|
||||
@ -2377,6 +2381,44 @@ 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";
|
||||
rejects_check "a String is not ordered"
|
||||
"(defn f [a String b String] bool (< a b))"
|
||||
~needle:"(bytes<? (bytes-view a) (bytes-view b))";
|
||||
rejects_check "a String is not a map key"
|
||||
"(defn f [s String] () (let [m (map-new String i32)] (put m s 1)))"
|
||||
~needle:"Key the map by str and put (str s)";
|
||||
rejects_check "a String compares only with text"
|
||||
"(defn f [s String] bool (= s 3))"
|
||||
~needle:"= compares a String with a String or a str, found";
|
||||
accepts "a String equals a String or a str, either side first"
|
||||
"(defn f [a String b String] bool (and (= a b) (!= \"x\" a) (= a \"y\")))";
|
||||
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"
|
||||
@ -3140,6 +3182,22 @@ let () =
|
||||
accepts "the fix a class-named-kind refusal offers compiles"
|
||||
"(defclass map-value [a])\n\
|
||||
(defn main [] i32 (if (= (type-of (map-value 1)) :map-value) 0 1))";
|
||||
(* A char literal past ASCII is not a byte: it is refused by its name at a
|
||||
u8, whichever operand of = it is, and pushing it into bytes too. *)
|
||||
rejects_check "a non-ASCII char is not a u8"
|
||||
"(defn main [] i32 (let [b (the u8 1)] (if (= b \\é) 1 0)))"
|
||||
~needle:"\\é is 2 bytes in UTF-8, not one, so it is not a u8";
|
||||
rejects_check "and not on the left of = either"
|
||||
"(defn main [] i32 (let [b (the u8 1)] (if (= \\日 b) 1 0)))"
|
||||
~needle:"\\日 is 3 bytes in UTF-8";
|
||||
rejects_check "nor pushed into bytes"
|
||||
"(defn main [] i32 (let [v (vec-new u8)] (push v \\é) 0))"
|
||||
~needle:"Write the str \"é\" for its bytes";
|
||||
rejects_check "a code point past a u16"
|
||||
"(defn main [] i32 (let [b (the u16 1)] (if (= b \\😀) 1 0)))"
|
||||
~needle:"\\😀 is code point 128512, which does not fit in a u16";
|
||||
accepts "an ASCII char is a u8"
|
||||
"(defn main [] i32 (let [b (the u8 97)] (if (= b \\a) 0 1)))";
|
||||
rejects_check "type-of takes one argument"
|
||||
"(defn main [] i32 (let [k (type-of 1 2)] 0))" ~needle:"type-of";
|
||||
(* The constructor is an ordinary function, so its arity is the ordinary
|
||||
|
||||
@ -546,6 +546,14 @@ let () =
|
||||
counter and a value published twice would be read half-formed. The last
|
||||
line is the flag being cleared: a short value after a truncated one must
|
||||
not inherit its ellipsis. *)
|
||||
(* A String's character walk, over a lead byte that promises more bytes
|
||||
than the length holds: every step stays inside the length, so the
|
||||
lead byte is one character and the one removed is the byte itself. *)
|
||||
let code, out, err = mode "string" in
|
||||
let want_string = "index 1\nend 2\nremoved 230 len 1\n" in
|
||||
if code <> 0 || out <> want_string then
|
||||
fail "a String's walk past its length\n got: %S (exit %d, err %S)\n wanted: %S"
|
||||
out code err want_string;
|
||||
let code, out, _ = mode "cap" in
|
||||
let want_cap = "len 4096\ntail ...\nmid b\nhead a\ngen 1\nagain 12\n" in
|
||||
if code <> 0 || out <> want_cap then
|
||||
|
||||
@ -495,6 +495,9 @@ let () =
|
||||
(* Characters, lexed before brackets and separators. *)
|
||||
reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])";
|
||||
reads "character arguments" "f(\\,, \\))" "(f \\, \\))";
|
||||
reads "character spellings"
|
||||
"x = [\\u0041 \\u0007 \\backspace \\formfeed \\日]"
|
||||
"(set x [\\A \\u0007 \\backspace \\formfeed \\日])";
|
||||
(* Keywords and annotations. *)
|
||||
reads "keyword" "let k = :else" "(def k dyn :else)";
|
||||
reads "annotation" "once grid: [4 [8 u32]]" "(defonce grid [4 [8 u32]])";
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user