Type literal-init loop counters as fixnums (lever 2/4)

A loop var with an integer-literal init now types :long (fx ops) when every recur
arg in its slot is an increment-style step — the var unchanged, inc/dec, or (+/-
var <int-literal>). So (loop [i 0] (recur (inc i))) gets fx1+/fx<? without a hint,
matching how Clojure treats a primitive-long loop counter.

Soundness: only increment steps qualify. A multiplicative or large-growth
accumulator like (recur (* acc 2)) is never seeded, so it stays generic and keeps
arbitrary precision — a bignum-producing loop (e.g. a factorial) is unaffected.
counter-step? gates this; the existing fixpoint demotes anything inconsistent.

test/chez/numeric-test.ss 44/44 (incl. a factorial loop staying bignum-exact while
its counter is fx); full make test green, 0 new corpus divergences.

jolt-core/jolt/passes/numeric.clj

@@ -66,6 +66,41 @@
       (= op :do) (recur-kinds (get node :ret) tenv)
       :else [])))
 
+;; The recur-arg NODE lists for the recurs at THIS loop level (structural, no env),
+;; parallel to recur-kinds. Used to recognise a counter.
+(defn- recur-arg-lists [node]
+  (let [op (get node :op)]
+    (cond
+      (= op :recur) [(get node :args)]
+      (= op :let) (recur-arg-lists (get node :body))
+      (= op :if) (concat (recur-arg-lists (get node :then)) (recur-arg-lists (get node :else)))
+      (= op :do) (recur-arg-lists (get node :ret))
+      :else [])))
+
+;; Is `arg` an increment-style step of loop var `vname`: the var unchanged, or
+;; inc/dec/unchecked-inc/dec, or (+/- var <int-literal>)? Bounded growth that a
+;; fixnum-range counter can sustain for any realistic loop — unlike (* acc x), which
+;; overflows fast, so a multiplicative accumulator never qualifies and stays
+;; arbitrary-precision.
+(defn- counter-step? [arg vname]
+  (cond
+    (and (= :local (get arg :op)) (= vname (get arg :name))) true
+    (= :invoke (get arg :op))
+    (let [f (get arg :fn) as (get arg :args)]
+      (and (= :var (get f :op)) (= "clojure.core" (get f :ns))
+           (let [nm (get f :name)
+                 v? (fn [n] (and (= :local (get n :op)) (= vname (get n :name))))]
+             (cond
+               (and (contains? #{"inc" "dec" "unchecked-inc" "unchecked-dec"} nm) (= 1 (count as)))
+               (v? (nth as 0))
+               (and (contains? #{"+" "unchecked-add"} nm) (= 2 (count as)))
+               (or (and (v? (nth as 0)) (int-lit? (nth as 1)))
+                   (and (v? (nth as 1)) (int-lit? (nth as 0))))
+               (and (contains? #{"-" "unchecked-subtract"} nm) (= 2 (count as)))
+               (and (v? (nth as 0)) (int-lit? (nth as 1)))
+               :else false))))
+    :else false))
+
 ;; Loop-var kinds by bounded fixpoint. A var keeps its init kind (:double or :long)
 ;; only if every recur arg in that slot is the same kind (under the current
 ;; assumption) — a monotone demotion that stops at a fixpoint, bounded by the var
@@ -73,8 +108,8 @@
 ;; keeps arbitrary precision (no :long from a bare literal). A typed loop var's init
 ;; and recur args are all flonums/fixnums (a :long init flows from a coerced ^long
 ;; value or an fx op), so no entry coercion is needed here, unlike a fn param.
-(defn- loop-kinds [names ik body tenv]
-  (loop [cur ik iter 0]
+(defn- loop-kinds [names seed body tenv]
+  (loop [cur seed iter 0]
     (if (> iter (count names))
       cur
       (let [te (reduce (fn [t i] (assoc t (nth names i) (nth cur i))) tenv (range (count names)))
@@ -152,7 +187,24 @@
       (let [binds (get node :bindings)
             names (mapv (fn [b] (nth b 0)) binds)
             ik (mapv (fn [b] (nth (an (nth b 1) tenv) 0)) binds)
-            lk (loop-kinds names ik (get node :body) tenv)
+            rlists (recur-arg-lists (get node :body))
+            ;; seed each var: an already-typed init keeps its kind; an integer-literal
+            ;; init whose recur args are all counter steps is a fixnum counter (:long).
+            seed (mapv (fn [j]
+                         (let [k (nth ik j) b (nth binds j)]
+                           (cond
+                             k k
+                             ;; an int-literal var is a fixnum counter only in a real
+                             ;; iterating loop (>= 1 recur) whose every step is bounded.
+                             ;; A recur-less loop is a let — its int literal stays
+                             ;; generic (arbitrary precision), like a let binding.
+                             (and (seq rlists)
+                                  (int-lit? (nth b 1))
+                                  (every? (fn [args] (counter-step? (nth args j) (nth b 0))) rlists))
+                             :long
+                             :else nil)))
+                       (range (count names)))
+            lk (loop-kinds names seed (get node :body) tenv)
             te (reduce (fn [t i] (assoc t (nth names i) (nth lk i))) tenv (range (count names)))]
         [nil (assoc node
                     :bindings (mapv (fn [b] [(nth b 0) (nth (an (nth b 1) tenv) 1)]) binds)

test/chez/numeric-test.ss

@@ -30,6 +30,7 @@
   (let-values (((f j) (rdr-read-form str 0 (string-length str))))
     (let ((ctx (make-analyze-ctx ns)))
       (jolt-ce-emit (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx)))))
+(define (ev s) (jolt-compile-eval s "u"))
 
 ;; --- emission: ^double -> fl-ops, ^long -> fx-ops ---
 (let ((e (emitf "u" "(fn* ([^double a ^double b] (+ (* a a) (* b b))))")))
@@ -64,6 +65,25 @@
 ;; precision (no fx* overflow).
 (let ((e (emitf "u" "(fn* ([] (loop [acc 1 i 1] (if (< i 25) (recur (* acc i) (inc i)) acc))))")))
   (ok "loop integer accumulator is NOT fx-specialized" (not (has? e "(fx*"))))
+;; a literal-init increment counter types as a fixnum (fx1+), even with no hint.
+(let ((e (emitf "u" "(fn* ([] (loop [i 0] (if (< i 5) (recur (inc i)) i))))")))
+  (ok "literal-init increment counter lowers to fx1+" (has? e "(fx1+")))
+;; but a multiplicative accumulator in the SAME loop stays generic (bignum-safe);
+;; only the counter types.
+(let ((e (emitf "u" "(fn* ([] (loop [acc 1 i 0] (if (< i 100) (recur (* acc i) (inc i)) acc))))")))
+  (ok "counter beside a * accumulator: counter is fx1+" (has? e "(fx1+"))
+  (ok "the * accumulator is NOT fx-specialized (bignum-safe)" (not (has? e "(fx*"))))
+(ok "counter+bignum-accumulator stays exact (1*2*...*99 is a bignum)"
+    (jolt-truthy? (ev "(< 1000000000000000000000 ((fn* ([] (loop [acc 1 i 1] (if (< i 100) (recur (* acc i) (inc i)) acc))))))")))
+(ok "increment counter runtime: counts to 1000"
+    (= 1000 (jnum->exact (ev "((fn* ([] (loop [i 0] (if (< i 1000) (recur (inc i)) i)))))"))))
+;; a recur-less loop is a let: its int-literal binding stays generic (no fx), so
+;; arbitrary precision is preserved (matches (let [i 5] ...)).
+(let ((e (emitf "u" "(fn* ([] (loop [i 5] (+ i 9223372036854775807))))")))
+  (ok "recur-less loop int binding is NOT fx-typed" (not (has? e "(fx+"))))
+(ok "recur-less loop with a big add stays exact (bignum)"
+    (jolt-truthy? (ev "(< 9223372036854775807 ((fn* ([] (loop [i 5] (+ i 9223372036854775807))))))")))
+
 ;; a ^long-seeded loop accumulator IS fx-typed (the hint is a fixnum promise, and
 ;; the value flows from a coerced ^long param).
 (let ((e (emitf "u" "(fn* ([^long start] (loop [acc start] (if (< acc 100) (recur (inc acc)) acc))))")))
@@ -85,7 +105,6 @@
   (ok "long division is NOT specialized (stays generic /)" (not (has? e "(fx"))))
 
 ;; --- runtime values match the generic result ---
-(define (ev s) (jolt-compile-eval s "u"))
 (ok "double dot: 3^2+4^2 = 25" (= 25 (jnum->exact (ev "((fn* ([^double a ^double b] (+ (* a a) (* b b)))) 3.0 4.0)"))))
 (ok "long sum: 2+3 = 5"        (= 5  (jnum->exact (ev "((fn* ([^long a ^long b] (+ a b))) 2 3)"))))
 (ok "double compare true"      (jolt-truthy? (ev "((fn* ([^double x] (< x 5.0))) 3.0)")))