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

^long is a 64-bit long: fast-path-with-fallback ops + logical unsigned shift

Browse source 
Completes the JVM long-compatibility gap so clojure.test.check (and the
property-based suites built on it, e.g. data.codec) run on jolt.

A ^long is 64-bit but a Chez fixnum is only 61-bit, so the backend's fast fx
comparison / quot / min / max / inc / dec ops raised on a full-width long (one
from the PRNG or wrapping arithmetic). They now go through the jolt-l* macros
(host/chez/seq.ss): the fx fast path when the operands ARE fixnums, the generic
op otherwise — so e.g. ((fn [^long a ^long b] (< a b)) Long/MAX 1) is false, not
an error. Arithmetic +/-/* keep the raw fx ops (under *unchecked-math* they're
already the wrapping unchecked-*).

Also fixes unsigned-bit-shift-right: it was an arithmetic (sign-propagating)
shift, now a logical shift over the 64-bit two's-complement window, so
(unsigned-bit-shift-right -1 1) is 2^63-1 like the JVM.

Result: test.check 1.1.3 loads and runs (generators, quick-check, shrinking);
data.codec's base64 property suite passes (12/12 defspecs; the 2 deftests check
clojure.lang.IFn$OLLOL, a JVM primitive-fn interface, N/A). Both added to
docs/libraries.md + the site.

re-mint (backend/seed). make test green (+3 corpus rows, 0 new divergences,
numeric gate updated to the jolt-l* ops), shakesmoke byte-identical.
This commit is contained in:
Yogthos 2026-06-27 16:04:19 -04:00
parent a028cab04f
commit 3340635714
7 changed files with 62 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

3
test/chez/corpus.edn
View file

@ -3375,4 +3375,7 @@
{:suite "numbers / unchecked wraps to signed 64-bit" :label "unchecked-negate of MIN wraps to MIN" :expected "-9223372036854775808" :actual "(unchecked-negate -9223372036854775808)"}
{:suite "numbers / unchecked wraps to signed 64-bit" :label "unchecked-inc of MAX wraps to MIN" :expected "-9223372036854775808" :actual "(unchecked-inc 9223372036854775807)"}
{:suite "host-interop / Long bit statics" :label "Long/bitCount, numberOfLeadingZeros, reverse" :expected "[10 63 0 -2]" :actual "[(Long/bitCount 1023) (Long/numberOfLeadingZeros 1) (Long/bitCount 0) (Long/reverse 9223372036854775807)]"}
{:suite "numbers / unsigned-bit-shift-right is logical over 64 bits" :label "shift of a negative shifts in zeros" :expected "[9223372036854775807 4611686018427387902]" :actual "[(unsigned-bit-shift-right -1 1) (unsigned-bit-shift-right -8 2)]"}
{:suite "numbers / ^long is 64-bit" :label "^long comparison on a full-width long" :expected "false" :actual "((fn* ([^long a ^long b] (< a b))) 9223372036854775807 1)"}
{:suite "numbers / ^long is 64-bit" :label "^long quot on a full-width long" :expected "3074457345618258602" :actual "((fn* ([^long a] (quot a 3))) 9223372036854775807)"}
]

18
test/chez/numeric-test.ss
View file

@ -41,14 +41,16 @@
(ok "long + lowers to fx+" (has? (emitf "u" "(fn* ([^long a ^long b] (+ a b)))") "(fx+"))
(ok "long * lowers to fx*" (has? (emitf "u" "(fn* ([^long a ^long b] (* a b)))") "(fx*"))
(ok "double < lowers to fl<?" (has? (emitf "u" "(fn* ([^double x] (< x 1.0)))") "(fl<?"))
(ok "long < lowers to fx<?" (has? (emitf "u" "(fn* ([^long a ^long b] (< a b)))") "(fx<?"))
(ok "long inc lowers to fx1+" (has? (emitf "u" "(fn* ([^long n] (inc n)))") "(fx1+"))
;; ^long comparisons / inc / dec / quot use the jolt-l* fast-path-with-fallback
;; helpers so a full 64-bit operand (past the 61-bit fixnum range) is handled.
(ok "long < lowers to jolt-l<" (has? (emitf "u" "(fn* ([^long a ^long b] (< a b)))") "(jolt-l<"))
(ok "long inc lowers to jolt-l-inc" (has? (emitf "u" "(fn* ([^long n] (inc n)))") "(jolt-l-inc"))
(ok "double inc lowers to fl+ 1.0" (has? (emitf "u" "(fn* ([^double x] (inc x)))") "(fl+"))
(ok "long dec lowers to fx1-" (has? (emitf "u" "(fn* ([^long n] (dec n)))") "(fx1-"))
(ok "long dec lowers to jolt-l-dec" (has? (emitf "u" "(fn* ([^long n] (dec n)))") "(jolt-l-dec"))
;; unchecked-* WRAP to signed 64 bits (Java long), so they emit the wrapping
;; jolt-unc* helpers, not the raising fx ops.
(ok "unchecked-add lowers to jolt-uncadd2" (has? (emitf "u" "(fn* ([^long n] (unchecked-add n 1)))") "(jolt-uncadd2"))
(ok "long quot lowers to fxquotient" (has? (emitf "u" "(fn* ([^long a ^long b] (quot a b)))") "(fxquotient"))
(ok "long quot lowers to jolt-l-quot" (has? (emitf "u" "(fn* ([^long a ^long b] (quot a b)))") "(jolt-l-quot"))
(ok "double == lowers to fl=?" (has? (emitf "u" "(fn* ([^double a ^double b] (== a b)))") "(fl=?"))
;; integer literal in a double op is coerced to a flonum (fl+ never sees an exact int)
@ -69,11 +71,11 @@
(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+")))
(ok "literal-init increment counter lowers to jolt-l-inc" (has? e "(jolt-l-inc")))
;; 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 "counter beside a * accumulator: counter is jolt-l-inc" (has? e "(jolt-l-inc"))
(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))))))")))
@ -89,8 +91,8 @@
;; a ^long-seeded loop accumulator IS fx-typed (the hint is a fixnum promise, and
;; 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))))")))
(ok "long-seeded loop accumulator lowers (inc acc) to fx1+" (has? e "(fx1+"))
(ok "long-seeded loop comparison lowers to fx<?" (has? e "(fx<?")))
(ok "long-seeded loop accumulator lowers (inc acc) to jolt-l-inc" (has? e "(jolt-l-inc"))
(ok "long-seeded loop comparison lowers to jolt-l<" (has? e "(jolt-l<")))
;; --- soundness: un-hinted / integer-literal code stays generic ---
(let ((e (emitf "u" "(fn* ([a b] (+ a b)))")))