From 570d2d88fb2cb4072ae9fbc27ab368919963e519 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 15:27:07 +0700 Subject: [PATCH] A char plus or minus an integer is checked for overflow, so a trap names the true sum or the side of the range it left. --- lib/check.ml | 17 +++++++++-------- lib/emit.ml | 1 + runtime/flan_dyn.c | 23 ++++++++++++++++------- runtime/flan_rt.c | 17 +++++++++++++++++ test/programs/char-arith.flan | 8 +++++++- test/test_acceptance.ml | 14 ++++++++++---- 6 files changed, 60 insertions(+), 20 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 89df4fba..5dacae87 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -11271,16 +11271,17 @@ and char_step ~want loc name (a : Tast.expr) (b : Tast.expr) : Tast.expr = let r = if op = Tast.Add then Int64.add x y else Int64.sub x y in if scalar r then mk loc Types.Char (Tast.Int (r, Types.U32)) else not_scalar (Int64.to_string r) - (* A u64 is taken as itself, so no large one wraps round to a char. *) - | _ when k = Types.U64 -> - rt loc Types.Char "flan_char_step_u64" - [ widen loc (Types.Int Types.I32) c; n; + (* The runtime takes the integer as itself — a u64 unsigned, anything + else as an i64 — and checks the sum for overflow, so no large one + wraps round to a char or to a wrong number in the trap. *) + | _ -> + rt loc Types.Char + (if k = Types.U64 then "flan_char_step_u64" else "flan_char_step_i64") + [ widen loc (Types.Int Types.I32) c; + (if k = Types.U64 then n else i64 n); mk loc (Types.Int Types.I32) (Tast.Int ((if op = Tast.Sub then 1L else 0L), Types.I32)); - here loc ] - | _ -> - let sum = mk loc dyn_i64 (Tast.Prim (op, [ i64 a; i64 b ])) in - rt loc Types.Char "flan_char_of" [ sum; here loc ]) + here loc ]) | _ -> char_arith (if a.Tast.ty = Types.Char then a.Tast.loc else b.Tast.loc) name; assert false diff --git a/lib/emit.ml b/lib/emit.ml index 5d732f9c..2f28d53e 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5149,6 +5149,7 @@ declare i32 @flan_dyn_need_char(i64, ptr, i64) declare i32 @flan_char_of(i64, ptr, i64) declare i32 @flan_char_of_u64(i64, ptr, i64) declare i32 @flan_char_step_u64(i32, i64, i32, ptr, i64) +declare i32 @flan_char_step_i64(i32, i64, i32, 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/runtime/flan_dyn.c b/runtime/flan_dyn.c index 93264feb..f7bd7c4a 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -3091,14 +3091,23 @@ static int char_arith(const uint8_t *loc, int64_t loclen, const char *op, *out = flan_dyn_from_i64((int64_t)dyn_payload(a) - (int64_t)dyn_payload(b)); return 1; } - if (ca && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) - n = (int64_t)((uint64_t)dyn_payload(a) + - (op[0] == '-' ? -(uint64_t)dyn_int_value(b) - : (uint64_t)dyn_int_value(b))); - else if (op[0] == '+' && cb && flan_dyn_tag(a) == FLAN_DYN_TAG_INT) - n = (int64_t)((uint64_t)dyn_int_value(a) + (uint64_t)dyn_payload(b)); - else + int64_t cp, m; + int sub = op[0] == '-'; + if (ca && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { + cp = (int64_t)dyn_payload(a); + m = dyn_int_value(b); + } else if (!sub && cb && flan_dyn_tag(a) == FLAN_DYN_TAG_INT) { + cp = (int64_t)dyn_payload(b); + m = dyn_int_value(a); + } else return 0; + /* Checked, so a trap names the true sum or which side it left. */ + if (sub ? __builtin_sub_overflow(cp, m, &n) : __builtin_add_overflow(cp, m, &n)) { + flan_say(loc, loclen, "dyn %s: %lld %s %lld is %s, so it is not a char", + op, (long long)cp, sub ? "minus" : "plus", (long long)m, + (sub ? m < 0 : m > 0) ? "past 0x10FFFF" : "below zero"); + dyn_trap((const uint8_t *)"InvalidChar", 11); + } if (!is_scalar(n)) { flan_say(loc, loclen, "dyn %s: %lld is not a Unicode scalar value, so it is not a char", diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 45f1b79c..45478900 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -3009,6 +3009,23 @@ uint32_t flan_char_step_u64(int32_t cp, uint64_t n, int32_t sub, return flan_char_of_u64(r, loc, loclen); } +/* A char plus or minus any other integer, as an i64 ([sub] 1 for minus). + * The sum is checked for overflow first, so a trap names the true result or + * says which side of the range it left, never a wrapped number. */ +uint32_t flan_char_step_i64(int32_t cp, int64_t n, int32_t sub, + const uint8_t *loc, int64_t loclen) { + int64_t r; + int over = sub ? __builtin_sub_overflow((int64_t)cp, n, &r) + : __builtin_add_overflow((int64_t)cp, n, &r); + if (over) { + flan_say(loc, loclen, "%lld %s %lld is %s, so it is not a char", + (long long)cp, sub ? "minus" : "plus", (long long)n, + (sub ? n < 0 : n > 0) ? "past 0x10FFFF" : "below zero"); + rt_trap((const uint8_t *)"InvalidChar", 11); + } + return flan_char_of(r, loc, loclen); +} + /* [n] elements from [src] onto the end of a Vec, growing it once. [src] may * point into the Vec's own block — (append s (str s)) — so where it lies is * found before the grow and read again after it: the grow frees the old diff --git a/test/programs/char-arith.flan b/test/programs/char-arith.flan index a37e1f4a..c017ca16 100644 --- a/test/programs/char-arith.flan +++ b/test/programs/char-arith.flan @@ -3,7 +3,8 @@ ;;;; is the distance, an i32. Dyn chars do the same. Byte code beside it is ;;;; unchanged. With "past" a char past U+10FFFF traps, with "surrogate" one ;;;; landing on a surrogate does, with "dyn" a dyn char below zero does, and -;;;; with "u64" a char plus the largest u64 does rather than wrapping round. +;;;; with "u64" a char plus the largest u64 does rather than wrapping round, +;;;; and with "i64" and "dyn-i64" a char plus the largest i64 does, naming it. (defn show [x] () (println x)) (defn add [a b] dyn (+ a b)) @@ -17,6 +18,7 @@ (push v (- a b)) (+ (- a b) (at v 0) 1))) (defn plus-u64 [c char n u64] char (+ c n)) +(defn plus-i64 [c char n i64] char (+ c n)) (defn main [args [str]] i32 ;; The fork case with arithmetic: a let-bound char stays a char. @@ -52,6 +54,10 @@ (println (+ (char 0xD7FF) (- k 1))) (= (at args 1) "u64") (println (plus-u64 \a (- (u64 0) (u64 (- k 1))))) + (= (at args 1) "i64") + (println (plus-i64 \a (- (max-value i64) (i64 (- k 2))))) + (= (at args 1) "dyn-i64") + (println (add \a (- (max-value i64) (i64 (- k 2))))) :else (println (sub \a (* k 100)))))) 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index ea95a277..f05d9a78 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5623,14 +5623,20 @@ level "1" %d)\n wanted: %S (exit 134)\n" arg (if x86 then ", --x86" else "") text code want end) - [ ("past", "programs/char-arith.flan:50:18: 1114112 is not a \ + [ ("past", "programs/char-arith.flan:52:18: 1114112 is not a \ Unicode scalar value, so it is not a char"); - ("surrogate", "programs/char-arith.flan:52:18: 55296 is not a \ + ("surrogate", "programs/char-arith.flan:54:18: 55296 is not a \ Unicode scalar value, so it is not a char"); - ("u64", "programs/char-arith.flan:19:36: 97 plus \ + ("u64", "programs/char-arith.flan:20:36: 97 plus \ 18446744073709551615 is past 0x10FFFF, so it is not a \ char"); - ("dyn", "programs/char-arith.flan:10:21: dyn -: -103 is not a \ + ("i64", "programs/char-arith.flan:21:36: 97 plus \ + 9223372036854775807 is past 0x10FFFF, so it is not a \ + char"); + ("dyn-i64", "programs/char-arith.flan:10:21: dyn +: 97 plus \ + 9223372036854775807 is past 0x10FFFF, so it is not \ + a char"); + ("dyn", "programs/char-arith.flan:11:21: dyn -: -103 is not a \ Unicode scalar value, so it is not a char") ]) [ false; true ]; (* A String, and a str made from one, cross into dyn as text measured