From 71f2b0b9b6189ce22bba29c2c782d3aa093b7ece Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 11:11:42 +0700 Subject: [PATCH 1/6] Dyn has a char that prints as its literal, dyn text counts characters, and chars and text convert between a text and a vec of chars. --- TODO.org | 15 ++- emacs/flan-inspect.el | 4 + emacs/test-flan-cider.el | 8 ++ lib/check.ml | 36 +++++- lib/emit.ml | 4 + lib/expand.ml | 5 +- lib/form.ml | 19 ++- lib/reader.ml | 5 + runtime/flan_dyn.c | 247 ++++++++++++++++++++++++++++++++++-- runtime/flan_dyn.h | 25 +++- test/dyn_ops.c | 24 +++- test/programs/dyn-char.flan | 46 +++++++ test/test_acceptance.ml | 28 ++++ test/test_dev.ml | 3 + 14 files changed, 433 insertions(+), 36 deletions(-) create mode 100644 test/programs/dyn-char.flan diff --git a/TODO.org b/TODO.org index 08a02ae2..27d782eb 100644 --- a/TODO.org +++ b/TODO.org @@ -15,10 +15,17 @@ rejected without a record is an idea that gets re-proposed. 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; it goes into typed code only as an i32 (the prelude's rune), and a +dyn int there traps rather than converts. 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. +Rules out char arithmetic, a typed code point turning into a char, and byte offsets on +dyn text. ** DONE Any typed container crosses into dyn as a view CLOSED: [2026-09-26] diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index e009669e..e5efa239 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -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))) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 7c27f106..69cce32f 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -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 ...] ...]")) diff --git a/lib/check.ml b/lib/check.ml index aa7423a1..3df117fe 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4192,6 +4192,11 @@ let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = 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)) + (* An i32 is the prelude's rune, so it takes a dyn char's code point, and + only a char: an int in the box is refused at run time, at this site, for + the reason the arm below refuses one at compile time. *) + | Types.Int Types.I32 -> + rt loc want "flan_dyn_need_char" [ e; here loc ] (* 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 @@ -5682,8 +5687,16 @@ 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 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 @@ -7885,6 +7898,7 @@ and generic_ctor ctx ~want loc name given = match a.Ast.e with | Ast.Float _ -> Types.Float Types.F64 | 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 @@ -12006,6 +12020,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 @@ -14614,9 +14637,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 \ @@ -14659,7 +14688,8 @@ let builtins : (string * string * string) list = (* containers *) ("length", "length [[n T]|[T]|str|(Vec T)|(Map K V)] i32", "How many elements. One question and one word across an array, a slice, \ - a string, a Vec and a Map."); + a string, a Vec and a Map. A str counts bytes; 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 \ diff --git a/lib/emit.ml b/lib/emit.ml index 97240c6e..7b83444f 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5007,6 +5007,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_vec_new() declare i64 @flan_dyn_map_new() declare i64 @flan_dyn_map_new_class(i64, ptr, i64) @@ -5066,6 +5069,7 @@ 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_char(i64, ptr, 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 diff --git a/lib/expand.ml b/lib/expand.ml index e1319623..c9a486bd 100644 --- a/lib/expand.ml +++ b/lib/expand.ml @@ -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 ()) diff --git a/lib/form.ml b/lib/form.ml index 2eda0357..e93caecc 100644 --- a/lib/form.ml +++ b/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,12 @@ 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 + let rec to_string f = let seq l = String.concat " " (List.map to_string l) in match f.v with @@ -37,6 +43,7 @@ let rec to_string f = | UInt (_, s) -> s | Float x -> Printf.sprintf "%g" x | Str s -> Printf.sprintf "%S" s + | Byte b when b > 127 -> "\\" ^ utf8 b | Byte b -> (match Char.chr b with | ' ' -> "\\space" @@ -117,11 +124,13 @@ let byte_repr b = | 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. *) + (* Printable ASCII, and any code point past ASCII, is written as itself. A + control character 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 when b > 127 -> "\\" ^ utf8 b | b -> Printf.sprintf "\\%d" b (** One line, and a reader reads it back. *) diff --git a/lib/reader.ml b/lib/reader.ml index 40890424..e32fe22d 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -129,6 +129,11 @@ let read_byte st = | "return" -> 13 | "nul" -> 0 | n when String.length n = 1 -> Char.code n.[0] + (* 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) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 8c2a24e6..b44df391 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -176,6 +176,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 @@ -491,7 +494,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 @@ -501,6 +505,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); @@ -527,6 +533,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; @@ -547,7 +554,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]; } @@ -642,6 +649,117 @@ 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 and + * lib/form.ml's [byte_repr] writes it: the five names, the character itself + * after the backslash, and the decimal for a control character, which has + * no spelling the reader takes. */ +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; + default: break; + } + if (cp < 32 || cp == 127) { snprintf(buf, 16, "\\%u", (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; [gen] + * says whether every byte is ASCII, which makes an index a byte offset. */ +#define TEXT_ASCII 1u + +static void text_measure(flan_obj *o) { + const uint8_t *p = obj_text_bytes(o); + int64_t i = 0, n = 0; + int w, ascii = 1; + while (i < o->len) { + if (p[i] < 0x80) { i++; n++; continue; } + ascii = 0; + utf8_decode(p + i, o->len - i, &w); + i += w; + n++; + } + o->u.i = n; + o->gen = ascii ? TEXT_ASCII : 0; +} + +/* 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->gen & TEXT_ASCII) 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); @@ -719,6 +837,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 +989,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; @@ -1670,9 +1797,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); +} + flan_dyn flan_dyn_vec_new(void) { flan_obj *o = gc_alloc(OBJ_VEC, 0); o->len = 0; @@ -2404,17 +2541,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; @@ -2532,6 +2667,19 @@ double flan_dyn_need_f64(flan_dyn v) { return dyn_num_value(v); } +/* A char into typed code is its code point, an i32 — the prelude's rune. Only + * a char: an int is not one, and a typed i32 is taken from an int by writing + * the conversion, (i32 x). */ +int32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) { + if (flan_dyn_tag(v) != FLAN_DYN_TAG_CHAR) + trap1(loc, loclen, TYPE_TRAP, "i32", + flan_dyn_tag(v) == FLAN_DYN_TAG_INT + ? "an i32 is taken from a char, and from an int only by (i32 x)" + : "an i32 is taken from a char, its code point", + v); + return (int32_t)dyn_payload(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); @@ -2823,8 +2971,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, @@ -3773,7 +3927,7 @@ flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { } 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. */ @@ -3802,9 +3956,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; @@ -3822,8 +3975,15 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len); return view_read(loc, loclen, "at", o, o->u.view.desc, view_elem_at(o, k)); } + 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]; } @@ -3839,7 +3999,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); @@ -3851,9 +4012,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); flan_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; diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 5e6a118b..2bae932b 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -95,6 +95,9 @@ flan_dyn flan_dyn_from_bool(uint8_t b); * to drop — because the bytes are copied before this returns. */ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n); +/* 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 +137,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); @@ -205,8 +208,8 @@ flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_neg(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); @@ -216,20 +219,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); @@ -270,6 +279,9 @@ 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); +/* A char's code point, for a typed i32: the prelude's rune. Any other tag + * traps at [loc], an int included. */ +int32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen); /* 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 @@ -481,6 +493,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); diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 692725cf..f14492ca 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -138,6 +138,24 @@ 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_char(flan_dyn_from_char(0x1F600), NULL, 0) == 0x1F600, + "need-char answers the 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_char(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"); @@ -248,14 +266,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_char(FDYN_at(a, flan_dyn_from_i64(0)), NULL, 0) == 'h', "at text"); + check(flan_dyn_need_char(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_char(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"); } { diff --git a/test/programs/dyn-char.flan b/test/programs/dyn-char.flan new file mode 100644 index 00000000..52b7d7fa --- /dev/null +++ b/test/programs/dyn-char.flan @@ -0,0 +1,46 @@ +;;;; 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 int handed to an +;;;; i32 — a code point — traps at the call. + +(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))) + (when (> (length args) 1) + (show (code-point (the dyn 5))))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index ff0185a4..f08f9000 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5346,6 +5346,34 @@ 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\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; + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/dyn-char.flan" in + let code, text = run exe (Some "x") in + let want = "programs/dyn-char.flan:45:25: dyn i32: int, and an i32 \ + is taken from a char" in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf + "FAIL dyn: a dyn int at an i32 traps%s\n got: %S (exit \ + %d)\n wanted: %S (exit 134)\n" + (if x86 then ", --x86" else "") text code want + end) + [ 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 diff --git a/test/test_dev.ml b/test/test_dev.ml index be21fb4e..ed8b54fe 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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" From 0ed3ce93e20163928c1d15f4ef7dbc2ea20cd6f9 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 11:54:03 +0700 Subject: [PATCH 2/6] Every char prints as a spelling that reads back as it, with a name or Clojure's \uXXXX for each control character. --- lib/check.ml | 3 +- lib/form.ml | 46 ++++++++++++++----------------- lib/reader.ml | 14 +++++++++- runtime/flan_dyn.c | 12 ++++---- test/programs/dyn-char-spell.flan | 13 +++++++++ test/test_acceptance.ml | 33 ++++++++++++++++++++++ test/test_flan.ml | 4 +++ test/test_syntax.ml | 3 ++ 8 files changed, 94 insertions(+), 34 deletions(-) create mode 100644 test/programs/dyn-char-spell.flan diff --git a/lib/check.ml b/lib/check.ml index 3df117fe..9b99ea93 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8927,8 +8927,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = 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 diff --git a/lib/form.ml b/lib/form.ml index e93caecc..f85d0665 100644 --- a/lib/form.ml +++ b/lib/form.ml @@ -34,6 +34,23 @@ let utf8 b = 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 and DEL, 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 -> 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 @@ -43,13 +60,7 @@ let rec to_string f = | UInt (_, s) -> s | Float x -> Printf.sprintf "%g" x | Str s -> Printf.sprintf "%S" s - | Byte b when b > 127 -> "\\" ^ utf8 b - | 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 ^ "}" @@ -77,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 \, 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 @@ -117,22 +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, and any code point past ASCII, is written as itself. A - control character 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 when b > 127 -> "\\" ^ utf8 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 diff --git a/lib/reader.ml b/lib/reader.ml index e32fe22d..07516ceb 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -113,7 +113,8 @@ let read_string st = go (); spanned st loc (Form.Str (Buffer.contents buf)) -(* \space \tab \newline \return \nul, or \ *) +(* \space \tab \newline \return \nul \backspace \formfeed, Clojure's \uXXXX + (four hex digits), or \ *) let read_byte st = let loc = here st in advance st; (* backslash *) @@ -128,7 +129,18 @@ 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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 9f9294f0..342d8866 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -739,10 +739,10 @@ 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 and - * lib/form.ml's [byte_repr] writes it: the five names, the character itself - * after the backslash, and the decimal for a control character, which has - * no spelling the reader takes. */ +/* 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 and DEL, the character itself after the + * backslash otherwise. */ static void char_spell(uint32_t cp, char buf[16]) { uint8_t u[4]; int n, i; @@ -752,9 +752,11 @@ static void char_spell(uint32_t cp, char buf[16]) { 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) { snprintf(buf, 16, "\\%u", (unsigned)cp); return; } + if (cp < 32 || cp == 127) { 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]; diff --git a/test/programs/dyn-char-spell.flan b/test/programs/dyn-char-spell.flan new file mode 100644 index 00000000..a4c26dca --- /dev/null +++ b/test/programs/dyn-char-spell.flan @@ -0,0 +1,13 @@ +;;;; Every ASCII code point, and a few past it, 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)))) + (let [u (the dyn "é日😀")] + (dotimes [i (length u)] (println (at u i)))) + (free v)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 4bc0fd6d..8d3f0f3b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5360,6 +5360,39 @@ level "1" 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; + (* Print, then read: each char dyn-char-spell.flan prints — every ASCII + code point, then three past it — 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 @ [ 0xE9; 0x65E5; 0x1F600 ] in + let read_char s = + match Reader.read_all ~file:"" 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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 6b853e5f..6407735e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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 ─────────────────────────────────────────────────── *) diff --git a/test/test_syntax.ml b/test/test_syntax.ml index fc970edb..400ab5e4 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -474,6 +474,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]])"; From d5437c3f220a1c6d3c4ac016ec4a8efdd1eee8fb Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 12:15:04 +0700 Subject: [PATCH 3/6] A non-ASCII char literal is refused where a byte is wanted, a dyn int or char goes into an i32 range-checked, a cast on a dyn char gives its code point, and C1 controls print as \uXXXX. --- TODO.org | 10 ++--- lib/check.ml | 38 ++++++++++++++---- lib/emit.ml | 3 +- lib/form.ml | 4 +- runtime/flan_dyn.c | 65 ++++++++++++++++++++++++------- runtime/flan_dyn.h | 8 ++-- test/dyn_ops.c | 16 +++++--- test/programs/dyn-char-spell.flan | 8 +++- test/programs/dyn-char.flan | 11 ++++-- test/test_acceptance.ml | 35 ++++++++++------- test/test_flan.ml | 16 ++++++++ 11 files changed, 159 insertions(+), 55 deletions(-) diff --git a/TODO.org b/TODO.org index 53edaa3b..539a3fe2 100644 --- a/TODO.org +++ b/TODO.org @@ -30,11 +30,11 @@ 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; it goes into typed code only as an i32 (the prelude's rune), and a -dyn int there traps rather than converts. 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. -Rules out char arithmetic, a typed code point turning into a char, and byte offsets on -dyn text. +literal, bare too, a control character as \\uXXXX; into a typed i32 (the prelude's +rune) or through (i32 c) it gives its code point. 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 u8 is wanted. Rules out char arithmetic, a typed code point +turning into a char, and byte offsets on dyn text. ** DONE Any typed container crosses into dyn as a view CLOSED: [2026-09-26] diff --git a/lib/check.ml b/lib/check.ml index 9b99ea93..9e07dae7 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4192,11 +4192,10 @@ let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr = 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)) - (* An i32 is the prelude's rune, so it takes a dyn char's code point, and - only a char: an int in the box is refused at run time, at this site, for - the reason the arm below refuses one at compile time. *) + (* An int that fits, range-checked at run time at this site, or a char's + code point: an i32 is the prelude's rune. *) | Types.Int Types.I32 -> - rt loc want "flan_dyn_need_char" [ e; here loc ] + rt loc want "flan_dyn_need_i32" [ e; here loc ] (* 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 @@ -4284,7 +4283,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. @@ -5692,6 +5691,29 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = | 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 -> @@ -13216,7 +13238,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 @@ -13224,7 +13246,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = | Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target | _ -> 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 @@ -13242,7 +13264,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 ────────────────────────────────────────────── *) diff --git a/lib/emit.ml b/lib/emit.ml index 7b83444f..9636f84c 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5069,7 +5069,8 @@ 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_char(i64, ptr, i64) +declare i32 @flan_dyn_need_i32(i64, 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 diff --git a/lib/form.ml b/lib/form.ml index f85d0665..e14f770b 100644 --- a/lib/form.ml +++ b/lib/form.ml @@ -36,7 +36,7 @@ let utf8 b = (* 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 and DEL, and the character itself otherwise. + 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 @@ -47,7 +47,7 @@ let byte_repr b = | 0 -> "\\nul" | 8 -> "\\backspace" | 12 -> "\\formfeed" - | b when b < 32 || b = 127 -> Printf.sprintf "\\u%04X" b + | 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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 342d8866..7fb3ee2f 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -741,7 +741,7 @@ static int is_scalar(int64_t cp) { /* 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 and DEL, the character itself after the + * 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]; @@ -756,7 +756,10 @@ static void char_spell(uint32_t cp, char buf[16]) { case 12: strcpy(buf, "\\formfeed"); return; default: break; } - if (cp < 32 || cp == 127) { snprintf(buf, 16, "\\u%04X", (unsigned)cp); return; } + 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]; @@ -2686,17 +2689,40 @@ double flan_dyn_need_f64(flan_dyn v) { return dyn_num_value(v); } -/* A char into typed code is its code point, an i32 — the prelude's rune. Only - * a char: an int is not one, and a typed i32 is taken from an int by writing - * the conversion, (i32 x). */ -int32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) { - if (flan_dyn_tag(v) != FLAN_DYN_TAG_CHAR) - trap1(loc, loclen, TYPE_TRAP, "i32", - flan_dyn_tag(v) == FLAN_DYN_TAG_INT - ? "an i32 is taken from a char, and from an int only by (i32 x)" - : "an i32 is taken from a char, its code point", - v); - return (int32_t)dyn_payload(v); +static const char *an(const char *w); /* forward: "a" or "an" */ + +/* A dyn into a typed i32: an int that fits, range-checked, or a char's code + * point — an i32 is the prelude's rune. The sentence names what was found + * and what would do, and no call: the site in front of it is the one that + * failed. */ +int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen) { + int32_t t = flan_dyn_tag(v); + char sv[SAY_MAX]; + if (t == FLAN_DYN_TAG_CHAR) return (int32_t)dyn_payload(v); + if (t == FLAN_DYN_TAG_INT) { + int64_t x = dyn_int_value(v); + if (x >= INT32_MIN && x <= INT32_MAX) return (int32_t)x; + flan_say(loc, loclen, + "dyn: an i32 is wanted here, and the int %lld is outside an " + "i32's range", (long long)x); + flan_trap((const uint8_t *)"DynRange", 8); + } + say(sv, SAY_MAX, v); + flan_say(loc, loclen, + "dyn: an i32 is wanted here, and this is %s %s, %s. An i32 takes an " + "int or a char's code point%s", + an(tag_of(v)), tag_of(v), sv, + t == FLAN_DYN_TAG_FLOAT ? "; convert a float with (i32 x)" : ""); + flan_trap((const uint8_t *)"DynType", 7); +} + +/* 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) { @@ -2788,6 +2814,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 diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index f0dfe8ed..372af22b 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -279,9 +279,11 @@ 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); -/* A char's code point, for a typed i32: the prelude's rune. Any other tag - * traps at [loc], an int included. */ -int32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen); +/* For a typed i32: an int in range, or a char's code point (the prelude's + * rune). Anything else, or an int out of range, traps at [loc]. */ +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 diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 3f24a639..6c2eb9c4 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -141,13 +141,17 @@ static void ops(void) { 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_char(flan_dyn_from_char(0x1F600), NULL, 0) == 0x1F600, - "need-char answers the code point"); + 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_char(FDYN_at(t, flan_dyn_from_i64(1)), NULL, 0) == 0x65E5, + 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"); @@ -267,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(flan_dyn_need_char(FDYN_at(a, flan_dyn_from_i64(0)), NULL, 0) == 'h', "at text"); - check(flan_dyn_need_char(FDYN_at(a, flan_dyn_from_i64(4)), NULL, 0) == '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(flan_dyn_need_char(FDYN_at(z, flan_dyn_from_i64(2)), NULL, 0) == '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"); } { diff --git a/test/programs/dyn-char-spell.flan b/test/programs/dyn-char-spell.flan index a4c26dca..c61cac62 100644 --- a/test/programs/dyn-char-spell.flan +++ b/test/programs/dyn-char-spell.flan @@ -1,4 +1,4 @@ -;;;; Every ASCII code point, and a few past it, as dyn chars printed one per +;;;; 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. @@ -7,6 +7,12 @@ (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)) diff --git a/test/programs/dyn-char.flan b/test/programs/dyn-char.flan index 52b7d7fa..a89d878a 100644 --- a/test/programs/dyn-char.flan +++ b/test/programs/dyn-char.flan @@ -1,7 +1,7 @@ ;;;; 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 int handed to an -;;;; i32 — a code point — traps at the call. +;;;; 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) @@ -41,6 +41,11 @@ (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) - (show (code-point (the dyn 5))))) + (if (= (at args 1) "big") + (show (code-point (the dyn 5000000000))) + (show (code-point (the dyn "x")))))) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 8d3f0f3b..bf2c3b08 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5355,16 +5355,19 @@ level "1" "\\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\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; (* Print, then read: each char dyn-char-spell.flan prints — every ASCII - code point, then three past it — reads back as the code point it was, + 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 @ [ 0xE9; 0x65E5; 0x1F600 ] in + 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:"" s with | [ { Form.v = Form.Byte b; _ } ] -> Some b @@ -5396,16 +5399,22 @@ level "1" List.iter (fun x86 -> let exe = compile ~x86 "programs/dyn-char.flan" in - let code, text = run exe (Some "x") in - let want = "programs/dyn-char.flan:45:25: dyn i32: int, and an i32 \ - is taken from a char" in - if code <> 134 || not (contains text want) then begin - incr failures; - Printf.printf - "FAIL dyn: a dyn int at an i32 traps%s\n got: %S (exit \ - %d)\n wanted: %S (exit 134)\n" - (if x86 then ", --x86" else "") text code want - end) + 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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 6407735e..2866d0c5 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -3014,6 +3014,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 From 9c47d3bacc245d1c98f486c0bfb2901a6f544f2f Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 12:27:40 +0700 Subject: [PATCH 4/6] A dyn goes into every integer width range-checked, a char where its code point fits, and the trap names the width and what it found. --- TODO.org | 11 ++--- lib/check.ml | 48 ++++++++++---------- lib/emit.ml | 1 + runtime/flan_dyn.c | 73 ++++++++++++++++++++++++------- runtime/flan_dyn.h | 8 +++- test/programs/dyn-int-widths.flan | 48 ++++++++++++++++++++ test/test_acceptance.ml | 54 ++++++++++++++++++++++- 7 files changed, 191 insertions(+), 52 deletions(-) create mode 100644 test/programs/dyn-int-widths.flan diff --git a/TODO.org b/TODO.org index 539a3fe2..560bda95 100644 --- a/TODO.org +++ b/TODO.org @@ -30,11 +30,12 @@ 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 a typed i32 (the prelude's -rune) or through (i32 c) it gives its code point. 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 u8 is wanted. Rules out char arithmetic, a typed code point -turning into a char, and byte offsets on dyn text. +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 Any typed container crosses into dyn as a view CLOSED: [2026-09-26] diff --git a/lib/check.ml b/lib/check.ml index 9e07dae7..3558f8f3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4185,38 +4185,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)) - (* An int that fits, range-checked at run time at this site, or a char's - code point: an i32 is the prelude's rune. *) - | Types.Int Types.I32 -> - rt loc want "flan_dyn_need_i32" [ e; here loc ] - (* 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 numeric cast written on a dyn ───────────────────────────────── diff --git a/lib/emit.ml b/lib/emit.ml index 9636f84c..bef243f1 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5070,6 +5070,7 @@ 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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 7fb3ee2f..1c76b1f7 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -2691,31 +2691,70 @@ double flan_dyn_need_f64(flan_dyn v) { static const char *an(const char *w); /* forward: "a" or "an" */ -/* A dyn into a typed i32: an int that fits, range-checked, or a char's code - * point — an i32 is the prelude's rune. The sentence names what was found - * and what would do, and no call: the site in front of it is the one that - * failed. */ -int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen) { +/* 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 (t == FLAN_DYN_TAG_CHAR) return (int32_t)dyn_payload(v); - if (t == FLAN_DYN_TAG_INT) { - int64_t x = dyn_int_value(v); - if (x >= INT32_MIN && x <= INT32_MAX) return (int32_t)x; - flan_say(loc, loclen, - "dyn: an i32 is wanted here, and the int %lld is outside an " - "i32's range", (long long)x); + 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); } - say(sv, SAY_MAX, v); + 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: an i32 is wanted here, and this is %s %s, %s. An i32 takes an " - "int or a char's code point%s", - an(tag_of(v)), tag_of(v), sv, - t == FLAN_DYN_TAG_FLOAT ? "; convert a float with (i32 x)" : ""); + "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 diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 372af22b..24a290f9 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -279,8 +279,12 @@ 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 i32: an int in range, or a char's code point (the prelude's - * rune). Anything else, or an int out of range, traps at [loc]. */ +/* 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); diff --git a/test/programs/dyn-int-widths.flan b/test/programs/dyn-int-widths.flan new file mode 100644 index 00000000..7faf69da --- /dev/null +++ b/test/programs/dyn-int-widths.flan @@ -0,0 +1,48 @@ +;;;; 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))) + (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 \😀))) + :else (println (to-i64 (d "x"))))))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index bf2c3b08..604e43dc 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5360,6 +5360,56 @@ level "1" 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 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\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", "37:42: dyn: a u8 is wanted here, and the int 256 is \ + outside a u8's range"); + ("u8-neg", "38:42: dyn: a u8 is wanted here, and the int -1 is \ + outside a u8's range"); + ("i8-128", "39:42: dyn: an i8 is wanted here, and the int 128 is \ + outside an i8's range"); + ("i16-big", "40:44: dyn: an i16 is wanted here, and the int 32768"); + ("u16-big", "41:44: dyn: a u16 is wanted here, and the int 65536"); + ("i32-big", "42:44: dyn: an i32 is wanted here, and the int \ + 2147483648"); + ("u32-neg", "43:44: dyn: a u32 is wanted here, and the int -1 is \ + outside a u32's range"); + ("u64-neg", "44:44: dyn: a u64 is wanted here, and the int -1"); + ("u8-char", "45:43: dyn: a u8 is wanted here, and the char \\é is \ + more than one byte in UTF-8"); + ("u16-char", "46:45: dyn: a u16 is wanted here, and the char \ + \\😀, code point 128512, is outside a u16's range"); + ("x", "47: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 @@ -5567,7 +5617,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 @@ -5615,7 +5665,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 From 5d41a2d424473d074f60e0941663cd662da22343 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 12:54:08 +0700 Subject: [PATCH 5/6] A dyn vec or map moved into typed storage takes a char where its code point fits, and a whole float in a trap's sentence reads as 2.0. --- runtime/flan_dyn.c | 21 +++++++++++++++++++++ test/programs/dyn-int-widths.flan | 18 ++++++++++++++++++ test/test_acceptance.ml | 30 ++++++++++++++++++------------ 3 files changed, 57 insertions(+), 12 deletions(-) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index cacfa7d9..1044f30e 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -994,6 +994,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: { @@ -4536,6 +4539,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); @@ -4550,6 +4570,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; } diff --git a/test/programs/dyn-int-widths.flan b/test/programs/dyn-int-widths.flan index 7faf69da..63857a26 100644 --- a/test/programs/dyn-int-widths.flan +++ b/test/programs/dyn-int-widths.flan @@ -31,6 +31,8 @@ (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 @@ -44,5 +46,21 @@ (= 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)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 0dfb48b0..11b717c8 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5456,7 +5456,7 @@ level "1" -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\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" @@ -5477,24 +5477,30 @@ level "1" wanted: %S (exit 134)\n" arg (if x86 then ", --x86" else "") text code want end) - [ ("u8-256", "37:42: dyn: a u8 is wanted here, and the int 256 is \ + [ ("u8-256", "39:42: dyn: a u8 is wanted here, and the int 256 is \ outside a u8's range"); - ("u8-neg", "38:42: dyn: a u8 is wanted here, and the int -1 is \ + ("u8-neg", "40:42: dyn: a u8 is wanted here, and the int -1 is \ outside a u8's range"); - ("i8-128", "39:42: dyn: an i8 is wanted here, and the int 128 is \ + ("i8-128", "41:42: dyn: an i8 is wanted here, and the int 128 is \ outside an i8's range"); - ("i16-big", "40:44: dyn: an i16 is wanted here, and the int 32768"); - ("u16-big", "41:44: dyn: a u16 is wanted here, and the int 65536"); - ("i32-big", "42:44: dyn: an i32 is wanted here, and the int \ + ("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", "43:44: dyn: a u32 is wanted here, and the int -1 is \ + ("u32-neg", "45:44: dyn: a u32 is wanted here, and the int -1 is \ outside a u32's range"); - ("u64-neg", "44:44: dyn: a u64 is wanted here, and the int -1"); - ("u8-char", "45:43: dyn: a u8 is wanted here, and the char \\é is \ + ("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", "46:45: dyn: a u16 is wanted here, and the char \ + ("u16-char", "48:45: dyn: a u16 is wanted here, and the char \ \\😀, code point 128512, is outside a u16's range"); - ("x", "47:34: dyn: an i64 is wanted here, and this is a text, \ + ("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 From d9802516325476fd5cd870bd455bf92d08a2868a Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 13:01:33 +0700 Subject: [PATCH 6/6] A text's ASCII check is its char count against its length, so pinning a text never changes how it counts, and a char writes through a dyn view where its code point fits. --- runtime/flan_dyn.c | 40 ++++++++++++++++++++++-------- test/programs/dyn-char-pinned.flan | 25 +++++++++++++++++++ test/test_acceptance.ml | 23 +++++++++++++++++ 3 files changed, 78 insertions(+), 10 deletions(-) create mode 100644 test/programs/dyn-char-pinned.flan diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 1044f30e..1756ed75 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -767,23 +767,20 @@ static void char_spell(uint32_t cp, char buf[16]) { } /* 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; [gen] - * says whether every byte is ASCII, which makes an index a byte offset. */ -#define TEXT_ASCII 1u - + * 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, ascii = 1; + int w; while (i < o->len) { if (p[i] < 0x80) { i++; n++; continue; } - ascii = 0; utf8_decode(p + i, o->len - i, &w); i += w; n++; } o->u.i = n; - o->gen = ascii ? TEXT_ASCII : 0; } /* The byte offset of char [k], 0 <= k <= the char count. */ @@ -791,7 +788,7 @@ 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->gen & TEXT_ASCII) return k; + if (o->u.i == o->len) return k; while (k > 0 && i < o->len) { utf8_decode(p + i, o->len - i, &w); i += w; @@ -1681,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 @@ -4067,6 +4065,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); @@ -4098,6 +4117,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; } diff --git a/test/programs/dyn-char-pinned.flan b/test/programs/dyn-char-pinned.flan new file mode 100644 index 00000000..3801c28a --- /dev/null +++ b/test/programs/dyn-char-pinned.flan @@ -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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 11b717c8..ce12cc2c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5447,6 +5447,29 @@ level "1" 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 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