simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #179 from jolt-lang/spike/fast-arith-long-loops

Browse source 
Type :long loop-carried vars (complete round 2)
This commit is contained in:
Dmitri Sotnikov 2026-06-23 21:05:06 +00:00 • committed by GitHub
commit 0db417a491
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 166 additions and 159 deletions
Download patch file Download diff file Expand all files Collapse all files

298
host/chez/seed/image.ss
View file

File diff suppressed because one or more lines are too long

20
jolt-core/jolt/passes/numeric.clj
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)))))))

7
test/chez/numeric-test.ss
View file

@ -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))