3340635714
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.
88 lines
4.7 KiB
Scheme
88 lines
4.7 KiB
Scheme
;; bit ops + string->number parsers — host-coupled natives (bit family,
|
|
;; parse-long/double). jolt models every number as a double, so bit ops coerce
|
|
;; to an exact integer, operate, and return a flonum. parse-* use strict shapes
|
|
;; (Clojure 1.11: nil on malformed, throw on a non-string).
|
|
|
|
;; bit ops return EXACT integers (= JVM long). ->int coerces the operand.
|
|
(define (->int x) (exact (truncate x)))
|
|
(define (jolt-bit-and a b) (bitwise-and (->int a) (->int b)))
|
|
(define (jolt-bit-or a b) (bitwise-ior (->int a) (->int b)))
|
|
(define (jolt-bit-xor a b) (bitwise-xor (->int a) (->int b)))
|
|
(define (jolt-bit-and-not a b) (bitwise-and (->int a) (bitwise-not (->int b))))
|
|
(define (jolt-bit-not a) (bitwise-not (->int a)))
|
|
(define (jolt-bit-shift-left x n) (bitwise-arithmetic-shift-left (->int x) (->int n)))
|
|
(define (jolt-bit-shift-right x n) (bitwise-arithmetic-shift-right (->int x) (->int n)))
|
|
(define (bit-mask n) (bitwise-arithmetic-shift-left 1 (->int n)))
|
|
(define (jolt-bit-set x n) (bitwise-ior (->int x) (bit-mask n)))
|
|
(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 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 (bitwise-and (->int x) #xFFFFFFFFFFFFFFFF)
|
|
(bitwise-and (->int n) 63)))
|
|
|
|
;; ---- string->scalar parsers -------------------------------------------------
|
|
(define (ascii-digit? c) (and (char>=? c #\0) (char<=? c #\9)))
|
|
(define (skip-digits s i n) (let loop ((i i)) (if (and (< i n) (ascii-digit? (string-ref s i))) (loop (+ i 1)) i)))
|
|
(define (sign-at? s i n) (and (< i n) (let ((c (string-ref s i))) (or (char=? c #\+) (char=? c #\-)))))
|
|
|
|
(define (parse-long-shape? s)
|
|
(let* ((n (string-length s)) (i0 (if (sign-at? s 0 n) 1 0)))
|
|
(and (> n i0) (= (skip-digits s i0 n) n))))
|
|
|
|
(define (jolt-parse-long s)
|
|
(if (not (string? s)) (error #f "parse-long requires a string" s)
|
|
(if (parse-long-shape? s) (string->number s) jolt-nil))) ; exact long
|
|
|
|
;; strict float shape: [+-]? ( D+ (. D*)? | . D+ ) ([eE][+-]? D+)? fully anchored.
|
|
(define (parse-double-shape? s)
|
|
(let ((n (string-length s)))
|
|
(and (> n 0)
|
|
(call/cc
|
|
(lambda (no)
|
|
(let* ((i0 (if (sign-at? s 0 n) 1 0))
|
|
(after-int (skip-digits s i0 n))
|
|
(had-int (> after-int i0))
|
|
;; mantissa end
|
|
(jm (cond
|
|
((and had-int (< after-int n) (char=? (string-ref s after-int) #\.))
|
|
(skip-digits s (+ after-int 1) n)) ; D+ . D*
|
|
((and (not had-int) (< i0 n) (char=? (string-ref s i0) #\.))
|
|
(let ((k (skip-digits s (+ i0 1) n))) ; . D+
|
|
(if (> k (+ i0 1)) k (no #f))))
|
|
(had-int after-int)
|
|
(else (no #f))))
|
|
;; optional exponent
|
|
(je (if (and (< jm n) (let ((c (string-ref s jm))) (or (char=? c #\e) (char=? c #\E))))
|
|
(let* ((es (if (sign-at? s (+ jm 1) n) (+ jm 2) (+ jm 1)))
|
|
(ee (skip-digits s es n)))
|
|
(if (> ee es) ee (no #f)))
|
|
jm)))
|
|
(= je n)))))))
|
|
|
|
(define (jolt-parse-double s)
|
|
(if (not (string? s)) (error #f "parse-double requires a string" s)
|
|
(cond
|
|
((string=? s "Infinity") +inf.0)
|
|
((string=? s "-Infinity") -inf.0)
|
|
((string=? s "NaN") +nan.0)
|
|
((parse-double-shape? s) (exact->inexact (string->number s)))
|
|
(else jolt-nil))))
|
|
|
|
(def-var! "clojure.core" "__bit-and" jolt-bit-and)
|
|
(def-var! "clojure.core" "__bit-or" jolt-bit-or)
|
|
(def-var! "clojure.core" "__bit-xor" jolt-bit-xor)
|
|
(def-var! "clojure.core" "__bit-and-not" jolt-bit-and-not)
|
|
(def-var! "clojure.core" "bit-not" jolt-bit-not)
|
|
(def-var! "clojure.core" "bit-shift-left" jolt-bit-shift-left)
|
|
(def-var! "clojure.core" "bit-shift-right" jolt-bit-shift-right)
|
|
(def-var! "clojure.core" "bit-set" jolt-bit-set)
|
|
(def-var! "clojure.core" "bit-clear" jolt-bit-clear)
|
|
(def-var! "clojure.core" "bit-flip" jolt-bit-flip)
|
|
(def-var! "clojure.core" "bit-test" jolt-bit-test)
|
|
(def-var! "clojure.core" "unsigned-bit-shift-right" jolt-unsigned-bit-shift-right)
|
|
(def-var! "clojure.core" "parse-long" jolt-parse-long)
|
|
(def-var! "clojure.core" "parse-double" jolt-parse-double)
|