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.
This commit is contained in:
Yogthos 2026-06-23 17:04:44 -04:00
parent eab18e363c
commit 7d1b9e56d8
3 changed files with 166 additions and 159 deletions

View file

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