Rename src/jolt -> stdlib (the runtime-loaded layer; jolt-core stays the seed-baked layer) and update the loader / emit-image / doc paths. Drop dead code: the spike/ experiments, the duplicate clojuredocs-export.edn (json moves to tools/), the Janet-era jolt.http binding, and the orphaned persistent_vector.clj whose ns/path didn't even match. Strip porting residue from comments and docstrings across host/chez, jolt-core, stdlib, tests, and docs: internal issue ids, "Phase N" markers, and the "vs Janet" historical exposition, leaving present-tense descriptions and the real JVM-Clojure semantic contrasts. Same pass over the corpus suite labels. The seed is unchanged (docstrings/comments aren't emitted), so the self-host fixpoint and corpus are untouched. Port tools/spec_coverage.py off the dead janet probe to bin/joltc and regenerate coverage.md; drop the dead :host/janet rule from certify.clj and regenerate the conformance profile. Add docs/host-interop.md (the JVM shims and how to register your own host class from a library) and a writing-style note in CLAUDE.md. Stabilize the four racy concurrency corpus cases (future-cancel and agent send/send-off): give the future a sleeping body and the agent a slow action, so cancel reliably catches an in-flight future and deref reliably reads the pre-update snapshot. They certify deterministically now, so drop their :flaky allowlist entries and the orphaned legend.
73 lines
4.2 KiB
Scheme
73 lines
4.2 KiB
Scheme
;; natives-queue.ss — clojure.lang.PersistentQueue for the Chez host.
|
|
;;
|
|
;; A functional queue: a `front` Scheme list (the dequeue end, head = front of the
|
|
;; queue) + a reversed `rear` Scheme list (the enqueue end, head = most recent).
|
|
;; conj adds to rear; peek/first read front; pop drops the front, rebalancing
|
|
;; rear->front when front empties — amortized O(1). A queue is jolt-sequential?, so
|
|
;; seq=?/seq-hash give cross-type equality (= [1 2 3] (queue 1 2 3)) for free, like
|
|
;; the JVM. Loaded after seq/collections/lazy-bridge/records/host-table so every
|
|
;; dispatcher it chains is at its latest binding.
|
|
|
|
(define-record-type jolt-queue (fields front rear cnt) (nongenerative jolt-queue-v1))
|
|
(define jolt-queue-empty (make-jolt-queue '() '() 0))
|
|
|
|
(define (queue-conj q x)
|
|
(if (null? (jolt-queue-front q))
|
|
(make-jolt-queue (list x) '() (fx+ (jolt-queue-cnt q) 1))
|
|
(make-jolt-queue (jolt-queue-front q) (cons x (jolt-queue-rear q)) (fx+ (jolt-queue-cnt q) 1))))
|
|
(define (queue->list q) (append (jolt-queue-front q) (reverse (jolt-queue-rear q))))
|
|
(define (queue-peek q) (if (null? (jolt-queue-front q)) jolt-nil (car (jolt-queue-front q))))
|
|
(define (queue-pop q)
|
|
(let ((f (jolt-queue-front q)))
|
|
(cond ((null? f) (error 'pop "can't pop empty queue"))
|
|
((null? (cdr f)) (make-jolt-queue (reverse (jolt-queue-rear q)) '() (fx- (jolt-queue-cnt q) 1)))
|
|
(else (make-jolt-queue (cdr f) (jolt-queue-rear q) (fx- (jolt-queue-cnt q) 1))))))
|
|
|
|
;; --- extend the collection dispatchers to see a jolt-queue ------------------
|
|
(define %q-seq jolt-seq)
|
|
(set! jolt-seq (lambda (x) (if (jolt-queue? x)
|
|
(let ((l (queue->list x))) (if (null? l) jolt-nil (list->cseq l)))
|
|
(%q-seq x))))
|
|
(define %q-count jolt-count)
|
|
(set! jolt-count (lambda (x) (if (jolt-queue? x) (jolt-queue-cnt x) (%q-count x))))
|
|
(define %q-empty? jolt-empty?)
|
|
(set! jolt-empty? (lambda (x) (if (jolt-queue? x) (fx=? 0 (jolt-queue-cnt x)) (%q-empty? x))))
|
|
(define %q-peek jolt-peek)
|
|
(set! jolt-peek (lambda (x) (if (jolt-queue? x) (queue-peek x) (%q-peek x))))
|
|
(define %q-pop jolt-pop)
|
|
(set! jolt-pop (lambda (x) (if (jolt-queue? x) (queue-pop x) (%q-pop x))))
|
|
(define %q-conj1 jolt-conj1)
|
|
(set! jolt-conj1 (lambda (coll x) (if (jolt-queue? coll) (queue-conj coll x) (%q-conj1 coll x))))
|
|
;; sequential => seq=?/seq-hash handle queue equality + hashing.
|
|
(define %q-sequential? jolt-sequential?)
|
|
(set! jolt-sequential? (lambda (x) (or (jolt-queue? x) (%q-sequential? x))))
|
|
|
|
;; printing: render the elements as a parenthesized list (delegate to the seq path).
|
|
(define (jolt-seq-or-empty x) (let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-empty-list s)))
|
|
(define %q-pr-readable jolt-pr-readable)
|
|
(set! jolt-pr-readable (lambda (x) (if (jolt-queue? x) (%q-pr-readable (jolt-seq-or-empty x)) (%q-pr-readable x))))
|
|
(define %q-str-render-one jolt-str-render-one)
|
|
(set! jolt-str-render-one (lambda (x) (if (jolt-queue? x) (%q-str-render-one (jolt-seq-or-empty x)) (%q-str-render-one x))))
|
|
|
|
;; class / type / instance? recognize a queue.
|
|
(define %q-class jolt-class)
|
|
(set! jolt-class (lambda (x) (if (jolt-queue? x) "clojure.lang.PersistentQueue" (%q-class x))))
|
|
(def-var! "clojure.core" "class" jolt-class)
|
|
(define %q-instance-check instance-check)
|
|
(set! instance-check
|
|
(lambda (type-sym val)
|
|
(if (jolt-queue? val)
|
|
(let ((tn (cond ((string? type-sym) type-sym)
|
|
((symbol-t? type-sym) (symbol-t-name type-sym)) (else ""))))
|
|
(and (member (last-dot tn)
|
|
'("PersistentQueue" "IPersistentCollection" "Sequential" "Collection" "Object"))
|
|
#t))
|
|
(%q-instance-check type-sym val))))
|
|
(def-var! "clojure.core" "instance-check" instance-check)
|
|
|
|
;; clojure.lang.PersistentQueue/EMPTY + a queue? predicate.
|
|
(register-class-statics! "PersistentQueue" (list (cons "EMPTY" jolt-queue-empty)))
|
|
(register-class-statics! "clojure.lang.PersistentQueue" (list (cons "EMPTY" jolt-queue-empty)))
|
|
(def-var! "clojure.core" "queue?" (lambda (x) (jolt-queue? x)))
|
|
;; the FQ class token self-evaluates (for (instance? clojure.lang.PersistentQueue …)).
|
|
(def-var! "clojure.core" "clojure.lang.PersistentQueue" "clojure.lang.PersistentQueue")
|