array-stack should use the specified storage-class

The original code was based on (chibi math linalg) which preferred the domain of the stacked arrays.
ashinn · May 27, 2024 · a8939fe · a8939fe
1 parent 07f3301
commit a8939fe
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 4 deletions.
diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld
@@ -3277,6 +3277,29 @@
             (array->list*
              (array-stack 0 (list (list*->array 2 '((4 7) (2 6)))
                                   (list*->array 2 '((1 0) (0 1)))))))
+        (test-error
+         (array-stack 0
+                      (list (make-array (make-interval '#(2 2)) list)
+                            (make-array (make-interval '#(2 2)) list))
+                      'a))
+        (test-error
+         (array-stack 0
+                      (list (make-array (make-interval '#(2 2)) list) (make-array (make-interval '#(2 2)) list))
+                      u1-storage-class
+                      'a))
+        (test-error
+         (array-stack 0
+                      (list (make-array (make-interval '#(2 2)) list) (make-array (make-interval '#(2 2)) list))
+                      u1-storage-class))
+        (test
+            generic-storage-class
+            (array-storage-class
+             (array-stack
+              1
+              (list (array-copy (make-array (make-interval '#(10)) (lambda (i) 42))
+                                u8-storage-class)
+                    (array-copy (make-array (make-interval '#(10)) (lambda (i) 5000))
+                                u16-storage-class)))))
         (test '((0 1 4 6 7 8)
                 (2 3 5 9 10 11)
                 (12 13 14 15 16 17))

diff --git a/lib/srfi/231/transforms.scm b/lib/srfi/231/transforms.scm
@@ -683,10 +683,7 @@
             (make-interval
              `#(,@(take a-lbs axis) 0 ,@(drop a-lbs axis))
              `#(,@(take a-ubs axis) ,(length arrays) ,@(drop a-ubs axis))))
-           (res (make-specialized-array/default domain
-                                                (or (array-storage-class a)
-                                                    generic-storage-class)
-                                                safe?))
+           (res (make-specialized-array/default domain storage safe?))
            ;; Stack by permuting the desired axis to the first
            ;; dimension and currying on that, assigning the
            ;; corresponding array argument to each element.