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

9
host/chez/natives-num.ss
View file

@ -17,11 +17,12 @@
(define (jolt-bit-clear x n) (bitwise-and (->int x) (bitwise-not (bit-mask n))))
(define (jolt-bit-flip x n) (bitwise-xor (->int x) (bit-mask n)))
(define (jolt-bit-test x n) (not (zero? (bitwise-and (->int x) (bit-mask n)))))
;; unsigned-bit-shift-right: logical shift over 64-bit longs. For the common
;; non-negative operand it equals the arithmetic shift; the negative-operand
;; 64-bit-window case is not modeled.
;; unsigned-bit-shift-right: LOGICAL right shift over a 64-bit long (Java >>>),
;; so a negative operand shifts in zeros from its 64-bit two's-complement window
;; ((>>> -1 1) = 2^63-1), not the sign. The shift count is taken mod 64.
(define (jolt-unsigned-bit-shift-right x n)
(bitwise-arithmetic-shift-right (->int x) (->int n)))
(bitwise-arithmetic-shift-right (bitwise-and (->int x) #xFFFFFFFFFFFFFFFF)
(bitwise-and (->int n) 63)))
;; ---- string->scalar parsers -------------------------------------------------
(define (ascii-digit? c) (and (char>=? c #\0) (char<=? c #\9)))

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

@ -143,7 +143,7 @@
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "dbl-ops" (let* ((_o$7452 "+") (_o$7453 "fl+") (_o$7454 "-") (_o$7455 "fl-") (_o$7456 "*") (_o$7457 "fl*") (_o$7458 "/") (_o$7459 "fl/") (_o$7460 "min") (_o$7461 "flmin") (_o$7462 "max") (_o$7463 "flmax") (_o$7464 "<") (_o$7465 "fl<?") (_o$7466 ">") (_o$7467 "fl>?") (_o$7468 "<=") (_o$7469 "fl<=?") (_o$7470 ">=") (_o$7471 "fl>=?") (_o$7472 "=") (_o$7473 "fl=?") (_o$7474 "==") (_o$7475 "fl=?")) (jolt-hash-map _o$7452 _o$7453 _o$7454 _o$7455 _o$7456 _o$7457 _o$7458 _o$7459 _o$7460 _o$7461 _o$7462 _o$7463 _o$7464 _o$7465 _o$7466 _o$7467 _o$7468 _o$7469 _o$7470 _o$7471 _o$7472 _o$7473 _o$7474 _o$7475)) (let* ((_o$7476 (keyword #f "private")) (_o$7477 #t)) (jolt-hash-map _o$7476 _o$7477))))
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "lng-ops" (let* ((_o$7478 "+") (_o$7479 "fx+") (_o$7480 "-") (_o$7481 "fx-") (_o$7482 "*") (_o$7483 "fx*") (_o$7484 "min") (_o$7485 "fxmin") (_o$7486 "max") (_o$7487 "fxmax") (_o$7488 "unchecked-add") (_o$7489 "jolt-uncadd2") (_o$7490 "unchecked-subtract") (_o$7491 "jolt-uncsub2") (_o$7492 "unchecked-multiply") (_o$7493 "jolt-uncmul2") (_o$7494 "quot") (_o$7495 "fxquotient") (_o$7496 "rem") (_o$7497 "fxremainder") (_o$7498 "mod") (_o$7499 "fxmodulo") (_o$7500 "<") (_o$7501 "fx<?") (_o$7502 ">") (_o$7503 "fx>?") (_o$7504 "<=") (_o$7505 "fx<=?") (_o$7506 ">=") (_o$7507 "fx>=?") (_o$7508 "=") (_o$7509 "fx=?") (_o$7510 "==") (_o$7511 "fx=?")) (jolt-hash-map _o$7478 _o$7479 _o$7480 _o$7481 _o$7482 _o$7483 _o$7484 _o$7485 _o$7486 _o$7487 _o$7488 _o$7489 _o$7490 _o$7491 _o$7492 _o$7493 _o$7494 _o$7495 _o$7496 _o$7497 _o$7498 _o$7499 _o$7500 _o$7501 _o$7502 _o$7503 _o$7504 _o$7505 _o$7506 _o$7507 _o$7508 _o$7509 _o$7510 _o$7511)) (let* ((_o$7512 (keyword #f "private")) (_o$7513 #t)) (jolt-hash-map _o$7512 _o$7513))))
(def-var-with-meta! "jolt.backend-scheme" "lng-ops" (let* ((_o$7478 "+") (_o$7479 "fx+") (_o$7480 "-") (_o$7481 "fx-") (_o$7482 "*") (_o$7483 "fx*") (_o$7484 "min") (_o$7485 "jolt-l-min") (_o$7486 "max") (_o$7487 "jolt-l-max") (_o$7488 "unchecked-add") (_o$7489 "jolt-uncadd2") (_o$7490 "unchecked-subtract") (_o$7491 "jolt-uncsub2") (_o$7492 "unchecked-multiply") (_o$7493 "jolt-uncmul2") (_o$7494 "quot") (_o$7495 "jolt-l-quot") (_o$7496 "rem") (_o$7497 "jolt-l-rem") (_o$7498 "mod") (_o$7499 "jolt-l-mod") (_o$7500 "<") (_o$7501 "jolt-l<") (_o$7502 ">") (_o$7503 "jolt-l>") (_o$7504 "<=") (_o$7505 "jolt-l<=") (_o$7506 ">=") (_o$7507 "jolt-l>=") (_o$7508 "=") (_o$7509 "jolt-l=") (_o$7510 "==") (_o$7511 "jolt-l=")) (jolt-hash-map _o$7478 _o$7479 _o$7480 _o$7481 _o$7482 _o$7483 _o$7484 _o$7485 _o$7486 _o$7487 _o$7488 _o$7489 _o$7490 _o$7491 _o$7492 _o$7493 _o$7494 _o$7495 _o$7496 _o$7497 _o$7498 _o$7499 _o$7500 _o$7501 _o$7502 _o$7503 _o$7504 _o$7505 _o$7506 _o$7507 _o$7508 _o$7509 _o$7510 _o$7511)) (let* ((_o$7512 (keyword #f "private")) (_o$7513 #t)) (jolt-hash-map _o$7512 _o$7513))))
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "bd-ops" (let* ((_o$7514 "+") (_o$7515 "jbd-add") (_o$7516 "-") (_o$7517 "jbd-sub") (_o$7518 "*") (_o$7519 "jbd-mul") (_o$7520 "/") (_o$7521 "jbd-div") (_o$7522 "min") (_o$7523 "jbd-min") (_o$7524 "max") (_o$7525 "jbd-max") (_o$7526 "quot") (_o$7527 "jbd-quot") (_o$7528 "rem") (_o$7529 "jbd-rem") (_o$7530 "<") (_o$7531 "jbd-lt?") (_o$7532 ">") (_o$7533 "jbd-gt?") (_o$7534 "<=") (_o$7535 "jbd-le?") (_o$7536 ">=") (_o$7537 "jbd-ge?") (_o$7538 "zero?") (_o$7539 "jbd-zero?") (_o$7540 "pos?") (_o$7541 "jbd-pos?") (_o$7542 "neg?") (_o$7543 "jbd-neg?")) (jolt-hash-map _o$7514 _o$7515 _o$7516 _o$7517 _o$7518 _o$7519 _o$7520 _o$7521 _o$7522 _o$7523 _o$7524 _o$7525 _o$7526 _o$7527 _o$7528 _o$7529 _o$7530 _o$7531 _o$7532 _o$7533 _o$7534 _o$7535 _o$7536 _o$7537 _o$7538 _o$7539 _o$7540 _o$7541 _o$7542 _o$7543)) (let* ((_o$7544 (keyword #f "private")) (_o$7545 #t)) (jolt-hash-map _o$7544 _o$7545))))
(guard (e (#t #f))
@ -241,7 +241,7 @@
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "stdlib-var?" (letrec ((stdlib-var? (lambda (n) (let fnrec7835 ((n n)) (let* ((and__25__auto (jolt= (keyword #f "var") (jolt-get n (keyword #f "op"))))) (if (jolt-truthy? and__25__auto) (jolt-invoke (var-deref "clojure.string" "starts-with?") (let* ((or__26__auto (jolt-get n (keyword #f "ns")))) (if (jolt-truthy? or__26__auto) or__26__auto "")) "clojure.") and__25__auto)))))) stdlib-var?) (let* ((_o$7836 (keyword #f "private")) (_o$7837 #t)) (jolt-hash-map _o$7836 _o$7837))))
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "emit-numeric" (letrec ((emit-numeric (lambda (kind nm args order-args) (let fnrec7838 ((kind kind) (nm nm) (args args) (order-args order-args)) (if (let* ((and__25__auto (jolt= kind (keyword #f "double")))) (if (jolt-truthy? and__25__auto) (jolt= nm "inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fl+ " (jolt-first args) " 1.0)") (if (let* ((and__25__auto (jolt= kind (keyword #f "double")))) (if (jolt-truthy? and__25__auto) (jolt= nm "dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fl- " (jolt-first args) " 1.0)") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fx1+ " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fx1- " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "unchecked-inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uncinc " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "unchecked-dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uncdec " (jolt-first args) ")") (if (jolt-truthy? (keyword #f "else")) (let* ((op (let* ((G__140 kind)) (if (jolt= G__140 (keyword #f "double")) (jolt-invoke (var-deref "jolt.backend-scheme" "dbl-ops") nm) (if (jolt= G__140 (keyword #f "long")) (jolt-invoke (var-deref "jolt.backend-scheme" "lng-ops") nm) (if (jolt= G__140 (keyword #f "bigdec")) (jolt-invoke (var-deref "jolt.backend-scheme" "bd-ops") nm) (jolt-throw (let* ((_a$7839 (jolt-invoke (var-deref "clojure.core" "str") "No matching clause: " G__140)) (_a$7840 (jolt-hash-map))) (jolt-ex-info _a$7839 _a$7840))))))))) (jolt-invoke order-args (lambda (as) (let fnrec7841 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" op " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")"))))) jolt-nil))))))))))) emit-numeric) (let* ((_o$7842 (keyword #f "private")) (_o$7843 #t)) (jolt-hash-map _o$7842 _o$7843))))
(def-var-with-meta! "jolt.backend-scheme" "emit-numeric" (letrec ((emit-numeric (lambda (kind nm args order-args) (let fnrec7838 ((kind kind) (nm nm) (args args) (order-args order-args)) (if (let* ((and__25__auto (jolt= kind (keyword #f "double")))) (if (jolt-truthy? and__25__auto) (jolt= nm "inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fl+ " (jolt-first args) " 1.0)") (if (let* ((and__25__auto (jolt= kind (keyword #f "double")))) (if (jolt-truthy? and__25__auto) (jolt= nm "dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(fl- " (jolt-first args) " 1.0)") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-l-inc " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-l-dec " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "unchecked-inc") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uncinc " (jolt-first args) ")") (if (let* ((and__25__auto (jolt= kind (keyword #f "long")))) (if (jolt-truthy? and__25__auto) (jolt= nm "unchecked-dec") and__25__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uncdec " (jolt-first args) ")") (if (jolt-truthy? (keyword #f "else")) (let* ((op (let* ((G__140 kind)) (if (jolt= G__140 (keyword #f "double")) (jolt-invoke (var-deref "jolt.backend-scheme" "dbl-ops") nm) (if (jolt= G__140 (keyword #f "long")) (jolt-invoke (var-deref "jolt.backend-scheme" "lng-ops") nm) (if (jolt= G__140 (keyword #f "bigdec")) (jolt-invoke (var-deref "jolt.backend-scheme" "bd-ops") nm) (jolt-throw (let* ((_a$7839 (jolt-invoke (var-deref "clojure.core" "str") "No matching clause: " G__140)) (_a$7840 (jolt-hash-map))) (jolt-ex-info _a$7839 _a$7840))))))))) (jolt-invoke order-args (lambda (as) (let fnrec7841 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" op " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")"))))) jolt-nil))))))))))) emit-numeric) (let* ((_o$7842 (keyword #f "private")) (_o$7843 #t)) (jolt-hash-map _o$7842 _o$7843))))
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "struct-field-index" (letrec ((struct-field-index (lambda (shape kw) (let fnrec7844 ((shape shape) (kw kw)) (if (jolt-truthy? shape) (let* ((i 0)) (let loop7845 ((i i)) (if (>= i (jolt-count shape)) jolt-nil (if (jolt= (jolt-nth shape i) kw) i (if (jolt-truthy? (keyword #f "else")) (loop7845 (jolt-inc i)) jolt-nil))))) jolt-nil))))) struct-field-index) (let* ((_o$7846 (keyword #f "private")) (_o$7847 #t)) (jolt-hash-map _o$7846 _o$7847))))
(guard (e (#t #f))

26
host/chez/seq.ss
View file

@ -180,6 +180,32 @@
;; the clojure.core/unchecked-* vars are def-var!'d in natives-seq.ss (def-var! is
;; defined after this file loads).
;; --- ^long ops that tolerate a full 64-bit value -----------------------------
;; A ^long is 64-bit but a Chez fixnum is only 61-bit, so the backend's fast fx
;; ops would raise on a value past 2^60 (e.g. a long from the PRNG / wrapping
;; arithmetic). These take the fx fast path when the operands ARE fixnums and fall
;; back to the generic op otherwise — so ^long comparisons / quot / min etc. on a
;; full-width long stay correct. Macros (define-syntax) so the fast path inlines.
(define-syntax define-l-binop
(syntax-rules ()
((_ name fxop genop)
(define-syntax name
(syntax-rules ()
((_ a b) (let ((x a) (y b))
(if (and (fixnum? x) (fixnum? y)) (fxop x y) (genop x y)))))))))
(define-l-binop jolt-l< fx<? <)
(define-l-binop jolt-l<= fx<=? <=)
(define-l-binop jolt-l> fx>? >)
(define-l-binop jolt-l>= fx>=? >=)
(define-l-binop jolt-l= fx=? =)
(define-l-binop jolt-l-min fxmin min)
(define-l-binop jolt-l-max fxmax max)
(define-l-binop jolt-l-quot fxquotient quotient)
(define-l-binop jolt-l-rem fxremainder remainder)
(define-l-binop jolt-l-mod fxmodulo modulo)
(define-syntax jolt-l-inc (syntax-rules () ((_ a) (let ((x a)) (if (fixnum? x) (fx1+ x) (+ x 1))))))
(define-syntax jolt-l-dec (syntax-rules () ((_ a) (let ((x a)) (if (fixnum? x) (fx1- x) (- x 1))))))
;; ============================================================================
;; IFn dispatch — the dynamic "value as fn" fallback. A callee that the emitter
;; can't statically resolve to a procedure (a keyword/coll/proc held in a local)