Master is merged into the when, get and if let lane, and dyn get over text counts characters through at's own body.

This commit is contained in:
Joseph Ferano 2026-09-26 13:17:57 +07:00
commit b545584de8
21 changed files with 946 additions and 94 deletions

View File

@ -31,10 +31,18 @@ last form is not kept. =get= over dyn text or vec is nil when out of range; =.fi
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]

View File

@ -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)))

View File

@ -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 ...] ...]"))

View File

@ -4488,34 +4488,34 @@ let mismatch_found : Types.t Found.t = Found.create 16
let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
let need sym ty = rt loc ty sym [ e ] in
match want with
| Types.Int Types.I64 -> need "flan_dyn_need_i64" dyn_i64
| Types.Float Types.F64 -> need "flan_dyn_need_f64" dyn_f64
| Types.Bool ->
(* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the
language's own cast and cannot fail — the runtime already decided the
value was a bool, so what comes back is 0 or 1. *)
widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32))
(* Every other width is refused rather than served by a need_i64 and a
truncation. Narrowing is written or it does not happen — that survives
widening becoming implicit (TODO.org, "Implicit numeric widening is
legal; narrowing stays a hard error") untouched, and this is the
boundary where it matters most: the value's type was *already* uncertain
here, so an annotation that quietly discarded the high bits would read as
a check and be the opposite of one.
Nor does widening reach this arm from the other side. The box carries one
integer width and one float width, so there is no narrower source here to
widen from — a u32 want is asking the i64 in the box to fit in half of
itself, which is the refusal above and not a conversion the lattice has.
The ABI grows a per-width entry point when there is a reason to; until
then the spelling that works is an i64 and a written conversion after
it. *)
| Types.Int _ | Types.Float _ ->
no_dyn_yet loc ~into:false want
(Printf.sprintf
" — take it as %s and convert"
(if Types.is_numeric want && (match want with Types.Float _ -> true | _ -> false)
then "f64" else "i64"))
(* Any integer width, checked at run time at this site (TODO.org, "Dyn
unless annotated"): an int in the width's range, or a char's code point
where it fits — ASCII only into a byte, since a byte past ASCII is not
that char in UTF-8. The runtime answers an i64 it has already checked,
so the narrowing after it cannot lose a bit. *)
| Types.Int k ->
let code =
match k with
| Types.I8 -> 0L | Types.U8 -> 1L | Types.I16 -> 2L | Types.U16 -> 3L
| Types.I32 -> 4L | Types.U32 -> 5L | Types.I64 -> 6L | Types.U64 -> 7L
in
let n =
rt loc dyn_i64 "flan_dyn_need_int"
[ e; mk loc (Types.Int Types.I32) (Tast.Int (code, Types.I32)); here loc ]
in
if k = Types.I64 then n else mk loc want (Tast.Prim (Tast.Cast want, [ n ]))
(* An f32 is refused rather than served by a need_f64 and a rounding: the
box carries one float width, and narrowing is written or it does not
happen (TODO.org, "Implicit numeric widening is legal; narrowing stays a
hard error"). *)
| Types.Float _ ->
no_dyn_yet loc ~into:false want " — take it as f64 and convert"
| _ -> no_dyn_yet loc ~into:false want ""
(* A dyn where a str, a slice, a fixed array or a struct was written:
@ -4624,7 +4624,7 @@ let cast_dyn ctx loc (target : Types.t) (got : Tast.expr) : Tast.expr =
[ mk loc target
(Tast.If (is_float,
arm "flan_dyn_need_f64" dyn_f64,
arm "flan_dyn_need_i64" dyn_i64)) ]))
arm "flan_dyn_int_of" dyn_i64)) ]))
(* nil is written [nil] and nothing else produces it, so this is the whole of
"the checker can see a nil reaching here" — a name, not a dataflow fact.
@ -6055,8 +6055,39 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
n (tyname loc t) gname var (Int64.neg n) n
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
| Ast.UInt (n, s) -> wide_literal loc ~want n s
(* A char literal that ends up dyn is a dyn char, never an int; a typed code
point that crosses later is an int, because only the literal says char. *)
| Ast.Byte b when want = Some Types.Dyn ->
rt loc Types.Dyn "flan_dyn_from_char"
[ mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int b, Types.I32)) ]
(* A char literal is a code point, and a byte type holds one only when it
is ASCII: \é as a u8 would be 0xE9, which is not é in UTF-8 and never
equals a byte of it. Refused by the char's name, not its number. *)
| Ast.Byte b
when (match want with
| Some (Types.Int (Types.U8 | Types.I8)) -> b > 127
| Some (Types.Int Types.I16) -> b > 32767
| Some (Types.Int Types.U16) -> b > 65535
| _ -> false) ->
let t = tyname loc (Option.get want) in
let c = Form.byte_repr b in
if (match want with
| Some (Types.Int (Types.U8 | Types.I8)) -> true
| _ -> false)
then
Loc.failk literal_at_want loc
"%s is %d bytes in UTF-8, not one, so it is not a %s. Write the str \
\"%s\" for its bytes, or take its code point as an i32"
c (String.length (Form.utf8 b)) t (Form.utf8 b)
else
Loc.failk literal_at_want loc
"%s is code point %d, which does not fit in a %s. Take its code point \
as an i32" c b t
(* A non-ASCII literal is a code point, which a u8 cannot hold as itself:
its default is the prelude's rune, an i32. *)
| Ast.Byte b ->
int_literal loc ~want ~preds:ctx.env.tvpreds ~default:Types.U8
int_literal loc ~want ~preds:ctx.env.tvpreds
~default:(if b > 127 then Types.I32 else Types.U8)
(Int64.of_int b)
(* The float literal's own dyn case, for the reason the integer's has one:
the ABI carries one width and the literal is built at it. f64 is already
@ -8756,6 +8787,7 @@ and generic_ctor ctx ~want loc name given =
match a.Ast.e with
| Ast.Float _ -> Types.Float (float_default ())
| Ast.UInt _ -> Types.Int Types.U64
| Ast.Byte b when b > 127 -> Types.Int Types.I32
| Ast.Byte _ -> Types.Int Types.U8
| _ -> Types.Int Types.I32
in
@ -9793,8 +9825,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc
if p >= 17 || float_of_string t = x then t else go (p + 1)
in
go 1
| Ast.Byte b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
| Ast.Byte b -> string_of_int b
| Ast.Byte b -> Form.byte_repr b
| Ast.Str t -> Printf.sprintf "%S" t
| Ast.Kw k -> ":" ^ k
| Ast.Var b -> b
@ -13774,6 +13805,15 @@ and named_call ?(qualified = false) ctx ~want loc name args =
(rt loc Types.Dyn "flan_dyn_type_of" [ check ctx ~want:Types.Dyn v ])
| _ -> assert false)
(* (chars t) and (text x): a dyn text as a vec of its chars, and back. A
dyn text is immutable, so a vec of chars is how one is edited. *)
| "chars" | "text" ->
arity ctx loc name 1 args;
let sym = if name = "chars" then "flan_dyn_chars" else "flan_dyn_text" in
expect ctx loc ~want
(rt loc Types.Dyn sym
[ check ctx ~want:Types.Dyn (List.hd args); here loc ])
(* (map-remove m k) -> (Option V): the value that was there, or None when
the key was not. The same answer [get] gives, for the same reason — a key
that is not in the map is an answer and not a failure — and the value
@ -14983,7 +15023,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
at the target instead, so (u64 2935910691) and (i64 5000000000) are the
constants they say. One that fits i32 keeps the default and the cast,
which is what (u32 -1) has always meant. *)
let want =
let operand_want =
match (List.hd args).Ast.e, target with
| Ast.Int n, (Types.Int _ | Types.Float _)
when Int64.compare n (-2147483648L) < 0
@ -14996,7 +15036,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
Some (Types.Float Types.F64)
| _ -> None
in
let a = check ctx ?want (List.hd args) in
let a = check ctx ?want:operand_want (List.hd args) in
(match a.Tast.ty with
| Types.Enum _ -> ()
(* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
@ -15014,7 +15054,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
~what:"a number or an enum" ~is:"a number" v
| t -> fail loc "%s converts a number, found %s" name (tyname loc t));
(match a.Tast.ty with
| Types.Dyn -> cast_dyn ctx loc target a
| Types.Dyn -> expect ctx loc ~want (cast_dyn ctx loc target a)
| _ -> prim (Tast.Cast target) target [ a ])
(* ── ordinary calls ────────────────────────────────────────────── *)
@ -16515,9 +16555,15 @@ let builtins : (string * string * string) list =
is the same generic function written the other way.");
("type-of", "type-of [dyn] dyn",
"The value's kind as a keyword — :nil :bool :int :float :text :vec \
:keyword :map — or, for a value built by a defclass constructor, the \
:keyword :map :char — or, for a value built by a defclass constructor, the \
class's name as class-of answers it. A typed value answers the kind it \
has as a dyn value: an i32 is :int.");
("chars", "chars [dyn] dyn",
"A dyn text's characters, as a new dyn vector of chars. A dyn text \
counts characters, not bytes, in length, at and slice.");
("text", "text [dyn] dyn",
"The dyn text a dyn vector of chars, or a single char, spells: \
(text (chars t)) is t.");
("keyword", "keyword [str|[const u8]] dyn",
"The interned dyn keyword named by the bytes, for a name that only \
exists at run time — a reader building :texture-path out of a token's \
@ -16560,8 +16606,8 @@ let builtins : (string * string * string) list =
(* containers *)
("length", "length [[n T]|[T]|str|String|(Vec T)|(Map K V)] i32",
"How many elements. One question and one word across an array, a slice, \
a string, a Vec and a Map. A str and a String count bytes; rune-count \
counts characters.");
a string, a Vec and a Map. A str and a String count bytes, as rune-count \
does not; a dyn text counts characters.");
("at", "at [collection i32 ...] T",
"The element at an index, bounds-checked — and for a Vec with the \
allocator's epoch checked first. On a string it is the byte, a u8. It \

View File

@ -5056,6 +5056,9 @@ 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()
@ -5128,6 +5131,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

View File

@ -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 ())

View File

@ -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

View 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)

View File

@ -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,19 @@ 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) {
@ -2531,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;
@ -2659,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);
@ -2748,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
@ -3062,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,
@ -3837,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);
@ -3868,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; }
@ -4309,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);
@ -4323,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; }
@ -4585,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. */
@ -4614,10 +4889,10 @@ 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. */
/* [at]'s, and [get]'s over a text or a vec: one body, so the two always
/* 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.
*
* [at]'s, and [get]'s over a text or a vec: one body, so the two always
* count the same way. [soft] is [get]'s — an index out of range is nil
* rather than a trap. */
static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc,
@ -4648,11 +4923,21 @@ static flan_dyn at_core(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) {
if (soft) return flan_dyn_nil();
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) {
if (soft) return flan_dyn_nil();
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];
}
@ -4673,7 +4958,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);
@ -4685,9 +4971,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;
@ -4845,7 +5189,7 @@ flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc,
* still be an int — a wrong kind of key is a mistake, not an absence. */
flan_dyn flan_dyn_get_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
int64_t loclen) {
/* Through [at]'s own body, so however [at] counts a text — bytes now —
/* Through [at]'s own body, so however [at] counts a text — by code point —
* [get] counts the same. */
if (!is_text(v) && !is_vec(v)) return flan_dyn_get(v, i, loc, loclen);
return at_core(v, i, loc, loclen, 1);

View File

@ -97,6 +97,9 @@ 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);
@ -136,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);
@ -221,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);
@ -232,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);
@ -290,6 +299,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
@ -522,6 +540,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);

View File

@ -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");
}
{

View 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)

View 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)

View 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)

View 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)

View 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))))

View File

@ -10,7 +10,7 @@
(defn dvec [] dyn [10 [20 21] 30])
(defn dmap [] dyn {:a 1 :b [5 6]})
(defn dtext [] dyn "hey")
(defn dtext [] dyn "héy")
(defn main [] ()
(let [a [1 2 3]
@ -62,6 +62,7 @@
(println (get m :b 1))
(println (get m :z 1))
(println (.a m))
;; Dyn text: get counts it as at does.
;; Dyn text: get counts it as at does, by character.
(println (get (dtext) 1))
(println (get (dtext) 2))
(println (get (dtext) 3))))

View File

@ -2235,7 +2235,7 @@ let () =
let get_checked_out =
"none\n1\n3\nnone\n4\nnone\nnone\n6\nnone\n3\nnone\n\
none\n10\n30\nnone\n20\n30\nnone\nnone\n101\nnone\n\
nil\n10\n30\nnil\n21\nnil\nnil\n1\nnil\n6\nnil\n1\n101\nnil\n"
nil\n10\n30\nnil\n21\nnil\nnil\n1\nnil\n6\nnil\n1\n\\\u{e9}\n\\y\nnil\n"
in
outputs "get as a checked lookup" "programs/get-checked.flan" get_checked_out;
outputs ~opt:"-O0" "get as a checked lookup, -O0" "programs/get-checked.flan"
@ -5536,6 +5536,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
@ -5687,7 +5848,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
@ -5735,7 +5896,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

View File

@ -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"

View File

@ -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 ─────────────────────────────────────────────────── *)
@ -3178,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

View File

@ -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]])";