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