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

unchecked-* on a ratio (or any non-long) shouldn't wrap to 64-bit

Browse source 
jolt-unc{add,sub,mul,inc,dec,neg}2 wrapped every non-flonum result to a
signed 64-bit integer, so (unchecked-add 2/3 2/3) truncated to 1 instead
of 4/3. Under *unchecked-math* the analyzer rewrites +/-/* to unchecked-*,
so any ratio arithmetic in such a file silently floored. Clojure's
unchecked-add falls back to regular arithmetic for non-primitives; only
long math wraps. Wrap iff both operands are exact integers.

Shaken out by test.check's gen/ratio monoid property (the + and 0 monoid
held for small-integers but failed for ratios).
This commit is contained in:
Yogthos 2026-06-27 22:49:42 -04:00
parent 92368b49f1
commit 253d64b1e7
2 changed files with 19 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

24
host/chez/seq.ss
View file

@ -165,16 +165,20 @@
(define (jolt-wrap64 x) (define (jolt-wrap64 x)
(let ((m (bitwise-and (if (and (number? x) (exact? x) (integer? x)) x (exact (floor x))) unc-mask64))) (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))) (if (>= m unc-2^63) (- m unc-2^64) m)))
;; unchecked-* only WRAP integer (long) math; on a flonum operand they are an ;; unchecked-* only WRAP integer (long) math; on a flonum OR ratio operand they
;; ordinary float op, since *unchecked-math* never wraps doubles — Clojure: ;; are an ordinary numeric op, since *unchecked-math* never wraps a non-long —
;; (unchecked-multiply 1.5 2.0) => 3.0, not a truncated long. (test.check's ;; Clojure's unchecked-add falls back to regular arithmetic for non-primitives:
;; rand-double is (* double-unit shifted) under *unchecked-math*.) ;; (unchecked-multiply 1.5 2.0) => 3.0, (unchecked-add 2/3 2/3) => 4/3, not a
(define (jolt-uncadd2 a b) (if (or (flonum? a) (flonum? b)) (+ a b) (jolt-wrap64 (+ a b)))) ;; truncated long. (test.check's rand-double is (* double-unit shifted), and
(define (jolt-uncsub2 a b) (if (or (flonum? a) (flonum? b)) (- a b) (jolt-wrap64 (- a b)))) ;; gen/ratio sums ratios, both under *unchecked-math*.) Wrap iff both are exact
(define (jolt-uncmul2 a b) (if (or (flonum? a) (flonum? b)) (* a b) (jolt-wrap64 (* a b)))) ;; integers.
(define (jolt-uncinc x) (if (flonum? x) (+ x 1.0) (jolt-wrap64 (+ x 1)))) (define (unc-int? x) (and (exact? x) (integer? x)))
(define (jolt-uncdec x) (if (flonum? x) (- x 1.0) (jolt-wrap64 (- x 1)))) (define (jolt-uncadd2 a b) (if (and (unc-int? a) (unc-int? b)) (jolt-wrap64 (+ a b)) (+ a b)))
(define (jolt-uncneg x) (if (flonum? x) (- x) (jolt-wrap64 (- x)))) (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-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-mul . xs) (if (null? xs) 1 (fold-left jolt-uncmul2 (car xs) (cdr xs))))
(define (jolt-unchecked-sub . 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-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 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-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 "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 integer" :expected "true" :actual "(int? 5)"}
{:suite "numbers / promoting & unchecked aliases" :label "int? on double" :expected "false" :actual "(int? 5.5)"} {:suite "numbers / promoting & unchecked aliases" :label "int? on double" :expected "false" :actual "(int? 5.5)"}