Unchecked / *unchecked-math* arithmetic wraps to signed 64-bit

clojure.core's unchecked-* (and +/-/*/inc/dec under *unchecked-math*) are long
ops that WRAP on overflow; jolt's checked arithmetic is arbitrary-precision and
its unchecked-* were plain non-wrapping (+ x y), diverging from the JVM. Now they
truncate to the low 64 bits as a signed long, matching Clojure:

  (unchecked-add 9223372036854775807 1)        => -9223372036854775808
  (unchecked-multiply 9223372036854775807 …)   => 1

- host/chez/seq.ss: jolt-wrap64 + binary jolt-unc{add,sub,mul,inc,dec,neg}2 and
  the variadic clojure.core/unchecked-* fns (def-var!'d in natives-seq.ss, where
  def-var! is bound). The overlay's plain unchecked-* defns are removed.
- backend lng-ops: unchecked-+/-/* emit the wrapping jolt-unc* helpers (the
  raising fx ops can't wrap on Chez's 61-bit fixnums); unchecked-inc/dec too.
- *unchecked-math* is honored: the analyzer reads it (jolt.host/unchecked-math?)
  and rewrites +/-/*/inc/dec to their unchecked-* for the rest of a file that
  (set!)s it, like the JVM.
- jolt->fx: a ^long value that overflows the 61-bit fixnum range passes through
  as an exact integer instead of erroring (a full-width long from wrapping math).

Also adds Long/bitCount / numberOfLeadingZeros / reverse and Math/getExponent /
scalb (test.check's splittable PRNG uses them).

This lets clojure.test.check load and run quick-check on jolt. re-mint (analyzer/
backend/overlay are seed sources). make test green (+6 corpus rows, 0 new
divergences, numeric gate updated), shakesmoke byte-identical.

host/chez/host-contract.ss

@@ -80,6 +80,12 @@
 (define (hc-var-value-ns x) (var-cell-ns x))
 (define (hc-var-value-name x) (var-cell-name x))
 
+;; *unchecked-math* read at compile time: when truthy (a file's (set!
+;; *unchecked-math* …)), the analyzer rewrites +/-/*/inc/dec to their wrapping
+;; unchecked-* forms for the rest of that file, like the JVM.
+(define (hc-unchecked-math?)
+  (jolt-truthy? (guard (e (#t #f)) (var-deref "clojure.core" "*unchecked-math*"))))
+
 ;; --- form accessors ---------------------------------------------------------
 (define (hc-char-code x) (char->integer x))  ; native Chez char -> codepoint
 (define (hc-sym-name x) (symbol-t-name x))
@@ -471,6 +477,7 @@
   (def-var! "jolt.host" "form-var-value?" hc-var-value?)
   (def-var! "jolt.host" "form-var-value-ns" hc-var-value-ns)
   (def-var! "jolt.host" "form-var-value-name" hc-var-value-name)
+  (def-var! "jolt.host" "unchecked-math?" hc-unchecked-math?)
   (def-var! "jolt.host" "form-bigdec?" hc-bigdec?)
   (def-var! "jolt.host" "form-bigdec-source" hc-bigdec-source)
   (def-var! "jolt.host" "form-elements" hc-elements)

host/chez/java/host-static-methods.ss

@@ -21,6 +21,11 @@
         (cons "acos" (lambda (x) (->dbl (acos x)))) (cons "atan" (lambda (x) (->dbl (atan x))))
         (cons "log" (lambda (x) (->dbl (log x)))) (cons "log10" (lambda (x) (->dbl (/ (log x) (log 10)))))
         (cons "exp" (lambda (x) (->dbl (exp x))))
+        ;; getExponent: the unbiased binary exponent of a double (floor(log2|x|));
+        ;; scalb: x * 2^n. test.check's double generator uses both.
+        (cons "getExponent" (lambda (x) (if (= x 0.0) -1023
+                                            (exact (floor (/ (log (abs (exact->inexact x))) (log 2.0)))))))
+        (cons "scalb" (lambda (x n) (->dbl (* (exact->inexact x) (expt 2.0 (jnum->exact n))))))
         (cons "max" (lambda (a b) (if (> a b) a b))) (cons "min" (lambda (a b) (if (< a b) a b)))
         (cons "signum" (lambda (x) (cond ((< x 0) -1.0) ((> x 0) 1.0) (else 0.0))))
         (cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1)))
@@ -180,9 +185,28 @@
         (cons "getProperties" (lambda () (sys-properties-map)))
         (cons "getenv" (lambda k (apply sys-getenv k)))))
 
+;; java.lang.Long.bitCount: the population count of the value's 64-bit two's-
+;; complement (mask to 64 bits so a negative long counts like the JVM, e.g.
+;; bitCount(-1) = 64). test.check's splittable PRNG uses it.
+(define long-mask64 #xFFFFFFFFFFFFFFFF)
+(define long-2^63 (expt 2 63))
+(define long-2^64 (expt 2 64))
+;; interpret a 64-bit value as a signed long (top bit = sign), like the JVM.
+(define (as-signed64 v) (if (>= v long-2^63) (- v long-2^64) v))
+(define (long-nlz n) (- 64 (integer-length (bitwise-and (jnum->exact n) long-mask64))))
+(define (long-reverse n)
+  (let ((v (bitwise-and (jnum->exact n) long-mask64)))
+    (let loop ((i 0) (r 0))
+      (if (fx=? i 64) (as-signed64 r)
+          (loop (fx+ i 1)
+                (bitwise-ior (bitwise-arithmetic-shift-left r 1)
+                             (bitwise-and (bitwise-arithmetic-shift-right v i) 1)))))))
 (register-class-statics! "Long"
   (list (cons "MAX_VALUE" (->num 9223372036854775807))
         (cons "MIN_VALUE" (->num -9223372036854775808))
+        (cons "bitCount" (lambda (n) (->num (bitwise-bit-count (bitwise-and (jnum->exact n) long-mask64)))))
+        (cons "numberOfLeadingZeros" (lambda (n) (->num (long-nlz n))))
+        (cons "reverse" (lambda (n) (->num (long-reverse n))))
         (cons "parseLong" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "parseLong")))
         (cons "valueOf" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "valueOf")))))
 

host/chez/natives-seq.ss

@@ -228,3 +228,14 @@
       (list->cseq (reverse (seq->list (jolt-seq coll))))
       (jolt-throw (jolt-ex-info "rseq requires a vector or sorted collection" (jolt-hash-map)))))
 (def-var! "clojure.core" "rseq" jolt-rseq)
+
+;; clojure.core/unchecked-* — host-defined wrapping (Java long) arithmetic from
+;; seq.ss. def-var!'d here because def-var! isn't bound when seq.ss loads.
+(let ((d! (lambda (n v) (def-var! "clojure.core" n v))))
+  (d! "unchecked-add" jolt-unchecked-add)        (d! "unchecked-add-int" jolt-unchecked-add)
+  (d! "unchecked-subtract" jolt-unchecked-sub)   (d! "unchecked-subtract-int" jolt-unchecked-sub)
+  (d! "unchecked-multiply" jolt-unchecked-mul)   (d! "unchecked-multiply-int" jolt-unchecked-mul)
+  (d! "unchecked-negate" jolt-uncneg)            (d! "unchecked-negate-int" jolt-uncneg)
+  (d! "unchecked-inc" jolt-uncinc)               (d! "unchecked-inc-int" jolt-uncinc)
+  (d! "unchecked-dec" jolt-uncdec)               (d! "unchecked-dec-int" jolt-uncdec)
+  (d! "unchecked-divide-int" jolt-unchecked-div) (d! "unchecked-remainder-int" jolt-unchecked-rem))

host/chez/rt.ss

@@ -22,12 +22,17 @@
 ;; pass an exact integer through, error if it doesn't fit a fixnum or isn't a
 ;; number. The hint is a promise the value is a fixnum-range long; the body's fx*
 ;; ops rely on it. (^double params coerce with the built-in exact->inexact.)
+;; A ^long is a 64-bit value; a Chez fixnum is only 61-bit, so a value that
+;; overflows the fixnum range (a full-width long, e.g. from unchecked / wrapping
+;; arithmetic) passes through as an exact integer rather than erroring. fx ops in
+;; the body still require fixnums (they raise on a bignum), but generic /
+;; unchecked-* ops handle it.
 (define (jolt->fx x)
-  (let ((n (cond ((fixnum? x) x)
+  (cond ((fixnum? x) x)
-                 ((flonum? x) (exact (truncate x)))
+        ((and (number? x) (exact? x) (integer? x)) x)
-                 ((rational? x) (exact (truncate x)))
+        ((flonum? x) (exact (truncate x)))
-                 (else (error 'jolt "^long hint: not a number" x)))))
+        ((rational? x) (exact (truncate x)))
-    (if (fixnum? n) n (error 'jolt "^long hint: value out of fixnum range" x))))
+        (else (error 'jolt "^long hint: not a number" x))))
 ;; jolt `not`: only nil and false are falsey.
 (define (jolt-not x) (if (jolt-truthy? x) #f #t))
 

host/chez/seq.ss

@@ -152,6 +152,34 @@
 (define (jolt-min . xs) (apply min xs))
 (define (jolt-max . xs) (apply max xs))
 
+;; --- unchecked (Java long) arithmetic: wrap to signed 64 bits ----------------
+;; Clojure's unchecked-* (and +/-/* under *unchecked-math*) are long ops that
+;; WRAP on overflow; jolt's checked arithmetic is arbitrary-precision. These
+;; truncate to the low 64 bits as a two's-complement signed long. Chez fixnums are
+;; 61-bit, so wrapping uses bignum bit ops + a mask (no fx fast path). The backend
+;; emits the binary jolt-unc* for :long-typed unchecked ops; the variadic
+;; clojure.core/unchecked-* fns reduce through them.
+(define unc-mask64 #xFFFFFFFFFFFFFFFF)
+(define unc-2^63   #x8000000000000000)
+(define unc-2^64   #x10000000000000000)
+(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)))
+(define (jolt-uncadd2 a b) (jolt-wrap64 (+ a b)))
+(define (jolt-uncsub2 a b) (jolt-wrap64 (- a b)))
+(define (jolt-uncmul2 a b) (jolt-wrap64 (* a b)))
+(define (jolt-uncinc x)    (jolt-wrap64 (+ x 1)))
+(define (jolt-uncdec x)    (jolt-wrap64 (- x 1)))
+(define (jolt-uncneg x)    (jolt-wrap64 (- 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)
+  (cond ((null? xs) 0) ((null? (cdr xs)) (jolt-uncneg (car xs))) (else (fold-left jolt-uncsub2 (car xs) (cdr xs)))))
+(define (jolt-unchecked-div a b) (quotient (jolt-wrap64 a) (jolt-wrap64 b)))
+(define (jolt-unchecked-rem a b) (remainder (jolt-wrap64 a) (jolt-wrap64 b)))
+;; the clojure.core/unchecked-* vars are def-var!'d in natives-seq.ss (def-var! is
+;; defined after this file loads).
+
 ;; ============================================================================
 ;; 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)

jolt-core/clojure/core/22-coll.clj

@@ -194,20 +194,9 @@
 (def *' *)
 (def inc' inc)
 (def dec' dec)
-(defn unchecked-add [x y] (+ x y))
+;; unchecked-add / -subtract / -multiply / -negate / -inc / -dec (+ the -int
-(defn unchecked-subtract [x y] (- x y))
+;; variants) and -divide-int / -remainder-int are host-defined (host/chez/seq.ss):
-(defn unchecked-multiply [x y] (* x y))
+;; they WRAP to signed 64 bits like the JVM, which a plain (+ x y) overlay can't do.
-(defn unchecked-negate [x] (- x))
-(defn unchecked-inc [x] (+ x 1))
-(defn unchecked-dec [x] (- x 1))
-(def unchecked-add-int unchecked-add)
-(def unchecked-subtract-int unchecked-subtract)
-(def unchecked-multiply-int unchecked-multiply)
-(def unchecked-negate-int unchecked-negate)
-(def unchecked-inc-int unchecked-inc)
-(def unchecked-dec-int unchecked-dec)
-(defn unchecked-divide-int [x y] (quot x y))
-(defn unchecked-remainder-int [x y] (rem x y))
 (defn unchecked-int [x] (int x))
 (def unchecked-long unchecked-int)
 

jolt-core/jolt/analyzer.clj

@@ -26,6 +26,7 @@
                                form-bigdec? form-bigdec-source
                                form-ns-value? form-ns-value-name
                                form-var-value? form-var-value-ns form-var-value-name
+                               unchecked-math?
                                form-macro? form-expand-1 resolve-global
                                form-sym-meta form-coll-meta host-intern! form-syntax-quote-lower
                                record-type? record-ctor-key form-position late-bind?
@@ -611,6 +612,18 @@
                   (var-ref (compile-ns ctx) nm)
                   (uncompilable (str "Unable to resolve symbol: " nm " in this context"))))))))
 
+;; The wrapping unchecked-* name a core arithmetic op rewrites to under
+;; *unchecked-math*, or nil. n is the full item count (head + args); unary - is a
+;; negate.
+(defn- unchecked-arith [hname n]
+  (cond
+    (= hname "+") "unchecked-add"
+    (= hname "*") "unchecked-multiply"
+    (= hname "-") (if (= n 2) "unchecked-negate" "unchecked-subtract")
+    (= hname "inc") "unchecked-inc"
+    (= hname "dec") "unchecked-dec"
+    :else nil))
+
 (defn- analyze-list [ctx form env]
   (let [items (vec (form-elements form))]
     (if (zero? (count items))
@@ -626,8 +639,15 @@
                                    (= "clojure.core" (form-sym-ns head))
                                    (contains? handled (form-sym-name head)))
                           (form-sym-name head)))
-            shadowed (and hname (local? env hname))]
+            shadowed (and hname (local? env hname))
+            ;; under *unchecked-math*, a core +/-/*/inc/dec becomes its wrapping
+            ;; unchecked-* (computed once; nil when off or not such an op).
+            unm (when (and hname (not shadowed) (unchecked-math?))
+                  (unchecked-arith hname (count items)))]
         (cond
+          ;; *unchecked-math* rewrite, before macro/special dispatch (these are
+          ;; ordinary core fns). The unchecked-* form re-analyzes normally.
+          unm (analyze ctx (cons (symbol unm) (rest items)) env)
           ;; Canonical order (Clojure/CLJS analyze-seq): macroexpand FIRST, then
           ;; dispatch special forms / interop / invoke. A local shadows the macro.
           ;; A true special form is NOT shadowable by a same-named macro, matching

jolt-core/jolt/backend_scheme.clj

@@ -96,7 +96,9 @@
    "<" "fl<?" ">" "fl>?" "<=" "fl<=?" ">=" "fl>=?" "=" "fl=?" "==" "fl=?"})
 (def ^:private lng-ops
   {"+" "fx+" "-" "fx-" "*" "fx*" "min" "fxmin" "max" "fxmax"
-   "unchecked-add" "fx+" "unchecked-subtract" "fx-" "unchecked-multiply" "fx*"
+   ;; unchecked-* WRAP to signed 64 bits (Java long), so they can't use the raising
+   ;; fx ops — the backend emits the wrapping jolt-unc* helpers (host/chez/seq.ss).
+   "unchecked-add" "jolt-uncadd2" "unchecked-subtract" "jolt-uncsub2" "unchecked-multiply" "jolt-uncmul2"
    "quot" "fxquotient" "rem" "fxremainder" "mod" "fxmodulo"
    "<" "fx<?" ">" "fx>?" "<=" "fx<=?" ">=" "fx>=?" "=" "fx=?" "==" "fx=?"})
 
@@ -485,8 +487,11 @@
   (cond
     (and (= kind :double) (= nm "inc")) (str "(fl+ " (first args) " 1.0)")
     (and (= kind :double) (= nm "dec")) (str "(fl- " (first args) " 1.0)")
-    (and (= kind :long) (or (= nm "inc") (= nm "unchecked-inc"))) (str "(fx1+ " (first args) ")")
+    (and (= kind :long) (= nm "inc")) (str "(fx1+ " (first args) ")")
-    (and (= kind :long) (or (= nm "dec") (= nm "unchecked-dec"))) (str "(fx1- " (first args) ")")
+    (and (= kind :long) (= nm "dec")) (str "(fx1- " (first args) ")")
+    ;; unchecked-inc/dec wrap (Java long), so the raising fx1+/fx1- can't be used.
+    (and (= kind :long) (= nm "unchecked-inc")) (str "(jolt-uncinc " (first args) ")")
+    (and (= kind :long) (= nm "unchecked-dec")) (str "(jolt-uncdec " (first args) ")")
     :else
     (let [op (case kind :double (dbl-ops nm) :long (lng-ops nm) :bigdec (bd-ops nm))]
       (order-args (fn [as] (str "(" op " " (str/join " " as) ")"))))))

test/chez/corpus.edn

@@ -3369,4 +3369,10 @@
   {:suite "host-interop / class hierarchy" :label "(class sym)-dispatched multimethod hits an IFn method" :expected ":ifn" :actual "(do (defmulti cm1 class) (defmethod cm1 clojure.lang.IFn [_] :ifn) (cm1 (quote sym)))"}
   {:suite "host-interop / extend-protocol java.io" :label "protocol extended to Reader / String dispatches a StringReader and a String" :expected "[:reader :string]" :actual "(do (import (quote (java.io StringReader))) (defprotocol Prdr (mrd [x])) (extend-protocol Prdr java.io.Reader (mrd [_] :reader) String (mrd [_] :string)) [(mrd (StringReader. \"x\")) (mrd \"y\")])"}
   {:suite "host-interop / StringWriter" :label "(str StringWriter) returns its accumulated content" :expected "\"hi!\"" :actual "(do (import (quote (java.io StringWriter))) (let [w (StringWriter.)] (.write w \"hi\") (.write w \"!\") (str w)))"}
+  {:suite "numbers / unchecked wraps to signed 64-bit" :label "unchecked-add overflow wraps" :expected "-9223372036854775808" :actual "(unchecked-add 9223372036854775807 1)"}
+  {:suite "numbers / unchecked wraps to signed 64-bit" :label "unchecked-multiply overflow wraps" :expected "1" :actual "(unchecked-multiply 9223372036854775807 9223372036854775807)"}
+  {:suite "numbers / unchecked wraps to signed 64-bit" :label "unchecked-subtract underflow wraps" :expected "9223372036854775807" :actual "(unchecked-subtract -9223372036854775808 1)"}
+  {: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)]"}
 ]

test/chez/numeric-test.ss

@@ -45,7 +45,9 @@
 (ok "long inc lowers to fx1+"     (has? (emitf "u" "(fn* ([^long n] (inc n)))") "(fx1+"))
 (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 "unchecked-add lowers to fx+" (has? (emitf "u" "(fn* ([^long n] (unchecked-add n 1)))") "(fx+"))
+;; 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 "double == lowers to fl=?"    (has? (emitf "u" "(fn* ([^double a ^double b] (== a b)))") "(fl=?"))