Add utilities useful for working with arrays

diff --git a/misc.scm b/misc.scm
index aee2fed082a33121d970268f4403929021ebe8d5..42037a398cb93211c0f97559b4d33fef06c150d5 100644 (file)
--- a/misc.scm
+++ b/misc.scm
@@ -1,6 +1,15 @@
 (define-module (vouivre misc)
+  #:use-module (ice-9 arrays)
+  #:use-module (srfi srfi-1)
   #:export
-  (if-let))
+  (array-map
+   array-map-indexed
+   for-indices-in-range
+   if-let
+   ifn
+   list-zeros
+   map-indexed
+   produce-array))
 
 (define-syntax if-let
   (syntax-rules ()
@@ -10,3 +19,53 @@
     [(_ (x test) consequent)
      (let ([x test])
        (if x consequent))]))
+
+(define-syntax ifn
+  (syntax-rules ()
+    [(_ test alternate consequent)
+     (if test consequent alternate)]
+    [(_ test alternate)
+     (if (not test) alternate)]))
+
+(define (list-zeros n)
+  (list-tabulate n (lambda _ 0)))
+
+(define (map-indexed f . lists)
+  "Like `map' but the last argument of `f' is passed the corresponding index."
+  (apply map f (append lists (list (list-tabulate (length (car lists))
+                                                 identity)))))
+
+(define (for-indices-in-range f starts ends)
+  (define (for-indices-in-range% f indices starts ends)
+    (if (null? starts)
+      (apply f (reverse indices))
+      (do ((i (car starts) (1+ i)))
+        ((= i (car ends)))
+        (for-indices-in-range%
+          f
+          (cons i indices)
+          (cdr starts)
+          (cdr ends)))))
+  (for-indices-in-range% f '() starts ends))
+
+;;;; array utilities
+
+(define (produce-array f . dims)
+  (let ((a (apply make-array 0 dims)))
+    (array-index-map! a f)
+    a))
+
+(define (array-map proc array . more)
+  (let ((x (array-copy array)))
+    (apply array-map! x proc array more)
+    x))
+
+(define (array-map-indexed proc array)
+  (let ((x (array-copy array)))
+    (array-index-map!
+     x
+     (lambda indices
+       (apply proc
+             (apply array-ref array indices)
+             indices)))
+    x))