transducer: bridge pmap/pset/pvec as sources and destinations
ober
90c9f508352a324537f4c3ba2293ee1316797e43
--- a/docs/clojure-remaining.md +++ b/docs/clojure-remaining.md @@ -1704,7 +1704,7 @@ in this doc. **[deferred]** items are non-goals. | `inc`/`dec`/`count`/`empty?` | [current] | — | | `hash-map`/`hash-set`/`vec` constructors | [current] | — | | Atoms + deref/swap!/reset!/CAS | [current] | — | -| Transducer ↔ pmap/pset bridge | [gap] | §4.1 | +| Transducer ↔ pmap/pset bridge | [current] `(std transducer)` | §4.1 landed | | PersistentQueue | [gap] (ideque exists) | §4.2 | | Sorted-set | [gap] | §4.3 | | Metadata (`with-meta`/`meta`) | [gap] | §4.4 | --- a/lib/std/transducer.sls +++ b/lib/std/transducer.sls @@ -53,6 +53,10 @@ ;; transducers are just procedures; the record wraps them for identity.) transducer? + ;; Reduced sentinel (exposed so users and other libraries + ;; can signal early termination in custom reducing functions) + reduced reduced? unreduced + ;; Core transducers mapping filtering @@ -81,13 +85,23 @@ rf-count rf-sum rf-into-vector + rf-into-pmap + rf-into-pset + rf-into-pvec ;; High-level combinators into sequence eduction) - (import (chezscheme)) + (import (chezscheme) + (std pmap) + (std pset) + (rename (std pvec) + (transient pvec-transient) + (transient? pvec-transient?) + (persistent! pvec-persistent!) + (transient-append! pvec-t-append!))) ;; ====================================================================== ;; Transducer record @@ -177,6 +191,28 @@ [(acc) (list->vector (inner acc))] [(acc x) (inner acc x)]))) + ;; Collect into a persistent-map. Steps receive (k . v) pairs + ;; (matching Clojure's map-as-seq-of-entries convention). + (define (rf-into-pmap) + (case-lambda + [() (transient-map pmap-empty)] + [(t) (persistent-map! t)] + [(t kv) (tmap-set! t (car kv) (cdr kv)) t])) + + ;; Collect into a persistent-set. + (define (rf-into-pset) + (case-lambda + [() (transient-set pset-empty)] + [(t) (persistent-set! t)] + [(t x) (tset-add! t x) t])) + + ;; Collect into a persistent-vector via the pvec transient API. + (define (rf-into-pvec) + (case-lambda + [() (pvec-transient pvec-empty)] + [(t) (pvec-persistent! t)] + [(t x) (pvec-t-append! t x) t])) + ;; ====================================================================== ;; Core transducers ;; ====================================================================== @@ -418,19 +454,90 @@ ;; (transduce xf rf init coll) ;; Apply transducer xf to reducing function rf, then fold coll. - ;; coll must be a proper list. + ;; coll may be a proper list, a vector, a string, or a persistent + ;; map/set/vector (HAMT / BVT structures from std pmap/pset/pvec). + ;; + ;; Elements handed to the reducing function: + ;; - list/vector/string/pvec : each element in order + ;; - pset : each element (HAMT iteration order) + ;; - pmap : each (key . val) pair (like Clojure's seq-of-entries) (define (transduce xf rf init coll) (let ([xrf (apply-xf xf rf)]) - (let loop ([acc init] [lst coll]) - (cond - [(null? lst) - ;; Call completion - (xrf (ensure-unreduced acc))] - [(reduced? acc) - (xrf (reduced-box-val acc))] - [else - (let ([result (xrf acc (car lst))]) - (loop result (cdr lst)))])))) + (cond + ;; List — existing fast path. + [(or (null? coll) (pair? coll)) + (let loop ([acc init] [lst coll]) + (cond + [(null? lst) + (xrf (ensure-unreduced acc))] + [(reduced? acc) + (xrf (reduced-box-val acc))] + [else + (let ([result (xrf acc (car lst))]) + (loop result (cdr lst)))]))] + ;; Vector — indexed walk. + [(vector? coll) + (let ([n (vector-length coll)]) + (let loop ([acc init] [i 0]) + (cond + [(fx>= i n) + (xrf (ensure-unreduced acc))] + [(reduced? acc) + (xrf (reduced-box-val acc))] + [else + (loop (xrf acc (vector-ref coll i)) (fx+ i 1))])))] + ;; String — indexed walk yielding characters. + [(string? coll) + (let ([n (string-length coll)]) + (let loop ([acc init] [i 0]) + (cond + [(fx>= i n) + (xrf (ensure-unreduced acc))] + [(reduced? acc) + (xrf (reduced-box-val acc))] + [else + (loop (xrf acc (string-ref coll i)) (fx+ i 1))])))] + ;; Persistent map — iterate (k, v) and hand the rf a pair. + [(persistent-map? coll) + (call/cc + (lambda (escape) + (let ([final + (persistent-map-fold + (lambda (acc k v) + (let ([r (xrf acc (cons k v))]) + (if (reduced? r) + (escape (xrf (reduced-box-val r))) + r))) + init coll)]) + (xrf (ensure-unreduced final)))))] + ;; Persistent set — each element. + [(persistent-set? coll) + (call/cc + (lambda (escape) + (let ([final + (persistent-set-fold + (lambda (acc x) + (let ([r (xrf acc x)]) + (if (reduced? r) + (escape (xrf (reduced-box-val r))) + r))) + init coll)]) + (xrf (ensure-unreduced final)))))] + ;; Persistent vector — ordered. + [(persistent-vector? coll) + (call/cc + (lambda (escape) + (let ([final + (persistent-vector-fold + (lambda (acc x) + (let ([r (xrf acc x)]) + (if (reduced? r) + (escape (xrf (reduced-box-val r))) + r))) + init coll)]) + (xrf (ensure-unreduced final)))))] + [else + (error 'transduce "unsupported collection type" coll)]))) ;; ====================================================================== ;; High-level combinators @@ -441,9 +548,12 @@ (transduce xf (rf-cons) '() coll)) ;; (into dest xf coll) - ;; dest: '() -> returns a list - ;; #() -> returns a vector - ;; "" -> returns a string (elements must be chars) + ;; dest: '() -> returns a list + ;; #() -> returns a vector + ;; "" -> returns a string (elements must be chars) + ;; persistent-map -> returns a persistent-map (src yields k.v pairs) + ;; persistent-set -> returns a persistent-set + ;; persistent-vec -> returns a persistent-vector (define (into dest xf coll) (cond [(null? dest) @@ -453,6 +563,14 @@ (transduce xf rf (rf) coll))] [(string? dest) (list->string (sequence xf coll))] + [(persistent-map? dest) + ;; Start from the existing dest via a transient. rf-into-pmap's + ;; completion finalises the transient back into a persistent map. + (transduce xf (rf-into-pmap) (transient-map dest) coll)] + [(persistent-set? dest) + (transduce xf (rf-into-pset) (transient-set dest) coll)] + [(persistent-vector? dest) + (transduce xf (rf-into-pvec) (pvec-transient dest) coll)] [else (error 'into "unsupported destination type" dest)])) --- a/tests/test-transducer.ss +++ b/tests/test-transducer.ss @@ -1,7 +1,8 @@ #!chezscheme ;;; Tests for (std transducer) — Composable data transformations -(import (chezscheme) (std transducer)) +(import (chezscheme) (std transducer) + (std pmap) (std pset) (std pvec)) (define pass 0) (define fail 0) @@ -236,6 +237,80 @@ (sequence (filtering even?) '()) '()) +;;; =================================================================== +;;; Bridges to persistent collections (pmap / pset / pvec) +;;; =================================================================== + +;;;; Test 28: transduce over a persistent-vector +(test "transduce/pvec source" + (transduce (mapping (lambda (x) (* x x))) (rf-sum) 0 + (persistent-vector 1 2 3 4)) + 30) + +;;;; Test 29: transduce over a persistent-set +(test "transduce/pset source sums to 12 (2+4+6)" + (transduce (filtering even?) (rf-sum) 0 + (persistent-set 1 2 3 4 5 6)) + 12) + +;;;; Test 30: transduce over a persistent-map — yields (k . v) pairs +(test "transduce/pmap source sums values" + (transduce (mapping (lambda (p) (cdr p))) (rf-sum) 0 + (persistent-map 'a 1 'b 2 'c 3)) + 6) + +;;;; Test 31: rf-into-pvec via into +(test-true "into/pvec dest is persistent-vector" + (persistent-vector? + (into pvec-empty (filtering odd?) '(1 2 3 4 5)))) + +(test "into/pvec filter odd" + (persistent-vector->list + (into pvec-empty (filtering odd?) '(1 2 3 4 5))) + '(1 3 5)) + +;;;; Test 32: rf-into-pset via into +(test-true "into/pset dest is persistent-set" + (persistent-set? + (into pset-empty (mapping (lambda (x) (* x x))) '(1 2 3 4)))) + +(test "into/pset size after mapping" + (persistent-set-size + (into pset-empty (mapping (lambda (x) (* x x))) '(1 2 3 4))) + 4) + +;;;; Test 33: rf-into-pmap via into +(test "into/pmap from kv pairs" + (persistent-map-ref + (into pmap-empty + (mapping (lambda (p) (cons (car p) (* (cdr p) 2)))) + '((a . 1) (b . 2) (c . 3))) + 'b) + 4) + +;;;; Test 34: early termination on persistent collection with (taking n) +(test "transduce/pvec with taking — early stop" + (transduce (taking 3) (rf-sum) 0 (persistent-vector 1 2 3 4 5 6 7)) + 6) + +;;;; Test 35: composed transducer on a persistent vector +(test "transduce/pvec composed filter+map" + (transduce (compose-transducers (filtering even?) + (mapping (lambda (x) (* x 10)))) + (rf-cons) '() + (persistent-vector 1 2 3 4 5 6)) + '(20 40 60)) + +;;;; Test 36: string source to list via transduce +(test "transduce/string source" + (sequence (mapping char-upcase) "abc") + '(#\A #\B #\C)) + +;;;; Test 37: vector source to vector destination +(test "into/vector-from-vector" + (into (vector) (mapping (lambda (x) (+ x 1))) (vector 10 20 30)) + (vector 11 21 31)) + (printf "~%~a tests: ~a passed, ~a failed~%" (+ pass fail) pass fail) (when (> fail 0) (exit 1))