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

Merge pull request #257 from jolt-lang/numeric/unchecked-math-wrap

Browse source 
Long compatibility: *unchecked-math* wrapping + ^long is 64-bit (unblocks test.check)
This commit is contained in:
Dmitri Sotnikov 2026-06-27 20:10:07 +00:00 • committed by GitHub
commit 8a4df7b204
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
14 changed files with 645 additions and 532 deletions
Download patch file Download diff file Expand all files Collapse all files

4
docs/libraries.md
View file

@ -61,6 +61,10 @@ e.g. the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring
`clojure.data.zip.xml`; XML parsing via [jolt-lang/xml](https://github.com/jolt-lang/xml)
(which now ships `clojure.xml/parse`).
* [data.csv](https://github.com/clojure/data.csv) — reading and writing CSV.
* [data.codec](https://github.com/clojure/data.codec) — base64 encode/decode over
byte arrays.
* [test.check](https://github.com/clojure/test.check) — property-based testing
(generators, `quick-check`, shrinking).
* [tick](https://github.com/juxt/tick) — date/time over Jolt's `java.time`;
`#time/…` literals via `time-literals`.
* [transit-jolt](https://github.com/jolt-lang/transit-jolt) — Transit (JSON) read/write

7
host/chez/host-contract.ss
View file

@ -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)

24
host/chez/java/host-static-methods.ss
View file

@ -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")))))

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)))

11
host/chez/natives-seq.ss
View file

@ -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))

15
host/chez/rt.ss
View file

@ -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)
((flonum? x) (exact (truncate x)))
((rational? x) (exact (truncate x)))
(else (error 'jolt "^long hint: not a number" x)))))
(if (fixnum? n) n (error 'jolt "^long hint: value out of fixnum range" x))))
(cond ((fixnum? x) x)
((and (number? x) (exact? x) (integer? x)) x)
((flonum? x) (exact (truncate x)))
((rational? x) (exact (truncate 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))

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

File diff suppressed because one or more lines are too long

386
host/chez/seed/prelude.ss
View file

File diff suppressed because one or more lines are too long

54
host/chez/seq.ss
View file

@ -152,6 +152,60 @@
(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).
;; --- ^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)

17
jolt-core/clojure/core/22-coll.clj
View file

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

22
jolt-core/jolt/analyzer.clj
View file

@ -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

23
jolt-core/jolt/backend_scheme.clj
View file

@ -94,11 +94,18 @@
(def ^:private dbl-ops
{"+" "fl+" "-" "fl-" "*" "fl*" "/" "fl/" "min" "flmin" "max" "flmax"
"<" "fl<?" ">" "fl>?" "<=" "fl<=?" ">=" "fl>=?" "=" "fl=?" "==" "fl=?"})
;; A ^long is 64-bit; a Chez fixnum is only 61-bit. Arithmetic +/-/* keep the raw
;; fx ops (the fast-arith path; under *unchecked-math* they're already rewritten to
;; the wrapping unchecked-*). The comparisons / min/max / quot/rem/mod use the
;; jolt-l* fast-path-with-fallback macros (host/chez/seq.ss) so a full 64-bit
;; operand falls back to the generic op instead of raising.
(def ^:private lng-ops
{"+" "fx+" "-" "fx-" "*" "fx*" "min" "fxmin" "max" "fxmax"
"unchecked-add" "fx+" "unchecked-subtract" "fx-" "unchecked-multiply" "fx*"
"quot" "fxquotient" "rem" "fxremainder" "mod" "fxmodulo"
"<" "fx<?" ">" "fx>?" "<=" "fx<=?" ">=" "fx>=?" "=" "fx=?" "==" "fx=?"})
{"+" "fx+" "-" "fx-" "*" "fx*" "min" "jolt-l-min" "max" "jolt-l-max"
;; 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" "jolt-l-quot" "rem" "jolt-l-rem" "mod" "jolt-l-mod"
"<" "jolt-l<" ">" "jolt-l>" "<=" "jolt-l<=" ">=" "jolt-l>=" "=" "jolt-l=" "==" "jolt-l="})
;; BigDecimal ops. jolt.passes.numeric tags an arithmetic/comparison invoke
;; :num-kind :bigdec when every operand is a bigdec (or an integer literal); these
@ -485,8 +492,12 @@
(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) (or (= nm "dec") (= nm "unchecked-dec"))) (str "(fx1- " (first args) ")")
;; inc/dec tolerate a 64-bit operand (jolt-l-inc/dec fall back past fixnum range);
;; unchecked-inc/dec wrap (Java long). Neither can use the raising fx1+/fx1-.
(and (= kind :long) (= nm "inc")) (str "(jolt-l-inc " (first args) ")")
(and (= kind :long) (= nm "dec")) (str "(jolt-l-dec " (first args) ")")
(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) ")"))))))

9
test/chez/corpus.edn
View file

@ -3369,4 +3369,13 @@
{: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)]"}
{: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)"}
]

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

@ -41,12 +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 "unchecked-add lowers to fx+" (has? (emitf "u" "(fn* ([^long n] (unchecked-add n 1)))") "(fx+"))
(ok "long quot lowers to fxquotient" (has? (emitf "u" "(fn* ([^long a ^long b] (quot a b)))") "(fxquotient"))
(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 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)
@ -67,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))))))")))
@ -87,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)))")))