Fix list/vector*->array for list elements.

Issue #962.
ashinn · May 25, 2024 · 698dcb2 · 698dcb2
1 parent 6c49071
commit 698dcb2
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 8 deletions.
diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld
@@ -1803,6 +1803,23 @@
                                              list)
                                  (make-array (make-interval '#(3 4) '#(4 5))
                                              list)))
+        (test-assert (array-every equal?
+                                  (list*->array 1 '(a b c))
+                                  (list->array (make-interval '#(3))
+                                               '(a b c))))
+        (test-assert (array-every equal?
+                                  (list*->array 2 '((a b c) (1 2 3)))
+                                  (list->array (make-interval '#(2 3))
+                                               '(a b c 1 2 3))))
+        (test-assert
+            (array-every equal?
+                         (list*->array 2 '(((a b c) (1 2))))
+                         (list->array (make-interval '#(1 2))
+                                      '((a b c) (1 2)))))
+        ;; (test-assert
+        ;;     (array-every equal?
+        ;;                  (list*->array 0 '())
+        ;;                  (make-array (make-interval '#()) (lambda () '()))))
         (test-error (array-any 1 2))
         (test-error (array-any list 1))
         (test-error (array-any list

diff --git a/lib/srfi/231/transforms.scm b/lib/srfi/231/transforms.scm
@@ -516,9 +516,9 @@
      (else
       (error "can't reshape" array new-domain)))))
 
-(define (flatten ls)
-  (if (pair? (car ls))
-      (append-map flatten ls)
+(define (flatten ls d)
+  (if (and (positive? d) (pair? (car ls)))
+      (append-map (lambda (x) (flatten x (- d 1))) ls)
       ls))
 
 (define (list*->array dimension nested-ls . o)
@@ -529,7 +529,7 @@
      (else
       (apply list->array
              (make-interval (list->vector (reverse lens)))
-             (flatten nested-ls)
+             (flatten nested-ls (- dimension 1))
              o)))))
 
 (define (array->list* a)
@@ -562,9 +562,10 @@
                    (vector-iota (interval-width domain 0)
                                 (interval-lower-bound domain 0)))))))
 
-(define (flatten-vector->list vec)
-  (if (vector? (vector-ref vec 0))
-      (append-map flatten-vector->list (vector->list vec))
+(define (flatten-vector->list vec d)
+  (if (and (positive? d) (vector? (vector-ref vec 0)))
+      (append-map (lambda (x) (flatten-vector->list x (- d 1)))
+                  (vector->list vec))
       (vector->list vec)))
 
 (define (vector*->array dimension nested-vec . o)
@@ -575,7 +576,7 @@
      (else
       (apply list->array
              (make-interval (reverse-list->vector lens))
-             (flatten-vector->list nested-vec)
+             (flatten-vector->list nested-vec (- dimension 1))
              o)))))
 
 (define (dimensions-compatible? a-domain b-domain axis)