Commit08952595Recorded31 Mar 2026Repositorysigil-transducers

Extract sigil-transducers from sigil-stdlib

Message

Standalone package providing the (sigil seq) transducer library with polymorphic sequence operations for lists, vectors, arrays, and dicts.

Changed
 .gitignore        |   1 +
 README.md         | 101 ++++++++++++++++++++++++++++++++++++
 dev-redirects.sgl |   6 +++
 package.sgl       |  28 ++++++++++
 src/sigil/seq.sgl | 498 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 634 insertions(+)
Diff
.gitignoreadded
@@ -0,0 +1 @@
+1
build/
README.mdadded
@@ -0,0 +1,101 @@
+1
# sigil-transducers
+2
+3
Composable transducer library for Sigil. Provides polymorphic sequence operations and transducer pipelines that work across lists, vectors, arrays, and dicts.
+4
+5
## Installation
+6
+7
Add to your `package.sgl` dependencies:
+8
+9
```scheme
+10
(from-git url: "codeberg:sigil/sigil-transducers")
+11
```
+12
+13
## Usage
+14
+15
### Polymorphic Operations
+16
+17
When imported, `(sigil seq)` provides polymorphic versions of common operations that work on any collection type:
+18
+19
```scheme
+20
(import (sigil seq))
+21
+22
(map square '(1 2 3)) ; => (1 4 9)
+23
(map square #(1 2 3)) ; => #(1 4 9)
+24
(filter even? '(1 2 3 4)) ; => (2 4)
+25
(filter even? #(1 2 3 4)) ; => #(2 4)
+26
(fold + 0 '(1 2 3 4)) ; => 10
+27
(any even? '(1 3 4 5)) ; => #t
+28
(every even? '(2 4 6)) ; => #t
+29
(find even? '(1 3 4 5)) ; => 4
+30
```
+31
+32
### Transducers
+33
+34
Transducers are composable transformation pipelines that separate *what* to transform from *how* to iterate:
+35
+36
```scheme
+37
(import (sigil seq))
+38
+39
(define xform
+40
(comp (filtering even?)
+41
(mapping square)
+42
(taking 5)))
+43
+44
(transduce xform conj '() (iota 100)) ; => (0 4 16 36 64)
+45
```
+46
+47
### Transducer Constructors
+48
+49
- `(mapping f)` - Transform each element by applying `f`
+50
- `(filtering pred)` - Keep only elements satisfying `pred`
+51
- `(taking n)` - Take at most `n` elements, then stop
+52
- `(dropping n)` - Skip the first `n` elements
+53
- `(taking-while pred)` - Take elements while `pred` is true
+54
- `(dropping-while pred)` - Drop elements while `pred` is true
+55
- `cat` - Flatten one level of nesting
+56
- `(mapcat f)` - Map then concatenate
+57
+58
### Composition
+59
+60
Compose transducers left-to-right with `comp`:
+61
+62
```scheme
+63
(comp (filtering even?) (mapping square) (taking 3))
+64
```
+65
+66
### Execution
+67
+68
- `(transduce xform rf init coll)` - Apply transducer `xform` with reducing function `rf`, initial value `init`, over collection `coll`
+69
- `(into to xform from)` - Transform and collect into a collection of the same type as `to`
+70
- `(sequence xform coll)` - Transform a collection, preserving its type
+71
+72
### Reducers
+73
+74
- `conj` - Build lists (via cons)
+75
- `conj-vec` - Build vectors (builds list, convert with `into`)
+76
- `conj-dict` - Build dicts from `(key . value)` pairs
+77
+78
### Stream Processing
+79
+80
Transducers also work for processing channel message streams:
+81
+82
```scheme
+83
(import (sigil seq)
+84
(sigil channels)
+85
(sigil async))
+86
+87
(define log-xform
+88
(comp (filtering (lambda (msg) (equal? (dict-ref msg level:) "error")))
+89
(mapping (lambda (msg) (dict-ref msg text:)))))
+90
+91
(with-async
+92
(go (for-each (lambda (msg) (channel-send logs msg)) messages)
+93
(channel-close! logs))
+94
(go (for-channel (msg logs)
+95
(let ((xrf (log-xform (lambda (acc x) (println "ERROR: ~a" x) acc))))
+96
(xrf #f msg)))))
+97
```
+98
+99
## License
+100
+101
BSD-3-Clause
dev-redirects.sgladded
@@ -0,0 +1,6 @@
+1
;; Development redirects — point dependencies at local checkouts
+2
(redirects
+3
repos: (list
+4
(for-repo
+5
url: "codeberg:sigil/sigil"
+6
use: (from-path dir: "../sigil"))))
package.sgladded
@@ -0,0 +1,28 @@
+1
;;; sigil-transducers - Composable transducer library for Sigil
+2
;;;
+3
;;; Provides polymorphic sequence operations and composable transducer
+4
;;; pipelines that work across lists, vectors, arrays, and dicts.
+5
+6
(define sigil-repo "codeberg:sigil/sigil")
+7
+8
(package
+9
name: "sigil-transducers"
+10
version: "0.9.0"
+11
description: "Composable transducer library for Sigil"
+12
url: "https://codeberg.org/sigil/sigil-transducers"
+13
license: "BSD-3-Clause"
+14
authors: (list "David Wilson <[email protected]>")
+15
+16
configs: (list
+17
(config name: 'dev output-dir: "build/dev" debug?: #t optimize: 0)
+18
(config name: 'release output-dir: "build/release" debug?: #f optimize: 2))
+19
+20
dependencies: (list
+21
(from-git url: sigil-repo package: "sigil-stdlib"))
+22
+23
tasks: (list
+24
(task
+25
name: 'build
+26
description: "Compile sigil-transducers modules"
+27
steps: (list
+28
(compile-sigil-modules sources: "src/**/*.sgl")))))
src/sigil/seq.sgladded
@@ -0,0 +1,498 @@
+1
;;; (sigil seq) - Polymorphic Sequences and Transducers
+2
;;;
+3
;;; Unified collection processing that works across lists, vectors, and dicts.
+4
;;; Built on transducers for composable, efficient transformations.
+5
;;;
+6
;;; ## Polymorphic Operations
+7
;;;
+8
;;; When imported, these shadow the single-type versions from prelude:
+9
;;;
+10
;;; ```scheme
+11
;;; (import (sigil seq))
+12
;;;
+13
;;; (map square '(1 2 3)) ; => (1 4 9)
+14
;;; (map square #(1 2 3)) ; => #(1 4 9)
+15
;;; (filter even? '(1 2 3 4)) ; => (2 4)
+16
;;; (filter even? #(1 2 3 4)) ; => #(2 4)
+17
;;; ```
+18
;;;
+19
;;; ## Transducers
+20
;;;
+21
;;; Transducers are composable transformation pipelines:
+22
;;;
+23
;;; ```scheme
+24
;;; (define xform
+25
;;; (comp (filtering even?)
+26
;;; (mapping square)
+27
;;; (taking 5)))
+28
;;;
+29
;;; (transduce xform conj '() (iota 100)) ; => (0 4 16 36 64)
+30
;;; ```
+31
;;;
+32
;;; Transducers separate the "what" (transformation) from the "how" (iteration),
+33
;;; enabling the same transformation to work on any collection type.
+34
;;;
+35
;;; ## Stream Processing with Channels
+36
;;;
+37
;;; The same transducers work for processing channel message streams:
+38
;;;
+39
;;; ```scheme
+40
;;; (import (sigil seq)
+41
;;; (sigil channels)
+42
;;; (sigil async))
+43
;;;
+44
;;; (define log-xform
+45
;;; (comp (filtering (lambda (msg) (equal? (dict-ref msg level:) "error")))
+46
;;; (mapping (lambda (msg) (dict-ref msg text:)))))
+47
;;;
+48
;;; (with-async
+49
;;; ;; Producer: send log messages
+50
;;; (go (for-each (lambda (msg) (channel-send logs msg))
+51
;;; messages)
+52
;;; (channel-close! logs))
+53
;;;
+54
;;; ;; Consumer: process with transducer
+55
;;; (go (for-channel (msg logs)
+56
;;; (let ((xrf (log-xform (lambda (acc x) (println "ERROR: ~a" x) acc))))
+57
;;; (xrf #f msg)))))
+58
;;; ```
+59
+60
(define-library (sigil seq)
+61
(import (sigil array))
+62
+63
(export
+64
;; Transducer constructors
+65
mapping
+66
filtering
+67
taking
+68
dropping
+69
taking-while
+70
dropping-while
+71
cat
+72
mapcat
+73
+74
;; Transducer composition
+75
comp
+76
+77
;; Transducer execution
+78
transduce
+79
into
+80
sequence
+81
+82
;; Reducers (reducing functions)
+83
conj
+84
conj-vec
+85
conj-dict
+86
+87
;; Polymorphic operations (shadow prelude)
+88
map
+89
filter
+90
fold
+91
for-each
+92
any
+93
every
+94
find)
+95
+96
(begin
+97
+98
;; ============================================================
+99
;; Reduced wrapper for early termination
+100
;; ============================================================
+101
+102
;; Reduced signals early termination in transducers.
+103
;; We use a tagged list for simplicity.
+104
(define (reduced x)
+105
(list '%reduced x))
+106
+107
(define (reduced? x)
+108
(and (pair? x)
+109
(eq? (car x) '%reduced)))
+110
+111
(define (unreduced x)
+112
(if (reduced? x)
+113
(cadr x)
+114
x))
+115
+116
;; Ensure result is unwrapped after transduction
+117
(define (ensure-unreduced x)
+118
(unreduced x))
+119
+120
;; ============================================================
+121
;; Transducer Constructors
+122
;; ============================================================
+123
+124
;;; Create a mapping transducer.
+125
;;;
+126
;;; Transforms each element by applying f.
+127
;;;
+128
;;; ```scheme
+129
;;; (transduce (mapping square) conj '() '(1 2 3)) ; => (1 4 9)
+130
;;; ```
+131
(define (mapping f)
+132
(: procedure? -> procedure?)
+133
(lambda (rf)
+134
(lambda (acc x)
+135
(rf acc (f x)))))
+136
+137
;;; Create a filtering transducer.
+138
;;;
+139
;;; Keeps only elements satisfying the predicate.
+140
;;;
+141
;;; ```scheme
+142
;;; (transduce (filtering even?) conj '() '(1 2 3 4)) ; => (2 4)
+143
;;; ```
+144
(define (filtering pred)
+145
(: procedure? -> procedure?)
+146
(lambda (rf)
+147
(lambda (acc x)
+148
(if (pred x)
+149
(rf acc x)
+150
acc))))
+151
+152
;;; Create a taking transducer.
+153
;;;
+154
;;; Takes at most n elements, then terminates early.
+155
;;;
+156
;;; ```scheme
+157
;;; (transduce (taking 3) conj '() '(1 2 3 4 5)) ; => (1 2 3)
+158
;;; ```
+159
(define (taking n)
+160
(: integer? -> procedure?)
+161
(lambda (rf)
+162
(let ((remaining n))
+163
(lambda (acc x)
+164
(if (<= remaining 0)
+165
(reduced acc)
+166
(begin
+167
(set! remaining (- remaining 1))
+168
(if (= remaining 0)
+169
(reduced (rf acc x))
+170
(rf acc x))))))))
+171
+172
;;; Create a dropping transducer.
+173
;;;
+174
;;; Skips the first n elements.
+175
;;;
+176
;;; ```scheme
+177
;;; (transduce (dropping 2) conj '() '(1 2 3 4 5)) ; => (3 4 5)
+178
;;; ```
+179
(define (dropping n)
+180
(: integer? -> procedure?)
+181
(lambda (rf)
+182
(let ((remaining n))
+183
(lambda (acc x)
+184
(if (> remaining 0)
+185
(begin
+186
(set! remaining (- remaining 1))
+187
acc)
+188
(rf acc x))))))
+189
+190
;;; Create a taking-while transducer.
+191
;;;
+192
;;; Takes elements while predicate is true, then stops.
+193
;;;
+194
;;; ```scheme
+195
;;; (transduce (taking-while (lambda (x) (< x 4))) conj '() '(1 2 3 4 5))
+196
;;; ; => (1 2 3)
+197
;;; ```
+198
(define (taking-while pred)
+199
(: procedure? -> procedure?)
+200
(lambda (rf)
+201
(lambda (acc x)
+202
(if (pred x)
+203
(rf acc x)
+204
(reduced acc)))))
+205
+206
;;; Create a dropping-while transducer.
+207
;;;
+208
;;; Drops elements while predicate is true, then takes the rest.
+209
;;;
+210
;;; ```scheme
+211
;;; (transduce (dropping-while (lambda (x) (< x 3))) conj '() '(1 2 3 4 5))
+212
;;; ; => (3 4 5)
+213
;;; ```
+214
(define (dropping-while pred)
+215
(: procedure? -> procedure?)
+216
(lambda (rf)
+217
(let ((dropping #t))
+218
(lambda (acc x)
+219
(if dropping
+220
(if (pred x)
+221
acc
+222
(begin
+223
(set! dropping #f)
+224
(rf acc x)))
+225
(rf acc x))))))
+226
+227
;;; Concatenating transducer.
+228
;;;
+229
;;; Flattens one level of nesting.
+230
;;;
+231
;;; ```scheme
+232
;;; (transduce cat conj '() '((1 2) (3 4))) ; => (1 2 3 4)
+233
;;; ```
+234
(define (cat rf)
+235
(: procedure? -> procedure?)
+236
(lambda (acc xs)
+237
(reduce-coll rf acc xs)))
+238
+239
;;; Mapcat transducer (map then concatenate).
+240
;;;
+241
;;; Like (comp (mapping f) cat) but slightly more efficient.
+242
;;;
+243
;;; ```scheme
+244
;;; (transduce (mapcat (lambda (x) (list x x))) conj '() '(1 2 3))
+245
;;; ; => (1 1 2 2 3 3)
+246
;;; ```
+247
(define (mapcat f)
+248
(: procedure? -> procedure?)
+249
(comp (mapping f) cat))
+250
+251
;; ============================================================
+252
;; Transducer Composition
+253
;; ============================================================
+254
+255
;;; Compose transducers left-to-right.
+256
;;;
+257
;;; Unlike function composition, transducers compose in reading order.
+258
;;;
+259
;;; ```scheme
+260
;;; (comp (filtering even?) (mapping square) (taking 3))
+261
;;; ```
+262
(define (comp . xforms)
+263
(: procedure? ... -> procedure?)
+264
(if (null? xforms)
+265
(lambda (rf) rf) ; identity transducer
+266
(let loop ((xforms xforms))
+267
(if (null? (cdr xforms))
+268
(car xforms)
+269
(let ((first (car xforms))
+270
(rest (loop (cdr xforms))))
+271
(lambda (rf)
+272
(first (rest rf))))))))
+273
+274
;; ============================================================
+275
;; Collection Abstraction
+276
;; ============================================================
+277
+278
;; Internal: reduce over any collection type
+279
(define (reduce-coll rf init coll)
+280
(cond
+281
((list? coll)
+282
(let loop ((lst coll) (acc init))
+283
(if (or (null? lst) (reduced? acc))
+284
(ensure-unreduced acc)
+285
(loop (cdr lst) (rf acc (car lst))))))
+286
((vector? coll)
+287
(let ((len (vector-length coll)))
+288
(let loop ((i 0) (acc init))
+289
(if (or (>= i len) (reduced? acc))
+290
(ensure-unreduced acc)
+291
(loop (+ i 1) (rf acc (vector-ref coll i)))))))
+292
((array? coll)
+293
(let ((len (array-length coll)))
+294
(let loop ((i 0) (acc init))
+295
(if (or (>= i len) (reduced? acc))
+296
(ensure-unreduced acc)
+297
(loop (+ i 1) (rf acc (array-ref coll i)))))))
+298
((dict? coll)
+299
(let loop ((entries (dict-entries coll)) (acc init))
+300
(if (or (null? entries) (reduced? acc))
+301
(ensure-unreduced acc)
+302
(loop (cdr entries) (rf acc (car entries))))))
+303
(else
+304
(error "reduce-coll: unsupported collection type" coll))))
+305
+306
;; Internal: detect collection type for output
+307
(define (collection-type coll)
+308
(cond
+309
((list? coll) 'list)
+310
((vector? coll) 'vector)
+311
((array? coll) 'array)
+312
((dict? coll) 'dict)
+313
(else (error "Unknown collection type" coll))))
+314
+315
;; ============================================================
+316
;; Reducers (reducing functions for building collections)
+317
;; ============================================================
+318
+319
;;; Reducer for building lists.
+320
;;;
+321
;;; ```scheme
+322
;;; (transduce (mapping square) conj '() '(1 2 3)) ; => (1 4 9)
+323
;;; ```
+324
(define (conj acc x)
+325
(: any? any? -> pair?)
+326
(cons x acc))
+327
+328
;;; Reducer for building vectors.
+329
;;;
+330
;;; Note: builds a list then converts (vectors are immutable).
+331
(define (conj-vec acc x)
+332
(: any? any? -> pair?)
+333
(cons x acc))
+334
+335
;;; Reducer for building dicts from (key . value) pairs.
+336
(define (conj-dict acc pair)
+337
(: dict? pair? -> dict?)
+338
(dict-set acc (car pair) (cdr pair)))
+339
+340
;; ============================================================
+341
;; Transducer Execution
+342
;; ============================================================
+343
+344
;;; Apply a transducer to a collection.
+345
;;;
+346
;;; The core transducer execution function.
+347
;;;
+348
;;; ```scheme
+349
;;; (transduce (mapping square) conj '() '(1 2 3)) ; => (9 4 1)
+350
;;; (transduce (mapping square) + 0 '(1 2 3)) ; => 14
+351
;;; ```
+352
(define (transduce xform rf init coll)
+353
(: procedure? procedure? any? any? -> any?)
+354
(let ((xrf (xform rf)))
+355
(reduce-coll xrf init coll)))
+356
+357
;;; Transform and collect into a collection of the same type.
+358
;;;
+359
;;; ```scheme
+360
;;; (into '() (mapping square) '(1 2 3)) ; => (9 4 1)
+361
;;; (into #() (mapping square) '(1 2 3)) ; => #(1 4 9)
+362
;;; ```
+363
(define (into to xform from)
+364
(: any? procedure? any? -> any?)
+365
(let ((result (cond
+366
((list? to)
+367
(transduce xform conj '() from))
+368
((vector? to)
+369
(list->vector (reverse (transduce xform conj-vec '() from))))
+370
((dict? to)
+371
(transduce xform conj-dict to from))
+372
(else
+373
(error "into: unsupported target type" to)))))
+374
(if (list? to)
+375
(reverse result)
+376
result)))
+377
+378
;;; Transform a collection, preserving its type.
+379
;;;
+380
;;; ```scheme
+381
;;; (sequence (mapping square) '(1 2 3)) ; => (1 4 9)
+382
;;; (sequence (mapping square) #(1 2 3)) ; => #(1 4 9)
+383
;;; ```
+384
(define (sequence xform coll)
+385
(: procedure? any? -> any?)
+386
(cond
+387
((list? coll)
+388
(reverse (transduce xform conj '() coll)))
+389
((vector? coll)
+390
(list->vector (reverse (transduce xform conj '() coll))))
+391
((array? coll)
+392
(list->array (reverse (transduce xform conj '() coll))))
+393
((dict? coll)
+394
(transduce xform conj-dict #{} coll))
+395
(else
+396
(error "sequence: unsupported collection type" coll))))
+397
+398
;; ============================================================
+399
;; Polymorphic Operations
+400
;; ============================================================
+401
+402
;;; Apply a procedure to each element, returning a collection of the same type.
+403
;;;
+404
;;; Works on lists, vectors, arrays, and dicts.
+405
;;;
+406
;;; ```scheme
+407
;;; (map square '(1 2 3)) ; => (1 4 9)
+408
;;; (map square #(1 2 3)) ; => #(1 4 9)
+409
;;; (map cdr #{ a: 1 b: 2 }) ; => (1 2) - maps over entries
+410
;;; ```
+411
(define (map proc coll)
+412
(: procedure? any? -> any?)
+413
(sequence (mapping proc) coll))
+414
+415
;;; Return elements satisfying a predicate, preserving collection type.
+416
;;;
+417
;;; ```scheme
+418
;;; (filter even? '(1 2 3 4)) ; => (2 4)
+419
;;; (filter even? #(1 2 3 4)) ; => #(2 4)
+420
;;; ```
+421
(define (filter pred coll)
+422
(: procedure? any? -> any?)
+423
(sequence (filtering pred) coll))
+424
+425
;;; Reduce a collection with a procedure.
+426
;;;
+427
;;; Works on lists, vectors, arrays, and dicts.
+428
;;;
+429
;;; ```scheme
+430
;;; (fold + 0 '(1 2 3 4)) ; => 10
+431
;;; (fold + 0 #(1 2 3 4)) ; => 10
+432
;;; ```
+433
(define (fold proc init coll)
+434
(: procedure? any? any? -> any?)
+435
(reduce-coll proc init coll))
+436
+437
;;; Apply a procedure to each element for side effects.
+438
;;;
+439
;;; ```scheme
+440
;;; (for-each println '(1 2 3))
+441
;;; (for-each println #(1 2 3))
+442
;;; ```
+443
(define (for-each proc coll)
+444
(: procedure? any? -> void?)
+445
(reduce-coll (lambda (acc x) (proc x) acc) #f coll)
+446
(values))
+447
+448
;;; Test if any element satisfies a predicate.
+449
;;;
+450
;;; ```scheme
+451
;;; (any even? '(1 3 4 5)) ; => #t
+452
;;; (any even? #(1 3 5 7)) ; => #f
+453
;;; ```
+454
(define (any pred coll)
+455
(: procedure? any? -> boolean?)
+456
(reduce-coll
+457
(lambda (acc x)
+458
(if (pred x)
+459
(reduced #t)
+460
#f))
+461
#f
+462
coll))
+463
+464
;;; Test if all elements satisfy a predicate.
+465
;;;
+466
;;; ```scheme
+467
;;; (every even? '(2 4 6)) ; => #t
+468
;;; (every even? #(2 3 4)) ; => #f
+469
;;; ```
+470
(define (every pred coll)
+471
(: procedure? any? -> boolean?)
+472
(reduce-coll
+473
(lambda (acc x)
+474
(if (pred x)
+475
#t
+476
(reduced #f)))
+477
#t
+478
coll))
+479
+480
;;; Find the first element satisfying a predicate.
+481
;;;
+482
;;; Returns `#f` if no element matches.
+483
;;;
+484
;;; ```scheme
+485
;;; (find even? '(1 3 4 5)) ; => 4
+486
;;; (find even? '(1 3 5 7)) ; => #f
+487
;;; ```
+488
(define (find pred coll)
+489
(: procedure? any? -> any?)
+490
(reduce-coll
+491
(lambda (acc x)
+492
(if (pred x)
+493
(reduced x)
+494
#f))
+495
#f
+496
coll))
+497
+498
))