Type :long loop-carried vars too (complete round 2)

loop-kinds only typed :double accumulators; a ^long-seeded loop var (e.g.
(loop [acc start] ...) with a ^long start) stayed generic even though it's sound
to fx-type — :long only ever comes from an explicit hint, and a ^long value is
already coerced to a fixnum at fn entry. Keep the init's kind (:double or :long)
through the fixpoint, demoting only on a recur-arg mismatch.

Integer-literal-init loop vars (a bare (loop [i 0] ...)) still stay generic by
design: :long is never seeded from a literal, so a bignum-producing loop keeps
arbitrary precision.

jolt-core/jolt/passes/numeric.clj

@@ -66,22 +66,22 @@
       (= op :do) (recur-kinds (get node :ret) tenv)
       :else [])))
 
-;; Loop-var kinds by bounded fixpoint. A var is :double only if its init is double
+;; Loop-var kinds by bounded fixpoint. A var keeps its init kind (:double or :long)
-;; AND every recur arg in that slot is double (under the current assumption) — a
+;; only if every recur arg in that slot is the same kind (under the current
-;; monotone demotion that stops at a fixpoint, bounded by the var count. Integers
+;; assumption) — a monotone demotion that stops at a fixpoint, bounded by the var
-;; stay untyped (no :long from a bare init literal, so a bignum-producing loop keeps
+;; count. An integer-literal init has kind nil and stays generic, so a bignum loop
-;; arbitrary precision). A :double loop var's init and recur args are all flonums,
+;; keeps arbitrary precision (no :long from a bare literal). A typed loop var's init
-;; so no entry coercion is needed (unlike a fn param fed an arbitrary argument).
+;; 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 (mapv (fn [k] (if (= k :double) :double nil)) ik) iter 0]
+  (loop [cur ik 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)))
             rks (recur-kinds body te)
             nxt (mapv (fn [j]
-                        (if (and (= (nth cur j) :double)
+                        (let [k (nth cur j)]
-                                 (every? (fn [rk] (= :double (nth rk j))) rks))
+                          (if (and k (every? (fn [rk] (= k (nth rk j))) rks)) k nil)))
-                          :double nil))
                       (range (count names)))]
         (if (= nxt cur) cur (recur nxt (inc iter)))))))
 

test/chez/numeric-test.ss

@@ -64,6 +64,11 @@
 ;; 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 ^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))))")))
+  (ok "long-seeded loop accumulator lowers (inc acc) to fx1+" (has? e "(fx1+"))
+  (ok "long-seeded loop comparison lowers to fx<?" (has? e "(fx<?")))
 
 ;; --- soundness: un-hinted / integer-literal code stays generic ---
 (let ((e (emitf "u" "(fn* ([a b] (+ a b)))")))
@@ -92,6 +97,8 @@
     (= 15 (jnum->exact (ev "((fn* ([] (loop [acc 0.0 i 0] (if (< i 10) (recur (+ acc 1.5) (inc i)) acc)))))"))))
 (ok "loop integer factorial stays exact (bignum preserved)"
     (jolt-truthy? (ev "(< 1000000000000000000000 ((fn* ([] (loop [acc 1 i 1] (if (< i 25) (recur (* acc i) (inc i)) acc)))) ))")))
+(ok "long-seeded loop accumulator counts to 100"
+    (= 100 (jnum->exact (ev "((fn* ([^long start] (loop [acc start] (if (< acc 100) (recur (inc acc)) acc)))) 0)"))))
 
 (printf "~a/~a passed~n" (- total fails) total)
 (exit (if (zero? fails) 0 1))