pqueue: Clojure-style persistent FIFO queue on top of srfi-134
ober
aae5acfa695de2ff2f0ace37f9d17ae97d7c5a86
--- a/docs/clojure-remaining.md +++ b/docs/clojure-remaining.md @@ -1698,14 +1698,14 @@ in this doc. **[deferred]** items are non-goals. | `in-pmap`/`in-pset`/iterators | [current] | — | | `get`/`assoc`/`dissoc`/`merge` | [current] `(std clojure)` | — | | `get-in`/`assoc-in`/`update-in` | [current] `(std misc nested)` | — | -| `conj`/`peek`/`pop` polymorphism | [current] (mostly) | §4.2 adds pqueue | +| `conj`/`peek`/`pop` polymorphism | [current] (list/pvec/pqueue/set/map) | §4.2 landed | | `first`/`rest`/`next`/`last` | [current] | — | | `reduce`/`into`/`range`/`seq` | [current] | §4.1 into-pmap | | `inc`/`dec`/`count`/`empty?` | [current] | — | | `hash-map`/`hash-set`/`vec` constructors | [current] | — | | Atoms + deref/swap!/reset!/CAS | [current] | — | | Transducer ↔ pmap/pset bridge | [current] `(std transducer)` | §4.1 landed | -| PersistentQueue | [gap] (ideque exists) | §4.2 | +| PersistentQueue | [current] `(std pqueue)` | §4.2 landed | | Sorted-set | [gap] | §4.3 | | Metadata (`with-meta`/`meta`) | [gap] | §4.4 | | `defmulti`/`defmethod` value-dispatch | [gap] | §4.5 | --- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -42,6 +42,7 @@ merge update select-keys first rest next last conj cons* empty? + peek pop reduce into range seq =? hash inc dec @@ -79,7 +80,13 @@ atom atom? deref reset! swap! compare-and-set! ;; ---- Re-exports from (std misc nested) ---- - get-in assoc-in update-in) + get-in assoc-in update-in + + ;; ---- Re-exports from (std pqueue) ---- + persistent-queue pqueue-empty pqueue? + pqueue-conj pqueue-peek pqueue-pop + pqueue-count pqueue->list + pqueue-empty? list->pqueue) (import (except (chezscheme) make-hash-table hash-table? @@ -101,7 +108,8 @@ (persistent-set! pset-persistent!)) (std concur hash) (std misc atom) - (std misc nested)) + (std misc nested) + (std pqueue)) ;; ========================================================================= ;; Numerics @@ -372,9 +380,10 @@ ;; Clojure's conj: ;; - list: prepend - ;; - vector: append + ;; - vector: append (both mutable Chez vectors and persistent vectors) ;; - map: must be a [k v] pair; assoc ;; - set: add element + ;; - queue: enqueue at the back (define (conj coll . xs) (cond [(null? coll) @@ -386,6 +395,19 @@ [(vector? coll) ;; Build a new vector (list->vector (append (vector->list coll) xs))] + [(persistent-vector? coll) + (let loop ([v coll] [rest xs]) + (if (null? rest) v + (loop (persistent-vector-append v (car rest)) (cdr rest))))] + [(pqueue? coll) + ;; NOTE: pqueue? is srfi-134's ideque predicate, which is a + ;; superset of "queue" — any ideque passed in is treated as a + ;; queue. This branch must precede the persistent-map? check + ;; because ideques are records distinct from pmap, but we want + ;; the polymorphism to be unambiguous. + (let loop ([q coll] [rest xs]) + (if (null? rest) q + (loop (pqueue-conj q (car rest)) (cdr rest))))] [(persistent-map? coll) ;; Expect (k . v) pairs or (list k v) (let loop ([m coll] [rest xs]) @@ -405,6 +427,43 @@ (loop (persistent-set-add s (car rest)) (cdr rest))))] [else (error 'conj "unsupported collection type" coll)])) + ;; ========================================================================= + ;; peek / pop — Clojure's stack/queue surface + ;; + ;; Clojure defines these on "stack-like" collections with type- + ;; specific ends: + ;; - list: peek = first, pop = rest + ;; - persistent-vector: peek = last, pop = drop-last (stack end) + ;; - persistent-queue: peek = front, pop = drop-front (FIFO end) + ;; Calling either on an empty coll returns nil (#f) for peek and + ;; raises for pop, mirroring clojure.lang.IPersistentStack. + ;; ========================================================================= + + (define (peek coll) + (cond + [(or (eq? coll #f) (null? coll)) #f] + [(pair? coll) (car coll)] + [(pqueue? coll) (pqueue-peek coll)] + [(persistent-vector? coll) + (let ([n (persistent-vector-length coll)]) + (if (zero? n) #f (persistent-vector-ref coll (- n 1))))] + [(vector? coll) + (let ([n (vector-length coll)]) + (if (zero? n) #f (vector-ref coll (- n 1))))] + [else (error 'peek "unsupported collection type" coll)])) + + (define (pop coll) + (cond + [(null? coll) (error 'pop "cannot pop from an empty list")] + [(pair? coll) (cdr coll)] + [(pqueue? coll) (pqueue-pop coll)] + [(persistent-vector? coll) + (let ([n (persistent-vector-length coll)]) + (cond + [(zero? n) (error 'pop "cannot pop from an empty vector")] + [else (persistent-vector-slice coll 0 (- n 1))]))] + [else (error 'pop "unsupported collection type" coll)])) + ;; cons* — Chez's built-in cons* has identical semantics to Clojure's list*: ;; (cons* 1 2 3 '(4 5)) → (1 2 3 4 5). Re-used below as list*. new file mode 100644 --- /dev/null +++ b/lib/std/pqueue.sls @@ -0,0 +1,74 @@ +#!chezscheme +;;; (std pqueue) — Persistent FIFO queue +;;; +;;; A thin compatibility wrapper over `(std srfi srfi-134)` ideques +;;; that exposes Clojure's `PersistentQueue` surface: `pqueue-empty`, +;;; `pqueue-conj` (enqueue at the back), `pqueue-peek` (look at the +;;; front), `pqueue-pop` (dequeue from the front). Ideques are +;;; doubly-ended and provide a superset of what a queue needs, but +;;; this module intentionally only exposes the FIFO operations so that +;;; the type can later be swapped for a dedicated single-ended queue +;;; without breaking callers. +;;; +;;; This module is re-exported from `(std clojure)` with the Clojure +;;; names `peek` and `pop` wired up polymorphically across pairs, +;;; persistent vectors, and persistent queues. +;;; +;;; API: +;;; persistent-queue — variadic constructor +;;; pqueue-empty — empty queue constant +;;; pqueue? — predicate +;;; pqueue-conj q x — enqueue one item, returns new queue +;;; pqueue-peek q — front element, or #f when empty +;;; pqueue-pop q — drop front, returns new queue +;;; (#f or same-empty-queue if empty) +;;; pqueue-count q — number of queued items +;;; pqueue->list q — front-to-back list +;;; list->pqueue lst — build from a list +;;; pqueue-empty? q — empty predicate + +(library (std pqueue) + (export persistent-queue pqueue-empty pqueue? + pqueue-conj pqueue-peek pqueue-pop + pqueue-count pqueue->list + list->pqueue pqueue-empty?) + + (import (chezscheme) + (std srfi srfi-134)) + + ;; The empty queue is just an empty ideque. `pqueue-empty` is a + ;; fresh ideque each library load — because ideques are mutable + ;; internally we avoid aliasing a single instance across threads. + (define pqueue-empty (ideque)) + + ;; Variadic constructor: (persistent-queue 1 2 3) → front=1, back=3. + (define (persistent-queue . items) + (list->ideque items)) + + (define (list->pqueue items) + (list->ideque items)) + + (define pqueue? ideque?) + + (define (pqueue-conj q x) + ;; ideque-add-back is O(1) amortized — matching Clojure's + ;; PersistentQueue.conj which appends to the tail. + (ideque-add-back q x)) + + (define (pqueue-peek q) + ;; Clojure's peek returns nil on an empty queue. We model nil + ;; as #f so callers can use `or` / `when-let` ergonomically. + (if (ideque-empty? q) #f (ideque-front q))) + + (define (pqueue-pop q) + ;; pop on an empty queue: Clojure raises. We preserve that so + ;; programs that shouldn't be popping an empty queue fail loud. + (if (ideque-empty? q) + (error 'pqueue-pop "cannot pop from an empty queue") + (ideque-remove-front q))) + + (define pqueue-count ideque-length) + (define pqueue->list ideque->list) + (define pqueue-empty? ideque-empty?) + +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-pqueue.ss @@ -0,0 +1,192 @@ +#!chezscheme +;;; Tests for (std pqueue) and Clojure's peek/pop polymorphism. +;;; +;;; Exercises the pqueue-* primitives directly and verifies the +;;; polymorphic conj/peek/pop dispatch in (std clojure) handles +;;; lists, persistent vectors, and persistent queues. + +(import (chezscheme) + (std pqueue) + (std pvec) + (std clojure)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))])) + +(define-syntax test-true + (syntax-rules () + [(_ name expr) + (test name (if expr #t #f) #t)])) + +(printf "--- (std pqueue) + Clojure peek/pop ---~%~%") + +;;; ===== pqueue primitives ===== + +(test "pqueue-empty is empty" + (pqueue-empty? pqueue-empty) + #t) + +(test "pqueue? accepts the empty queue" + (pqueue? pqueue-empty) + #t) + +(test "pqueue? rejects plain list" + (pqueue? '(1 2 3)) + #f) + +(test "persistent-queue constructor builds front-to-back" + (pqueue->list (persistent-queue 1 2 3 4)) + '(1 2 3 4)) + +(test "pqueue-conj appends at the back" + (pqueue->list + (pqueue-conj (pqueue-conj (pqueue-conj pqueue-empty 'a) 'b) 'c)) + '(a b c)) + +(test "pqueue-peek returns the front" + (pqueue-peek (persistent-queue 10 20 30)) + 10) + +(test "pqueue-peek on empty returns #f" + (pqueue-peek pqueue-empty) + #f) + +(test "pqueue-pop drops the front" + (pqueue->list (pqueue-pop (persistent-queue 1 2 3))) + '(2 3)) + +(test "pqueue-pop twice" + (pqueue->list (pqueue-pop (pqueue-pop (persistent-queue 1 2 3)))) + '(3)) + +(test "pqueue-count" + (pqueue-count (persistent-queue 'a 'b 'c 'd)) + 4) + +(test "list->pqueue round-trips" + (pqueue->list (list->pqueue '(x y z))) + '(x y z)) + +;;; ===== conj polymorphism — existing types still work ===== + +(test "conj on list prepends" + (conj '(1 2 3) 0) + '(0 1 2 3)) + +(test "conj on mutable vector appends" + (conj (vector 1 2 3) 4) + (vector 1 2 3 4)) + +;;; ===== conj on persistent vector ===== + +(test "conj on persistent-vector appends" + (persistent-vector->list + (conj (persistent-vector 1 2 3) 4)) + '(1 2 3 4)) + +(test "conj on persistent-vector multiple" + (persistent-vector->list + (conj (persistent-vector 1) 2 3 4)) + '(1 2 3 4)) + +;;; ===== conj on pqueue ===== + +(test "conj on pqueue single" + (pqueue->list (conj pqueue-empty 'x)) + '(x)) + +(test "conj on pqueue multiple — order preserved" + (pqueue->list (conj (persistent-queue 1 2) 3 4 5)) + '(1 2 3 4 5)) + +;;; ===== peek polymorphism ===== + +(test "peek list = first" + (peek '(10 20 30)) + 10) + +(test "peek empty list is #f" + (peek '()) + #f) + +(test "peek pqueue = front" + (peek (persistent-queue 'a 'b 'c)) + 'a) + +(test "peek empty pqueue is #f" + (peek pqueue-empty) + #f) + +(test "peek persistent-vector = last (stack end)" + (peek (persistent-vector 1 2 3 4)) + 4) + +(test "peek empty persistent-vector is #f" + (peek (persistent-vector)) + #f) + +(test "peek mutable vector = last" + (peek (vector 'x 'y 'z)) + 'z) + +;;; ===== pop polymorphism ===== + +(test "pop list = rest" + (pop '(1 2 3 4)) + '(2 3 4)) + +(test "pop pqueue = drop front" + (pqueue->list (pop (persistent-queue 1 2 3 4))) + '(2 3 4)) + +(test "pop persistent-vector = drop last (stack end)" + (persistent-vector->list + (pop (persistent-vector 1 2 3 4))) + '(1 2 3)) + +(test "pop persistent-vector until empty" + (persistent-vector->list + (pop (pop (pop (persistent-vector 1 2 3))))) + '()) + +;;; ===== Queue used as a work queue — FIFO semantics ===== + +(test "pqueue FIFO drain via peek + pop" + (let loop ([q (persistent-queue 'a 'b 'c 'd)] [acc '()]) + (if (pqueue-empty? q) + (reverse acc) + (loop (pop q) (cons (peek q) acc)))) + '(a b c d)) + +;;; ===== Empty-queue semantics ===== + +(test "pop on empty pqueue raises" + (guard (exn [#t 'raised]) + (pop pqueue-empty)) + 'raised) + +(test "pop on empty list raises" + (guard (exn [#t 'raised]) + (pop '())) + 'raised) + +(test "pop on empty persistent-vector raises" + (guard (exn [#t 'raised]) + (pop (persistent-vector))) + 'raised) + +(printf "~%~a tests: ~a passed, ~a failed~%" + (+ pass fail) pass fail) +(when (> fail 0) (exit 1))