BigDecimal call-position arithmetic via :bigdec type (Phase 2)

A direct (+ 1.5M 2.5M) emits a raw Chez + that rejects the bigdec record. Rather
than guard every arithmetic call site (measured 2-4x on unhinted fixnum loops),
let the analyzer dispatch where it can prove the type.

jolt.passes.numeric seeds a :bigdec kind from the M-literal and flows it through
let/loop/if like the existing :double/:long kinds; an arithmetic/comparison invoke
whose operands are all bigdec (integer literals allowed) gets :num-kind :bigdec.
The back end (bd-ops + emit-numeric) lowers those to the bigdec.ss engine
(jbd-add/-sub/-mul/-div, jbd-lt?/…, jbd-zero?/-pos?/-neg?, jbd-quot/-rem).

Zero cost on non-bigdec code: with no bigdec literals present the kind never
arises, so emission is byte-identical — the re-mint leaves prelude.ss unchanged,
only image.ss (the compiler) moves. Gaps (filed): a bigdec mixed with a flonum in
call position, and a bigdec the analyzer types :any, still hit the raw op and
throw; use value position or a literal-typed let.

Re-mint (numeric/backend are seed sources). 16 JVM-certified corpus rows.

host/chez/java/bigdec.ss

@@ -9,12 +9,19 @@
 ;; larger scale; multiply adds scales; divide gives the exact quotient at minimal
 ;; scale or throws ArithmeticException on a non-terminating expansion. Clojure
 ;; contagion: a bigdec mixed with an integer stays a bigdec; a flonum operand wins
-;; (the result is a double). jbd+/jbd-/jbd*/jbd-div and the comparison helpers are
+;; (the result is a double). jbd-add/-sub/-mul/-div, the jbd-lt?/…/zero? helpers,
-;; the shared engine; the value-position shims (jolt-add/-sub/-mul/-div, compare)
+;; and jbd-quot/-rem are the shared engine. Two paths reach it, both leaving the
-;; route through them when a bigdec is present, leaving the inlined native hot path
+;; inlined native hot path untouched:
-;; untouched. Call-position `(+ 1.5M 2.5M)` reaches the raw Chez op and needs the
+;;   - value position ((reduce + bigs)/(apply * bigs)): the jolt-add/-sub/-mul/-div
-;; analyzer's :bigdec type to dispatch (not yet wired); use it through reduce/apply
+;;     and compare shims dispatch here when a bigdec operand is present.
-;; or a let where the type is known.
+;;   - call position ((+ 1.5M 2.5M), (< a b), (zero? b)): jolt.passes.numeric tags
+;;     the invoke :num-kind :bigdec when every operand is statically a bigdec (M
+;;     literal or a let-bound copy, integer literals allowed), and the back end
+;;     lowers it to the jbd op. Non-bigdec code is unaffected.
+;; Gaps (a runtime bigdec the analyzer can't see statically): a bigdec mixed with a
+;; flonum in call position ((+ 1.5M 2.0)) and arithmetic over a bigdec the analyzer
+;; types as :any ((+ (bigdec x) 1)) fall through to the raw op and throw; use value
+;; position or a literal-typed let.
 
 (define-record-type jbigdec (fields unscaled scale) (nongenerative chez-jbigdec-v1))
 

jolt-core/jolt/backend_scheme.clj

@@ -94,6 +94,17 @@
    "quot" "fxquotient" "rem" "fxremainder" "mod" "fxmodulo"
    "<" "fx<?" ">" "fx>?" "<=" "fx<=?" ">=" "fx>=?" "=" "fx=?" "==" "fx=?"})
 
+;; BigDecimal ops. jolt.passes.numeric tags an arithmetic/comparison invoke
+;; :num-kind :bigdec when every operand is a bigdec (or an integer literal); these
+;; are the bigdec.ss engine procedures it lowers to. Variadic where the source op
+;; is; an integer-literal operand is coerced to a bigdec at runtime, so unlike the
+;; flonum path no literal rewrite is needed.
+(def ^:private bd-ops
+  {"+" "jbd-add" "-" "jbd-sub" "*" "jbd-mul" "/" "jbd-div"
+   "quot" "jbd-quot" "rem" "jbd-rem"
+   "<" "jbd-lt?" ">" "jbd-gt?" "<=" "jbd-le?" ">=" "jbd-ge?"
+   "zero?" "jbd-zero?" "pos?" "jbd-pos?" "neg?" "jbd-neg?"})
+
 ;; PRELUDE MODE. The default (subset) mode rejects any clojure.core ref
 ;; that isn't a native-op — a clean "out of subset" signal for user-facing `-e`.
 ;; When emitting clojure.core ITSELF as a prelude, core fns reference each other
@@ -461,7 +472,7 @@
     (and (= kind :long) (or (= nm "inc") (= nm "unchecked-inc"))) (str "(fx1+ " (first args) ")")
     (and (= kind :long) (or (= nm "dec") (= nm "unchecked-dec"))) (str "(fx1- " (first args) ")")
     :else
-    (let [op (if (= kind :double) (dbl-ops nm) (lng-ops nm))]
+    (let [op (case kind :double (dbl-ops nm) :long (lng-ops nm) :bigdec (bd-ops nm))]
       (order-args (fn [as] (str "(" op " " (str/join " " as) ")"))))))
 
 (defn- emit-invoke [node]

jolt-core/jolt/passes/numeric.clj

@@ -49,6 +49,18 @@
     (and (>= n 2) (contains? #{"<" ">" "<=" ">=" "=" "=="} nm)) :bool
     :else nil))
 
+;; result kind of a bigdec-specialized op, or nil. Arithmetic / quot / rem yield a
+;; bigdec; the comparisons and zero?/pos?/neg? yield a bool. `=` is left to the
+;; generic jolt= (already bigdec-aware), and `/` can throw (non-terminating) but is
+;; still a bigdec op. Each non-nil name must have an entry in backend bd-ops.
+(defn- bd-spec [nm n]
+  (cond
+    (and (>= n 1) (contains? #{"+" "-" "*" "/"} nm)) :bigdec
+    (and (= n 2) (contains? #{"quot" "rem"} nm)) :bigdec
+    (and (= n 1) (contains? #{"zero?" "pos?" "neg?"} nm)) :bool
+    (and (>= n 2) (contains? #{"<" ">" "<=" ">="} nm)) :bool
+    :else nil))
+
 ;; A non-numeric result (a comparison) doesn't propagate a numeric kind.
 (defn- propagate [spec] (if (= spec :bool) nil spec))
 
@@ -150,11 +162,12 @@
       (get fnode :num-ret) [(get fnode :num-ret) node1]
       (nil? nm) [nil node1]
       :else
-      (let [;; per-operand class: :double / :long (typed), :wild (integer literal,
+      (let [;; per-operand class: :double / :long / :bigdec (typed), :wild (integer
-            ;; usable in either), or :no (anything else — blocks specialization).
+            ;; literal, usable in any), or :no (anything else — blocks specialization).
             cls (mapv (fn [r] (let [k (nth r 0) nd (nth r 1)]
                                 (cond (= k :double) :double
                                       (= k :long) :long
+                                      (= k :bigdec) :bigdec
                                       (int-lit? nd) :wild
                                       :else :no)))
                       ars)
@@ -163,7 +176,8 @@
                        (every? (fn [c] (or (= c :wild) (= c allowed))) cls)
                        (some (fn [c] (= c need)) cls)))
             ds (dbl-spec nm n)
-            ls (lng-spec nm n)]
+            ls (lng-spec nm n)
+            bs (bd-spec nm n)]
         (cond
           (and ds (ok? :double :double))
           ;; coerce integer-literal operands to flonum so fl-ops never see an exact int.
@@ -172,6 +186,11 @@
             [(propagate ds) (assoc node1 :args args' :num-kind :double)])
           (and ls (ok? :long :long))
           [(propagate ls) (assoc node1 :num-kind :long)]
+          ;; bigdec: every operand a bigdec (integer literals allowed, coerced at
+          ;; runtime). A flonum operand blocks this (double contagion) and falls
+          ;; through to the generic op.
+          (and bs (ok? :bigdec :bigdec))
+          [(propagate bs) (assoc node1 :num-kind :bigdec)]
           :else [nil node1])))))
 
 ;; Returns [kind node'] — kind is :double, :long, or nil.
@@ -179,6 +198,9 @@
   (let [op (get node :op)]
     (cond
       (= op :const) [(if (float-lit? node) :double nil) node]
+      ;; a bigdec (M) literal seeds the :bigdec kind so call-position arithmetic
+      ;; over it (and let-bound copies of it) dispatches to the bigdec engine.
+      (= op :bigdec) [:bigdec node]
       (= op :local) [(get tenv (get node :name)) node]
       (= op :coerce) [(get node :kind) (assoc node :expr (nth (an (get node :expr) tenv) 1))]
       (= op :invoke) (an-invoke node tenv)

test/chez/corpus.edn

@@ -1325,6 +1325,22 @@
   {:suite "numbers / bigdec arithmetic" :label "compare is scale-independent" :expected "0" :actual "(compare 1.0M 1.00M)"}
   {:suite "numbers / bigdec arithmetic" :label "compare orders by value" :expected "-1" :actual "(compare 1.5M 2.5M)"}
   {:suite "numbers / bigdec arithmetic" :label "sort uses bigdec compare" :expected "[1M 2M 3M]" :actual "(vec (sort [3M 1M 2M]))"}
+  {:suite "numbers / bigdec call position" :label "add" :expected "4.0M" :actual "(+ 1.5M 2.5M)"}
+  {:suite "numbers / bigdec call position" :label "multiply adds scales" :expected "\"3.0000\"" :actual "(str (* 1.50M 2.00M))"}
+  {:suite "numbers / bigdec call position" :label "subtract" :expected "3.5M" :actual "(- 5M 1.5M)"}
+  {:suite "numbers / bigdec call position" :label "negate" :expected "-1.5M" :actual "(- 1.5M)"}
+  {:suite "numbers / bigdec call position" :label "long contagion" :expected "3.5M" :actual "(+ 1.5M 2)"}
+  {:suite "numbers / bigdec call position" :label "exact divide" :expected "0.25M" :actual "(/ 1M 4M)"}
+  {:suite "numbers / bigdec call position" :label "less-than" :expected "true" :actual "(< 1.5M 2.5M)"}
+  {:suite "numbers / bigdec call position" :label "greater-than false" :expected "false" :actual "(> 1.5M 2.5M)"}
+  {:suite "numbers / bigdec call position" :label "zero?" :expected "true" :actual "(zero? 0M)"}
+  {:suite "numbers / bigdec call position" :label "pos?" :expected "true" :actual "(pos? 1.5M)"}
+  {:suite "numbers / bigdec call position" :label "neg? false" :expected "false" :actual "(neg? 1.5M)"}
+  {:suite "numbers / bigdec call position" :label "quot truncates to scale 0" :expected "3M" :actual "(quot 7M 2M)"}
+  {:suite "numbers / bigdec call position" :label "rem" :expected "1M" :actual "(rem 7M 2M)"}
+  {:suite "numbers / bigdec call position" :label "let-bound operands" :expected "4.0M" :actual "(let [a 1.5M b 2.5M] (+ a b))"}
+  {:suite "numbers / bigdec call position" :label "nested arithmetic propagates" :expected "6.0M" :actual "(+ (* 1.5M 2M) 3M)"}
+  {:suite "numbers / bigdec call position" :label "non-terminating divide throws" :expected ":nonterm" :actual "(try (/ 1M 3M) (catch ArithmeticException _ :nonterm))"}
   {:suite "numbers / literal syntax" :label "ratio -> double" :expected "1/2" :actual "1/2"}
   {:suite "numbers / literal syntax" :label "ratio 3/4" :expected "3/4" :actual "3/4"}
   {:suite "numbers / literal syntax" :label "neg ratio" :expected "-1/2" :actual "-1/2"}