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

Merge pull request #266 from jolt-lang/conformance/laziness-semantics

Browse source 
Conformance hardening + perf: seq semantics, chunked-seq O(n^2), bitwise/var-cache codegen
This commit is contained in:
Dmitri Sotnikov 2026-06-28 16:40:50 +00:00 • committed by GitHub
commit 1375a59568
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
13 changed files with 539 additions and 184 deletions
Download patch file Download diff file Expand all files Collapse all files

6
host/chez/compile-eval.ss
View file

@ -104,6 +104,12 @@
;; is only for the bare -e subset with no prelude. Turn prelude mode on once, here,
;; so every analyze->emit on this spine sees the full core.
((var-deref "jolt.backend-scheme" "set-prelude-mode!") #t)
;; Cache resolved var cells per reference site in runtime-compiled code (the big
;; win for libraries / REPL code). emit-image.ss turns this back off so the seed
;; mint and AOT build stay byte-deterministic. Guarded: the flag is absent in an
;; older seed during the first re-mint pass.
(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
(when (procedure? scv) (scv #t)))
;; (quote X) -> X, else x — unwraps a quoted require spec.
(define (ce-unquote x)

10
host/chez/dyn-binding.ss
View file

@ -117,6 +117,16 @@
((eq? cell star-ns-cell) (intern-ns! (chez-current-ns)))
(else (var-cell-root cell)))))))
;; var-deref's read on an ALREADY-RESOLVED cell — what compiled code emits when it
;; caches the cell at a reference site. Binding stack first, then *ns* thread-local,
;; else the raw root. Lenient on an unbound root (returns the sentinel), matching
;; var-deref — NOT the strict jolt-var-get, which throws "Unbound var".
(define (var-cell-deref cell)
(let ((bv (dyn-binding-value cell)))
(cond ((not (eq? bv dyn-no-binding)) bv)
((eq? cell star-ns-cell) (intern-ns! (chez-current-ns)))
(else (var-cell-root cell)))))
;; jolt-var-get (vars.ss): the var-get fn + deref/@ on a cell. Stack first, then
;; the original (which errors on an unbound root, matching Clojure).
(define %dyn-var-get jolt-var-get)

5
host/chez/emit-image.ss
View file

@ -41,6 +41,11 @@
;; top-level entry: in direct-link mode it binds jv$<fqn> for a top-level def; off
;; that mode (the minter, runtime eval) it is exactly emit, so output is unchanged.
(define jolt-ce-emit-top (var-deref "jolt.backend-scheme" "emit-top-form"))
;; Seed mint and AOT build must stay byte-deterministic, so emit the image with var
;; cell-caching OFF (compile-eval.ss turned it on for runtime eval; this file loads
;; after it). Guarded for the first re-mint pass off an older seed.
(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
(when (procedure? scv) (scv #f)))
(define (ei-compile-form ctx f optimize?)
(let ((ir (jolt-ce-analyze ctx f)))
(jolt-ce-emit-top (if optimize? (jolt-ce-run-passes ir ctx) ir))))

17
host/chez/java/natives-array.ss
View file

@ -109,9 +109,24 @@
(let* ((v (cseq-cvec s)) (i (cseq-ci s)))
(cons v (fxmin (fx+ i na-chunk-size) (pvec-count v))))))
(define (na-chunked-seq? x) (and (na-vblock x) #t))
;; Copy the block [i, end) straight out of the pvec trie's 32-element leaf node
;; (pv-chunk-for is O(log n)). na-chunk-size == pv-width and blocks are 32-aligned,
;; so a block is exactly one leaf; the rare non-aligned window crossing a leaf
;; boundary falls back to per-index reads. Flattening the whole backing vector
;; per block (pvec-v) made chunk-first O(n), so walking a vector chunk-by-chunk
;; was O(n^2).
(define (na-chunk-first s)
(let ((vb (na-vblock s)))
(if vb (make-pvec (vec-copy-range (pvec-v (car vb)) (cseq-ci s) (cdr vb)))
(if vb
(let* ((pv (car vb)) (i (cseq-ci s)) (end (cdr vb)) (len (fx- end i))
(node (pv-chunk-for pv i)) (off (fxand i pv-mask)))
(if (fx<=? (fx+ off len) (vector-length node))
(make-pvec (vec-copy-range node off (fx+ off len)))
(let ((out (make-vector len)))
(let loop ((j 0))
(if (fx<? j len)
(begin (vector-set! out j (pvec-nth-d pv (fx+ i j) jolt-nil)) (loop (fx+ j 1)))
(make-pvec out))))))
(jolt-first s)))) ; eager-buffer fallback
(define (na-chunk-rest s)
(let ((vb (na-vblock s)))

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

File diff suppressed because one or more lines are too long

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

@ -539,11 +539,11 @@
(guard (e (#t #f))
(def-var! "clojure.core" "to-array-2d" (letrec ((to-array-2d (lambda (coll) (let fnrec4639 ((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" "unchecked-byte" (letrec ((unchecked-byte (lambda (x) (let fnrec4640 ((x x)) (jolt-invoke (var-deref "clojure.core" "bit-and") (jolt-invoke (var-deref "clojure.core" "int") x) 255))))) unchecked-byte)))
(def-var! "clojure.core" "unchecked-byte" (letrec ((unchecked-byte (lambda (x) (let fnrec4640 ((x x)) (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 255))))) unchecked-byte)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-short" (letrec ((unchecked-short (lambda (x) (let fnrec4641 ((x x)) (jolt-invoke (var-deref "clojure.core" "bit-and") (jolt-invoke (var-deref "clojure.core" "int") x) 65535))))) unchecked-short)))
(def-var! "clojure.core" "unchecked-short" (letrec ((unchecked-short (lambda (x) (let fnrec4641 ((x x)) (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 65535))))) unchecked-short)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-char" (letrec ((unchecked-char (lambda (x) (let fnrec4642 ((x x)) (jolt-invoke (var-deref "clojure.core" "char") (jolt-invoke (var-deref "clojure.core" "bit-and") (jolt-invoke (var-deref "clojure.core" "int") x) 65535)))))) unchecked-char)))
(def-var! "clojure.core" "unchecked-char" (letrec ((unchecked-char (lambda (x) (let fnrec4642 ((x x)) (jolt-invoke (var-deref "clojure.core" "char") (bitwise-and (jolt-invoke (var-deref "clojure.core" "int") x) 65535)))))) unchecked-char)))
(guard (e (#t #f))
(def-var! "clojure.core" "unchecked-float" (letrec ((unchecked-float (lambda (x) (let fnrec4643 ((x x)) (jolt-invoke (var-deref "clojure.core" "double") x))))) unchecked-float)))
(guard (e (#t #f))

12
host/chez/smoke.sh
View file

@ -46,5 +46,17 @@ check '(== 3 3.0)' 'true'
check_loc '(throw (ex-info "boom" {}))' ' at 1:'
check_loc '(do (+ 1 1) (/ 1 0))' ' at 1:'
# clojure.test extension points (assert-expr / do-report / report) need separate
# top-level forms — assert-expr must register before `is` expands — so this is a
# multi-form `joltc run`, not an -e one-liner. The file self-checks its tallies.
ct_out="$(bin/joltc run test/chez/clojure-test.clj 2>/dev/null)"
if printf '%s' "$ct_out" | grep -q 'CLOJURE-TEST OK'; then
pass=$((pass + 1))
else
echo " FAIL: clojure.test extension points"
echo " $(printf '%s' "$ct_out" | grep CLOJURE-TEST | tail -1)"
fails=$((fails + 1))
fi
echo "cli smoke: $pass passed, $fails failed"
[ "$fails" -eq 0 ]

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

@ -37,6 +37,16 @@
"even?" "jolt-even?" "odd?" "jolt-odd?" "pos?" "jolt-pos?" "neg?" "jolt-neg?"
"zero?" "jolt-zero?" "identity" "jolt-identity" "nil?" "jolt-nil?" "some?" "jolt-some?"
"ex-info" "jolt-ex-info"
;; bit ops: and/or/xor/not are Chez bitwise primitives (inlined to native code,
;; no helper call); operands must be integers (a non-integer errors, like the
;; JVM). The shifts keep their helpers (Java >>> masking / arithmetic shift) but
;; emit a direct call instead of var-deref + the variadic overlay.
;; and/or/xor/not map to variadic Chez bitwise prims (safe as a value at any
;; arity). bit-and-not is left to its overlay: its only Scheme impl is 2-arg, so
;; a value-position arity-3 use (via the variadic overlay) would mis-emit.
"bit-and" "bitwise-and" "bit-or" "bitwise-ior" "bit-xor" "bitwise-xor" "bit-not" "bitwise-not"
"bit-shift-left" "jolt-bit-shift-left" "bit-shift-right" "jolt-bit-shift-right"
"unsigned-bit-shift-right" "jolt-unsigned-bit-shift-right"
;; positional protocol-method dispatch (defprotocol-emitted shims) — bind
;; directly to the records.ss entry points so a protocol call doesn't var-deref.
"protocol-dispatch1" "protocol-dispatch1" "protocol-dispatch2" "protocol-dispatch2"
@ -66,7 +76,10 @@
"cons" #(= % 2) "filter" #(= % 2) "remove" #(= % 2) "into" #(= % 2)
"take" #(= % 2) "drop" #(= % 2) "map" #(>= % 2) "apply" #(>= % 2)
"reduce" #(or (= % 2) (= % 3)) "range" #(and (>= % 0) (<= % 3))
"ex-info" #(or (= % 2) (= % 3))})
"ex-info" #(or (= % 2) (= % 3))
"bit-and" #(= % 2) "bit-or" #(= % 2) "bit-xor" #(= % 2) "bit-not" #(= % 1)
"bit-shift-left" #(= % 2) "bit-shift-right" #(= % 2)
"unsigned-bit-shift-right" #(= % 2)})
;; jolt's comparison ops are vacuously true at arity 1 and DON'T inspect the arg,
;; but Scheme's < demands a number even there — special-case.
@ -147,6 +160,14 @@
(def direct-link-fns (atom #{}))
(defn direct-link-reset! [] (reset! direct-link-defined #{}) (reset! direct-link-fns #{}))
;; Cache a resolved var cell in a per-site cell so a non-direct-linked var
;; reference skips the name lookup (string-append + hash) after the first use.
;; OFF during the seed mint (the seed must stay a byte-fixpoint, and caching the
;; compiler's own refs shifts the gensym-numbered cell names every pass); the
;; runtime eval path turns it on for user code, where it's the big win.
(def var-cache? (atom false))
(defn set-var-cache! [on] (reset! var-cache? on))
;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
;; escaped so distinct vars never collide.
@ -170,14 +191,29 @@
(def ^:private gensym-counter (atom 0))
(defn- fresh-label [prefix] (str prefix (swap! gensym-counter inc)))
;; Per-site devirt cache cells collected while emitting one top-level def. A
;; devirtualized call resolves a CONSTANT impl (static tag/proto/method), so it
;; needs resolving once, not per call — the inline cache the JVM gets for free. When
;; a def init is being emitted this holds an atom; each devirt site appends a fresh
;; cell name (bound to #f in a let wrapping the def, so it persists across calls and
;; is shared by every invocation), and the site resolves into it on first use. nil
;; outside a def (a devirt there falls back to a per-call resolve).
(def ^:private devirt-cells (atom nil))
;; Per-site cache cells collected while emitting one top-level def. A site that
;; resolves a STABLE value — a devirtualized impl (constant tag/proto/method) or a
;; var cell (interned, so the cell never changes even when the var is redefined) —
;; resolves it once, not per call, the inline cache the JVM gets for free. When a
;; def init is being emitted this holds an atom; each site appends a fresh cell name
;; (bound to #f in a let wrapping the def, so it persists across calls and is shared
;; by every invocation) and resolves into it on first use. nil outside a def (a site
;; there falls back to a per-call resolve).
(def ^:private cache-cells (atom nil))
;; Emit a def's init (via the supplied thunk) under a fresh cache-cell collector,
;; then wrap the result in a let binding any cells its body registered so they
;; persist in the def's closure. Saves/restores the outer collector for nested
;; defs. Used by both the runtime def emit and the direct-link top-level emit.
(defn- emit-with-cells [emit-thunk]
(let [cells (atom [])
prev @cache-cells
_ (reset! cache-cells cells)
raw (emit-thunk)
_ (reset! cache-cells prev)]
(if (seq @cells)
(str "(let (" (str/join " " (map (fn [c] (str "(" c " #f)")) @cells)) ") " raw ")")
raw)))
;; Scheme syntactic keywords. A jolt local with one of these names would, when
;; emitted verbatim, shadow the Scheme form in operator position (a local named
@ -556,7 +592,7 @@
dv (str "(devirt-resolve " (chez-str-lit (:devirt-type node)) " "
(chez-str-lit (:devirt-proto node)) " " (chez-str-lit (:devirt-method node))
" " r ")")
cells @devirt-cells
cells @cache-cells
;; cache the resolved impl in a per-site cell when inside a
;; def (resolved once on first call, then reused); else
;; resolve per call.
@ -686,7 +722,22 @@
(and (stdlib-var? node) (not (deref prelude-mode?)))
(throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node)
"` (no core on Chez yet)") {}))
:else (str "(var-deref " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")))
;; inside a def, cache the interned var cell in a per-site cell so the
;; name lookup (string-append + hash) runs once, not per access; the
;; cell is stable and def-var! mutates its root in place, so this stays
;; correct under redefinition. Read through var-cell-deref — the
;; cell-based var-deref: binding-aware (a thread-bound dynamic var
;; resolves to its binding) AND lenient on an unbound root (the strict
;; jolt-var-get throws on a forward-declared var). Outside a def,
;; resolve per access.
:else
(let [cells @cache-cells
nslit (chez-str-lit (:ns node)) nmlit (chez-str-lit (:name node))]
(if (and @var-cache? cells)
(let [c (fresh-label "_vc$")]
(swap! cells conj c)
(str "(var-cell-deref (or " c " (let ((_v (jolt-var " nslit " " nmlit "))) (set! " c " _v) _v)))"))
(str "(var-deref " nslit " " nmlit ")")))))
:the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
;; (set! *var* val) -> set the var's innermost binding (else root); returns val.
:set-var (str "(jolt-var-set " (emit (:the-var node)) " " (emit (:val node)) ")")
@ -757,10 +808,10 @@
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
(jmeta-nonempty? (:meta node))
(str "(def-var-with-meta! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
(emit (:init node)) " " (emit-def-meta node) ")")
(emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
:else
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
(emit (:init node)) ")"))
(emit-with-cells #(emit (:init node))) ")"))
(throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {}))))
;; ^:dynamic / ^:redef on a def opts it out of direct-linking: it stays redefinable,
@ -773,15 +824,14 @@
;; Off direct-link mode this is exactly `emit`, so the seed mint and runtime eval are
;; byte-unchanged. Nested defs (a defonce's inner def) never reach a top-level branch
;; here, so they stay indirect — a `define` would be illegal in their position.
(defn emit-top-form [node]
(cond
(not @direct-link?) (emit node)
;; top-level do splices: each statement/ret is itself a top-level form.
(= :do (:op node))
(str "(begin " (str/join " " (map emit-top-form (:statements node)))
(if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
(and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)
;; Emit a def, wrapping its init in a let that binds each per-site cache cell
;; (var-ref + devirt) so a hot loop's lookups resolve once into the def's closure.
;; Runs in BOTH modes; in direct-link mode a non-opt-out def also binds jv$<fqn>
;; and registers it for app->app direct linking + a source-map frame.
(defn- emit-def-cached [node]
(let [ns (:ns node) nm (:name node)
dl? (and @direct-link? (not (dl-opt-out? (:meta node))))
b (dl-name ns nm)
fn? (= :fn (:op (:init node)))
;; A fn def gets a source-registry entry so a native backtrace can map its
;; frame to ns/name (file:line). Chez names the frame by whatever emit-fn
@ -790,28 +840,37 @@
;; no letrec, so the lambda sits directly under (define jv$ns$name …) and
;; takes that name. Register under whichever Chez will report.
pos (:pos node)
frame-name (when fn?
(if-let [fnm (:name (:init node))] (munge-name fnm) b))
reg (when (and fn? pos)
frame-name (when fn? (if-let [fnm (:name (:init node))] (munge-name fnm) b))
reg (when (and dl? fn? pos)
(str " (jolt-register-source! " (chez-str-lit frame-name) " "
(chez-str-lit ns) " " (chez-str-lit nm) " "
(if (get pos :file) (chez-str-lit (get pos :file)) "jolt-nil") " "
(or (get pos :line) 0) ")"))]
(or (get pos :line) 0) ")"))
;; register before emitting the init so a self-referential body direct-links.
(swap! direct-link-defined conj (dl-fqn ns nm))
(when fn? (swap! direct-link-fns conj (dl-fqn ns nm)))
(let [cells (atom [])
_ (reset! devirt-cells cells)
raw (emit (:init node))
_ (reset! devirt-cells nil)
;; wrap the init so each devirt site's cache cell persists across calls,
;; shared by every invocation of this def.
init (if (seq @cells)
(str "(let (" (str/join " " (map (fn [c] (str "(" c " #f)")) @cells)) ") " raw ")")
raw)]
_ (when dl? (swap! direct-link-defined conj (dl-fqn ns nm))
(when fn? (swap! direct-link-fns conj (dl-fqn ns nm))))
init (emit-with-cells #(emit (:init node)))]
(cond
dl?
(if (jmeta-nonempty? (:meta node))
(str "(begin (define " b " " init ") (def-var-with-meta! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-def-meta node) ")" (or reg "") ")")
(str "(begin (define " b " " init ") (def-var! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b ")" (or reg "") ")"))))
(chez-str-lit ns) " " (chez-str-lit nm) " " b ")" (or reg "") ")"))
(jmeta-nonempty? (:meta node))
(str "(def-var-with-meta! " (chez-str-lit ns) " " (chez-str-lit nm) " " init " " (emit-def-meta node) ")")
:else
(str "(def-var! " (chez-str-lit ns) " " (chez-str-lit nm) " " init ")"))))
(defn emit-top-form [node]
(cond
;; off direct-link (the seed mint + runtime-via-image) this is exactly `emit`,
;; whose :def case already wraps cache cells, so the seed stays byte-unchanged.
(not @direct-link?) (emit node)
;; top-level do splices: each statement/ret is itself a top-level form.
(= :do (:op node))
(str "(begin " (str/join " " (map emit-top-form (:statements node)))
(if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
(and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
(emit-def-cached node)
:else (emit node)))

43
stdlib/clojure/test.clj
View file

@ -66,6 +66,42 @@
(defmulti report :type)
(defmethod report :default [_m] nil)
;; do-report routes a {:type …} report map through the report multimethod — the
;; seam clojure.test assertions emit through. The built-in :pass/:fail/:error
;; methods feed jolt's counters; a library can add report types (test.check's
;; ::trial/::shrunk/::complete) and they dispatch here.
(defn- report-line [m]
(str (when (:message m) (str (:message m)
(when (or (:form m) (contains? m :expected) (contains? m :actual)) " ")))
(when (:form m) (pr-str (:form m)))
(when (contains? m :expected) (str " expected: " (pr-str (:expected m))))
(when (contains? m :actual) (str " actual: " (pr-str (:actual m))))))
(defmethod report :pass [_m] (inc-pass!))
(defmethod report :fail [m] (fail! (report-line m)))
(defmethod report :error [m] (err! (report-line m)))
(defn do-report [m] (report m))
;; assert-expr is the macro-level extension point: `is` expands a form by calling
;; (assert-expr msg form), dispatched on the form's first symbol (or :default /
;; :always-fail). A library registers a custom assertion via
;; (defmethod assert-expr 'my-pred [msg form] <code returning an assertion form>).
;; 2-arg [msg form] signature matches clojure.test. `is` routes here only for a
;; symbol with an explicitly registered method, so built-in forms are unaffected.
(defmulti assert-expr (fn [_msg form]
(cond (nil? form) :always-fail
(and (seq? form) (symbol? (first form))) (first form)
:else :default)))
(defmethod assert-expr :always-fail [msg form]
`(clojure.test/do-report {:type :fail :message ~msg :form '~form}))
(defmethod assert-expr :default [msg form]
`(try
(if ~form
(clojure.test/do-report {:type :pass})
(clojure.test/do-report {:type :fail :message ~msg :form '~form}))
(catch Throwable e#
(clojure.test/do-report {:type :error :message ~msg :form '~form
:actual (clojure.test/err-text e#)}))))
;; --- class matching for thrown? --------------------------------------------
(defn- last-seg [s]
@ -130,6 +166,13 @@
(clojure.test/inc-pass!)
(clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#)))))))
;; a library-registered custom assertion (the assert-expr extension point);
;; only fires for a symbol with an explicitly registered method, so built-in
;; predicate forms keep the inline path below.
(and (seq? form) (symbol? (first form))
(contains? (methods clojure.test/assert-expr) (first form)))
(clojure.test/assert-expr msg form)
:else
`(try
(if ~form

47
test/chez/clojure-test.clj Normal file
View file

@ -0,0 +1,47 @@
;; Self-checking regression for clojure.test: the assert-expr / do-report / report
;; extension points plus the built-in is/are/testing/thrown?/use-fixtures surface.
;; Run via bin/joltc; prints a single sentinel line the smoke gate greps for.
(ns clojure-test-selfcheck
(:require [clojure.test :as t :refer [deftest is are testing use-fixtures run-tests]]))
;; a library-style custom assertion registered through the assert-expr seam
(defmethod t/assert-expr 'near? [msg form]
(let [[_ a b] form]
`(if (< (let [d# (- ~a ~b)] (if (neg? d#) (- d#) d#)) 0.01)
(clojure.test/do-report {:type :pass})
(clojure.test/do-report {:type :fail :message ~msg :form '~form}))))
;; a custom report type (how test.check surfaces trial/shrink progress)
(def trials (atom 0))
(defmethod t/report ::trial [_m] (swap! trials inc))
(def setups (atom 0))
(use-fixtures :each (fn [f] (swap! setups inc) (f)))
(deftest builtins
(testing "equality + predicate"
(is (= 1 1))
(is (vector? [1])))
(are [x y] (= x y)
2 (+ 1 1)
6 (* 2 3))
(is (thrown? clojure.lang.ExceptionInfo (throw (ex-info "x" {}))))
(is (thrown-with-msg? Exception #"bad" (throw (ex-info "bad" {}))))
(is (near? 1.0 1.005)))
(deftest expected-fail
(is (= 1 2))
(is (near? 1.0 5.0)))
(run-tests)
(t/do-report {:type ::trial})
(t/do-report {:type ::trial})
;; 7 pass (= + vector? + 2 are rows + thrown? + thrown-with-msg? + near?),
;; 2 fail (= 1 2, near? 1.0 5.0), 0 error, 2 fixture runs, 2 custom reports
(let [ok (and (= (t/n-pass) 7) (= (t/n-fail) 2) (= (t/n-error) 0)
(= @setups 2) (= @trials 2))]
(println (if ok
"CLOJURE-TEST OK"
(str "CLOJURE-TEST FAIL pass=" (t/n-pass) " fail=" (t/n-fail)
" error=" (t/n-error) " setups=" @setups " trials=" @trials))))

77
test/chez/corpus.edn
View file

@ -794,6 +794,28 @@
{:suite "lazy-seq / realization is shared across walks" :label "effects run once across three walks" :expected "3" :actual "(let [a (atom 0) s (map (fn [x] (swap! a inc) x) [1 2 3])] (doall s) (dorun s) (vec s) (deref a))"}
{:suite "lazy-seq / realization is shared across walks" :label "values stable across walks" :expected "true" :actual "(let [s (map inc [1 2 3])] (= (vec s) (vec s) [2 3 4]))"}
{:suite "lazy-seq / realization is shared across walks" :label "filter effects once" :expected "4" :actual "(let [a (atom 0) s (filter (fn [x] (swap! a inc) (odd? x)) [1 2 3 4])] (dorun s) (count s) (deref a))"}
{:suite "lazy / realization order & count" :label "map realizes left-to-right" :expected "[1 2 3]" :actual "(let [log (atom [])] (dorun (map (fn [x] (swap! log conj x) x) (list 1 2 3))) @log)"}
{:suite "lazy / realization order & count" :label "filter realizes left-to-right" :expected "[1 2 3]" :actual "(let [log (atom [])] (dorun (filter (fn [x] (swap! log conj x) true) (list 1 2 3))) @log)"}
{:suite "lazy / realization order & count" :label "take realizes exactly n, no over-realization" :expected "3" :actual "(let [a (atom 0)] (dorun (take 3 (map (fn [x] (swap! a inc) x) (iterate inc 0)))) @a)"}
{:suite "lazy / realization order & count" :label "nth realizes exactly index+1" :expected "3" :actual "(let [a (atom 0)] (nth (map (fn [x] (swap! a inc) x) (iterate inc 0)) 2) @a)"}
{:suite "lazy / realization order & count" :label "drop+first realizes through the index" :expected "3" :actual "(let [a (atom 0)] (first (drop 2 (map (fn [x] (swap! a inc) x) (iterate inc 0)))) @a)"}
{:suite "lazy / realization is memoized" :label "first twice realizes once" :expected "1" :actual "(let [a (atom 0) s (map (fn [x] (swap! a inc) x) (iterate inc 0))] (first s) (first s) @a)"}
{:suite "lazy / realization is memoized" :label "wider take extends, does not re-realize" :expected "4" :actual "(let [a (atom 0) s (map (fn [x] (swap! a inc) x) (iterate inc 0))] (doall (take 2 s)) (doall (take 4 s)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "keep" :expected "0" :actual "(let [a (atom 0)] (keep (fn [x] (swap! a inc) x) (range 5)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "keep-indexed" :expected "0" :actual "(let [a (atom 0)] (keep-indexed (fn [i x] (swap! a inc) x) (range 5)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "map-indexed" :expected "0" :actual "(let [a (atom 0)] (map-indexed (fn [i x] (swap! a inc) x) (range 5)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "distinct" :expected "0" :actual "(let [a (atom 0)] (distinct (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "partition-by" :expected "0" :actual "(let [a (atom 0)] (partition-by (fn [x] (swap! a inc) x) (range 5)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "partition-all" :expected "0" :actual "(let [a (atom 0)] (partition-all 2 (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "interpose" :expected "0" :actual "(let [a (atom 0)] (interpose 0 (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "interleave" :expected "0" :actual "(let [a (atom 0)] (interleave (map (fn [x] (swap! a inc) x) (range 5)) (range 5)) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "take-nth" :expected "0" :actual "(let [a (atom 0)] (take-nth 2 (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "reductions" :expected "0" :actual "(let [a (atom 0)] (reductions + (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "tree-seq" :expected "0" :actual "(let [a (atom 0)] (tree-seq (fn [x] (swap! a inc) false) identity [1 [2]]) @a)"}
{:suite "lazy / family is lazy at construction (no side effect)" :label "replace over a seq" :expected "0" :actual "(let [a (atom 0)] (replace {} (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
{:suite "lazy / realization timing" :label "sequence realizes the first element" :expected "1" :actual "(let [a (atom 0)] (sequence (map (fn [x] (swap! a inc) x)) (range 5)) @a)"}
{:suite "lazy / realization timing" :label "next realizes head + one lookahead" :expected "2" :actual "(let [a (atom 0) s (map (fn [x] (swap! a inc) x) (iterate inc 0))] (next s) @a)"}
{:suite "lazy / realization timing" :label "rest realizes only the head" :expected "1" :actual "(let [a (atom 0) s (map (fn [x] (swap! a inc) x) (iterate inc 0))] (rest s) @a)"}
{:suite "list / construct & predicate" :label "list" :expected "[1 2 3]" :actual "(list 1 2 3)"}
{:suite "list / construct & predicate" :label "empty list" :expected "[]" :actual "(list)"}
{:suite "list / construct & predicate" :label "quoted list" :expected "[1 2 3]" :actual "(quote (1 2 3))"}
@ -1523,6 +1545,17 @@
{:suite "numbers / variadic bit ops" :label "bit-and-not 3" :expected "8" :actual "(bit-and-not 12 6 3)"}
{:suite "numbers / variadic bit ops" :label "bit-and single arg throws" :expected :throws :actual "(bit-and 5)"}
{:suite "numbers / variadic bit ops" :label "bit-or keeps binary fast path" :expected "3" :actual "(bit-or 1 2)"}
{:suite "numbers / variadic bit ops" :label "bit-not" :expected "-6" :actual "(bit-not 5)"}
{:suite "numbers / variadic bit ops" :label "bit-and in value position" :expected "8" :actual "(reduce bit-and [15 9 12])"}
{:suite "numbers / variadic bit ops" :label "bit-xor in value position" :expected "0" :actual "(reduce bit-xor 0 [1 2 3])"}
{:suite "numbers / variadic bit ops" :label "bit-or via apply" :expected "7" :actual "(apply bit-or [1 2 4])"}
{:suite "numbers / variadic bit ops" :label "unsigned-shift over a full 64-bit value" :expected "17179869183" :actual "(unsigned-bit-shift-right -1 30)"}
;; var-reference cell caching (runtime path): a ref inside a fn caches the
;; resolved cell, but stays correct under redefinition (cell root mutated in
;; place) and dynamic binding (read goes through the binding-aware path).
{:suite "vars / cached reference stays correct" :label "redefinition is seen through a cached ref" :expected "2" :actual "(do (def x 1) (defn f [] x) (def x 2) (f))"}
{:suite "vars / cached reference stays correct" :label "dynamic binding is seen through a cached ref" :expected "[1 9 1]" :actual "(do (def ^:dynamic *d* 1) (defn g [] *d*) [(g) (binding [*d* 9] (g)) (g)])"}
{:suite "vars / cached reference stays correct" :label "forward reference resolves once the var is defined" :expected "42" :actual "(do (defn a [] (b)) (defn b [] 42) (a))"}
{:suite "predicates / nil & boolean" :label "nil? true" :expected "true" :actual "(nil? nil)"}
{:suite "predicates / nil & boolean" :label "nil? false" :expected "false" :actual "(nil? 0)"}
{:suite "predicates / nil & boolean" :label "some? true" :expected "true" :actual "(some? 0)"}
@ -1633,7 +1666,7 @@
{:suite "predicates / tagged-value" :label "tagged-literal? yes" :expected "true" :actual "(tagged-literal? (tagged-literal (quote inst) \"2020\"))"}
{:suite "predicates / tagged-value" :label "tagged-literal? no" :expected "false" :actual "(tagged-literal? 1)"}
{:suite "predicates / tagged-value" :label "reader-conditional? no" :expected "false" :actual "(reader-conditional? 1)"}
{:suite "predicates / tagged-value" :label "chunked-seq? always false" :expected "true" :actual "(chunked-seq? (seq [1 2 3]))"}
{:suite "predicates / tagged-value" :label "chunked-seq? true for a vector seq" :expected "true" :actual "(chunked-seq? (seq [1 2 3]))"}
{:suite "predicates / equality & identity" :label "= same" :expected "true" :actual "(= 1 1)"}
{:suite "predicates / equality & identity" :label "= vectors" :expected "true" :actual "(= [1 2] [1 2])"}
{:suite "predicates / equality & identity" :label "= vector & list" :expected "true" :actual "(= [1 2] (list 1 2))"}
@ -2702,6 +2735,48 @@
{:suite "untested / chunk family (eager equivalents) + cat" :label "halt-when" :expected "4" :actual "(transduce (halt-when even?) conj [] [1 3 4 5])"}
{:suite "untested / chunk family (eager equivalents) + cat" :label "chunk-next exhausted" :expected "nil" :actual "(let [cb (chunk-buffer 2)] (chunk-append cb 1) (chunk-next (chunk-cons (chunk cb) nil)))"}
{:suite "untested / chunk family (eager equivalents) + cat" :label "chunk-rest seqable" :expected "[]" :actual "(let [cb (chunk-buffer 2)] (chunk-append cb 1) (vec (chunk-rest (chunk-cons (chunk cb) nil))))"}
{:suite "chunked-seq / over a vector" :label "chunk-first is a 32-element block" :expected "32" :actual "(count (chunk-first (seq (vec (range 100)))))"}
{:suite "chunked-seq / over a vector" :label "chunked-seq? true for vector seq" :expected "true" :actual "(chunked-seq? (seq (vec (range 100))))"}
{:suite "chunked-seq / over a vector" :label "chunked-seq? false for a list seq" :expected "false" :actual "(chunked-seq? (seq (list 1 2 3)))"}
{:suite "chunked-seq / over a vector" :label "chunk-first contents + chunk-rest boundary" :expected "[32 0 31 32]" :actual "(let [s (seq (vec (range 50))) c (chunk-first s)] [(count c) (nth c 0) (nth c 31) (first (chunk-rest s))])"}
{:suite "chunked-seq / over a vector" :label "chunk-first window past the first block" :expected "[32 33 34 35 36 37 38 39]" :actual "(vec (chunk-first (chunk-rest (seq (vec (range 40))))))"}
;; --- seq-type-model divergences (allowlisted): jolt models every seq as
;; PersistentList (eager) or LazySeq (deferred); JVM reifies a specialized class
;; per producer. Values + laziness are correct, only (class …) differs. jolt-aei7.
{:suite "seq-type-model / specialized seq classes collapse" :label "cons over a vector" :expected "clojure.lang.PersistentList" :actual "(class (cons 1 [2 3]))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "iterate" :expected "clojure.lang.PersistentList" :actual "(class (iterate inc 0))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "range" :expected "clojure.lang.PersistentList" :actual "(class (range 5))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "repeat" :expected "clojure.lang.LazySeq" :actual "(class (repeat 3 :x))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "cycle" :expected "clojure.lang.LazySeq" :actual "(class (cycle [1 2]))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "vector seq" :expected "clojure.lang.PersistentList" :actual "(class (seq [1 2 3]))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "string seq" :expected "clojure.lang.PersistentList" :actual "(class (seq \"abc\"))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "keys" :expected "clojure.lang.PersistentList" :actual "(class (keys {:a 1 :b 2}))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "rseq" :expected "clojure.lang.PersistentList" :actual "(class (rseq [1 2 3]))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "sort" :expected "clojure.lang.PersistentList" :actual "(class (sort [3 1 2]))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "subvec" :expected "clojure.lang.PersistentVector" :actual "(class (subvec [1 2 3] 1))"}
{:suite "seq-type-model / specialized seq classes collapse" :label "drop over a vector" :expected "clojure.lang.LazySeq" :actual "(class (drop 1 [1 2 3]))"}
;; --- chunking-model divergences (allowlisted): jolt is unchunked, so forcing
;; one element realizes 1 (JVM realizes a 32-element chunk), and mapcat/dedupe
;; realize 0 at construction (JVM forces the first chunk). jolt-mm6v.
{:suite "chunking-model / unchunked realization granularity" :label "first over a vector realizes one, not a chunk" :expected "1" :actual "(let [a (atom 0)] (first (map (fn [x] (swap! a inc) x) (vec (range 100)))) @a)"}
{:suite "chunking-model / unchunked realization granularity" :label "nth 0 over a vector realizes one" :expected "1" :actual "(let [a (atom 0)] (nth (map (fn [x] (swap! a inc) x) (vec (range 100))) 0) @a)"}
{:suite "chunking-model / unchunked realization granularity" :label "mapcat is fully lazy at construction" :expected "0" :actual "(let [a (atom 0)] (mapcat (fn [x] (swap! a inc) [x]) (range 5)) @a)"}
{:suite "chunking-model / unchunked realization granularity" :label "dedupe is fully lazy at construction" :expected "0" :actual "(let [a (atom 0)] (dedupe (map (fn [x] (swap! a inc) x) (range 5))) @a)"}
;; --- integer-box-model: narrow int values behave as integers (certified) ---
;; jolt unifies every integer as one exact-integer type, so (byte/short/int n)
;; produce value-correct integers — only the reified class differs (below).
{:suite "integer-box-model / narrow ints behave as integers" :label "byte = plain integer by value" :expected "true" :actual "(= (byte 5) 5)"}
{:suite "integer-box-model / narrow ints behave as integers" :label "byte arithmetic promotes" :expected "6" :actual "(+ (byte 5) 1)"}
{:suite "integer-box-model / narrow ints behave as integers" :label "byte is a Number" :expected "true" :actual "(instance? Number (byte 5))"}
;; --- integer-box-model divergences (allowlisted): no narrow box types. A Chez
;; fixnum is an immediate identical to the plain integer (cannot be tagged), so
;; (byte/short/int n) report Long, not Byte/Short/Integer. Value is correct.
;; jolt-k9sw (accepted divergence).
{:suite "integer-box-model / narrow int class collapses to Long" :label "byte class" :expected "java.lang.Long" :actual "(class (byte 5))"}
{:suite "integer-box-model / narrow int class collapses to Long" :label "short class" :expected "java.lang.Long" :actual "(class (short 5))"}
{:suite "integer-box-model / narrow int class collapses to Long" :label "int class" :expected "java.lang.Long" :actual "(class (int 5))"}
{:suite "integer-box-model / narrow int class collapses to Long" :label "instance? Byte is false" :expected "false" :actual "(instance? Byte (byte 5))"}
{:suite "integer-box-model / narrow int class collapses to Long" :label "instance? Long is true" :expected "true" :actual "(instance? Long (byte 5))"}
{:suite "untested / JVM-shape stubs (documented jolt behavior)" :label "class number" :expected "java.lang.Long" :actual "(class 1)"}
{:suite "untested / JVM-shape stubs (documented jolt behavior)" :label "class string" :expected "java.lang.String" :actual "(class \"s\")"}
{:suite "untested / JVM-shape stubs (documented jolt behavior)" :label "class keyword" :expected "clojure.lang.Keyword" :actual "(class :k)"}

48
test/conformance/SPEC.md
View file

@ -84,6 +84,54 @@ implements. Current profile (≈2735 portable, ≈167 non-portable):
| `:impl/representation` | representation detail (e.g. syntax-quote yields a `list?`, not a `Cons`) |
| `:bug` | a *known defect* (tracked bead) — not a host difference |
## Seq semantics
Values alone don't pin laziness — an eager `map` and a lazy `map` return the same
elements. The spec certifies seq *semantics* by reducing them to values with a
side-effect counter, so the corpus catches a laziness regression the value
comparison would miss.
**Laziness (certified — jolt matches JVM).** The whole producer family
(`map`/`filter`/`remove`/`take`/`drop`/`concat`/`take-while`/`drop-while`/`mapcat`/
`partition`/`partition-all`/`partition-by`/`keep`/`keep-indexed`/`map-indexed`/
`distinct`/`interpose`/`interleave`/`take-nth`/`reductions`/`tree-seq`/`replace`)
is lazy at construction: building over a side-effecting source realizes **zero**
elements (`lazy / family is lazy at construction`). Realization order is
left-to-right, `take`/`nth`/`drop` realize exactly as far as demanded, a lazy seq
memoizes (realize-once across walks), and `next` realizes head + one lookahead
while `rest` realizes only the head (`lazy / realization order & count`,
`lazy / realization is memoized`, `lazy / realization timing`). A lazy result is
`clojure.lang.LazySeq`.
**Accepted divergences.** jolt is a simpler, finer-grained superset of JVM seq
behavior; two classes diverge by representation, never by value, and are
allowlisted in `known-divergences.edn`:
- **`:seq-type-model`** (`seq-type-model / …` suite, jolt-aei7) — jolt reifies
every seq as `PersistentList` (eager) or `LazySeq` (deferred). JVM has a
specialized class per producer (`Cons`, `Iterate`, `LongRange`, `Repeat`,
`Cycle`, `PersistentVector$ChunkedSeq`, `StringSeq`, `KeySeq`/`ValSeq`, `RSeq`,
`ArraySeq`, `SubVector`), so `(class …)` differs. `instance?
clojure.lang.ISeq/Sequential` and all values/laziness are correct.
- **`:chunking-model`** (`chunking-model / …` suite, jolt-mm6v) — jolt seqs are
unchunked: forcing one element realizes one, where JVM realizes a ~32-element
chunk; `mapcat`/`dedupe` realize 0 at construction where JVM forces the first
chunk. Strictly finer-grained laziness, decided after the chunk fast path
(jolt-j9dz) was made O(n).
## Narrow integer types
jolt unifies every integer as one exact-integer type (`:integer-box-model`,
jolt-k9sw). `(byte n)`/`(short n)`/`(int n)` produce value-correct integers —
arithmetic, `=`, and `hash` behave exactly as the JVM — but report `Long`, not
`Byte`/`Short`/`Integer`, so `(class (byte 5))` and `(instance? Byte (byte 5))`
diverge. This is substrate-inherent: a Chez fixnum is an immediate `identical?`
to the plain integer (nothing to tag, and numbers carry no metadata), so the only
faithful representation is a boxed type — which would crash raw compiled `(+ …)`
(arithmetic emits a bare Chez `+`) or force every `+`/`-`/`*` through an
unwrapping dispatcher, de-optimizing all arithmetic. Same shape as the accepted
BigInt-vs-Long unification.
## Hosting jolt on a new runtime
1. Implement the reader + analyzer + a backend for your runtime (see the Chez port

31
test/conformance/known-divergences.edn
View file

@ -12,7 +12,13 @@
:strictness
"jolt is intentionally stricter: throws on odd assoc! args / defn with no param vector",
:impl-detail
"representation detail: syntax-quote yields a list? (JVM yields a Cons)"},
"representation detail: syntax-quote yields a list? (JVM yields a Cons)",
:seq-type-model
"jolt models every seq as PersistentList (eager) or LazySeq (deferred); JVM reifies a specialized class per producer (Cons/Iterate/LongRange/Repeat/Cycle/ChunkedSeq/StringSeq/KeySeq/RSeq/ArraySeq/SubVector). Values and laziness are correct, only (class …) differs. jolt-aei7",
:chunking-model
"jolt seqs are unchunked: forcing one element realizes one (JVM realizes a ~32-element chunk), and mapcat/dedupe realize 0 at construction where JVM forces the first chunk — jolt is a finer-grained lazy superset. jolt-mm6v",
:integer-box-model
"jolt unifies every integer as one exact-integer type. A Chez fixnum is an immediate identical to the plain integer (no distinct identity to tag, no metadata on numbers), so (byte/short/int n) report Long, not Byte/Short/Integer. Value/arithmetic/equality are correct; a faithful narrow box would crash raw compiled (+ …) or de-optimize all arithmetic. jolt-k9sw"},
:entries
[{:suite "forms / fn",
:label "no param vector",
@ -34,4 +40,25 @@
:category :host-model}
{:suite "untested / chunk family (eager equivalents) + cat",
:label "chunk round-trip",
:category :host-model}]}
:category :host-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "cons over a vector", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "iterate", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "range", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "repeat", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "cycle", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "vector seq", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "string seq", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "keys", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "rseq", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "sort", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "subvec", :category :seq-type-model}
{:suite "seq-type-model / specialized seq classes collapse", :label "drop over a vector", :category :seq-type-model}
{:suite "chunking-model / unchunked realization granularity", :label "first over a vector realizes one, not a chunk", :category :chunking-model}
{:suite "chunking-model / unchunked realization granularity", :label "nth 0 over a vector realizes one", :category :chunking-model}
{:suite "chunking-model / unchunked realization granularity", :label "mapcat is fully lazy at construction", :category :chunking-model}
{:suite "chunking-model / unchunked realization granularity", :label "dedupe is fully lazy at construction", :category :chunking-model}
{:suite "integer-box-model / narrow int class collapses to Long", :label "byte class", :category :integer-box-model}
{:suite "integer-box-model / narrow int class collapses to Long", :label "short class", :category :integer-box-model}
{:suite "integer-box-model / narrow int class collapses to Long", :label "int class", :category :integer-box-model}
{:suite "integer-box-model / narrow int class collapses to Long", :label "instance? Byte is false", :category :integer-box-model}
{:suite "integer-box-model / narrow int class collapses to Long", :label "instance? Long is true", :category :integer-box-model}]}