cesarum.array: added array-to-list.

Pascal J. Bourguignon [2021-08-20 07:36]
cesarum.array: added array-to-list.
Filename
common-lisp/cesarum/array-test.lisp
common-lisp/cesarum/array.lisp
diff --git a/common-lisp/cesarum/array-test.lisp b/common-lisp/cesarum/array-test.lisp
index 4b89e91..c0754af 100644
--- a/common-lisp/cesarum/array-test.lisp
+++ b/common-lisp/cesarum/array-test.lisp
@@ -94,7 +94,38 @@
                                                 :test (function /=))
                       '((1 . 4) (4 . 7)))))

+
+(define-test test/array-to-list ()
+  (assert-true (equal (array-to-lists #0A42)
+                      42))
+  (assert-true (equal (array-to-lists #(1 2 3))
+                      '(1 2 3)))
+  (assert-true (equal (array-to-lists "abc")
+                      '(#\a #\b #\c)))
+  (assert-true (equal (array-to-lists #1A(1 2 3))
+                      '(1 2 3)))
+  (assert-true (equal (array-to-lists #2A((1 2 3)
+                                          (4 5 6)
+                                          (7 8 9)))
+                      '((1 2 3) (4 5 6) (7 8 9))))
+  (assert-true (equal (array-to-lists #())
+                      'nil))
+  (assert-true (equal (array-to-lists #2A())
+                      'nil))
+  (assert-true (equal (array-to-lists #2A(()))
+                      '(nil)))
+  (assert-true (equal (array-to-lists #2A((())))
+                      '((nil))))
+  (assert-true (equal (array-to-lists #3A(((1 2 3)
+                                           (4 5 6)
+                                           (7 8 9))
+                                          ((a b c)
+                                           (d e f)
+                                           (g h i))))
+                      '(((1 2 3) (4 5 6) (7 8 9)) ((a b c) (d e f) (g h i))))))
+
 (define-test test/all ()
-  (test/positions-of-subsequence))
+  (test/positions-of-subsequence)
+  (test/array-to-list))

 ;;;; THE END ;;;;
diff --git a/common-lisp/cesarum/array.lisp b/common-lisp/cesarum/array.lisp
index 7791b1a..3bc0176 100644
--- a/common-lisp/cesarum/array.lisp
+++ b/common-lisp/cesarum/array.lisp
@@ -482,4 +482,26 @@ numbers, or equal otherwise."
                :always (same i))))))


+
+(defun array-to-lists (array)
+  (labels ((atl (array dimensions)
+             (if (null (rest dimensions))
+                 (loop
+                   :with max := (pop dimensions)
+                   :for i :below max
+                   :collect (funcall array i))
+                 (loop
+                   :with max := (pop dimensions)
+                   :for i :below max
+                   :collect (atl (lambda (&rest indices)
+                                   (apply array i indices))
+                                 dimensions)))))
+    (let ((dimensions (array-dimensions array)))
+      (case (length dimensions)
+        ((0) (aref array))
+        ((1) (coerce array 'list))
+        (otherwise (atl (lambda (&rest indices) (apply (function aref) array indices))
+                        dimensions))))))
+
+
 ;;;; THE END ;;;;
ViewGit