Dead-code removal, perf fixes, deterministic seed emission

Round 1 (correctness + dead code):
- Fix duplicate java.util.HashMap registration in host-static.ss: the alist
  impl shadowed the hashtable ctor while leaving the hashtable methods bound,
  so .keySet/.values/.remove/.clear crashed. Drop the alist version.
- Delete jolt-core/jolt/reader.clj: a 463-line dead duplicate reader, never
  required or compiled (the live reader is host/chez/reader.ss) and drifted.
- Remove dead defs: ir/rt + :rt op + unused ir/op; the Janet branch in
  clojure.edn/drain-reader; a shadowed first clojure.string/trim-newline;
  io.ss jolt-char-array + the reader def-var (both shadowed by natives-array);
  concurrency.ss jolt-future-done?*; compile-eval.ss jolt-analyze-emit.

Round 2 (perf + determinism):
- emit-quoted-map-value / quoted sets now emit sorted by emitted text instead
  of host-hash order, which isn't stable across Chez versions (jolt-8479).
- jolt-into folds through a transient, so into/vec/mapv/filterv onto a vector
  are O(n) instead of O(n^2).
- deps resolve-deps walks its queue with an index cursor (was subvec-per-pop).
- async channel and agent action queues use amortized-O(1) FIFOs; ArrayList is
  backed by a growable vector (O(1) add/get) instead of a list.
This commit is contained in:
Yogthos 2026-06-23 01:05:45 -04:00
parent adafe04072
commit e93006b4be
14 changed files with 199 additions and 656 deletions

View file

@ -21,20 +21,39 @@
(define (jolt-async-sliding-buffer n) (make-async-buffer n 'sliding))
;; --- channels ---------------------------------------------------------------
;; items: a FIFO list of (value . box); box is #f for a buffered value or a 1-slot
;; vector for an unbuffered rendezvous put (set #t when taken, waking the putter).
;; items: an amortized-O(1) FIFO held as a mutable #(out in len) — `out` is the
;; front (pop from its head), `in` holds pushed entries reversed onto it, `len` is
;; the count (an append-to-a-list FIFO is O(n) per push and O(n) to measure).
;; Each entry is (value . box); box is #f for a buffered value or a 1-slot vector
;; for an unbuffered rendezvous put (set #t when taken, waking the putter).
;; cap 0 + kind 'unbuffered = rendezvous; cap>0 with kind fixed/dropping/sliding.
(define-record-type async-chan
(fields mu cv (mutable items) cap kind (mutable closed?) (mutable xrf))
(nongenerative async-chan-v1))
(define (ac-qlen ch) (length (async-chan-items ch)))
(define (ac-qempty? ch) (null? (async-chan-items ch)))
(define (ac-qpush! ch entry) (async-chan-items-set! ch (append (async-chan-items ch) (list entry))))
(define (ac-qnew) (vector '() '() 0))
(define (ac-qlen ch) (vector-ref (async-chan-items ch) 2))
(define (ac-qempty? ch) (fx=? 0 (vector-ref (async-chan-items ch) 2)))
(define (ac-qpush! ch entry)
(let ((q (async-chan-items ch)))
(vector-set! q 1 (cons entry (vector-ref q 1)))
(vector-set! q 2 (fx+ 1 (vector-ref q 2)))))
(define (ac-qfront! q) ; ensure `out` is non-empty: out := reverse in
(when (null? (vector-ref q 0))
(vector-set! q 0 (reverse (vector-ref q 1)))
(vector-set! q 1 '())))
(define (ac-qpop! ch)
(let ((e (car (async-chan-items ch))))
(async-chan-items-set! ch (cdr (async-chan-items ch))) e))
(define (ac-qdrop-oldest! ch) (async-chan-items-set! ch (cdr (async-chan-items ch))))
(let ((q (async-chan-items ch)))
(ac-qfront! q)
(let ((out (vector-ref q 0)))
(vector-set! q 0 (cdr out))
(vector-set! q 2 (fx- (vector-ref q 2) 1))
(car out))))
(define (ac-qdrop-oldest! ch)
(let ((q (async-chan-items ch)))
(ac-qfront! q)
(vector-set! q 0 (cdr (vector-ref q 0)))
(vector-set! q 2 (fx- (vector-ref q 2) 1))))
;; enqueue honoring the buffer kind (used by the transducer step + buffered puts).
(define (ac-buf-give! ch v)
@ -54,7 +73,7 @@
((null? (cdr args)) (car args)) ; completion
(else (ac-buf-give! ch (cadr args)) (car args))))) ; step
(define (ac-make cap kind xrf) (make-async-chan (make-mutex) (make-condition) '() cap kind #f xrf))
(define (ac-make cap kind xrf) (make-async-chan (make-mutex) (make-condition) (ac-qnew) cap kind #f xrf))
;; (chan) | (chan n) | (chan buf) | (chan n|buf xform)
(define (jolt-async-chan . args)

View file

@ -62,10 +62,6 @@
(ir (jolt-ce-analyze ctx form)))
(jolt-ce-emit ir)))
;; Source string -> Scheme source string (read then analyze -> emit, all on Chez).
(define (jolt-analyze-emit src ns)
(jolt-analyze-emit-form (jolt-ce-read src) ns))
;; --- runtime defmacro -------------------------------------------------------
;; Shared with emit-image.ss (loaded after this). A defmacro lowers to a def of
;; its expander fn + a macro flag, exactly as the prelude emits build-time macros.

View file

@ -96,7 +96,6 @@
#t)))))
cancelled))
(define (jolt-future-done?* f) (and (jolt-future? f) (jolt-future-done? f)))
(define (jolt-native-future-done? x)
(if (jolt-future? x) (jolt-future-done? x)
(jolt-throw (jolt-ex-info "future-done? requires a future" (jolt-hash-map)))))
@ -158,22 +157,34 @@
(let loop ((o opts) (validator jolt-nil))
(cond
((or (null? o) (null? (cdr o)))
(make-jolt-agent state jolt-nil validator '() #f (make-mutex) (make-condition)))
(make-jolt-agent state jolt-nil validator (vector '() '()) #f (make-mutex) (make-condition)))
((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "validator"))
(loop (cddr o) (cadr o)))
(else (loop (cddr o) validator)))))
;; The action queue is an amortized-O(1) FIFO held as a mutable #(out in): `out` is
;; the front, `in` holds sends reversed onto it (an append-to-a-list send was O(n)).
;; All three helpers run under the agent mutex.
(define (jagent-q-empty? a)
(let ((q (jolt-agent-queue a))) (and (null? (vector-ref q 0)) (null? (vector-ref q 1)))))
(define (jagent-q-push! a entry)
(let ((q (jolt-agent-queue a))) (vector-set! q 1 (cons entry (vector-ref q 1)))))
(define (jagent-q-pop! a)
(let ((q (jolt-agent-queue a)))
(when (null? (vector-ref q 0))
(vector-set! q 0 (reverse (vector-ref q 1))) (vector-set! q 1 '()))
(let ((out (vector-ref q 0))) (vector-set! q 0 (cdr out)) (car out))))
;; Drain the queue, applying each action (f state arg*) outside the lock (an action
;; may send/deref the same agent). A validator rejection or a thrown action puts the
;; agent in an error state and halts the queue (JVM :fail mode).
(define (jolt-agent-worker a)
(let loop ()
(let ((act (with-mutex (jolt-agent-mu a)
(if (or (not (jolt-nil? (jolt-agent-err a))) (null? (jolt-agent-queue a)))
(if (or (not (jolt-nil? (jolt-agent-err a))) (jagent-q-empty? a))
(begin (jolt-agent-running?-set! a #f)
(condition-broadcast (jolt-agent-cv a)) #f)
(let ((x (car (jolt-agent-queue a))))
(jolt-agent-queue-set! a (cdr (jolt-agent-queue a))) x)))))
(jagent-q-pop! a)))))
(when act
(guard (e (#t (with-mutex (jolt-agent-mu a)
(jolt-agent-err-set! a e)
@ -190,7 +201,7 @@
;; the JVM's fixed/cached pool split.)
(define (jolt-agent-send a f . args)
(with-mutex (jolt-agent-mu a)
(jolt-agent-queue-set! a (append (jolt-agent-queue a) (list (cons f args))))
(jagent-q-push! a (cons f args))
(unless (jolt-agent-running? a)
(jolt-agent-running?-set! a #t)
(fork-thread (lambda () (jolt-agent-worker a)))))
@ -202,7 +213,7 @@
(lambda (a)
(with-mutex (jolt-agent-mu a)
(let loop ()
(when (or (jolt-agent-running? a) (pair? (jolt-agent-queue a)))
(when (or (jolt-agent-running? a) (not (jagent-q-empty? a)))
(condition-wait (jolt-agent-cv a) (jolt-agent-mu a)) (loop)))))
agents)
jolt-nil)

View file

@ -427,12 +427,41 @@
(register-class-ctor! "Object" (lambda _ (make-jhost "object" (vector))))
;; ---- java.util.ArrayList ----------------------------------------------------
;; A mutable list backed by a Scheme list in a box. medley's stateful transducers
;; (window / partition-between) build one with .add / .size / .toArray / .clear /
;; .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll).
(define (al-list self) (vector-ref (jhost-state self) 0))
(define (al-set! self xs) (vector-set! (jhost-state self) 0 xs))
(define (make-arraylist xs) (make-jhost "arraylist" (vector xs)))
;; A mutable list backed by a growable Scheme vector. State is #(backing count);
;; .add amortizes O(1) and .get is O(1) (a list backing made both O(n)). medley's
;; stateful transducers (window / partition-between) build one with .add / .size /
;; .toArray / .clear / .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll).
(define al-min-cap 8)
(define (al-vec self) (vector-ref (jhost-state self) 0))
(define (al-cnt self) (vector-ref (jhost-state self) 1))
(define (al-cnt! self n) (vector-set! (jhost-state self) 1 n))
(define (make-arraylist xs) ; xs: a Scheme list of initial elements
(let* ((n (length xs)) (cap (fxmax al-min-cap n)) (v (make-vector cap jolt-nil)))
(let loop ((i 0) (xs xs)) (when (pair? xs) (vector-set! v i (car xs)) (loop (fx+ i 1) (cdr xs))))
(make-jhost "arraylist" (vector v n))))
(define (al-ensure! self need) ; grow the backing vector (doubling) to fit `need`
(let ((v (al-vec self)))
(when (fx>? need (vector-length v))
(let grow ((cap (fxmax al-min-cap (vector-length v))))
(if (fx<? cap need) (grow (fx* cap 2))
(let ((nv (make-vector cap jolt-nil)))
(let cp ((i 0)) (when (fx<? i (al-cnt self)) (vector-set! nv i (vector-ref v i)) (cp (fx+ i 1))))
(vector-set! (jhost-state self) 0 nv)))))))
(define (al-push! self x)
(let ((n (al-cnt self))) (al-ensure! self (fx+ n 1)) (vector-set! (al-vec self) n x) (al-cnt! self (fx+ n 1))))
(define (al-insert-at! self i x)
(let ((n (al-cnt self)))
(al-ensure! self (fx+ n 1))
(let ((v (al-vec self)))
(let shift ((j n)) (when (fx>? j i) (vector-set! v j (vector-ref v (fx- j 1))) (shift (fx- j 1))))
(vector-set! v i x) (al-cnt! self (fx+ n 1)))))
(define (al-remove-at! self i)
(let ((n (al-cnt self)) (v (al-vec self)))
(let shift ((j i)) (when (fx<? j (fx- n 1)) (vector-set! v j (vector-ref v (fx+ j 1))) (shift (fx+ j 1))))
(vector-set! v (fx- n 1) jolt-nil) (al-cnt! self (fx- n 1))))
(define (al->list self) ; first `count` elements as a Scheme list
(let ((v (al-vec self)))
(let loop ((i (fx- (al-cnt self) 1)) (acc '())) (if (fx<? i 0) acc (loop (fx- i 1) (cons (vector-ref v i) acc))))))
(register-class-ctor! "ArrayList"
(lambda args
(cond ((null? args) (make-arraylist '()))
@ -443,34 +472,28 @@
(cond ((null? args) (make-arraylist '()))
((number? (car args)) (make-arraylist '()))
(else (make-arraylist (seq->list (jolt-seq (car args))))))))
(define (al-remove-at xs i)
(let loop ((xs xs) (i i) (acc '()))
(cond ((null? xs) (reverse acc))
((= i 0) (append (reverse acc) (cdr xs)))
(else (loop (cdr xs) (- i 1) (cons (car xs) acc))))))
(register-host-methods! "arraylist"
(list
(cons "add" (lambda (self . a)
;; (.add x) -> append+true; (.add i x) -> insert at i, returns nil.
(if (= 1 (length a))
(begin (al-set! self (append (al-list self) (list (car a)))) #t)
(let ((i (jnum->exact (car a))) (x (cadr a)) (xs (al-list self)))
(al-set! self (append (list-head xs i) (list x) (list-tail xs i))) jolt-nil))))
(cons "add!" (lambda (self x) (al-set! self (append (al-list self) (list x))) #t))
(cons "get" (lambda (self i) (list-ref (al-list self) (jnum->exact i))))
(begin (al-push! self (car a)) #t)
(begin (al-insert-at! self (jnum->exact (car a)) (cadr a)) jolt-nil))))
(cons "add!" (lambda (self x) (al-push! self x) #t))
(cons "get" (lambda (self i) (vector-ref (al-vec self) (jnum->exact i))))
(cons "set" (lambda (self i x)
(let* ((xs (al-list self)) (idx (jnum->exact i)) (old (list-ref xs idx)))
(al-set! self (append (list-head xs idx) (list x) (list-tail xs (+ idx 1)))) old)))
(cons "size" (lambda (self) (->num (length (al-list self)))))
(cons "isEmpty" (lambda (self) (null? (al-list self))))
(let* ((idx (jnum->exact i)) (old (vector-ref (al-vec self) idx)))
(vector-set! (al-vec self) idx x) old)))
(cons "size" (lambda (self) (->num (al-cnt self))))
(cons "isEmpty" (lambda (self) (fx=? 0 (al-cnt self))))
(cons "remove" (lambda (self i)
(let* ((xs (al-list self)) (idx (jnum->exact i)) (old (list-ref xs idx)))
(al-set! self (al-remove-at xs idx)) old)))
(cons "clear" (lambda (self) (al-set! self '()) jolt-nil))
(cons "contains" (lambda (self x) (and (memp (lambda (e) (jolt=2 e x)) (al-list self)) #t)))
(cons "toArray" (lambda (self . _) (apply jolt-vector (al-list self))))
(cons "iterator" (lambda (self) (make-jiterator (list->cseq (al-list self)))))
(cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al-list self)))))))
(let* ((idx (jnum->exact i)) (old (vector-ref (al-vec self) idx)))
(al-remove-at! self idx) old)))
(cons "clear" (lambda (self) (vector-set! (jhost-state self) 0 (make-vector al-min-cap jolt-nil)) (al-cnt! self 0) jolt-nil))
(cons "contains" (lambda (self x) (and (memp (lambda (e) (jolt=2 e x)) (al->list self)) #t)))
(cons "toArray" (lambda (self . _) (apply jolt-vector (al->list self))))
(cons "iterator" (lambda (self) (make-jiterator (list->cseq (al->list self)))))
(cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self)))))))
(register-class-ctor! "StringBuilder"
(lambda args (make-jhost "string-builder"
@ -631,32 +654,6 @@
jolt-nil))
(cons "close" (lambda (self) jolt-nil))))
;; ---- HashMap ----------------------------------------------------------------
;; state: a box holding an alist of (k . v), jolt= keyed.
(define (hm-alist self) (vector-ref (jhost-state self) 0))
(define (hm-set! self al) (vector-set! (jhost-state self) 0 al))
(define (hm-assoc al k v)
(let loop ((ps al) (acc '()) (hit #f))
(cond ((null? ps) (reverse (if hit acc (cons (cons k v) acc))))
((jolt=2 (caar ps) k) (loop (cdr ps) (cons (cons k v) acc) #t))
(else (loop (cdr ps) (cons (car ps) acc) hit)))))
(define (hm-get al k) (let loop ((ps al)) (cond ((null? ps) jolt-nil) ((jolt=2 (caar ps) k) (cdar ps)) (else (loop (cdr ps))))))
(define (coll->pairs m)
(if (jolt-nil? m) '()
(let loop ((s (jolt-seq m)) (acc '()))
(if (jolt-nil? s) (reverse acc)
(let ((e (seq-first s))) (loop (jolt-seq (seq-more s)) (cons (cons (jolt-nth e 0) (jolt-nth e 1)) acc)))))))
(register-class-ctor! "HashMap"
(lambda args
(let ((init (and (pair? args) (car args))))
(make-jhost "hashmap" (vector (if (and init (not (number? init))) (coll->pairs init) '()))))))
(register-host-methods! "hashmap"
(list (cons "get" (lambda (self k) (hm-get (hm-alist self) k)))
(cons "put" (lambda (self k v) (hm-set! self (hm-assoc (hm-alist self) k v)) v))
(cons "putAll" (lambda (self m) (for-each (lambda (p) (hm-set! self (hm-assoc (hm-alist self) (car p) (cdr p)))) (coll->pairs m)) jolt-nil))
(cons "containsKey" (lambda (self k) (not (jolt-nil? (hm-get (hm-alist self) k)))))
(cons "size" (lambda (self) (->num (length (hm-alist self)))))))
;; ---- StringTokenizer --------------------------------------------------------
;; state: a vector #(tokens-list pos)
(define (tokenize s delims)

View file

@ -261,18 +261,6 @@
(def-var! "clojure.core" "spit" jolt-spit)
(def-var! "clojure.core" "flush" jolt-flush)
;; --- char-array: a seq of chars over a string (the JVM char[]). io/reader's
;; char[] branch + selmer's (char-array template) feed on this.
;; char-array (string -> chars). A leaf array native; lives here as io/reader
;; is its only Chez consumer so far.
(define (jolt-char-array a . rest)
(cond
((string? a) (list->cseq (string->list a)))
((number? a) (list->cseq (make-list (exact (truncate a)) #\nul)))
(else (list->cseq (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c)))))
(seq->list a))))))
(def-var! "clojure.core" "char-array" jolt-char-array)
;; --- with-open's close seam (__close): a map-like value closes via its :close
;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything
;; else is an error.
@ -323,7 +311,8 @@
;; --- clojure.java.io ns -----------------------------------------------------
(def-var! "clojure.java.io" "file" jolt-make-file)
(def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x)))))
(def-var! "clojure.java.io" "reader" jolt-io-reader)
;; "reader" is bound by natives-array.ss (loaded later) so a char[] argument is
;; handled; that binding delegates here via jolt-io-reader for everything else.
(def-var! "clojure.java.io" "writer" jolt-io-writer)
(def-var! "clojure.java.io" "input-stream" jolt-io-reader)
(def-var! "clojure.java.io" "output-stream" jolt-io-writer)

File diff suppressed because one or more lines are too long

View file

@ -1063,7 +1063,7 @@
(guard (e (#t #f))
(def-var! "clojure.edn" "read-string" (letrec ((read-string (case-lambda ((s) (let fnrec93 ((s s)) (jolt-invoke (var-deref "clojure.edn" "read-edn") (jolt-hash-map) s))) ((opts s) (let fnrec94 ((opts opts) (s s)) (jolt-invoke (var-deref "clojure.edn" "read-edn") opts s)))))) read-string)))
(guard (e (#t #f))
(def-var! "clojure.edn" "drain-reader" (letrec ((drain-reader (lambda (reader) (let fnrec95 ((reader reader)) (if (jolt= (keyword "core" "file") (host-static-call "janet" "type" reader)) (host-static-call "janet.file" "read" reader (keyword #f "all")) (let* ((acc (jolt-invoke (var-deref "clojure.core" "transient") (jolt-vector))) (c (record-method-dispatch reader "read" (jolt-vector)))) (let loop96 ((acc acc) (c c)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "==") -1 c)) (jolt-apply (var-deref "clojure.core" "str") (jolt-map (var-deref "clojure.core" "char") (jolt-invoke (var-deref "clojure.core" "persistent!") acc))) (let* ((_a$97 (jolt-invoke (var-deref "clojure.core" "conj!") acc c)) (_a$98 (record-method-dispatch reader "read" (jolt-vector)))) (loop96 _a$97 _a$98)))))))))) drain-reader)))
(def-var! "clojure.edn" "drain-reader" (letrec ((drain-reader (lambda (reader) (let fnrec95 ((reader reader)) (let* ((acc (jolt-invoke (var-deref "clojure.core" "transient") (jolt-vector))) (c (record-method-dispatch reader "read" (jolt-vector)))) (let loop96 ((acc acc) (c c)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "==") -1 c)) (jolt-apply (var-deref "clojure.core" "str") (jolt-map (var-deref "clojure.core" "char") (jolt-invoke (var-deref "clojure.core" "persistent!") acc))) (let* ((_a$97 (jolt-invoke (var-deref "clojure.core" "conj!") acc c)) (_a$98 (record-method-dispatch reader "read" (jolt-vector)))) (loop96 _a$97 _a$98))))))))) drain-reader)))
(guard (e (#t #f))
(def-var! "clojure.edn" "read" (letrec ((read (case-lambda ((reader) (let fnrec99 ((reader reader)) (jolt-invoke read (jolt-hash-map) reader))) ((opts reader) (let fnrec100 ((opts opts) (reader reader)) (jolt-invoke (var-deref "clojure.edn" "read-edn") opts (jolt-invoke (var-deref "clojure.edn" "drain-reader") reader))))))) read)))
(guard (e (#t #f))

View file

@ -206,7 +206,13 @@
(if (jolt-reduced? r) (jolt-reduced-val r) r))))
(else (reduce-seq f init (jolt-seq coll)))))))
(define (jolt-into to from) (reduce-seq (lambda (acc x) (jolt-conj1 acc x)) to (jolt-seq from)))
;; Fold through a transient so a pvec/pmap/pset target is built in O(n): a
;; persistent pvec-conj copies its whole backing vector each step, making a naive
;; fold O(n^2) (and into/vec/mapv/filterv all route here). jolt-transient-new
;; falls back to a copy-on-write wrapper for other targets (lists, sorted colls,
;; nil), so those keep the old per-step jolt-conj behaviour.
(define (jolt-into to from)
(jolt-persistent! (reduce-seq (lambda (t x) (jolt-conj! t x)) (jolt-transient-new to) (jolt-seq from))))
(define (range-from n) (cseq-lazy n (lambda () (range-from (+ n 1)))))
(define (range-bounded n end step)