From 4a058e40b26c2b614ac68bad96a412809a7bac13 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 5 Jul 2023 16:14:13 -0500
Subject: Initial commit

---
 chicanery.extras.scm | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 chicanery.extras.scm

(limited to 'chicanery.extras.scm')

diff --git a/chicanery.extras.scm b/chicanery.extras.scm
new file mode 100644
index 0000000..24cdff9
--- /dev/null
+++ b/chicanery.extras.scm
@@ -0,0 +1,78 @@
+;;; chicanery extras --- extra stuff from ur old pal acdw
+
+(export list-map list-for-each list-append)
+
+;; Generalized map, for-each, ...
+;; List versions are renamed `list-<function>'.  Un-prefixed versions work
+;; with any (default) datatype.  TODO: generalize?
+(define list-map map)
+(define list-for-each for-each)
+(define list-append append)
+
+(define (map proc . collections)
+  (let ((first (car collections)))    ; we only need to check the first one
+    (cond
+     ((list? first)
+      (apply list-map proc collections))
+     ((vector? first)
+      (apply vector-map proc collections))
+     ((string? first)
+      (apply string-map proc collections))
+     (else (error "Bad datatype" first)))))
+
+(define (for-each proc . collections)
+  (let ((first (car collections)))    ; we only need to check the first one
+    (cond
+     ((list? first)
+      (apply list-for-each proc collections))
+     ((vector? first)
+      (apply vector-for-each proc collections))
+     ((string? first)
+      (apply string-for-each proc collections))
+     (else (error "Bad datatype" first)))))
+
+(define (append . collections)
+  (let ((first (car collections)))    ; we only need to check the first one
+    (cond
+     ((list? first)
+      (apply list-append collections))
+     ((vector? first)
+      (apply vector-append collections))
+     ((string? first)
+      (apply string-append collections))
+     ((bytevector? first)
+      (apply bytevector-append collections))
+     (else (error "Bad datatype" first)))))
+
+(export ref copy)
+
+;; Extended generic functions.
+;; These functions already have a list- version defined, but no non-prefixed
+;; one.  So I'm fixing that.
+(define (ref collection k)
+  (cond
+   ((list? collection)
+    (list-ref collection k))
+   ((vector? collection)
+    (vector-ref collection k))
+   ((string? collection)
+    (string-ref collection k))
+   ((bytevector? collection)
+    (bytevector-u8-ref collection k))
+   (else (error "Bad datatype" collection))))
+
+;; I'm not going to generalize -copy! because I don't think it's a great idea,
+;; really.
+(define (copy collection)
+  (cond
+   ((list? collection)
+    (list-copy collection))
+   ((vector? collection)
+    (vector-copy collection))
+   ((string? collection)
+    (string-copy collection))
+   ((bytevector? collection)
+    (bytevector-copy collection))
+   (else (error "Bad datatype" collection))))
+
+;; TODO: look at set! semantics -- generalizable?
-- 
cgit 1.4.1-21-gabe81