Merge pull request #296 from jolt-lang/casts/checked-narrow

Checked narrow casts; fix runtime require in self-contained-built binaries
This commit is contained in:
Dmitri Sotnikov 2026-07-02 13:52:34 +00:00 committed by GitHub
commit a9542077fc
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
10 changed files with 237 additions and 77 deletions

View file

@ -109,6 +109,24 @@ jobs:
out="$("$work/app/app")"
test "$out" = "built: 45" || { echo "self-contained build ran '$out', want 'built: 45'"; exit 1; }
# A built binary must also run the DYNAMIC require path: a namespace not
# in the static ns graph compiles from the source roots at runtime, so the
# boot's top-level defines must be visible to the runtime compiler's eval
# (issue #290: this died with "variable var-deref is not bound").
- name: Smoke a runtime require in a built binary
run: |
joltc="$(pwd)/target/release/joltc"
work="$(mktemp -d)"
mkdir -p "$work/app/src/app"
printf '{:paths ["src"]}\n' > "$work/app/deps.edn"
printf '(ns app.extra)\n(defn greet [s] (str "Hello, " s "!"))\n' \
> "$work/app/src/app/extra.clj"
printf '(ns app.core)\n(defn -main [& _]\n (println ((requiring-resolve (quote app.extra/greet)) "runtime")))\n' \
> "$work/app/src/app/core.clj"
( cd "$work/app" && "$joltc" build -m app.core -o app )
out="$(cd "$work/app" && ./app)"
test "$out" = "Hello, runtime!" || { echo "runtime require ran '$out', want 'Hello, runtime!'"; exit 1; }
- name: Package
run: |
ver="${GITHUB_REF_NAME}"

View file

@ -561,21 +561,67 @@
(bld-native-link-flags natives))))))))
;; --- self-contained link (in-process compile + append the boot to the stub) ---
;; compile-file runs with a FRESH scheme-environment as the interaction
;; environment: the loaded jolt runtime redefines `error` (regex.ss), and flat.ss
;; inlines that same runtime, so an early reference to `error` (before its define
;; runs) must bind to the kernel primitive — a clean env gives exactly that, the
;; same as the legacy path compiling in a fresh Chez process. Without it the boot
;; dies at startup with "variable error is not bound".
;; compile-file runs against the DEFAULT interaction environment, so the boot's
;; top-level defines land in the real symbol cells — the runtime compiler's
;; eval'd code must resolve them (var-deref, jolt-invoke, the jolt-n* macros)
;; when the built binary dynamically requires a namespace. Compiling in a clean
;; copy-environment instead orphans every define in locations eval can't see,
;; and the binary dies with "variable var-deref is not bound" the moment a
;; runtime require compiles source.
;;
;; The default env has a wrinkle the legacy fresh-Chez path doesn't: THIS
;; process's cells hold jolt's redefinitions of some kernel names (`error`,
;; regex.ss), so references to them compile as cell reads — and a read that
;; runs before the redefining form would find the fresh binary's cell unbound.
;; The prologue closes that: it first binds each redefined kernel name's cell
;; to its kernel value, making the boot's earliest reads identical to the
;; legacy path's primitive references.
;; every top-level (define nm …)/(define (nm …) …) name in the flat file that
;; shadows a scheme-environment VARIABLE (syntax names don't eval; skip them).
(define (bld-kernel-prologue flat-ss)
(let ((seen (make-eq-hashtable))
(kenv (scheme-environment))
(names '()))
(let ((ip (open-input-file flat-ss)))
(let loop ()
(let ((f (read ip)))
(unless (eof-object? f)
(when (and (pair? f) (eq? (car f) 'define) (pair? (cdr f)))
(let* ((h (cadr f))
(nm (if (pair? h) (car h) h)))
(when (and (symbol? nm)
(not (hashtable-ref seen nm #f))
(guard (e (#t #f)) (begin (eval nm kenv) #t)))
(hashtable-set! seen nm #t)
(set! names (cons nm names)))))
(loop))))
(close-port ip))
(apply string-append
(map (lambda (nm)
(let ((s (symbol->string nm)))
(string-append "(define " s " (eval '" s " (scheme-environment)))\n")))
(reverse names)))))
;; prepend the prologue to the flat file in place.
(define (bld-prepend-prologue! flat-ss)
(let ((prologue (bld-kernel-prologue flat-ss))
(body (read-file-string flat-ss)))
(let ((out (open-output-file flat-ss 'replace)))
(put-string out ";; kernel-name cells pre-bound so early reads match the kernel primitives\n")
(put-string out prologue)
(put-string out body)
(close-port out))))
(define (build-self-contained entry-ns out-path mode builddir flat-ss flat-so boot native-link)
(let ((petite (string-append builddir "/petite.boot"))
(scheme (string-append builddir "/scheme.boot")))
(jolt-spill-embedded! "csv/petite.boot" petite)
(jolt-spill-embedded! "csv/scheme.boot" scheme)
(display (string-append "jolt build: compiling " entry-ns " (" mode " mode, self-contained)\n"))
(parameterize ((interaction-environment (copy-environment (scheme-environment))))
(bld-prepend-prologue! flat-ss)
(compile-file flat-ss flat-so)
(make-boot-file boot '() petite scheme flat-so))
(make-boot-file boot '() petite scheme flat-so)
;; The stub is the native launcher the boot is appended to. With no :static
;; natives it's the prebuilt one bundled in joltc (no cc needed); with :static
;; natives it's re-linked here from the bundled kernel + launcher source so the

View file

@ -155,7 +155,12 @@
;; int/long: truncate toward zero to an EXACT integer (= JVM long). char -> code
;; point (exact). double: always a flonum (= JVM double).
(define (jolt-int x) (if (char? x) (char->integer x) (exact (truncate x))))
(define (jolt-double x) (if (char? x) (exact->inexact (char->integer x)) (exact->inexact x)))
;; a numeric type outside Chez's tower converts through this hook (bigdec).
(define (jolt-double-slow x) (jolt-num-cast-throw x))
(define (jolt-double x)
(cond ((char? x) (exact->inexact (char->integer x)))
((number? x) (exact->inexact x))
(else (jolt-double-slow x))))
;; compare: 3-way, returns an EXACT integer (= JVM compare -> int).
(define (jolt-cmp3 x y) (cond ((< x y) -1) ((> x y) 1) (else 0)))
@ -195,16 +200,72 @@
(def-var! "clojure.core" "keyword" jolt-keyword)
(def-var! "clojure.core" "symbol" jolt-symbol-new)
(def-var! "clojure.core" "gensym" jolt-gensym)
(def-var! "clojure.core" "int" jolt-int)
;; char: coerce a code point (jolt's all-flonum number) to a Chez char; pass a
;; char through. Inverse of int on chars. The cross-compiled emitter's
;; chez-str-lit needs it for printable-ASCII escaping.
(define (jolt-char x) (if (char? x) x (integer->char (exact (round x)))))
;; --- checked narrow casts (RT.byteCast/shortCast/intCast/longCast/charCast) --
;; One helper carries the JVM ranges: truncate toward zero, then range-check.
;; NaN casts to 0 (Java (long)NaN); an out-of-range value (including a float
;; infinity) is IllegalArgumentException "Value out of range for <type>: x".
;; A non-numeric operand is the usual ClassCastException. Numeric types outside
;; Chez's tower truncate through a hook the shim extends (BigDecimal).
(define (jolt-cast-range-throw name x)
(jolt-throw (jolt-host-throwable
"java.lang.IllegalArgumentException"
(string-append "Value out of range for " name ": " (jolt-str x)))))
(define (jolt-cast-truncate-slow x) (jolt-num-cast-throw x))
(define (jolt-checked-cast name lo hi x)
(let ((n (cond ((char? x) (char->integer x))
((and (number? x) (exact? x)) (truncate x))
;; a double range-checks ITSELF (before truncation): (byte
;; 127.000001) throws, (byte 1.1) is 1; NaN casts to 0; an
;; infinity always fails the compare.
((flonum? x) (cond ((nan? x) 0)
((or (< x lo) (> x hi)) (+ hi 1))
(else (exact (truncate x)))))
(else (jolt-cast-truncate-slow x)))))
(if (and (>= n lo) (<= n hi)) n (jolt-cast-range-throw name x))))
(define (jolt-byte-cast x) (jolt-checked-cast "byte" -128 127 x))
(define (jolt-short-cast x) (jolt-checked-cast "short" -32768 32767 x))
(define (jolt-int-cast x) (jolt-checked-cast "int" -2147483648 2147483647 x))
(define (jolt-long-cast x) (jolt-checked-cast "long" -9223372036854775808 9223372036854775807 x))
(def-var! "clojure.core" "int" jolt-int-cast)
(def-var! "clojure.core" "long" jolt-long-cast)
(def-var! "clojure.core" "byte" jolt-byte-cast)
(def-var! "clojure.core" "short" jolt-short-cast)
;; char: pass a char through; a code point must be in [0, 0xFFFF] (charCast).
(define (jolt-char x)
(if (char? x) x (integer->char (jolt-checked-cast "char" 0 65535 x))))
(def-var! "clojure.core" "char" jolt-char)
;; long: same truncation as int in jolt's all-flonum model (seed core-long =
;; math/trunc; char -> code point). Distinct cell so (long ...) resolves.
(def-var! "clojure.core" "long" jolt-int)
;; unchecked-long: truncate + wrap to 64 bits (RT.uncheckedLongCast — a float
;; infinity saturates, NaN is 0). unchecked-int wraps and sign-folds to 32.
(define (jolt-cast-saturate n lo hi) (cond ((< n lo) lo) ((> n hi) hi) (else n)))
(define (jolt-unchecked-long x)
(cond ((char? x) (char->integer x))
;; an exact integer wraps (long narrowing); a double SATURATES (Java's
;; double->long conversion clamps at the bounds, NaN is 0).
((and (number? x) (exact? x)) (jolt-wrap64 (truncate x)))
((flonum? x) (if (nan? x) 0
(jolt-cast-saturate (if (infinite? x) (if (> x 0.0) unc-2^63 (- unc-2^63)) (exact (truncate x)))
-9223372036854775808 9223372036854775807)))
(else (jolt-wrap64 (jolt-cast-truncate-slow x)))))
(define (jolt-unchecked-int x)
(if (flonum? x)
;; double->int clamps like Java
(if (nan? x) 0
(jolt-cast-saturate (if (infinite? x) (if (> x 0.0) #x80000000 (- #x80000000)) (exact (truncate x)))
-2147483648 2147483647))
(let ((i (bitwise-and (jolt-unchecked-long x) #xffffffff)))
(if (>= i #x80000000) (- i #x100000000) i))))
(def-var! "clojure.core" "unchecked-long" jolt-unchecked-long)
(def-var! "clojure.core" "unchecked-int" jolt-unchecked-int)
(def-var! "clojure.core" "double" jolt-double)
;; float: Chez has no single-float type, so float coerces to a flonum like double.
(def-var! "clojure.core" "float" jolt-double)
;; float: Chez has no single-float type, so the value stays a flonum — but the
;; cast range-checks against Float/MAX_VALUE like RT.floatCast (an infinity is
;; out of range; NaN passes).
(define fl-float-max 3.4028234663852886e38)
(define (jolt-float x)
(let ((d (jolt-double x)))
(if (and (flonum? d) (not (nan? d))
(or (< d (- fl-float-max)) (> d fl-float-max)))
(jolt-cast-range-throw "float" x)
d)))
(def-var! "clojure.core" "float" jolt-float)
(def-var! "clojure.core" "compare" jolt-compare)

View file

@ -355,6 +355,19 @@
(else (jolt-num-cast-throw x))))
(def-var! "clojure.core" "rationalize" jolt-rationalize)
;; double/float of a bigdec is its flonum value.
(set! jolt-double-slow
(let ((prev jolt-double-slow))
(lambda (x) (if (jbigdec? x) (jbigdec->flonum x) (prev x)))))
;; narrow casts truncate a bigdec like Number.longValue.
(set! jolt-cast-truncate-slow
(let ((prev jolt-cast-truncate-slow))
(lambda (x)
(if (jbigdec? x)
(truncate (/ (jbigdec-unscaled x) (expt 10 (jbigdec-scale x))))
(prev x)))))
;; compare: add a bigdec arm (enables compare / sort / sorted collections). A
;; bigdec vs a plain number compares by value; bigdec vs bigdec is scale-independent.
(define jbd-prev-compare jolt-compare)

View file

@ -85,10 +85,8 @@
(define (na-bytes x) (if (and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) x (na-byte-array x)))
(define (na-bytes? x) (and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)))
(define (na-identity x) x)
(define (na-byte x)
(let ((b (bitwise-and (exact (floor x)) #xff))) (if (>= b 128) (- b 256) b)))
(define (na-short x)
(let ((s (bitwise-and (exact (floor x)) #xffff))) (if (>= s #x8000) (- s #x10000) s)))
(define (na-byte x) (jolt-byte-cast x))
(define (na-short x) (jolt-short-cast x))
;; --- chunked seqs -----------------------------------------------------------
;; The chunked-seq accessors (chunked-seq? / chunk-first / chunk-rest / chunk-next)

View file

@ -519,75 +519,73 @@
(guard (e (#t #f))
(def-var! "clojure.core" "dec'" jolt-dec))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-int" (letrec ((unchecked-int (lambda (x) (let fnrec4644 ((x x)) (jolt-invoke (var-deref "clojure.core" "int") x))))) unchecked-int)))
(def-var! "clojure.core" "int?" (letrec ((int? (lambda (x) (let fnrec4644 ((x x)) (jolt-invoke (var-deref "clojure.core" "integer?") x))))) int?)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-long" (var-deref "clojure.core" "unchecked-int")))
(def-var! "clojure.core" "num" (letrec ((num (lambda (x) (let fnrec4645 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") x)) x (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "num requires a number, got: " x))))))) num)))
(guard (e (#t #f))
(def-var! "clojure.core" "int?" (letrec ((int? (lambda (x) (let fnrec4645 ((x x)) (jolt-invoke (var-deref "clojure.core" "integer?") x))))) int?)))
(def-var! "clojure.core" "==" (letrec ((== (case-lambda ((x) (let fnrec4646 ((x x)) #t)) ((x y) (let fnrec4647 ((x x) (y y)) (if (jolt-truthy? (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "number?") x))) (if (jolt-truthy? and__25__auto) (jolt-invoke (var-deref "clojure.core" "number?") y) and__25__auto))) (jolt= x y) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Cannot cast to number: " (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") x)) y x)))))) ((x y . more) (let fnrec4648 ((x x) (y y) (more (list->cseq more))) (if (jolt-truthy? (== x y)) (jolt-apply == y more) #f)))))) ==)))
(guard (e (#t #f))
(def-var! "clojure.core" "num" (letrec ((num (lambda (x) (let fnrec4646 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") x)) x (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "num requires a number, got: " x))))))) num)))
(def-var! "clojure.core" "ensure-reduced" (letrec ((ensure-reduced (lambda (x) (let fnrec4649 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "reduced?") x)) x (jolt-invoke (var-deref "clojure.core" "reduced") x)))))) ensure-reduced)))
(guard (e (#t #f))
(def-var! "clojure.core" "==" (letrec ((== (case-lambda ((x) (let fnrec4647 ((x x)) #t)) ((x y) (let fnrec4648 ((x x) (y y)) (if (jolt-truthy? (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "number?") x))) (if (jolt-truthy? and__25__auto) (jolt-invoke (var-deref "clojure.core" "number?") y) and__25__auto))) (jolt= x y) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Cannot cast to number: " (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") x)) y x)))))) ((x y . more) (let fnrec4649 ((x x) (y y) (more (list->cseq more))) (if (jolt-truthy? (== x y)) (jolt-apply == y more) #f)))))) ==)))
(def-var! "clojure.core" "halt-when" (letrec ((halt-when (case-lambda ((pred) (let fnrec4650 ((pred pred)) (halt-when pred jolt-nil))) ((pred retf) (let fnrec4651 ((pred pred) (retf retf)) (lambda (rf) (let fnrec4652 ((rf rf)) (case-lambda (() (let fnrec4653 () (jolt-invoke rf))) ((result) (let fnrec4654 ((result result)) (if (jolt-truthy? (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "map?") result))) (if (jolt-truthy? and__25__auto) (jolt-contains? result (keyword "clojure.core" "halt")) and__25__auto))) (jolt-get result (keyword "clojure.core" "halt")) (jolt-invoke rf result)))) ((result input) (let fnrec4655 ((result result) (input input)) (if (jolt-truthy? (jolt-invoke pred input)) (jolt-invoke (var-deref "clojure.core" "reduced") (jolt-hash-map-fn (keyword "clojure.core" "halt") (if (jolt-truthy? retf) (jolt-invoke retf (jolt-invoke rf result) input) input))) (jolt-invoke rf result input)))))))))))) halt-when)))
(guard (e (#t #f))
(def-var! "clojure.core" "ensure-reduced" (letrec ((ensure-reduced (lambda (x) (let fnrec4650 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "reduced?") x)) x (jolt-invoke (var-deref "clojure.core" "reduced") x)))))) ensure-reduced)))
(def-var! "clojure.core" "parse-boolean" (letrec ((parse-boolean (lambda (s) (let fnrec4656 ((s s)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") s)) (if (jolt= s "true") #t (if (jolt= s "false") #f (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "parse-boolean requires a string, got: " s))))))) parse-boolean)))
(guard (e (#t #f))
(def-var! "clojure.core" "halt-when" (letrec ((halt-when (case-lambda ((pred) (let fnrec4651 ((pred pred)) (halt-when pred jolt-nil))) ((pred retf) (let fnrec4652 ((pred pred) (retf retf)) (lambda (rf) (let fnrec4653 ((rf rf)) (case-lambda (() (let fnrec4654 () (jolt-invoke rf))) ((result) (let fnrec4655 ((result result)) (if (jolt-truthy? (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "map?") result))) (if (jolt-truthy? and__25__auto) (jolt-contains? result (keyword "clojure.core" "halt")) and__25__auto))) (jolt-get result (keyword "clojure.core" "halt")) (jolt-invoke rf result)))) ((result input) (let fnrec4656 ((result result) (input input)) (if (jolt-truthy? (jolt-invoke pred input)) (jolt-invoke (var-deref "clojure.core" "reduced") (jolt-hash-map-fn (keyword "clojure.core" "halt") (if (jolt-truthy? retf) (jolt-invoke retf (jolt-invoke rf result) input) input))) (jolt-invoke rf result input)))))))))))) halt-when)))
(def-var! "clojure.core" "newline" (letrec ((newline (lambda () (let fnrec4657 () (begin (jolt-invoke (var-deref "clojure.core" "print") "\n") jolt-nil))))) newline)))
(guard (e (#t #f))
(def-var! "clojure.core" "parse-boolean" (letrec ((parse-boolean (lambda (s) (let fnrec4657 ((s s)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") s)) (if (jolt= s "true") #t (if (jolt= s "false") #f (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "parse-boolean requires a string, got: " s))))))) parse-boolean)))
(def-var! "clojure.core" "seque" (letrec ((seque (case-lambda ((s) (let fnrec4658 ((s s)) s)) ((n-or-q s) (let fnrec4659 ((n-or-q n-or-q) (s s)) s))))) seque)))
(guard (e (#t #f))
(def-var! "clojure.core" "newline" (letrec ((newline (lambda () (let fnrec4658 () (begin (jolt-invoke (var-deref "clojure.core" "print") "\n") jolt-nil))))) newline)))
(def-var! "clojure.core" "array-seq" (letrec ((array-seq (lambda (arr . _) (let fnrec4660 ((arr arr) (_ (list->cseq _))) (jolt-seq arr))))) array-seq)))
(guard (e (#t #f))
(def-var! "clojure.core" "seque" (letrec ((seque (case-lambda ((s) (let fnrec4659 ((s s)) s)) ((n-or-q s) (let fnrec4660 ((n-or-q n-or-q) (s s)) s))))) seque)))
(def-var! "clojure.core" "to-array-2d" (letrec ((to-array-2d (lambda (coll) (let fnrec4661 ((coll coll)) (jolt-invoke (var-deref "clojure.core" "to-array") (jolt-map (var-deref "clojure.core" "to-array") coll)))))) to-array-2d)))
(guard (e (#t #f))
(def-var! "clojure.core" "array-seq" (letrec ((array-seq (lambda (arr . _) (let fnrec4661 ((arr arr) (_ (list->cseq _))) (jolt-seq arr))))) array-seq)))
(def-var! "clojure.core" "unchecked-byte" (letrec ((unchecked-byte (lambda (x) (let fnrec4662 ((x x)) (let* ((b (bitwise-and (jolt-invoke (var-deref "clojure.core" "unchecked-long") x) 255))) (if (jolt-n< b 128) b (jolt-n- b 256))))))) unchecked-byte)))
(guard (e (#t #f))
(def-var! "clojure.core" "to-array-2d" (letrec ((to-array-2d (lambda (coll) (let fnrec4662 ((coll coll)) (jolt-invoke (var-deref "clojure.core" "to-array") (jolt-map (var-deref "clojure.core" "to-array") coll)))))) to-array-2d)))
(def-var! "clojure.core" "unchecked-short" (letrec ((unchecked-short (lambda (x) (let fnrec4663 ((x x)) (let* ((s (bitwise-and (jolt-invoke (var-deref "clojure.core" "unchecked-long") x) 65535))) (if (jolt-n< s 32768) s (jolt-n- s 65536))))))) unchecked-short)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-byte" (letrec ((unchecked-byte (lambda (x) (let fnrec4663 ((x x)) (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 255))))) unchecked-byte)))
(def-var! "clojure.core" "unchecked-char" (letrec ((unchecked-char (lambda (x) (let fnrec4664 ((x x)) (jolt-invoke (var-deref "clojure.core" "char") (bitwise-and (jolt-invoke (var-deref "clojure.core" "unchecked-long") x) 65535)))))) unchecked-char)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-short" (letrec ((unchecked-short (lambda (x) (let fnrec4664 ((x x)) (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 65535))))) unchecked-short)))
(def-var! "clojure.core" "unchecked-float" (letrec ((unchecked-float (lambda (x) (let fnrec4665 ((x x)) (jolt-invoke (var-deref "clojure.core" "double") x))))) unchecked-float)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-char" (letrec ((unchecked-char (lambda (x) (let fnrec4665 ((x x)) (jolt-invoke (var-deref "clojure.core" "char") (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 65535)))))) unchecked-char)))
(def-var! "clojure.core" "unchecked-double" (letrec ((unchecked-double (lambda (x) (let fnrec4666 ((x x)) (jolt-invoke (var-deref "clojure.core" "double") x))))) unchecked-double)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-float" (letrec ((unchecked-float (lambda (x) (let fnrec4666 ((x x)) (jolt-invoke (var-deref "clojure.core" "double") x))))) unchecked-float)))
(def-var! "clojure.core" "transduce" (letrec ((transduce (case-lambda ((xform f coll) (let fnrec4667 ((xform xform) (f f) (coll coll)) (transduce xform f (jolt-invoke f) coll))) ((xform f init coll) (let fnrec4668 ((xform xform) (f f) (init init) (coll coll)) (let* ((xf (jolt-invoke xform f))) (jolt-invoke xf (jolt-reduce xf init coll)))))))) transduce)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-double" (letrec ((unchecked-double (lambda (x) (let fnrec4667 ((x x)) (jolt-invoke (var-deref "clojure.core" "double") x))))) unchecked-double)))
(def-var! "clojure.core" "eduction" (letrec ((eduction (lambda args (let fnrec4669 ((args (list->cseq args))) (let* ((coll (jolt-last args)) (xforms (jolt-invoke (var-deref "clojure.core" "butlast") args))) (if (jolt-truthy? xforms) (jolt-invoke (var-deref "clojure.core" "sequence") (jolt-apply (var-deref "clojure.core" "comp") xforms) coll) (jolt-invoke (var-deref "clojure.core" "sequence") coll))))))) eduction)))
(guard (e (#t #f))
(def-var! "clojure.core" "transduce" (letrec ((transduce (case-lambda ((xform f coll) (let fnrec4668 ((xform xform) (f f) (coll coll)) (transduce xform f (jolt-invoke f) coll))) ((xform f init coll) (let fnrec4669 ((xform xform) (f f) (init init) (coll coll)) (let* ((xf (jolt-invoke xform f))) (jolt-invoke xf (jolt-reduce xf init coll)))))))) transduce)))
(def-var! "clojure.core" "->Eduction" (letrec ((->Eduction (lambda (xform coll) (let fnrec4670 ((xform xform) (coll coll)) (jolt-invoke (var-deref "clojure.core" "sequence") xform coll))))) ->Eduction)))
(guard (e (#t #f))
(def-var! "clojure.core" "eduction" (letrec ((eduction (lambda args (let fnrec4670 ((args (list->cseq args))) (let* ((coll (jolt-last args)) (xforms (jolt-invoke (var-deref "clojure.core" "butlast") args))) (if (jolt-truthy? xforms) (jolt-invoke (var-deref "clojure.core" "sequence") (jolt-apply (var-deref "clojure.core" "comp") xforms) coll) (jolt-invoke (var-deref "clojure.core" "sequence") coll))))))) eduction)))
(def-var! "clojure.core" "enumeration-seq" (letrec ((enumeration-seq (lambda (e) (let fnrec4671 ((e e)) (if (jolt-truthy? (let* ((or__26__auto (jolt-nil? e))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((or__26__auto (jolt-invoke (var-deref "clojure.core" "seq?") e))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt-invoke (var-deref "clojure.core" "sequential?") e)))))) (jolt-seq e) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4672 () (jolt-invoke (var-deref "clojure.core" "coll->cells") (if (jolt-truthy? (record-method-dispatch e "hasMoreElements" (jolt-vector))) (let* ((_a$4673 (record-method-dispatch e "nextElement" (jolt-vector))) (_a$4674 (enumeration-seq e))) (jolt-cons _a$4673 _a$4674)) jolt-nil)))))))))) enumeration-seq)))
(guard (e (#t #f))
(def-var! "clojure.core" "->Eduction" (letrec ((->Eduction (lambda (xform coll) (let fnrec4671 ((xform xform) (coll coll)) (jolt-invoke (var-deref "clojure.core" "sequence") xform coll))))) ->Eduction)))
(def-var! "clojure.core" "iterator-seq" (letrec ((iterator-seq (lambda (i) (let fnrec4675 ((i i)) (jolt-seq i))))) iterator-seq)))
(guard (e (#t #f))
(def-var! "clojure.core" "enumeration-seq" (letrec ((enumeration-seq (lambda (e) (let fnrec4672 ((e e)) (if (jolt-truthy? (let* ((or__26__auto (jolt-nil? e))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((or__26__auto (jolt-invoke (var-deref "clojure.core" "seq?") e))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt-invoke (var-deref "clojure.core" "sequential?") e)))))) (jolt-seq e) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4673 () (jolt-invoke (var-deref "clojure.core" "coll->cells") (if (jolt-truthy? (record-method-dispatch e "hasMoreElements" (jolt-vector))) (let* ((_a$4674 (record-method-dispatch e "nextElement" (jolt-vector))) (_a$4675 (enumeration-seq e))) (jolt-cons _a$4674 _a$4675)) jolt-nil)))))))))) enumeration-seq)))
(def-var! "clojure.core" "promise" (letrec ((promise (lambda () (let fnrec4676 () (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil))))) promise)))
(guard (e (#t #f))
(def-var! "clojure.core" "iterator-seq" (letrec ((iterator-seq (lambda (i) (let fnrec4676 ((i i)) (jolt-seq i))))) iterator-seq)))
(def-var! "clojure.core" "deliver" (letrec ((deliver (lambda (p v) (let fnrec4677 ((p p) (v v)) (begin (jolt-invoke (var-deref "clojure.core" "reset!") p v) p))))) deliver)))
(guard (e (#t #f))
(def-var! "clojure.core" "promise" (letrec ((promise (lambda () (let fnrec4677 () (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil))))) promise)))
(def-var! "clojure.core" "bean" (letrec ((bean (lambda (x) (let fnrec4678 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) x (jolt-hash-map)))))) bean)))
(guard (e (#t #f))
(def-var! "clojure.core" "deliver" (letrec ((deliver (lambda (p v) (let fnrec4678 ((p p) (v v)) (begin (jolt-invoke (var-deref "clojure.core" "reset!") p v) p))))) deliver)))
(def-var! "clojure.core" "uri?" (letrec ((uri? (lambda (x) (let fnrec4679 ((x x)) #f)))) uri?)))
(guard (e (#t #f))
(def-var! "clojure.core" "bean" (letrec ((bean (lambda (x) (let fnrec4679 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) x (jolt-hash-map)))))) bean)))
(def-var-with-meta! "clojure.core" "special-syms" (let* ((_o$4680 (jolt-symbol #f "if")) (_o$4681 (jolt-symbol #f "do")) (_o$4682 (jolt-symbol #f "let*")) (_o$4683 (jolt-symbol #f "fn*")) (_o$4684 (jolt-symbol #f "quote")) (_o$4685 (jolt-symbol #f "var")) (_o$4686 (jolt-symbol #f "def")) (_o$4687 (jolt-symbol #f "loop*")) (_o$4688 (jolt-symbol #f "recur")) (_o$4689 (jolt-symbol #f "throw")) (_o$4690 (jolt-symbol #f "try")) (_o$4691 (jolt-symbol #f "catch")) (_o$4692 (jolt-symbol #f "finally")) (_o$4693 (jolt-symbol #f "new")) (_o$4694 (jolt-symbol #f "set!")) (_o$4695 (jolt-symbol #f ".")) (_o$4696 (jolt-symbol #f "monitor-enter")) (_o$4697 (jolt-symbol #f "monitor-exit"))) (jolt-hash-set _o$4680 _o$4681 _o$4682 _o$4683 _o$4684 _o$4685 _o$4686 _o$4687 _o$4688 _o$4689 _o$4690 _o$4691 _o$4692 _o$4693 _o$4694 _o$4695 _o$4696 _o$4697)) (let* ((_o$4698 (keyword #f "private")) (_o$4699 #t)) (jolt-hash-map _o$4698 _o$4699))))
(guard (e (#t #f))
(def-var! "clojure.core" "uri?" (letrec ((uri? (lambda (x) (let fnrec4680 ((x x)) #f)))) uri?)))
(def-var! "clojure.core" "special-symbol?" (letrec ((special-symbol? (lambda (s) (let fnrec4700 ((s s)) (jolt-contains? (var-deref "clojure.core" "special-syms") s))))) special-symbol?)))
(guard (e (#t #f))
(def-var-with-meta! "clojure.core" "special-syms" (let* ((_o$4681 (jolt-symbol #f "if")) (_o$4682 (jolt-symbol #f "do")) (_o$4683 (jolt-symbol #f "let*")) (_o$4684 (jolt-symbol #f "fn*")) (_o$4685 (jolt-symbol #f "quote")) (_o$4686 (jolt-symbol #f "var")) (_o$4687 (jolt-symbol #f "def")) (_o$4688 (jolt-symbol #f "loop*")) (_o$4689 (jolt-symbol #f "recur")) (_o$4690 (jolt-symbol #f "throw")) (_o$4691 (jolt-symbol #f "try")) (_o$4692 (jolt-symbol #f "catch")) (_o$4693 (jolt-symbol #f "finally")) (_o$4694 (jolt-symbol #f "new")) (_o$4695 (jolt-symbol #f "set!")) (_o$4696 (jolt-symbol #f ".")) (_o$4697 (jolt-symbol #f "monitor-enter")) (_o$4698 (jolt-symbol #f "monitor-exit"))) (jolt-hash-set _o$4681 _o$4682 _o$4683 _o$4684 _o$4685 _o$4686 _o$4687 _o$4688 _o$4689 _o$4690 _o$4691 _o$4692 _o$4693 _o$4694 _o$4695 _o$4696 _o$4697 _o$4698)) (let* ((_o$4699 (keyword #f "private")) (_o$4700 #t)) (jolt-hash-map _o$4699 _o$4700))))
(def-var! "clojure.core" "proxy-mappings" (letrec ((proxy-mappings (lambda (p) (let fnrec4701 ((p p)) (jolt-hash-map))))) proxy-mappings)))
(guard (e (#t #f))
(def-var! "clojure.core" "special-symbol?" (letrec ((special-symbol? (lambda (s) (let fnrec4701 ((s s)) (jolt-contains? (var-deref "clojure.core" "special-syms") s))))) special-symbol?)))
(def-var! "clojure.core" "proxy-call-with-super" (letrec ((proxy-call-with-super (lambda (f p meth) (let fnrec4702 ((f f) (p p) (meth meth)) (jolt-invoke f))))) proxy-call-with-super)))
(guard (e (#t #f))
(def-var! "clojure.core" "proxy-mappings" (letrec ((proxy-mappings (lambda (p) (let fnrec4702 ((p p)) (jolt-hash-map))))) proxy-mappings)))
(def-var! "clojure.core" "init-proxy" (letrec ((init-proxy (lambda (p mappings) (let fnrec4703 ((p p) (mappings mappings)) p)))) init-proxy)))
(guard (e (#t #f))
(def-var! "clojure.core" "proxy-call-with-super" (letrec ((proxy-call-with-super (lambda (f p meth) (let fnrec4703 ((f f) (p p) (meth meth)) (jolt-invoke f))))) proxy-call-with-super)))
(def-var! "clojure.core" "update-proxy" (letrec ((update-proxy (lambda (p mappings) (let fnrec4704 ((p p) (mappings mappings)) p)))) update-proxy)))
(guard (e (#t #f))
(def-var! "clojure.core" "init-proxy" (letrec ((init-proxy (lambda (p mappings) (let fnrec4704 ((p p) (mappings mappings)) p)))) init-proxy)))
(def-var! "clojure.core" "proxy-super" (letrec ((proxy-super (lambda args (let fnrec4705 ((args (list->cseq args))) (jolt-throw "proxy-super: JVM proxies are not supported in Jolt"))))) proxy-super)))
(guard (e (#t #f))
(def-var! "clojure.core" "update-proxy" (letrec ((update-proxy (lambda (p mappings) (let fnrec4705 ((p p) (mappings mappings)) p)))) update-proxy)))
(def-var! "clojure.core" "construct-proxy" (letrec ((construct-proxy (lambda (c . args) (let fnrec4706 ((c c) (args (list->cseq args))) (jolt-throw "construct-proxy: not supported in Jolt"))))) construct-proxy)))
(guard (e (#t #f))
(def-var! "clojure.core" "proxy-super" (letrec ((proxy-super (lambda args (let fnrec4706 ((args (list->cseq args))) (jolt-throw "proxy-super: JVM proxies are not supported in Jolt"))))) proxy-super)))
(def-var! "clojure.core" "get-proxy-class" (letrec ((get-proxy-class (lambda interfaces (let fnrec4707 ((interfaces (list->cseq interfaces))) (jolt-throw "get-proxy-class: not supported in Jolt"))))) get-proxy-class)))
(guard (e (#t #f))
(def-var! "clojure.core" "construct-proxy" (letrec ((construct-proxy (lambda (c . args) (let fnrec4707 ((c c) (args (list->cseq args))) (jolt-throw "construct-proxy: not supported in Jolt"))))) construct-proxy)))
(guard (e (#t #f))
(def-var! "clojure.core" "get-proxy-class" (letrec ((get-proxy-class (lambda interfaces (let fnrec4708 ((interfaces (list->cseq interfaces))) (jolt-throw "get-proxy-class: not supported in Jolt"))))) get-proxy-class)))
(def-var! "clojure.core" "requiring-resolve" (letrec ((requiring-resolve (lambda (sym) (let fnrec4708 ((sym sym)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "qualified-symbol?") sym)) (let* ((or__26__auto (jolt-invoke (var-deref "clojure.core" "resolve") sym))) (if (jolt-truthy? or__26__auto) or__26__auto (begin (jolt-invoke (var-deref "clojure.core" "require") (jolt-invoke (var-deref "clojure.core" "symbol") (jolt-invoke (var-deref "clojure.core" "namespace") sym))) (jolt-invoke (var-deref "clojure.core" "resolve") sym)))) (jolt-throw (host-new "IllegalArgumentException" (jolt-invoke (var-deref "clojure.core" "str") "Not a qualified symbol: " sym)))))))) requiring-resolve)))
(guard (e (#t #f))
(def-var-with-meta! "clojure.core" "sfield" (letrec ((sfield (lambda (sc k) (let fnrec2744 ((sc sc) (k k)) (jolt-invoke (var-deref "jolt.host" "ref-get") sc k))))) sfield) (let* ((_o$2745 (keyword #f "private")) (_o$2746 #t)) (jolt-hash-map _o$2745 _o$2746))))
(guard (e (#t #f))

View file

@ -198,10 +198,9 @@
(def inc' inc)
(def dec' dec)
;; 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)
;; variants), -divide-int / -remainder-int, and the unchecked-long/-int casts are
;; host-defined (host/chez/seq.ss, converters.ss): they WRAP like the JVM
;; primitive conversions, which a plain overlay over checked casts can't do.
;; int? is integer? on jolt: one number type, so fixed-precision and
;; arbitrary-precision integers coincide.
@ -263,12 +262,14 @@
(defn to-array-2d [coll] (to-array (map to-array coll)))
;; Masking integer coercions (not aliases): byte/short wrap to their width.
;; unchecked-byte/short truncate to a number; unchecked-char returns a char (as on
;; the JVM). int handles chars, so (unchecked-byte \a) works.
(defn unchecked-byte [x] (bit-and (int x) 0xff))
(defn unchecked-short [x] (bit-and (int x) 0xffff))
(defn unchecked-char [x] (char (bit-and (int x) 0xffff)))
;; Wrapping (unchecked) coercions: truncate to the width and sign-fold like the
;; JVM primitive conversions ((unchecked-byte 200) is -56); unchecked-char wraps
;; into char range. unchecked-long/int are host natives (converters.ss).
(defn unchecked-byte [x]
(let [b (bit-and (unchecked-long x) 0xff)] (if (< b 128) b (- b 256))))
(defn unchecked-short [x]
(let [s (bit-and (unchecked-long x) 0xffff)] (if (< s 32768) s (- s 65536))))
(defn unchecked-char [x] (char (bit-and (unchecked-long x) 0xffff)))
(defn unchecked-float [x] (double x))
(defn unchecked-double [x] (double x))
@ -338,3 +339,14 @@
(defn proxy-super [& args] (throw "proxy-super: JVM proxies are not supported in Jolt"))
(defn construct-proxy [c & args] (throw "construct-proxy: not supported in Jolt"))
(defn get-proxy-class [& interfaces] (throw "get-proxy-class: not supported in Jolt"))
;; resolve, requiring the symbol's namespace first when it isn't loaded yet —
;; the dynamic-require pattern (tooling, plugin registries). The require and
;; resolve are the runtime fns, so this works identically under joltc run and
;; in an AOT binary (which compiles the namespace from the source roots).
(defn requiring-resolve [sym]
(if (qualified-symbol? sym)
(or (resolve sym)
(do (require (symbol (namespace sym)))
(resolve sym)))
(throw (new IllegalArgumentException (str "Not a qualified symbol: " sym)))))

View file

@ -3551,4 +3551,11 @@
{:suite "iref / watches" :label "add-watch returns the var; a validator gates the var root" :expected "[true :ise]" :actual "(do (def vv-y 1) [(= (var vv-y) (add-watch (var vv-y) :k (fn [a b c d] nil))) (do (set-validator! (var vv-y) pos?) (try (alter-var-root (var vv-y) -) (catch IllegalStateException _ :ise)))])"}
{:suite "iref / watches" :label "agent watches fire on state change" :expected "[0 1]" :actual "(let [ag (agent 0) p (promise)] (add-watch ag :w (fn [k r o n] (deliver p [o n]))) (send ag inc) (deref p 2000 :timeout))"}
{:suite "iref / meta" :label "alter-meta! works on atoms" :expected "{:x 1 :y 2}" :actual "(let [a (atom 1 :meta {:x 1})] (alter-meta! a assoc :y 2))"}
{:suite "casts / checked narrow" :label "doubles range-check themselves, then truncate" :expected "[1 1 3 1 \\a 0]" :actual "[(byte 1.1) (short 1.9) (int 3.7) (long 1.5) (char 97.5) (long ##NaN)]"}
{:suite "casts / checked narrow" :label "out-of-range values throw IllegalArgumentException" :expected "[:iae :iae :iae :iae :iae :iae :iae]" :actual "[(try (byte 128) (catch IllegalArgumentException _ :iae)) (try (byte 127.000001) (catch IllegalArgumentException _ :iae)) (try (short 40000) (catch IllegalArgumentException _ :iae)) (try (int 2147483647.000001) (catch IllegalArgumentException _ :iae)) (try (char -1) (catch IllegalArgumentException _ :iae)) (try (char 65536) (catch IllegalArgumentException _ :iae)) (try (long 1e300) (catch IllegalArgumentException _ :iae))]"}
{:suite "casts / checked narrow" :label "the throw carries the JVM message" :expected "\"Value out of range for byte: 128\"" :actual "(try (byte 128) (catch IllegalArgumentException e (ex-message e)))"}
{:suite "casts / checked narrow" :label "ratios and bigdecs truncate; non-numbers are CCE" :expected "[1 5 :cce]" :actual "[(byte 3/2) (int 5.5M) (try (byte true) (catch ClassCastException _ :cce))]"}
{:suite "casts / checked narrow" :label "float range-checks against Float/MAX_VALUE" :expected "[:iae 1.5]" :actual "[(try (float 1e300) (catch IllegalArgumentException _ :iae)) (float 1.5)]"}
{:suite "casts / unchecked wrap" :label "unchecked casts wrap and sign-fold; doubles saturate" :expected "[-56 -25536 \\A 9223372036854775807 0 0]" :actual "[(unchecked-byte 200) (unchecked-short 40000) (unchecked-char 65) (unchecked-long 1e300) (unchecked-int 4294967296) (unchecked-long ##NaN)]"}
{:suite "ns / requiring-resolve" :label "loads the namespace then resolves; unqualified throws" :expected "[#{1 2} :iae]" :actual "[((requiring-resolve (quote clojure.set/union)) #{1} #{2}) (try (requiring-resolve (quote unqualified)) (catch IllegalArgumentException _ :iae))]"}
]

View file

@ -6,30 +6,25 @@ clojure.core-test.add-watch 0 1
clojure.core-test.bigint 6 0
clojure.core-test.bit-set 1 0
clojure.core-test.boolean-qmark 0 3
clojure.core-test.byte 7 5
clojure.core-test.char 1 0
clojure.core-test.compare 1 0
clojure.core-test.conj 1 0
clojure.core-test.contains-qmark 3 0
clojure.core-test.counted-qmark 1 0
clojure.core-test.dec 1 0
clojure.core-test.denominator 0 3
clojure.core-test.double 0 4
clojure.core-test.double-qmark 3 0
clojure.core-test.empty 1 0
clojure.core-test.eq 2 0
clojure.core-test.eval 0 3
clojure.core-test.even-qmark 1 0
clojure.core-test.float 4 4
clojure.core-test.float 1 0
clojure.core-test.get 0 1
clojure.core-test.ifn-qmark 2 0
clojure.core-test.inc 1 0
clojure.core-test.int 4 5
clojure.core-test.int-qmark 3 0
clojure.core-test.intern 2 0
clojure.core-test.keys 0 4
clojure.core-test.lazy-seq 3 0
clojure.core-test.long 2 5
clojure.core-test.minus 2 0
clojure.core-test.mod 23 0
clojure.core-test.neg-int-qmark 1 0
@ -55,7 +50,6 @@ clojure.core-test.remove-watch 0 1
clojure.core-test.run-bang 1 0
clojure.core-test.select-keys 2 0
clojure.core-test.seqable-qmark 1 0
clojure.core-test.short 7 5
clojure.core-test.shuffle 1 0
clojure.core-test.some-fn 3 0
clojure.core-test.sort-by 2 0

View file

@ -132,6 +132,19 @@ arithmetic fast path (both operands Chez numbers → the raw Chez op) or force
every `+`/`-`/`*` through an unwrapping dispatcher, de-optimizing all
arithmetic. Same shape as the accepted BigInt-vs-Long unification.
The cast RANGE contract is full parity (corpus `casts / *`): `byte`/`short`/
`int`/`long`/`char` range-check like `RT.byteCast` — an out-of-range value is
IllegalArgumentException "Value out of range for byte: 128". A double operand
range-checks ITSELF before truncating (`(byte 1.1)` is `1`, `(byte 127.000001)`
throws), NaN casts to 0, ratios and bigdecs truncate, a non-number is
ClassCastException. `float` range-checks against Float/MAX_VALUE. The
`unchecked-*` casts wrap and sign-fold like the JVM primitive conversions
(`(unchecked-byte 200)` is `-56`; a double saturates instead of wrapping).
What jolt does NOT model is a distinct single-float type: `(float x)` keeps
the double VALUE, so a double below Float/MIN_VALUE stays nonzero and float
rounding does not occur (the accepted no-single-float residue, baselined with
`:integer-box-model`'s class residue).
## Number operations
Binary arithmetic and comparisons follow the JVM's `Numbers.ops(x, y)` category