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

Merge pull request #293 from jolt-lang/numeric/ops-dispatch

Browse source 
Numbers-style category dispatch for binary numeric ops
This commit is contained in:
Dmitri Sotnikov 2026-07-02 12:21:22 +00:00 • committed by GitHub
commit 7e1df2c600
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
13 changed files with 1106 additions and 729 deletions
Download patch file Download diff file Expand all files Collapse all files

212
host/chez/java/bigdec.ss
View file

@ -7,21 +7,19 @@
;; ;;
;; Arithmetic follows java.math.BigDecimal's scale rules: add/sub align to the ;; Arithmetic follows java.math.BigDecimal's scale rules: add/sub align to the
;; larger scale; multiply adds scales; divide gives the exact quotient at minimal ;; larger scale; multiply adds scales; divide gives the exact quotient at minimal
;; scale or throws ArithmeticException on a non-terminating expansion. Clojure ;; scale or throws ArithmeticException on a non-terminating expansion (a bound
;; contagion: a bigdec mixed with an integer stays a bigdec; a flonum operand wins ;; *math-context* rounds instead). Clojure contagion: a bigdec mixed with an
;; (the result is a double). jbd-add/-sub/-mul/-div, jbd-min/-max, the jbd-lt?/… ;; integer or ratio stays a bigdec; a flonum operand wins (the result is a
;; /zero? helpers, and jbd-quot/-rem are the shared engine. Two paths reach it, both ;; double). jbd-add/-sub/-mul/-div, jbd-min/-max, the jbd-lt?/…/zero? helpers,
;; leaving the inlined native hot path untouched: ;; and jbd-quot/-rem are the shared engine. Two paths reach it, both leaving the
;; - value position ((reduce + bigs)/(apply * bigs)): the jolt-add/-sub/-mul/-div ;; inlined fast path untouched:
;; and compare shims dispatch here when a bigdec operand is present. ;; - the seq.ss binary dispatch: every generic op (any position — (+ (bigdec x)
;; - call position ((+ 1.5M 2.5M), (< a b), (zero? b)): jolt.passes.numeric tags ;; 1), (reduce + bigs), (quot 10.0 3M)) whose operand is outside Chez's tower
;; the invoke :num-kind :bigdec when every operand is statically a bigdec (M ;; falls to the jolt-*-slow hooks extended below.
;; literal or a let-bound copy, integer literals allowed), and the back end ;; - static call position ((+ 1.5M 2.5M), (< a b), (zero? b)): jolt.passes.numeric
;; lowers it to the jbd op. Non-bigdec code is unaffected. ;; tags the invoke :num-kind :bigdec when every operand is statically a bigdec
;; Gaps (a runtime bigdec the analyzer can't see statically): a bigdec mixed with a ;; (M literal or a let-bound copy, integer literals allowed), and the back end
;; flonum in call position ((+ 1.5M 2.0)) and arithmetic over a bigdec the analyzer ;; lowers it directly to the jbd op.
;; 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)) (define-record-type jbigdec (fields unscaled scale) (nongenerative chez-jbigdec-v1))
@ -79,11 +77,13 @@
(define (jbigdec->flonum b) (define (jbigdec->flonum b)
(exact->inexact (/ (jbigdec-unscaled b) (expt 10 (jbigdec-scale b))))) (exact->inexact (/ (jbigdec-unscaled b) (expt 10 (jbigdec-scale b)))))
;; coerce an exact integer to a scale-0 bigdec; pass a bigdec through. Used on the ;; coerce an exact operand to a bigdec; pass a bigdec through. Used on the
;; non-flonum mixed path (bigdec + long -> bigdec). ;; non-flonum mixed path (bigdec + long -> bigdec). A Ratio converts like
;; Numbers.toBigDecimal — exact decimal expansion or throw on non-terminating.
(define (jbd-coerce x) (define (jbd-coerce x)
(cond ((jbigdec? x) x) (cond ((jbigdec? x) x)
((and (number? x) (exact? x) (integer? x)) (make-jbigdec x 0)) ((and (number? x) (exact? x) (integer? x)) (make-jbigdec x 0))
((and (number? x) (exact? x) (rational? x)) (jbd-rational->bigdec x))
(else (error #f "bigdec arithmetic: cannot coerce operand" x)))) (else (error #f "bigdec arithmetic: cannot coerce operand" x))))
;; --- core arithmetic on the {unscaled, scale} pair -------------------------- ;; --- core arithmetic on the {unscaled, scale} pair --------------------------
@ -117,12 +117,39 @@
"java.lang.ArithmeticException" "java.lang.ArithmeticException"
"Non-terminating decimal expansion; no exact representable decimal result."))))))) "Non-terminating decimal expansion; no exact representable decimal result.")))))))
;; floor(log10 |r|) for a nonzero exact rational.
(define (jbd-exp10 r)
(let ((n (abs (numerator r))) (d (denominator r)))
(if (>= n d)
(- (jbd-digits (quotient n d)) 1)
(let loop ((x (* n 10)) (e -1))
(if (>= x d) e (loop (* x 10) (- e 1)))))))
;; round an exact rational to `prec` significant digits (the MathContext divide).
(define (jbd-rational-prec r prec mode)
(if (= r 0)
(make-jbigdec 0 0)
(let* ((neg (< r 0)) (ar (abs r))
(s (- prec 1 (jbd-exp10 ar)))
(scaled (* ar (expt 10 s)))
(q (floor scaled)) (frac (- scaled q))
(q2 (if (jbd-round-inc? q frac 1 mode neg) (+ q 1) q))
(res (make-jbigdec (if neg (- q2) q2) s)))
;; a carry can add a digit (9.99 -> 10.0); re-normalizing drops an exact
;; trailing zero, never re-rounds.
(if (> (jbd-digits q2) prec) (jbd-round-prec res prec mode) res))))
(define (jbd2-div a b) (define (jbd2-div a b)
(when (= 0 (jbigdec-unscaled b)) (when (= 0 (jbigdec-unscaled b))
(jolt-throw (jolt-host-throwable "java.lang.ArithmeticException" "Divide by zero"))) (jolt-throw (jolt-host-throwable "java.lang.ArithmeticException" "Divide by zero")))
;; a/b = (ua * 10^sb) / (ub * 10^sa) as an exact rational. ;; a/b = (ua * 10^sb) / (ub * 10^sa) as an exact rational. Unlimited context:
(jbd-rational->bigdec (/ (* (jbigdec-unscaled a) (expt 10 (jbigdec-scale b))) ;; exact result at minimal scale or throw on a non-terminating expansion. A
(* (jbigdec-unscaled b) (expt 10 (jbigdec-scale a)))))) ;; bound *math-context* instead rounds to its precision.
(let ((r (/ (* (jbigdec-unscaled a) (expt 10 (jbigdec-scale b)))
(* (jbigdec-unscaled b) (expt 10 (jbigdec-scale a)))))
(mc (jbd-math-context)))
(if mc
(jbd-rational-prec r (jbd-mc-precision mc) (jbd-mc-mode mc))
(jbd-rational->bigdec r))))
;; integer-division semantics (quot/rem): truncate toward zero, scale 0. ;; integer-division semantics (quot/rem): truncate toward zero, scale 0.
(define (jbd-int-quot a b) (define (jbd-int-quot a b)
@ -139,13 +166,65 @@
(define (jbd-compare2 a b) (define (jbd-compare2 a b)
(let-values (((ua ub s) (jbd-align a b))) (cond ((< ua ub) -1) ((> ua ub) 1) (else 0)))) (let-values (((ua ub s) (jbd-align a b))) (cond ((< ua ub) -1) ((> ua ub) 1) (else 0))))
;; --- *math-context* (with-precision) -----------------------------------------
;; with-precision binds clojure.core/*math-context* to {:precision N :rounding
;; MODE}; every exact bigdec result rounds through it (java.math.MathContext).
(define jbd-kw-precision (keyword #f "precision"))
(define jbd-kw-rounding (keyword #f "rounding"))
(define (jbd-math-context)
(let ((mc (var-deref "clojure.core" "*math-context*")))
(if (jolt-nil? mc) #f mc)))
(define (jbd-mc-precision mc) (jolt-get mc jbd-kw-precision))
(define (jbd-mc-mode mc)
(let ((r (jolt-get mc jbd-kw-rounding)))
(cond ((symbol-t? r) (symbol-t-name r))
((string? r) r)
(else "HALF_UP"))))
;; should |value| = q + r/div (0 <= r < div) round up in magnitude? neg is the
;; value's sign; r/div may be exact rationals (the division path).
(define (jbd-round-inc? q r div mode neg)
(cond ((= r 0) #f)
((string=? mode "UP") #t)
((string=? mode "DOWN") #f)
((string=? mode "CEILING") (not neg))
((string=? mode "FLOOR") neg)
((string=? mode "HALF_DOWN") (> (* 2 r) div))
((string=? mode "HALF_EVEN")
(let ((c (- (* 2 r) div)))
(cond ((> c 0) #t) ((< c 0) #f) (else (odd? q)))))
((string=? mode "UNNECESSARY")
(jolt-throw (jolt-host-throwable "java.lang.ArithmeticException" "Rounding necessary")))
(else (>= (* 2 r) div)))) ; HALF_UP, the MathContext default
(define (jbd-digits n) (string-length (number->string (abs n))))
;; round a bigdec to `prec` significant digits with `mode` (a RoundingMode name).
(define (jbd-round-prec bd prec mode)
(let ((u (jbigdec-unscaled bd)) (s (jbigdec-scale bd)))
(if (= u 0)
bd
(let ((digs (jbd-digits u)))
(if (<= digs prec)
bd
(let* ((drop (- digs prec)) (div (expt 10 drop))
(neg (< u 0)) (au (abs u))
(q (quotient au div)) (r (remainder au div))
(q2 (if (jbd-round-inc? q r div mode neg) (+ q 1) q))
(res (make-jbigdec (if neg (- q2) q2) (- s drop))))
;; a carry can add a digit back (99 -> 100 at precision 2)
(if (> (jbd-digits q2) prec) (jbd-round-prec res prec mode) res)))))))
(define (jbd-mc-round x)
(let ((mc (and (jbigdec? x) (jbd-math-context))))
(if mc (jbd-round-prec x (jbd-mc-precision mc) (jbd-mc-mode mc)) x)))
;; A binary op over operands that may mix bigdec / integer / flonum. flonum-op is ;; A binary op over operands that may mix bigdec / integer / flonum. flonum-op is
;; the native fallback for the double-contagion path; bd-op is the exact bigdec op. ;; the native fallback for the double-contagion path; bd-op is the exact bigdec op
;; (its result rounds through a bound *math-context*).
(define (jbd-binop flonum-op bd-op a b) (define (jbd-binop flonum-op bd-op a b)
(if (or (flonum? a) (flonum? b)) (if (or (flonum? a) (flonum? b))
(flonum-op (if (jbigdec? a) (jbigdec->flonum a) a) (flonum-op (if (jbigdec? a) (jbigdec->flonum a) a)
(if (jbigdec? b) (jbigdec->flonum b) b)) (if (jbigdec? b) (jbigdec->flonum b) b))
(bd-op (jbd-coerce a) (jbd-coerce b)))) (jbd-mc-round (bd-op (jbd-coerce a) (jbd-coerce b)))))
;; --- variadic engine ops (Phase-2 emit targets + value-position folds) ------- ;; --- variadic engine ops (Phase-2 emit targets + value-position folds) -------
(define (jbd-fold flonum-op bd-op init xs) (define (jbd-fold flonum-op bd-op init xs)
@ -203,23 +282,78 @@
;; --- wire into the value model ---------------------------------------------- ;; --- wire into the value model ----------------------------------------------
(def-var! "clojure.core" "bigdec" jolt-bigdec) (def-var! "clojure.core" "bigdec" jolt-bigdec)
;; Value-position arithmetic: (reduce + bigs) / (apply * bigs) pass +/*/- // AS A ;; The seq.ss binary numeric dispatch (jolt-add2/… and the jolt-n* macros) routes
;; VALUE, which lowers to these shims (NOT the inlined hot-path native op). Extend ;; any op whose operand is outside Chez's tower to the *-slow hooks; extend each
;; them to dispatch to the bigdec engine when a bigdec operand is present; ordinary ;; with a bigdec arm. Every arithmetic position (call, value, higher-order)
;; numeric folds hit the captured native path unchanged. ;; funnels through these, so contagion and *math-context* rounding apply
(define jbd-prev-add jolt-add) ;; uniformly. min/max need no arm: the generic jolt-min2 compares through
(define jbd-prev-sub jolt-sub) ;; jolt-num-cmp-slow and returns the original operand.
(define jbd-prev-mul jolt-mul) (set! jolt-num-slow?
(define jbd-prev-div jolt-div) (let ((prev jolt-num-slow?)) (lambda (x) (or (jbigdec? x) (prev x)))))
(define jbd-prev-min jolt-min) (define (jbd-extend-hook prev bd-op)
(define jbd-prev-max jolt-max) (lambda (a b)
(define (jbd-any? xs) (and (pair? xs) (or (jbigdec? (car xs)) (jbd-any? (cdr xs))))) (if (or (jbigdec? a) (jbigdec? b)) (bd-op a b) (prev a b))))
(set! jolt-add (lambda xs (if (jbd-any? xs) (apply jbd-add xs) (apply jbd-prev-add xs)))) (set! jolt-add-slow (jbd-extend-hook jolt-add-slow (lambda (a b) (jbd-binop + jbd2+ a b))))
(set! jolt-sub (lambda xs (if (jbd-any? xs) (apply jbd-sub xs) (apply jbd-prev-sub xs)))) (set! jolt-sub-slow (jbd-extend-hook jolt-sub-slow (lambda (a b) (jbd-binop - jbd2- a b))))
(set! jolt-mul (lambda xs (if (jbd-any? xs) (apply jbd-mul xs) (apply jbd-prev-mul xs)))) (set! jolt-mul-slow (jbd-extend-hook jolt-mul-slow (lambda (a b) (jbd-binop * jbd2* a b))))
(set! jolt-div (lambda xs (if (jbd-any? xs) (apply jbd-div xs) (apply jbd-prev-div xs)))) (set! jolt-div-slow (jbd-extend-hook jolt-div-slow (lambda (a b) (jbd-binop / jbd2-div a b))))
(set! jolt-min (lambda xs (if (jbd-any? xs) (apply jbd-min xs) (apply jbd-prev-min xs)))) (set! jolt-num-cmp-slow
(set! jolt-max (lambda xs (if (jbd-any? xs) (apply jbd-max xs) (apply jbd-prev-max xs)))) (let ((prev jolt-num-cmp-slow))
(lambda (a b)
(if (and (or (jbigdec? a) (jbigdec? b)) (jbd-numberish? a) (jbd-numberish? b))
(jbd-value-compare a b)
(prev a b)))))
;; quot/rem/mod: a double operand demotes to the double path; exact operands use
;; the integer-division bigdec ops (mod = rem, floor-adjusted to the divisor's sign).
(define (jbd->num x) (if (jbigdec? x) (jbigdec->flonum x) x))
(set! jolt-quot-slow
(jbd-extend-hook jolt-quot-slow
(lambda (a b) (if (or (flonum? a) (flonum? b))
(jolt-quot (jbd->num a) (jbd->num b))
(jbd-int-quot (jbd-coerce a) (jbd-coerce b))))))
(set! jolt-rem-slow
(jbd-extend-hook jolt-rem-slow
(lambda (a b) (if (or (flonum? a) (flonum? b))
(jolt-rem (jbd->num a) (jbd->num b))
(jbd-int-rem (jbd-coerce a) (jbd-coerce b))))))
(set! jolt-mod-slow
(jbd-extend-hook jolt-mod-slow
(lambda (a b)
(if (or (flonum? a) (flonum? b))
(jolt-mod (jbd->num a) (jbd->num b))
(let* ((bb (jbd-coerce b))
(m (jbd-int-rem (jbd-coerce a) bb)))
(if (or (jbd-zero? m) (eq? (jbd-neg? m) (jbd-neg? bb))) m (jbd2+ m bb)))))))
;; unary shims: inc/dec and the sign predicates take a bigdec arm. set! updates
;; call-position references; the re-def-var! updates the var cell AND claims the
;; wrapped proc's class name before the prelude's inc'/dec' aliases are defined
;; ((type inc) stays clojure.core$inc — first def wins in the class registry).
(define jbd-one (make-jbigdec 1 0))
(set! jolt-inc (let ((prev jolt-inc)) (lambda (x) (if (jbigdec? x) (jbd-mc-round (jbd2+ x jbd-one)) (prev x)))))
(set! jolt-dec (let ((prev jolt-dec)) (lambda (x) (if (jbigdec? x) (jbd-mc-round (jbd2- x jbd-one)) (prev x)))))
(set! jolt-zero? (let ((prev jolt-zero?)) (lambda (x) (if (jbigdec? x) (jbd-zero? x) (prev x)))))
(set! jolt-pos? (let ((prev jolt-pos?)) (lambda (x) (if (jbigdec? x) (jbd-pos? x) (prev x)))))
(set! jolt-neg? (let ((prev jolt-neg?)) (lambda (x) (if (jbigdec? x) (jbd-neg? x) (prev x)))))
(def-var! "clojure.core" "inc" jolt-inc)
(def-var! "clojure.core" "dec" jolt-dec)
(def-var! "clojure.core" "zero?" jolt-zero?)
(def-var! "clojure.core" "pos?" jolt-pos?)
(def-var! "clojure.core" "neg?" jolt-neg?)
;; rationalize: reference Clojure goes through BigDecimal.valueOf(double) — the
;; SHORTEST decimal print of the double, not its exact binary value — so
;; (rationalize 1.1) is 11/10. A bigdec is exact already; other exacts pass through.
(define (jolt-rationalize x)
(cond ((jbigdec? x) (/ (jbigdec-unscaled x) (expt 10 (jbigdec-scale x))))
((flonum? x)
(if (or (nan? x) (infinite? x))
(jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
(string-append "Invalid input: " (number->string x))))
(let ((bd (jolt-bigdec-from-string (jolt-num->string x))))
(/ (jbigdec-unscaled bd) (expt 10 (jbigdec-scale bd))))))
((number? x) x)
(else (jolt-num-cast-throw x))))
(def-var! "clojure.core" "rationalize" jolt-rationalize)
;; compare: add a bigdec arm (enables compare / sort / sorted collections). A ;; compare: add a bigdec arm (enables compare / sort / sorted collections). A
;; bigdec vs a plain number compares by value; bigdec vs bigdec is scale-independent. ;; bigdec vs a plain number compares by value; bigdec vs bigdec is scale-independent.

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

File diff suppressed because one or more lines are too long

706
host/chez/seed/prelude.ss
View file

File diff suppressed because one or more lines are too long

212
host/chez/seq.ss
View file

@ -158,17 +158,209 @@
((fx=? i 0) (seq-first s)) ((fx=? i 0) (seq-first s))
(else (loop (jolt-seq (seq-more s)) (fx- i 1))))))) (else (loop (jolt-seq (seq-more s)) (fx- i 1)))))))
;; --- checked arithmetic: JVM Numbers.ops-style category dispatch -------------
;; Every arithmetic/comparison site (the inlined jolt-n* macros in call position,
;; the variadic shims in value position) funnels a binary op through ONE dispatch:
;; both operands inside Chez's tower take the native op with JVM contagion rules
;; patched in (a double operand wins — Chez's exact-zero shortcut must not leak:
;; (* 1.5 0) is 0.0, not 0; an exact zero divisor throws ArithmeticException, a
;; double zero divisor yields ##Inf/##NaN); an operand OUTSIDE the tower (e.g.
;; BigDecimal) falls to a slow hook the numeric shim extends (java/bigdec.ss).
;; A non-numeric operand is a ClassCastException, like the JVM.
(define (jolt-num-cast-throw x)
(if (jolt-nil? x)
(jolt-throw (jolt-host-throwable "java.lang.NullPointerException" ""))
(jolt-throw (jolt-host-throwable
"java.lang.ClassCastException"
(string-append "class " (jolt-class-name x)
" cannot be cast to class java.lang.Number")))))
(define (jolt-div0-throw)
(jolt-throw (jolt-host-throwable "java.lang.ArithmeticException" "Divide by zero")))
;; slow hooks: one per op, taking over when an operand is outside Chez's tower.
;; A numeric shim (java/bigdec.ss) set!-extends them; the base case is the JVM's:
;; not a number -> ClassCastException. The hooks are BINARY and never re-enter
;; the variadic shims, so extension order can't recurse.
(define (jolt-add-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-sub-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-mul-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-div-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
;; comparison of operands outside the Chez tower: numeric shims extend this to a
;; 3-way compare; anything left over is not a number.
(define (jolt-num-cmp-slow a b)
(jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-add2 a b)
(if (and (number? a) (number? b)) (+ a b) (jolt-add-slow a b)))
(define (jolt-sub2 a b)
(if (and (number? a) (number? b)) (- a b) (jolt-sub-slow a b)))
(define (jolt-mul2 a b)
(if (and (number? a) (number? b))
(if (or (flonum? a) (flonum? b))
(fl* (real->flonum a) (real->flonum b))
(* a b))
(jolt-mul-slow a b)))
(define (jolt-div2 a b)
(if (and (number? a) (number? b))
(if (or (flonum? a) (flonum? b))
(fl/ (real->flonum a) (real->flonum b))
(if (eqv? b 0) (jolt-div0-throw) (/ a b)))
(jolt-div-slow a b)))
(define (jolt-lt2 a b)
(if (and (number? a) (number? b)) (< a b) (< (jolt-num-cmp-slow a b) 0)))
(define (jolt-gt2 a b)
(if (and (number? a) (number? b)) (> a b) (> (jolt-num-cmp-slow a b) 0)))
(define (jolt-le2 a b)
(if (and (number? a) (number? b)) (<= a b) (<= (jolt-num-cmp-slow a b) 0)))
(define (jolt-ge2 a b)
(if (and (number? a) (number? b)) (>= a b) (>= (jolt-num-cmp-slow a b) 0)))
;; min/max return the ORIGINAL operand (type and exactness kept, like
;; Numbers.min): (min 1 2.0) is 1, not 1.0. A NaN operand wins.
(define (jolt-min2 a b)
(cond ((and (flonum? a) (nan? a)) a)
((and (flonum? b) (nan? b)) b)
(else (if (jolt-lt2 a b) a b))))
(define (jolt-max2 a b)
(cond ((and (flonum? a) (nan? a)) a)
((and (flonum? b) (nan? b)) b)
(else (if (jolt-gt2 a b) a b))))
;; quot/rem/mod over the full tower: truncating division; a double operand makes
;; the result a double; mod has floor semantics (result takes the divisor's
;; sign). A zero divisor throws ArithmeticException in both worlds (JVM double
;; quot/rem check the divisor before dividing). Non-tower operands hit the
;; set!-extensible slow hooks.
(define (jolt-quot-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-rem-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-mod-slow a b) (jolt-num-cast-throw (if (number? a) b a)))
(define (jolt-quot a b)
(cond ((not (and (number? a) (number? b))) (jolt-quot-slow a b))
((or (flonum? a) (flonum? b))
(let ((n (real->flonum a)) (d (real->flonum b)))
(if (fl= d 0.0) (jolt-div0-throw) (fltruncate (fl/ n d)))))
((eqv? b 0) (jolt-div0-throw))
((and (integer? a) (integer? b)) (quotient a b))
(else (truncate (/ a b)))))
(define (jolt-rem a b)
(cond ((not (and (number? a) (number? b))) (jolt-rem-slow a b))
((or (flonum? a) (flonum? b))
(let ((n (real->flonum a)) (d (real->flonum b)))
(if (fl= d 0.0) (jolt-div0-throw)
(fl- n (fl* d (fltruncate (fl/ n d)))))))
((eqv? b 0) (jolt-div0-throw))
((and (integer? a) (integer? b)) (remainder a b))
(else (- a (* b (truncate (/ a b)))))))
(define (jolt-mod a b)
(cond ((not (and (number? a) (number? b))) (jolt-mod-slow a b))
((and (integer? a) (integer? b) (not (flonum? a)) (not (flonum? b)))
(if (eqv? b 0) (jolt-div0-throw) (modulo a b)))
(else
(let ((m (jolt-rem a b)))
(if (or (zero? m) (eq? (negative? m) (negative? b))) m (jolt-add2 m b))))))
;; value-position arithmetic (the higher-order forms: (reduce + []), (apply * xs)). ;; value-position arithmetic (the higher-order forms: (reduce + []), (apply * xs)).
;; Scheme's +/-/*// already implement the JVM-parity numeric tower: exact+exact -> ;; Folded through the binary dispatch so contagion/edge rules hold; identities
;; exact, exact/exact -> Ratio, any flonum -> flonum. Identities (+)=0 / (*)=1 are ;; (+)=0 / (*)=1 are exact, matching exact integer arithmetic. The hot path uses
;; exact, matching exact integer arithmetic. The hot path uses the inlined native ;; the inlined native ops, not these.
;; ops, not these. ;; recognizer for slow-path numeric types; numeric shims extend it.
(define (jolt-add . xs) (apply + xs)) (define (jolt-num-slow? x) #f)
(define (jolt-sub . xs) (apply - xs)) (define (jolt-num-check1 x) ; (+ x)/(* x) return x but still type-check it
(define (jolt-mul . xs) (apply * xs)) (if (or (number? x) (jolt-num-slow? x)) x (jolt-num-cast-throw x)))
(define (jolt-div . xs) (apply / xs)) (define (jolt-add . xs)
(define (jolt-min . xs) (apply min xs)) (cond ((null? xs) 0)
(define (jolt-max . xs) (apply max xs)) ((null? (cdr xs)) (jolt-num-check1 (car xs)))
(else (fold-left jolt-add2 (car xs) (cdr xs)))))
(define (jolt-arity0-throw name)
(jolt-throw (jolt-host-throwable
"clojure.lang.ArityException"
(string-append "Wrong number of args (0) passed to: clojure.core/" name))))
(define (jolt-sub . xs)
(cond ((null? xs) (jolt-arity0-throw "-"))
((null? (cdr xs)) (jolt-sub2 0 (car xs)))
(else (fold-left jolt-sub2 (car xs) (cdr xs)))))
(define (jolt-mul . xs)
(cond ((null? xs) 1)
((null? (cdr xs)) (jolt-num-check1 (car xs)))
(else (fold-left jolt-mul2 (car xs) (cdr xs)))))
(define (jolt-div . xs)
(cond ((null? xs) (jolt-arity0-throw "/"))
((null? (cdr xs)) (jolt-div2 1 (car xs)))
(else (fold-left jolt-div2 (car xs) (cdr xs)))))
(define (jolt-min x . xs) (fold-left jolt-min2 x xs))
(define (jolt-max x . xs) (fold-left jolt-max2 x xs))
;; variadic comparison chains for value position ((apply < xs)).
(define (jolt-cmp-chain op2)
(lambda (x . xs)
(let loop ((a x) (rest xs))
(cond ((null? rest) #t)
((op2 a (car rest)) (loop (car rest) (cdr rest)))
(else #f)))))
(define jolt-lt (jolt-cmp-chain jolt-lt2))
(define jolt-gt (jolt-cmp-chain jolt-gt2))
(define jolt-le (jolt-cmp-chain jolt-le2))
(define jolt-ge (jolt-cmp-chain jolt-ge2))
;; call-position arithmetic: inlined macros with the both-Chez-numbers fast path
;; open-coded; anything else falls to the binary dispatch above. Comparisons
;; return a genuine Scheme boolean (the backend's truthy elision relies on it).
(define-syntax jolt-n+
(syntax-rules ()
((_) 0)
((_ a) (jolt-add a))
((_ ea eb) (let ((a ea) (b eb))
(if (and (number? a) (number? b)) (+ a b) (jolt-add a b))))
((_ a b c ...) (jolt-n+ (jolt-n+ a b) c ...))))
(define-syntax jolt-n-
(syntax-rules ()
((_) (jolt-sub))
((_ a) (jolt-sub a))
((_ ea eb) (let ((a ea) (b eb))
(if (and (number? a) (number? b)) (- a b) (jolt-sub a b))))
((_ a b c ...) (jolt-n- (jolt-n- a b) c ...))))
(define-syntax jolt-n*
(syntax-rules ()
((_) 1)
((_ a) (jolt-mul a))
((_ ea eb) (let ((a ea) (b eb))
(if (and (number? a) (number? b))
(if (or (flonum? a) (flonum? b))
(fl* (real->flonum a) (real->flonum b))
(* a b))
(jolt-mul a b))))
((_ a b c ...) (jolt-n* (jolt-n* a b) c ...))))
(define-syntax jolt-n-div
(syntax-rules ()
((_) (jolt-div))
((_ a) (jolt-div a))
((_ a b) (jolt-div2 a b))
((_ a b c ...) (jolt-n-div (jolt-div2 a b) c ...))))
(define-syntax define-n-cmp
(syntax-rules ()
((_ name op op2)
(define-syntax name
(syntax-rules ()
((_) (op2))
((_ a) (begin a #t))
((_ ea eb) (let ((a ea) (b eb))
(if (and (number? a) (number? b)) (op a b) (op2 a b))))
((_ ea eb c (... ...)) (let ((a ea) (b eb))
(and (name a b) (name b c (... ...))))))))))
(define-n-cmp jolt-n< < jolt-lt2)
(define-n-cmp jolt-n> > jolt-gt2)
(define-n-cmp jolt-n<= <= jolt-le2)
(define-n-cmp jolt-n>= >= jolt-ge2)
(define-syntax jolt-n-min
(syntax-rules ()
((_) (jolt-min))
((_ a) (jolt-min a))
((_ a b) (jolt-min2 a b))
((_ a b c ...) (jolt-n-min (jolt-min2 a b) c ...))))
(define-syntax jolt-n-max
(syntax-rules ()
((_) (jolt-max))
((_ a) (jolt-max a))
((_ a b) (jolt-max2 a b))
((_ a b c ...) (jolt-n-max (jolt-max2 a b) c ...))))
;; --- unchecked (Java long) arithmetic: wrap to signed 64 bits ---------------- ;; --- unchecked (Java long) arithmetic: wrap to signed 64 bits ----------------
;; Clojure's unchecked-* (and +/-/* under *unchecked-math*) are long ops that ;; Clojure's unchecked-* (and +/-/* under *unchecked-math*) are long ops that

4
jolt-core/clojure/core/21-coll.clj
View file

@ -133,8 +133,8 @@
(concat (map first ss) (concat (map first ss)
(apply interleave (map rest ss)))))))) (apply interleave (map rest ss))))))))
;; No ratio type on Jolt, so rationalize is identity. ;; rationalize is host-native (java/bigdec.ss): a double routes through its
(defn rationalize [x] x) ;; shortest decimal print like BigDecimal.valueOf, so (rationalize 1.1) is 11/10.
;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel ;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
;; value is needed). 1-arg: eager dedupe of consecutive equal elements. ;; value is needed). 1-arg: eager dedupe of consecutive equal elements.

12
jolt-core/clojure/core/30-macros.clj
View file

@ -109,11 +109,15 @@
(with-open ~(vec (drop 2 bindings)) ~@body) (with-open ~(vec (drop 2 bindings)) ~@body)
(finally (__close ~(first bindings))))))) (finally (__close ~(first bindings)))))))
;; jolt numbers are doubles — there is no BigDecimal math context, so the ;; Binds *math-context*; BigDecimal arithmetic in the dynamic scope rounds its
;; precision (and optional :rounding mode) is accepted and ignored. ;; results to the precision with the rounding mode (default HALF_UP, like
;; java.math.MathContext).
(defmacro with-precision [precision & exprs] (defmacro with-precision [precision & exprs]
(let [body (if (= :rounding (first exprs)) (drop 2 exprs) exprs)] (let [[rounding body] (if (= :rounding (first exprs))
`(do ~@body))) [(second exprs) (drop 2 exprs)]
['HALF_UP exprs])]
`(binding [clojure.core/*math-context* {:precision ~precision :rounding '~rounding}]
~@body)))
(defmacro with-bindings [binding-map & body] (defmacro with-bindings [binding-map & body]
`(with-bindings* ~binding-map (fn [] ~@body))) `(with-bindings* ~binding-map (fn [] ~@body)))

26
jolt-core/jolt/backend_scheme.clj
View file

@ -17,13 +17,17 @@
;; Hot clojure.core primitives lowered to native Scheme. ;; Hot clojure.core primitives lowered to native Scheme.
;; `=` is the exactness-aware jolt= from values.ss; inc/dec/ ;; `=` is the exactness-aware jolt= from values.ss; inc/dec/
;; not are rt shims; mod/rem/quot map to Scheme's (Scheme has all three). ;; not are rt shims. Arithmetic and comparisons lower to the jolt-n* checked
;; macros (host/chez/seq.ss): the both-Chez-numbers fast path is open-coded and
;; anything else (BigDecimal, a non-number) takes the Numbers.ops-style category
;; dispatch, with JVM contagion (a double operand wins; an exact zero divisor is
;; ArithmeticException; a double zero divisor is ##Inf/##NaN).
(def ^:private native-ops (def ^:private native-ops
{"+" "+" "-" "-" "*" "*" "/" "/" {"+" "jolt-n+" "-" "jolt-n-" "*" "jolt-n*" "/" "jolt-n-div"
"<" "<" ">" ">" "<=" "<=" ">=" ">=" "<" "jolt-n<" ">" "jolt-n>" "<=" "jolt-n<=" ">=" "jolt-n>="
"=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec" "not" "jolt-not" "=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec" "not" "jolt-not"
"min" "min" "max" "max" "min" "jolt-n-min" "max" "jolt-n-max"
"mod" "modulo" "rem" "remainder" "quot" "quotient" "mod" "jolt-mod" "rem" "jolt-rem" "quot" "jolt-quot"
"vector" "jolt-vector" "hash-map" "jolt-hash-map-fn" "hash-set" "jolt-hash-set" "vector" "jolt-vector" "hash-map" "jolt-hash-map-fn" "hash-set" "jolt-hash-set"
"conj" "jolt-conj" "get" "jolt-get" "nth" "jolt-nth" "count" "jolt-count" "conj" "jolt-conj" "get" "jolt-get" "nth" "jolt-nth" "count" "jolt-count"
"assoc" "jolt-assoc" "dissoc" "jolt-dissoc" "contains?" "jolt-contains?" "assoc" "jolt-assoc" "dissoc" "jolt-dissoc" "contains?" "jolt-contains?"
@ -53,12 +57,12 @@
"protocol-dispatch3" "protocol-dispatch3"}) "protocol-dispatch3" "protocol-dispatch3"})
;; Value-position resolution for a clojure.core ref passed AS A VALUE (to map / ;; Value-position resolution for a clojure.core ref passed AS A VALUE (to map /
;; filter / reduce / apply). Arithmetic is the exception — Scheme's +/-/*// return ;; filter / reduce / apply). The jolt-n* call-position forms are macros, so value
;; EXACT results for exact/zero-arg inputs, breaking the all-double model in ;; position substitutes the variadic procedures over the same binary dispatch.
;; higher-order use, so value-position arithmetic routes to the flonum wrappers.
(def ^:private core-value-procs (def ^:private core-value-procs
(merge native-ops {"+" "jolt-add" "-" "jolt-sub" "*" "jolt-mul" "/" "jolt-div" (merge native-ops {"+" "jolt-add" "-" "jolt-sub" "*" "jolt-mul" "/" "jolt-div"
"min" "jolt-min" "max" "jolt-max"})) "min" "jolt-min" "max" "jolt-max"
"<" "jolt-lt" ">" "jolt-gt" "<=" "jolt-le" ">=" "jolt-ge"}))
;; Per-op arity gate: only lower when the Scheme prim and the jolt fn agree at ;; Per-op arity gate: only lower when the Scheme prim and the jolt fn agree at
;; this arity. Ops absent from the table are variadic (legal at any arity). ;; this arity. Ops absent from the table are variadic (legal at any arity).
@ -83,7 +87,7 @@
;; jolt's comparison ops are vacuously true at arity 1 and DON'T inspect the arg, ;; jolt's comparison ops are vacuously true at arity 1 and DON'T inspect the arg,
;; but Scheme's < demands a number even there — special-case. ;; but Scheme's < demands a number even there — special-case.
(def ^:private cmp1-ops #{"<" ">" "<=" ">="}) (def ^:private cmp1-ops #{"jolt-n<" "jolt-n>" "jolt-n<=" "jolt-n>="})
;; Host interop methods with a Chez RT shim (rt.ss jolt-host-call). A `.method` ;; Host interop methods with a Chez RT shim (rt.ss jolt-host-call). A `.method`
;; call on any other method routes to record-method-dispatch (a reify/record ;; call on any other method routes to record-method-dispatch (a reify/record
@ -93,7 +97,7 @@
;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an ;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an
;; :if test built from them needs no jolt-truthy? wrapper. ;; :if test built from them needs no jolt-truthy? wrapper.
(def ^:private bool-returning-ops (def ^:private bool-returning-ops
#{"<" "<=" ">" ">=" "jolt=" "jolt-not" #{"jolt-n<" "jolt-n<=" "jolt-n>" "jolt-n>=" "jolt=" "jolt-not"
"jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?" "jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?"
"jolt-zero?" "jolt-empty?" "jolt-contains?" "jolt-nil?" "jolt-some?"}) "jolt-zero?" "jolt-empty?" "jolt-contains?" "jolt-nil?" "jolt-some?"})

7
jolt-core/jolt/passes/numeric.clj
View file

@ -183,7 +183,12 @@
ls (lng-spec nm n) ls (lng-spec nm n)
bs (bd-spec nm n)] bs (bd-spec nm n)]
(cond (cond
(and ds (ok? :double :double)) (and ds (ok? :double :double)
;; min/max return the ORIGINAL operand (Numbers.min: an integer
;; literal stays exact), so an int-literal operand blocks the
;; flonum lowering there — flmin would coerce it.
(or (not (contains? #{"min" "max"} nm))
(every? (fn [c] (= c :double)) cls)))
;; coerce integer-literal operands to flonum so fl-ops never see an exact int. ;; coerce integer-literal operands to flonum so fl-ops never see an exact int.
(let [args' (mapv (fn [nd] (if (int-lit? nd) (assoc nd :val (double (get nd :val))) nd)) (let [args' (mapv (fn [nd] (if (int-lit? nd) (assoc nd :val (double (get nd :val))) nd))
argnodes)] argnodes)]

19
test/chez/corpus.edn
View file

@ -3515,4 +3515,23 @@
{:suite "exceptions / hierarchy catch" :label "a typed throwable matches its superclasses, not unrelated ones" :expected "[true true true false]" :actual "(let [e (try (Long/parseLong \"z\") (catch Throwable e e))] [(instance? NumberFormatException e) (instance? IllegalArgumentException e) (instance? Exception e) (instance? java.io.IOException e)])"} {:suite "exceptions / hierarchy catch" :label "a typed throwable matches its superclasses, not unrelated ones" :expected "[true true true false]" :actual "(let [e (try (Long/parseLong \"z\") (catch Throwable e e))] [(instance? NumberFormatException e) (instance? IllegalArgumentException e) (instance? Exception e) (instance? java.io.IOException e)])"}
{:suite "equality / identity" :label "= short-circuits on identity without realizing a lazy seq (Util.equiv k1 == k2)" :expected "0" :actual "(let [n (atom 0) s (map (fn [x] (swap! n inc) x) [1 2 3])] (= s s) @n)"} {:suite "equality / identity" :label "= short-circuits on identity without realizing a lazy seq (Util.equiv k1 == k2)" :expected "0" :actual "(let [n (atom 0) s (map (fn [x] (swap! n inc) x) [1 2 3])] (= s s) @n)"}
{:suite "realized? / lazy seq" :label "realized? reads a lazy seq's realization flag" :expected "[false true]" :actual "(let [s (map inc [1 2 3])] [(realized? s) (do (doall s) (realized? s))])"} {:suite "realized? / lazy seq" :label "realized? reads a lazy seq's realization flag" :expected "[false true]" :actual "(let [s (map inc [1 2 3])] [(realized? s) (do (doall s) (realized? s))])"}
{:suite "numbers / ops dispatch" :label "double contagion beats exact-zero shortcut" :expected "[0.0 0.0 0.0 0.0]" :actual "[(* 1.0 0) (* 0 1.5) (/ 0 1.5) (- 0.0 0)]"}
{:suite "numbers / ops dispatch" :label "Inf times zero is NaN" :expected "[true true]" :actual "[(NaN? (* ##Inf 0)) (NaN? (* 0 ##-Inf))]"}
{:suite "numbers / ops dispatch" :label "zero over NaN is NaN" :expected "true" :actual "(NaN? (/ 0 ##NaN))"}
{:suite "numbers / ops dispatch" :label "double division by exact zero is signed Inf" :expected "[##Inf ##-Inf]" :actual "[(/ 1.0 0) (/ -1.0 0)]"}
{:suite "numbers / ops dispatch" :label "exact division by zero throws ArithmeticException" :expected "[:ae :ae :ae]" :actual "[(try (/ 1 0) (catch ArithmeticException _ :ae)) (try (/ 0) (catch ArithmeticException _ :ae)) (try (quot 1.0 0) (catch ArithmeticException _ :ae))]"}
{:suite "numbers / ops dispatch" :label "non-number operand is ClassCastException" :expected "[:cce :cce]" :actual "[(try (+ 1 \"a\") (catch ClassCastException _ :cce)) (try (< \"a\" 1) (catch ClassCastException _ :cce))]"}
{:suite "numbers / ops dispatch" :label "quot over ratios truncates" :expected "[6 -2 1]" :actual "[(quot 3 1/2) (quot -3 4/3) (quot 37/2 15)]"}
{:suite "numbers / ops dispatch" :label "quot/rem double contagion" :expected "[3.0 1.5 0.0]" :actual "[(quot 10.0 3) (rem 5.5 2) (quot 1 ##Inf)]"}
{:suite "numbers / ops dispatch" :label "mod takes the divisor's sign on doubles" :expected "[0.5 -0.5 1.5]" :actual "[(mod -5.5 2) (mod 5.5 -2) (mod 5.5 2)]"}
{:suite "numbers / ops dispatch" :label "min/max return the original operand" :expected "[1 4.0 1M]" :actual "[(min 1 2.0) (max 3 4.0) (min 1M 2)]"}
{:suite "numbers / ops dispatch" :label "NaN wins min/max" :expected "[true true]" :actual "[(NaN? (min 1.0 ##NaN)) (NaN? (max ##NaN 1.0))]"}
{:suite "numbers / ops dispatch" :label "bigdec call position mixes with doubles" :expected "[3.5 1.0 true]" :actual "[(+ 1.5M 2.0) (/ 2.0M 2.0) (< 1.5M 2.0)]"}
{:suite "numbers / ops dispatch" :label "runtime bigdec reaches call-position ops" :expected "[4M 2M true]" :actual "(let [x (bigdec 3)] [(+ x 1) (- x 1) (< 1 x)])"}
{:suite "numbers / ops dispatch" :label "inc/dec on bigdec" :expected "[2.5M 0.5M]" :actual "[(inc 1.5M) (dec 1.5M)]"}
{:suite "numbers / with-precision" :label "rounding modes" :expected "[2M -1M 1M -2M 2M 1M]" :actual "[(with-precision 1 :rounding UP (* 1.1M 1M)) (with-precision 1 :rounding CEILING (* -1.1M 1M)) (with-precision 1 :rounding DOWN (* 1.9M 1M)) (with-precision 1 :rounding FLOOR (* -1.9M 1M)) (with-precision 1 :rounding HALF_EVEN (* 2.5M 1M)) (with-precision 1 :rounding HALF_DOWN (* 1.5M 1M))]"}
{:suite "numbers / with-precision" :label "UNNECESSARY throws when rounding needed, passes exact" :expected "[:ae 2M]" :actual "[(try (with-precision 1 :rounding UNNECESSARY (* 1.5M 1M)) (catch ArithmeticException _ :ae)) (with-precision 1 :rounding UNNECESSARY (* 2M 1M))]"}
{:suite "numbers / with-precision" :label "division rounds to precision (default HALF_UP)" :expected "\"0.3333\"" :actual "(str (with-precision 4 (/ 1M 3M)))"}
{:suite "numbers / rationalize" :label "doubles go through shortest decimal print" :expected "[11/10 3/2 1 0 -1]" :actual "[(rationalize 1.1) (rationalize 1.5) (rationalize 1.0) (rationalize 0.0) (rationalize -1.0)]"}
{:suite "numbers / rationalize" :label "bigdec and exacts pass through exactly" :expected "[3/2 1/3 7]" :actual "[(rationalize 1.5M) (rationalize 1/3) (rationalize 7)]"}
] ]

17
test/chez/cts-known-failures.txt
View file

@ -1,7 +1,7 @@
# clojure-test-suite known failures: <namespace> <fail> <error> # clojure-test-suite known failures: <namespace> <fail> <error>
# The gate fails on any per-namespace change, worse OR better; regenerate # The gate fails on any per-namespace change, worse OR better; regenerate
# with: JOLT_CTS_WRITE_BASELINE=1 host/chez/cts.sh # with: JOLT_CTS_WRITE_BASELINE=1 host/chez/cts.sh
clojure.core-test.abs 1 1 clojure.core-test.abs 1 0
clojure.core-test.add-watch 0 3 clojure.core-test.add-watch 0 3
clojure.core-test.ancestors 9 0 clojure.core-test.ancestors 9 0
clojure.core-test.atom 14 0 clojure.core-test.atom 14 0
@ -34,10 +34,8 @@ clojure.core-test.intern 2 0
clojure.core-test.keys 0 4 clojure.core-test.keys 0 4
clojure.core-test.lazy-seq 3 0 clojure.core-test.lazy-seq 3 0
clojure.core-test.long 2 5 clojure.core-test.long 2 5
clojure.core-test.max 3 1
clojure.core-test.min 3 1
clojure.core-test.minus 2 0 clojure.core-test.minus 2 0
clojure.core-test.mod 12 34 clojure.core-test.mod 23 0
clojure.core-test.neg-int-qmark 1 0 clojure.core-test.neg-int-qmark 1 0
clojure.core-test.not-eq 3 0 clojure.core-test.not-eq 3 0
clojure.core-test.nth 0 1 clojure.core-test.nth 0 1
@ -52,32 +50,29 @@ clojure.core-test.plus 11 0
clojure.core-test.plus-squote 11 0 clojure.core-test.plus-squote 11 0
clojure.core-test.pop 0 1 clojure.core-test.pop 0 1
clojure.core-test.pos-int-qmark 1 0 clojure.core-test.pos-int-qmark 1 0
clojure.core-test.quot 12 23 clojure.core-test.quot 30 0
clojure.core-test.rand-nth 0 1 clojure.core-test.rand-nth 0 1
clojure.core-test.rational-qmark 3 0 clojure.core-test.rational-qmark 3 0
clojure.core-test.rationalize 10 0
clojure.core-test.realized-qmark 3 0 clojure.core-test.realized-qmark 3 0
clojure.core-test.reduce 0 1 clojure.core-test.reduce 0 1
clojure.core-test.rem 12 22 clojure.core-test.rem 21 0
clojure.core-test.remove-watch 0 1 clojure.core-test.remove-watch 0 1
clojure.core-test.run-bang 1 0 clojure.core-test.run-bang 1 0
clojure.core-test.select-keys 2 0 clojure.core-test.select-keys 2 0
clojure.core-test.seqable-qmark 1 0 clojure.core-test.seqable-qmark 1 0
clojure.core-test.short 7 5 clojure.core-test.short 7 5
clojure.core-test.shuffle 1 0 clojure.core-test.shuffle 1 0
clojure.core-test.slash 2 22
clojure.core-test.some-fn 3 0 clojure.core-test.some-fn 3 0
clojure.core-test.sort-by 2 0 clojure.core-test.sort-by 2 0
clojure.core-test.special-symbol-qmark 4 0 clojure.core-test.special-symbol-qmark 4 0
clojure.core-test.star 22 0 clojure.core-test.star 13 0
clojure.core-test.star-squote 19 0 clojure.core-test.star-squote 13 0
clojure.core-test.transient 23 0 clojure.core-test.transient 23 0
clojure.core-test.underive 7 0 clojure.core-test.underive 7 0
clojure.core-test.update 1 0 clojure.core-test.update 1 0
clojure.core-test.vals 0 3 clojure.core-test.vals 0 3
clojure.core-test.vec 1 0 clojure.core-test.vec 1 0
clojure.core-test.when-let 1 0 clojure.core-test.when-let 1 0
clojure.core-test.with-precision 17 0
clojure.edn-test.read-string 46 5 clojure.edn-test.read-string 46 5
clojure.string-test.capitalize 0 4 clojure.string-test.capitalize 0 4
clojure.string-test.ends-with-qmark 1 4 clojure.string-test.ends-with-qmark 1 4

2
test/chez/inline-test.ss
View file

@ -36,7 +36,7 @@
(ev "(def add1 (fn* ([x] (+ x 1))))") (ev "(def add1 (fn* ([x] (+ x 1))))")
(let ((e (emitf "u" "(fn* ([y] (add1 y)))"))) (let ((e (emitf "u" "(fn* ([y] (add1 y)))")))
(ok "plain fn is inlined (call to add1 gone)" (not (has? e "add1"))) (ok "plain fn is inlined (call to add1 gone)" (not (has? e "add1")))
(ok "inlined body present (+ ... 1)" (has? e "(+"))) (ok "inlined body present (jolt-n+ ... 1)" (has? e "(jolt-n+")))
(ok "inlined plain fn runtime: (add1 41) = 42" (= 42 (jnum->exact (ev "((fn* ([y] (add1 y))) 41)")))) (ok "inlined plain fn runtime: (add1 41) = 42" (= 42 (jnum->exact (ev "((fn* ([y] (add1 y))) 41)"))))
;; a ^double fn: body fl-ops fire after inlining, and the call is gone. ;; a ^double fn: body fl-ops fire after inlining, and the call is gone.

34
test/conformance/SPEC.md
View file

@ -127,10 +127,36 @@ arithmetic, `=`, and `hash` behave exactly as the JVM — but report `Long`, not
`Byte`/`Short`/`Integer`, so `(class (byte 5))` and `(instance? Byte (byte 5))` `Byte`/`Short`/`Integer`, so `(class (byte 5))` and `(instance? Byte (byte 5))`
diverge. This is substrate-inherent: a Chez fixnum is an immediate `identical?` diverge. This is substrate-inherent: a Chez fixnum is an immediate `identical?`
to the plain integer (nothing to tag, and numbers carry no metadata), so the only to the plain integer (nothing to tag, and numbers carry no metadata), so the only
faithful representation is a boxed type — which would crash raw compiled `(+ …)` faithful representation is a boxed type — which would crash the compiled
(arithmetic emits a bare Chez `+`) or force every `+`/`-`/`*` through an arithmetic fast path (both operands Chez numbers → the raw Chez op) or force
unwrapping dispatcher, de-optimizing all arithmetic. Same shape as the accepted every `+`/`-`/`*` through an unwrapping dispatcher, de-optimizing all
BigInt-vs-Long unification. arithmetic. Same shape as the accepted BigInt-vs-Long unification.
## Number operations
Binary arithmetic and comparisons follow the JVM's `Numbers.ops(x, y)` category
dispatch. Every position (call, value, higher-order) funnels a binary op through
one seam (`host/chez/seq.ss`): operands inside Chez's tower take the native op
with the JVM contagion rules patched in; an operand outside it (BigDecimal)
falls to a slow hook the numeric shim extends (`host/chez/java/bigdec.ss`); a
non-numeric operand throws `ClassCastException`. The rules the corpus pins
(`numbers / ops dispatch`, `numbers / with-precision`, `numbers / rationalize`):
- A double operand wins: `(* 1.0 0)` is `0.0` (Chez's exact-zero shortcut must
not leak), `(* ##Inf 0)` is `##NaN`, `(+ 1.5M 2.0)` is `3.5`.
- Division: an exact zero divisor throws `ArithmeticException`; a double zero
divisor yields `##Inf`/`##-Inf`/`##NaN`. `(/ 1M 3M)` with no bound
`*math-context*` throws (non-terminating); under `with-precision` it rounds.
- `quot`/`rem`/`mod` cover the full tower (ratios truncate; doubles keep double;
`mod` takes the divisor's sign; zero divisor throws in both worlds).
- `min`/`max` return the *original* operand (`(min 1 2.0)` is `1`, exact); a
`##NaN` operand wins.
- `with-precision` binds `*math-context*`; BigDecimal results round to the
precision with the `java.math.RoundingMode` semantics (default `HALF_UP`,
`UNNECESSARY` throws).
- `rationalize` routes a double through its shortest decimal print
(`BigDecimal.valueOf`), so `(rationalize 1.1)` is `11/10`, not the exact
binary expansion.
## Hosting jolt on a new runtime ## Hosting jolt on a new runtime

2
test/conformance/known-divergences.edn
View file

@ -2,7 +2,7 @@
"Rows of test/chez/corpus.edn whose :expected differs from reference JVM Clojure. The corpus is JVM-sourced (regen-corpus.clj), so this list is only the rows whose JVM value is an opaque host object that cannot round-trip to readable source — Java arrays, transients, atoms, beans, proxies, and chunks print as #object[..@addr] with a per-run identity — plus the (fn* foo) strictness case. For that the corpus keeps jolt's value. certify.clj gates on NEW (unlisted) divergences and STALE entries. Keyed by [suite label].", "Rows of test/chez/corpus.edn whose :expected differs from reference JVM Clojure. The corpus is JVM-sourced (regen-corpus.clj), so this list is only the rows whose JVM value is an opaque host object that cannot round-trip to readable source — Java arrays, transients, atoms, beans, proxies, and chunks print as #object[..@addr] with a per-run identity — plus the (fn* foo) strictness case. For that the corpus keeps jolt's value. certify.clj gates on NEW (unlisted) divergences and STALE entries. Keyed by [suite label].",
:legend :legend
{:numeric-model {:numeric-model
"jolt has a numeric tower (exact integer / Ratio / double); no BigDecimal", "jolt has the full numeric tower (exact integer / Ratio / double / BigDecimal); binary ops dispatch by operand category with JVM contagion rules",
:host-model :host-model
"no JVM host: classes->name strings, type->symbol, *in* is a map, inline-impl extenders, duck-typed with-open close", "no JVM host: classes->name strings, type->symbol, *in* is a map, inline-impl extenders, duck-typed with-open close",
:reader-model :reader-model