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

Fix seven more JVM divergences (rewrite-clj full suite)

Browse source 
Running the whole rewrite-clj test suite (159 tests) surfaced seven more bugs;
with these it passes 3377/0/0. Each is a general jolt/JVM divergence:

- *out* was pinned to the startup stdout port, so (.write *out* …) escaped a
  with-out-str capture (z/print writes via *out*). It now resolves the live
  current-output-port, like print/__write, so a redirect is seen.
- nth / assoc past the end of a vector or seq threw a bare Chez error (class
  :object). Throw IndexOutOfBoundsException, matching the JVM.
- A number's .toString(radix) ignored the base. Render in the base, lowercase
  (rewrite-clj rebuilds 0xff / 0377 / 2r1001 through it).
- A required namespace's own :as aliases leaked into its requirer: the loaded ns
  form compiles while (chez-current-ns) is still the requirer, so ce-scan-requires!
  registered the loaded ns's aliases under the wrong ns and clobbered a same-named
  alias there. Register an (ns NAME …) form's aliases under NAME.
- A quoted collection dropped its metadata; now it keeps USER metadata (drops the
  reader's :line/:column/:file), like a Clojure quoted constant.
- enumeration-seq only did (seq e); it now drives a java.util.Enumeration through
  hasMoreElements/nextElement, and StringTokenizer implements them.

Regressions: corpus rows (with-out-str/*out*, nth/assoc bounds, toString radix,
quote metadata, enumeration-seq) certified against JVM; a smoke fixture for the
alias leak (a required ns's alias must not leak). tools.reader + rewrite-clj added
to docs/libraries.md. make test green.
This commit is contained in:
Yogthos 2026-07-01 14:17:03 -04:00
parent 53112d06fb
commit 9bcac13fd2
15 changed files with 999 additions and 906 deletions
Download patch file Download diff file Expand all files Collapse all files

5
docs/libraries.md
View file

@ -72,6 +72,11 @@ e.g. the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring
[tools.macro](https://github.com/clojure/tools.macro).
* [test.check](https://github.com/clojure/test.check) — property-based testing
(generators, `quick-check`, shrinking).
* [tools.reader](https://github.com/clojure/tools.reader) — a Clojure reader in
Clojure (edn + full reader, indexing/pushback reader types).
* [rewrite-clj](https://github.com/clj-commons/rewrite-clj) — parse/rewrite Clojure
source while preserving whitespace and comments (nodes + zipper), over
[tools.reader](https://github.com/clojure/tools.reader).
* [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

6
host/chez/collections.ss
View file

@ -130,7 +130,7 @@
(vec-set (pvec-tail p) (fxand i pv-mask) x) #f)
(mk-pvec cnt (pvec-shift p)
(pv-assoc-trie (pvec-shift p) (pvec-root p) i x) (pvec-tail p) #f)))
(else (error 'assoc "vector index out of bounds")))))
(else (jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "vector index out of bounds"))))))
(define (pvec-peek p)
(let ((n (pvec-cnt p))) (if (fx=? n 0) jolt-nil (pvec-nth-d p (fx- n 1) jolt-nil))))
;; pop the last trie chunk back into the tail; #f means the subtree emptied.
@ -449,9 +449,9 @@
(let ((i (->idx i)))
(cond ((pvec? coll) (let ((v (pvec-v coll)))
(if (and (fx>=? i 0) (fx<? i (vector-length v))) (vector-ref v i)
(error 'nth "index out of bounds"))))
(jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "index out of bounds")))))
((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i)
(error 'nth "index out of bounds")))
(jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "index out of bounds"))))
((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #f jolt-nil))
((rec-coll-method coll "nth") => (lambda (m) (jolt-invoke m coll i)))
(else (error 'nth "unsupported collection")))))

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

@ -111,6 +111,16 @@
(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
(when (procedure? scv) (scv #t)))
;; (with-meta sym m) -> sym, else x — an (ns ^:no-doc name …) yields the name with
;; reader metadata as a with-meta form; strip it to read the bare ns symbol.
(define (ce-unwrap-meta x)
(if (and (cseq? x) (cseq-list? x))
(let ((items (seq->list x)))
(if (and (pair? items) (symbol-t? (car items))
(string=? (symbol-t-name (car items)) "with-meta") (pair? (cdr items)))
(cadr items) x))
x))
;; (quote X) -> X, else x — unwraps a quoted require spec.
(define (ce-unquote x)
(if (and (cseq? x) (cseq-list? x))
@ -135,14 +145,22 @@
;; (require spec...) / (use spec...) — specs are quoted
((and hn (or (string=? hn "require") (string=? hn "use")))
(for-each (lambda (a) (chez-register-spec! ns (ce-unquote a))) (cdr items)))
;; (ns name (:require [a :as x]) ...) — clause specs are literal
;; (ns name (:require [a :as x]) ...) — clause specs are literal. Register
;; the aliases under NAME (the ns being defined), not the passed `ns`:
;; when a file is loaded its ns form compiles while (chez-current-ns) is
;; still the requiring ns, so using `ns` would leak the loaded ns's
;; aliases into its requirer and clobber a same-named alias there
;; (rewrite-clj.zip.base's [node.protocols :as node] over the caller's node).
((and hn (string=? hn "ns"))
(let ((ns-name (if (and (pair? (cdr items)) (symbol-t? (ce-unwrap-meta (cadr items))))
(symbol-t-name (ce-unwrap-meta (cadr items)))
ns)))
(for-each (lambda (clause)
(when (and (cseq? clause) (cseq-list? clause))
(let ((cl (seq->list clause)))
(when (ce-clause-require? cl)
(for-each (lambda (spec) (chez-register-spec! ns spec)) (cdr cl))))))
(if (pair? (cdr items)) (cddr items) '())))
(for-each (lambda (spec) (chez-register-spec! ns-name spec)) (cdr cl))))))
(if (pair? (cdr items)) (cddr items) '()))))
(else (for-each (lambda (x) (ce-scan-requires! x ns)) items))))))))
;; Already-read FORM -> Scheme source string (analyze -> emit on Chez).

30
host/chez/java/host-static-classes.ss
View file

@ -176,14 +176,26 @@
;; push to the port (so (.write *out* s) and (binding [*out* *err*] …) work);
;; it isn't a buffer, so toString is empty. Lets libraries that touch *out*/*err*
;; (tools.logging, selmer) compile and run.
;; *out*/*err* resolve their port LIVE — 'out -> (current-output-port), 'err ->
;; (current-error-port) — so a (.write *out* …) / (.flush *out*) follows a
;; with-out-str redirect (with-output-to-string rebinds current-output-port) the
;; same way print/__write do. Storing the startup port instead pinned *out* to the
;; real stdout, so rewrite-clj's (z/print) — which writes via *out* — escaped the
;; capture. A stored port object (should any other code make a port-writer) is used
;; as-is.
(define (port-writer-port self)
(let ((p (vector-ref (jhost-state self) 0)))
(cond ((eq? p 'out) (current-output-port))
((eq? p 'err) (current-error-port))
(else p))))
(register-host-methods! "port-writer"
(list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil))
(cons "append" (lambda (self x . rest) (display (append-text x rest) (vector-ref (jhost-state self) 0)) self))
(cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil))
(list (cons "write" (lambda (self x) (display (writer-piece x) (port-writer-port self)) jolt-nil))
(cons "append" (lambda (self x . rest) (display (append-text x rest) (port-writer-port self)) self))
(cons "flush" (lambda (self) (flush-output-port (port-writer-port self)) jolt-nil))
(cons "close" (lambda (self) jolt-nil))
(cons "toString" (lambda (self) ""))))
(def-var! "clojure.core" "*out*" (make-jhost "port-writer" (vector (current-output-port))))
(def-var! "clojure.core" "*err*" (make-jhost "port-writer" (vector (current-error-port))))
(def-var! "clojure.core" "*out*" (make-jhost "port-writer" (vector 'out)))
(def-var! "clojure.core" "*err*" (make-jhost "port-writer" (vector 'err)))
;; PrintWriter — a thin wrapper over a target writer. write/append/print forward
;; the rendered text to the target. clojure.data.json's pretty printer builds
@ -440,6 +452,14 @@
(list (cons "hasMoreTokens" (lambda (self) (< (vector-ref (jhost-state self) 1) (length (vector-ref (jhost-state self) 0)))))
(cons "countTokens" (lambda (self) (->num (- (length (vector-ref (jhost-state self) 0)) (vector-ref (jhost-state self) 1)))))
(cons "nextToken" (lambda (self)
(let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
(if (< p (length toks))
(begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))
(error #f "NoSuchElementException")))))
;; StringTokenizer implements java.util.Enumeration — enumeration-seq drives
;; it through these, so alias them onto the token methods.
(cons "hasMoreElements" (lambda (self) (< (vector-ref (jhost-state self) 1) (length (vector-ref (jhost-state self) 0)))))
(cons "nextElement" (lambda (self)
(let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
(if (< p (length toks))
(begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))

7
host/chez/java/host-static.ss
View file

@ -117,7 +117,12 @@
((string=? method "longValue") (->num (jnum->exact n)))
((string=? method "doubleValue") (->num n))
((string=? method "floatValue") (->num n))
((string=? method "toString") (jolt-num->string n))
;; .toString(radix) — BigInteger/Integer render in a base, lowercase like the
;; JVM (rewrite-clj's integer node reconstructs 0xff / 0377 / 2r1001 this way).
((string=? method "toString")
(if (pair? args)
(string-downcase (number->string (jnum->exact n) (jnum->exact (car args))))
(jolt-num->string n)))
((string=? method "hashCode") (->num (jnum->exact n)))
;; Double/Float .isNaN / .isInfinite (a non-flonum is neither).
((string=? method "isNaN") (and (flonum? n) (not (= n n))))

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

4
host/chez/seq.ss
View file

@ -152,9 +152,9 @@
(if (jolt-nil? s) last (loop (jolt-seq (seq-more s)) (seq-first s)))))
;; nth over a seq (walks; forces lazily). default? selects the 3-arg behavior.
(define (seq-nth coll i default? d)
(if (fx<? i 0) (if default? d (error 'nth "index out of bounds"))
(if (fx<? i 0) (if default? d (jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "index out of bounds")))
(let loop ((s (jolt-seq coll)) (i i))
(cond ((jolt-nil? s) (if default? d (error 'nth "index out of bounds")))
(cond ((jolt-nil? s) (if default? d (jolt-throw (jolt-host-throwable "java.lang.IndexOutOfBoundsException" "index out of bounds"))))
((fx=? i 0) (seq-first s))
(else (loop (jolt-seq (seq-more s)) (fx- i 1)))))))

11
host/chez/smoke.sh
View file

@ -93,6 +93,17 @@ else
fails=$((fails + 1))
fi
# A required namespace's own :as aliases must not leak into the requirer: fix.main
# aliases clojure.string as ss and requires fix.lib (which aliases clojure.set as
# ss); (ss/upper-case "hi") in main must stay clojure.string -> "HI #{1 2}".
al_out="$(JOLT_PWD="$root/test/chez/alias-leak-app" bin/joltc run -m fix.main 2>/dev/null | tail -1)"
if [ "$al_out" = "HI #{1 2}" ]; then
pass=$((pass + 1))
else
echo " FAIL: a loaded ns's alias leaked into its requirer — got \`$al_out\`, want \`HI #{1 2}\`"
fails=$((fails + 1))
fi
# Unit-checks the REPL read-until-complete predicate over balanced/unbalanced,
# string, comment and regex-literal inputs. A multi-form `joltc run` so jolt.main
# is loaded and its private var resolves; the file self-checks and prints a sentinel.

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

@ -300,7 +300,14 @@
;; --- JVM-shape stubs and trivial shells --------------------------------------
;; Pure compositions or documented jolt stubs; the host keeps nothing.
(defn enumeration-seq [e] (seq e))
;; enumeration-seq drives a java.util.Enumeration (StringTokenizer, etc.) through
;; hasMoreElements/nextElement, like the JVM; an already-seqable arg (a jolt seq —
;; some host code passes a list) just seqs.
(defn enumeration-seq [e]
(if (or (nil? e) (seq? e) (sequential? e))
(seq e)
(lazy-seq (when (.hasMoreElements e)
(cons (.nextElement e) (enumeration-seq e))))))
(defn iterator-seq [i] (seq i))
;; jolt is single-threaded: a promise is an atom, deref never blocks

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

@ -394,7 +394,18 @@
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
;; A quoted collection keeps its USER metadata (rewrite-clj coerces
;; '^:x (4 5 6) and expects the meta back), but not the reader's location keys
;; (:line/:column/:file) — like Clojure, which strips those from a quoted
;; constant. The kept metadata is itself part of the literal, so quote it.
"quote" (let [qf (second items)
m (form-coll-meta qf)
m (when (map? m)
(let [u (dissoc m :line :column :end-line :end-column :file)]
(when (seq u) u)))]
(if (nil? m)
(quote-node qf)
(invoke (var-ref "clojure.core" "with-meta") [(quote-node qf) (quote-node m)])))
"if" (do
;; 2 or 3 argument forms only (spec 03-special-forms X1)
(when (or (< (count items) 3) (> (count items) 4))

1
test/chez/alias-leak-app/deps.edn Normal file
View file

@ -0,0 +1 @@
{:paths ["src"]}

3
test/chez/alias-leak-app/src/fix/lib.clj Normal file
View file

@ -0,0 +1,3 @@
(ns fix.lib
(:require [clojure.set :as ss]))
(defn u [] (ss/union #{1} #{2}))

5
test/chez/alias-leak-app/src/fix/main.clj Normal file
View file

@ -0,0 +1,5 @@
(ns fix.main
(:require [clojure.string :as ss]
[fix.lib :as lib]))
(defn -main [& _]
(println (ss/upper-case "hi") (lib/u)))

7
test/chez/corpus.edn
View file

@ -3498,4 +3498,11 @@
{:suite "lazy / chunking" :label "chained maps each batch by 32 (result is itself chunked)" :expected "[32 32]" :actual "(let [fc (atom 0) gc (atom 0) s (map (fn [x] (swap! gc inc) x) (map (fn [x] (swap! fc inc) x) (range 1 50)))] (first s) [@fc @gc])"}
{:suite "lazy / chunking" :label "filter over a chunked range applies pred to the whole first block" :expected "32" :actual "(let [c (atom 0) s (filter (fn [x] (swap! c inc) (even? x)) (range 1 50))] (first s) @c)"}
{:suite "lazy / chunking" :label "a plain lazy seq (not chunked) realizes one element at a time" :expected "1" :actual "(let [c (atom 0) lz (fn lz [n] (lazy-seq (cons n (lz (inc n))))) s (map (fn [x] (swap! c inc) x) (lz 0))] (first s) @c)"}
{:suite "io / with-out-str" :label "with-out-str captures (.write *out* …) and print alike" :expected "\"hi!x\"" :actual "(with-out-str (.write *out* \"hi\") (.write *out* \"!\") (print \"x\"))"}
{:suite "nth / bounds" :label "nth past a vector end throws IndexOutOfBoundsException" :expected ":ok" :actual "(try (nth [1 2] 5) (catch IndexOutOfBoundsException e :ok))"}
{:suite "nth / bounds" :label "nth past a seq end throws IndexOutOfBoundsException" :expected ":ok" :actual "(try (nth (seq [1 2]) 5) (catch IndexOutOfBoundsException e :ok))"}
{:suite "assoc / bounds" :label "assoc past a vector end throws IndexOutOfBoundsException" :expected ":ok" :actual "(try (assoc [1 2] 5 :x) (catch IndexOutOfBoundsException e :ok))"}
{:suite "number / toString radix" :label ".toString(radix) renders in base, lowercase" :expected "[\"ff\" \"377\" \"1001\"]" :actual "[(.toString (biginteger 255) 16) (.toString (biginteger 255) 8) (.toString (biginteger 9) 2)]"}
{:suite "quote / metadata" :label "a quoted form keeps user metadata, drops reader location" :expected "[{:x true} nil]" :actual "[(meta (quote ^:x (1 2))) (meta (quote (1 2)))]"}
{:suite "enumeration-seq" :label "enumeration-seq drives a java.util.Enumeration (StringTokenizer)" :expected "[\"1\" \"2\" \"3\"]" :actual "(vec (enumeration-seq (java.util.StringTokenizer. \"1 2 3\")))"}
]