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

Merge pull request #264 from jolt-lang/numeric/unchecked-ratio

Browse source 
unchecked arithmetic: ratio correctness + in-range fast path
This commit is contained in:
Dmitri Sotnikov 2026-06-28 05:30:59 +00:00 • committed by GitHub
commit f921e97c90
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 28 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

35
host/chez/seq.ss
View file

@ -162,19 +162,30 @@
(define unc-mask64 #xFFFFFFFFFFFFFFFF)
(define unc-2^63 #x8000000000000000)
(define unc-2^64 #x10000000000000000)
(define unc-neg-2^63 (- unc-2^63))
;; Wrap to a signed 64-bit value. Fast path: an exact integer already in
;; [-2^63, 2^63) is its own wrap — skip the bignum mask, which on Chez (61-bit
;; fixnums) allocates for any value past 2^60. Only an out-of-range result (a
;; multiply overflowing into 128 bits) needs the mask + sign fixup.
(define (jolt-wrap64 x)
(let ((m (bitwise-and (if (and (number? x) (exact? x) (integer? x)) x (exact (floor x))) unc-mask64)))
(if (>= m unc-2^63) (- m unc-2^64) m)))
;; unchecked-* only WRAP integer (long) math; on a flonum operand they are an
;; ordinary float op, since *unchecked-math* never wraps doubles — Clojure:
;; (unchecked-multiply 1.5 2.0) => 3.0, not a truncated long. (test.check's
;; rand-double is (* double-unit shifted) under *unchecked-math*.)
(define (jolt-uncadd2 a b) (if (or (flonum? a) (flonum? b)) (+ a b) (jolt-wrap64 (+ a b))))
(define (jolt-uncsub2 a b) (if (or (flonum? a) (flonum? b)) (- a b) (jolt-wrap64 (- a b))))
(define (jolt-uncmul2 a b) (if (or (flonum? a) (flonum? b)) (* a b) (jolt-wrap64 (* a b))))
(define (jolt-uncinc x) (if (flonum? x) (+ x 1.0) (jolt-wrap64 (+ x 1))))
(define (jolt-uncdec x) (if (flonum? x) (- x 1.0) (jolt-wrap64 (- x 1))))
(define (jolt-uncneg x) (if (flonum? x) (- x) (jolt-wrap64 (- x))))
(if (and (exact? x) (integer? x) (>= x unc-neg-2^63) (< x unc-2^63))
x
(let ((m (bitwise-and (if (and (number? x) (exact? x) (integer? x)) x (exact (floor x))) unc-mask64)))
(if (>= m unc-2^63) (- m unc-2^64) m))))
;; unchecked-* only WRAP integer (long) math; on a flonum OR ratio operand they
;; are an ordinary numeric op, since *unchecked-math* never wraps a non-long —
;; Clojure's unchecked-add falls back to regular arithmetic for non-primitives:
;; (unchecked-multiply 1.5 2.0) => 3.0, (unchecked-add 2/3 2/3) => 4/3, not a
;; truncated long. (test.check's rand-double is (* double-unit shifted), and
;; gen/ratio sums ratios, both under *unchecked-math*.) Wrap iff both are exact
;; integers.
(define (unc-int? x) (and (exact? x) (integer? x)))
(define (jolt-uncadd2 a b) (if (and (unc-int? a) (unc-int? b)) (jolt-wrap64 (+ a b)) (+ a b)))
(define (jolt-uncsub2 a b) (if (and (unc-int? a) (unc-int? b)) (jolt-wrap64 (- a b)) (- a b)))
(define (jolt-uncmul2 a b) (if (and (unc-int? a) (unc-int? b)) (jolt-wrap64 (* a b)) (* a b)))
(define (jolt-uncinc x) (if (unc-int? x) (jolt-wrap64 (+ x 1)) (+ x 1)))
(define (jolt-uncdec x) (if (unc-int? x) (jolt-wrap64 (- x 1)) (- x 1)))
(define (jolt-uncneg x) (if (unc-int? x) (jolt-wrap64 (- x)) (- x)))
(define (jolt-unchecked-add . xs) (if (null? xs) 0 (fold-left jolt-uncadd2 (car xs) (cdr xs))))
(define (jolt-unchecked-mul . xs) (if (null? xs) 1 (fold-left jolt-uncmul2 (car xs) (cdr xs))))
(define (jolt-unchecked-sub . xs)

5
test/chez/corpus.edn
View file

@ -1484,6 +1484,11 @@
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-remainder-int negative" :expected "-1" :actual "(unchecked-remainder-int -7 2)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-int truncates" :expected "3" :actual "(unchecked-int 3.7)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-int negative" :expected "-3" :actual "(unchecked-int -3.7)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-add on ratios does not wrap to long" :expected "4/3" :actual "(unchecked-add 2/3 2/3)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-multiply ratio by int" :expected "4/3" :actual "(unchecked-multiply 2/3 2)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-negate ratio" :expected "-2/3" :actual "(unchecked-negate 2/3)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-add ratios summing to zero" :expected "0" :actual "(unchecked-add 1/2 -1/2)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-inc ratio" :expected "3/2" :actual "(unchecked-inc 1/2)"}
{:suite "numbers / promoting & unchecked aliases" :label "unchecked-long" :expected "3" :actual "(unchecked-long 3.7)"}
{:suite "numbers / promoting & unchecked aliases" :label "int? on integer" :expected "true" :actual "(int? 5)"}
{:suite "numbers / promoting & unchecked aliases" :label "int? on double" :expected "false" :actual "(int? 5.5)"}