From 71f2b0b9b6189ce22bba29c2c782d3aa093b7ece Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 11:11:42 +0700 Subject: [PATCH] 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"