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.
This commit is contained in:
parent
79fa22eeab
commit
d4ba87446a
3 changed files with 231 additions and 156 deletions
File diff suppressed because one or more lines are too long
|
|
@ -66,6 +66,41 @@
|
||||||
(= op :do) (recur-kinds (get node :ret) tenv)
|
(= op :do) (recur-kinds (get node :ret) tenv)
|
||||||
:else [])))
|
: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)
|
;; 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
|
;; 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
|
;; 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
|
;; 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
|
;; 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.
|
;; value or an fx op), so no entry coercion is needed here, unlike a fn param.
|
||||||
(defn- loop-kinds [names ik body tenv]
|
(defn- loop-kinds [names seed body tenv]
|
||||||
(loop [cur ik iter 0]
|
(loop [cur seed iter 0]
|
||||||
(if (> iter (count names))
|
(if (> iter (count names))
|
||||||
cur
|
cur
|
||||||
(let [te (reduce (fn [t i] (assoc t (nth names i) (nth cur i))) tenv (range (count names)))
|
(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)
|
(let [binds (get node :bindings)
|
||||||
names (mapv (fn [b] (nth b 0)) binds)
|
names (mapv (fn [b] (nth b 0)) binds)
|
||||||
ik (mapv (fn [b] (nth (an (nth b 1) tenv) 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)))]
|
te (reduce (fn [t i] (assoc t (nth names i) (nth lk i))) tenv (range (count names)))]
|
||||||
[nil (assoc node
|
[nil (assoc node
|
||||||
:bindings (mapv (fn [b] [(nth b 0) (nth (an (nth b 1) tenv) 1)]) binds)
|
:bindings (mapv (fn [b] [(nth b 0) (nth (an (nth b 1) tenv) 1)]) binds)
|
||||||
|
|
|
||||||
|
|
@ -30,6 +30,7 @@
|
||||||
(let-values (((f j) (rdr-read-form str 0 (string-length str))))
|
(let-values (((f j) (rdr-read-form str 0 (string-length str))))
|
||||||
(let ((ctx (make-analyze-ctx ns)))
|
(let ((ctx (make-analyze-ctx ns)))
|
||||||
(jolt-ce-emit (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx)))))
|
(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 ---
|
;; --- emission: ^double -> fl-ops, ^long -> fx-ops ---
|
||||||
(let ((e (emitf "u" "(fn* ([^double a ^double b] (+ (* a a) (* b b))))")))
|
(let ((e (emitf "u" "(fn* ([^double a ^double b] (+ (* a a) (* b b))))")))
|
||||||
|
|
@ -64,6 +65,25 @@
|
||||||
;; precision (no fx* overflow).
|
;; precision (no fx* overflow).
|
||||||
(let ((e (emitf "u" "(fn* ([] (loop [acc 1 i 1] (if (< i 25) (recur (* acc i) (inc i)) acc))))")))
|
(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*"))))
|
(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
|
;; a ^long-seeded loop accumulator IS fx-typed (the hint is a fixnum promise, and
|
||||||
;; the value flows from a coerced ^long param).
|
;; 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))))")))
|
(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"))))
|
(ok "long division is NOT specialized (stays generic /)" (not (has? e "(fx"))))
|
||||||
|
|
||||||
;; --- runtime values match the generic result ---
|
;; --- 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 "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 "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)")))
|
(ok "double compare true" (jolt-truthy? (ev "((fn* ([^double x] (< x 5.0))) 3.0)")))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue