A char minus a char takes the integer width its site wants, a chain of + or - folds left step by step, and a char plus a u64 is checked unsigned.

lib/check.ml

@@ -11233,45 +11233,84 @@ and char_arith loc name =
 
 (* One step of char arithmetic (decision 131, Kotlin's rules): a char plus or
    minus an integer is a char, checked to be a scalar value — at compile time
-   when both sides are constants, by [flan_char_of] at run time otherwise —
-   and a char minus a char is the distance between them, an i32. Anything
-   else with a char in it is refused. *)
-and char_step _ctx loc name (a : Tast.expr) (b : Tast.expr) : Tast.expr =
+   when both sides are constants, at run time otherwise — and a char minus a
+   char is the distance between them, an integer at the width the site wants
+   (i32 when it wants none), as any integer expression is. A step with no char
+   in it is the ordinary one. Anything else with a char in it is refused. *)
+and char_step ~want loc name (a : Tast.expr) (b : Tast.expr) : Tast.expr =
   let i64 e = widen loc dyn_i64 e in
   let const (e : Tast.expr) =
     match e.Tast.e with Tast.Int (n, _) -> Some n | _ -> None
   in
   let op = if String.equal name "+" then Tast.Add else Tast.Sub in
-  let fold f = match const a, const b with
-    | Some x, Some y -> Some (f x y) | _ -> None
+  let scalar n =
+    Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
+    && not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
   in
-  let apply x y = if String.equal name "+" then Int64.add x y else Int64.sub x y in
+  let not_scalar n =
+    Loc.failk "check/char-range" loc
+      "this is %s, which is not a Unicode scalar value, so it is not a \
+       char. A char is a code point from 0 to 0x10FFFF, outside 0xD800 \
+       to 0xDFFF" n
+  in
+  let kind = match want with Some (Types.Int k) -> k | _ -> Types.I32 in
   match a.Tast.ty, b.Tast.ty with
   | Types.Char, Types.Char when String.equal name "-" ->
-    (match fold Int64.sub with
-     | Some n -> mk loc (Types.Int Types.I32) (Tast.Int (n, Types.I32))
-     | None ->
-       let i32 e = widen loc (Types.Int Types.I32) e in
-       mk loc (Types.Int Types.I32) (Tast.Prim (Tast.Sub, [ i32 a; i32 b ])))
-  | Types.Char, Types.Int _ | Types.Int _, Types.Char
+    let t = Types.Int kind in
+    (match const a, const b with
+     | Some x, Some y -> int_literal loc ~want:(Some t) (Int64.sub x y)
+     | _ -> mk loc t (Tast.Prim (Tast.Sub, [ widen loc t a; widen loc t b ])))
+  | Types.Char, Types.Int k | Types.Int k, Types.Char
     when not (String.equal name "-" && b.Tast.ty = Types.Char) ->
-    (match fold apply with
-     | Some n ->
-       if Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
-          && not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
-       then mk loc Types.Char (Tast.Int (n, Types.U32))
-       else
-         Loc.failk "check/char-range" loc
-           "this is %Ld, which is not a Unicode scalar value, so it is not a \
-            char. A char is a code point from 0 to 0x10FFFF, outside 0xD800 \
-            to 0xDFFF" n
-     | None ->
+    let c, n = if a.Tast.ty = Types.Char then a, b else b, a in
+    (match const c, const n with
+     (* A u64 past the largest i64 is held as a negative i64: no char. *)
+     | Some _, Some v when k = Types.U64 && Int64.compare v 0L < 0 ->
+       not_scalar (Printf.sprintf "past 0x10FFFF")
+     | Some x, Some y ->
+       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;
+           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 ])
   | _ ->
     char_arith (if a.Tast.ty = Types.Char then a.Tast.loc else b.Tast.loc) name;
     assert false
 
+(* Whether [e] may be a char, read off its form without checking it: a name
+   bound to one, a (char n), a function returning one, or [+]/[-] over any
+   of those. What decides whether a [+] or [-] is checked as char
+   arithmetic before the want of its site reaches its operands. A char
+   literal is not on the list: beside a number it is that number. *)
+and maybe_char ctx (e : Ast.expr) =
+  match e.Ast.e with
+  | Ast.Var n ->
+    (match lookup ctx n with
+     | Some b -> b.bty = Types.Char
+     | None ->
+       match peek_outer ctx n with
+       | Some b -> b.bty = Types.Char
+       | None ->
+         (match Hashtbl.find_opt ctx.env.globals n with
+          | Some (t, _) -> t = Types.Char
+          | None -> false))
+  | Ast.Call ({ Ast.e = Ast.Var "char"; _ }, [ _ ]) -> true
+  | Ast.Call ({ Ast.e = Ast.Var ("+" | "-"); _ }, args) ->
+    List.exists (maybe_char ctx) args
+  | Ast.Call ({ Ast.e = Ast.Var f; _ }, _) ->
+    (match Hashtbl.find_opt ctx.env.fns f with
+     | Some (_, r) -> r = Types.Char
+     | None -> false)
+  | _ -> false
+
 (* ── A conversion whose operand is a type variable ─────────────────────
    [(i32 x)] where [x] is a [$t]. The concrete question — is this a number —
    has no answer during the abstract pass, and asking it anyway is what
@@ -11347,30 +11386,61 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args =
     match args with x :: y :: rest -> x, y, rest | _ -> assert false
   in
   let charish = String.equal name "+" || String.equal name "-" in
+  let nwant = numeric_want want in
+  (* A char literal is a char here, not the number, when no number is
+     wanted; one that may be a char by its form keeps the want off the pair,
+     which a char minus a char answers at the want's width itself. *)
+  let int_lit (e : Ast.expr) = match e.Ast.e with Ast.Int _ -> true | _ -> false in
+  (* A char literal later in the chain is a char only while everything
+     before it is an integer literal too; beside a typed number it is that
+     number, as in (+ b c \0) over bytes. *)
+  let untyped = ref (int_lit x && int_lit y) in
+  let char_lit (e : Ast.expr) =
+    match e.Ast.e with Ast.Byte _ -> nwant = None && !untyped | _ -> false
+  in
   let a, b =
     try
-      (* An integer literal then a char literal, where no number is wanted:
-         char arithmetic, which the join would read the other way round. *)
-      (match x.Ast.e, y.Ast.e, numeric_want want with
-       | Ast.Int _, Ast.Byte _, None when charish ->
+      (match x.Ast.e, y.Ast.e with
+       | Ast.Int _, Ast.Byte _ when charish && nwant = None ->
          raise_notrace (Char_pair (check ctx x, check ctx y))
        | _ -> ());
+      let pwant = if charish && (maybe_char ctx x || maybe_char ctx y) then None else nwant in
       char_operands ctx ~charish name [ x; y ] (fun () ->
-          binary ctx ~dyn_ok:true ~char_ok:charish name loc
-            ~want:(numeric_want want) [ x; y ])
+          binary ctx ~dyn_ok:true ~char_ok:charish name loc ~want:pwant [ x; y ])
     with Char_pair (a, b) -> a, b
   in
   (* One dyn operand makes the whole fold dyn, whichever side it is on. The
      typed side is boxed by [dyn_fold]; a literal was already built at dyn by
      [binary], so [(+ x 1)] over a dyn x folds an i64 one. *)
-  if charish && (a.Tast.ty = Types.Char || b.Tast.ty = Types.Char)
-     && a.Tast.ty <> Types.Dyn && b.Tast.ty <> Types.Dyn then
-    let acc =
-      List.fold_left
-        (fun acc arg -> char_step ctx loc name acc (check ctx arg))
-        (char_step ctx loc name a b) rest
+  let is_char (e : Tast.expr) = e.Tast.ty = Types.Char in
+  if charish && a.Tast.ty <> Types.Dyn && b.Tast.ty <> Types.Dyn
+     && (is_char a || is_char b
+         || List.exists (maybe_char ctx) rest
+         || (let rec any = function
+               | [] -> false
+               | r :: tl -> char_lit r || (untyped := !untyped && int_lit r; any tl)
+             in
+             let was = !untyped in
+             let r = any rest in
+             untyped := was; r)) then
+    (* Left to right, each step char arithmetic when a char is in it and the
+       ordinary join when none is: (- \z \a 1) is 25 - 1, and (+ 1 2 \a) is
+       3 + \a. *)
+    let step acc (arg : Ast.expr) =
+      let lit = char_lit arg in
+      untyped := !untyped && int_lit arg;
+      if is_char acc || maybe_char ctx arg || lit then
+        let v = check ctx arg in
+        if is_char acc || is_char v then char_step ~want:nwant loc name acc v
+        else mk loc acc.Tast.ty (Tast.Prim (p, [ acc; expect ctx arg.Ast.loc ~want:(Some acc.Tast.ty) v ]))
+      else
+        mk loc acc.Tast.ty (Tast.Prim (p, [ acc; check ctx ~want:acc.Tast.ty arg ]))
     in
-    expect ctx loc ~want acc
+    let first =
+      if is_char a || is_char b then char_step ~want:nwant loc name a b
+      else mk loc a.Tast.ty (Tast.Prim (p, [ a; b ]))
+    in
+    expect ctx loc ~want (List.fold_left step first rest)
   else if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
     dyn_fold ctx ~want loc name [ a; b ] rest
   else begin
@@ -12853,6 +12923,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
      | Ast.Float v, _ -> check ctx ?want { Ast.e = Ast.Float (-.v); loc }
      | _ ->
        let v = check ctx ?want:(numeric_want want) x in
+       if v.Tast.ty = Types.Char then
+         Loc.failk "check/char-arithmetic" x.Ast.loc
+           "- does not negate a char. Take its code point with %s, and make a \
+            char of one with %s"
+           (if fln_source loc then "i32(c)" else "(i32 c)")
+           (if fln_source loc then "char(n)" else "(char n)");
        if v.Tast.ty = Types.Dyn then
          expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_neg" [ v; here loc ])
        else begin

lib/emit.ml

@@ -5148,6 +5148,7 @@ declare i64 @flan_dyn_int_of(i64)
 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)
 ; 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

runtime/flan_rt.c

@@ -2994,6 +2994,21 @@ uint32_t flan_char_of_u64(uint64_t n, const uint8_t *loc, int64_t loclen) {
   rt_trap((const uint8_t *)"InvalidChar", 11);
 }
 
+/* A char plus or minus a u64 ([sub] 1 for minus), taken unsigned so no u64
+ * past the largest i64 wraps round to a char. */
+uint32_t flan_char_step_u64(int32_t cp, uint64_t n, int32_t sub,
+                            const uint8_t *loc, int64_t loclen) {
+  uint64_t r;
+  if (sub ? n > (uint64_t)cp : n > 0x10ffff) {
+    flan_say(loc, loclen, "%lld %s %llu is %s, so it is not a char",
+             (long long)cp, sub ? "minus" : "plus", (unsigned long long)n,
+             sub ? "below zero" : "past 0x10FFFF");
+    rt_trap((const uint8_t *)"InvalidChar", 11);
+  }
+  r = sub ? (uint64_t)cp - n : (uint64_t)cp + n;
+  return flan_char_of_u64(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

test/programs/char-arith.flan

@@ -2,12 +2,21 @@
 ;;;; integer is a char, an integer plus a char is too, and a char minus a char
 ;;;; 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, and with "dyn" a dyn char below zero does.
+;;;; 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.
 
 (defn show [x] () (println x))
 (defn add [a b] dyn (+ a b))
 (defn sub [a b] dyn (- a b))
 (defn upper [c char] char (if (and (>= c \a) (<= c \z)) (- c 32) c))
+;; A char minus a char where an integer is wanted is that integer.
+(defn digit [c char] i32 (- c \0))
+(defn gap [a char b char] u8 (- a b))
+(defn gaps [a char b char] i32
+  (let [v (vec-new i32)]
+    (push v (- a b))
+    (+ (- a b) (at v 0) 1)))
+(defn plus-u64 [c char n u64] char (+ c n))
 
 (defn main [args [str]] i32
   ;; The fork case with arithmetic: a let-bound char stays a char.
@@ -19,6 +28,9 @@
         n 3]
     (println (+ c n) (+ n c) (- c n) (- c \a) (- \a \A) (+ \a 1 1)))
   (println (upper \q) (upper \Q) (upper \é))
+  (println (digit \7) (gap \c \a) (gaps \c \a) (plus-u64 \a (u64 2)))
+  ;; Longer chains fold left, each step by its own operands.
+  (println (- \z \a 1) (+ 1 2 \a) (- \z 1 \a))
   ;; += and -= on a char local.
   (let [c \a]
     (set c (+ c 2))
@@ -38,6 +50,8 @@
         (println (+ (char 0x10FFFF) (- k 1)))
         (= (at args 1) "surrogate")
         (println (+ (char 0xD7FF) (- k 1)))
+        (= (at args 1) "u64")
+        (println (plus-u64 \a (- (u64 0) (u64 (- k 1)))))
         :else
         (println (sub \a (* k 100))))))
   0)

test/test_acceptance.ml

@@ -5603,7 +5603,7 @@ level "1"
        with arithmetic, and a byte beside it; then a char past U+10FFFF, one
        on a surrogate, and a dyn one below zero, each trapping at its form. *)
     let char_arith_out =
-      "a\nb\ng g a 3 32 c\nQ Q é\nb\nb b y 32 z\n97 true\n"
+      "a\nb\ng g a 3 32 c\nQ Q é\n7 2 5 c\n24 d 24\nb\nb b y 32 z\n97 true\n"
     in
     outputs "char: arithmetic" "programs/char-arith.flan" char_arith_out;
     outputs ~opt:"-O0" "char: arithmetic, -O0" "programs/char-arith.flan"
@@ -5623,11 +5623,14 @@ level "1"
                    %d)\n     wanted: %S (exit 134)\n"
                   arg (if x86 then ", --x86" else "") text code want
               end)
-           [ ("past", "programs/char-arith.flan:38:18: 1114112 is not a \
+           [ ("past", "programs/char-arith.flan:50:18: 1114112 is not a \
                        Unicode scalar value, so it is not a char");
-             ("surrogate", "programs/char-arith.flan:40:18: 55296 is not a \
+             ("surrogate", "programs/char-arith.flan:52:18: 55296 is not a \
                             Unicode scalar value, so it is not a char");
-             ("dyn", "programs/char-arith.flan:9:21: dyn -: -103 is not a \
+             ("u64", "programs/char-arith.flan:19: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 \
                       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

test/test_flan.ml

@@ -3251,7 +3251,13 @@ let () =
     "(defn f [] char (- \\a 200))"
     ~needle:"this is -103, which is not a Unicode scalar value";
   rejects_check "nor negated"
-    "(defn f [c char] char (- c))" ~needle:"- takes an integer or a char";
+    "(defn f [c char] char (- c))" ~needle:"- does not negate a char";
+  accepts "a char minus a char where an i32 is wanted"
+    "(defn f [c char] i32 (- c \\0))";
+  accepts "a char minus a char where a u8 is wanted"
+    "(defn f [a char b char] u8 (- a b))";
+  accepts "a char distance in arithmetic"
+    "(defn f [a char b char] i32 (+ (- a b) 1))";
   rejects_check "nor bitwise"
     "(defn f [c char] char (bit-and c c))"
     ~needle:"bit-and does no arithmetic on a char";