From 27ea774e2e03ea76e0b6220cfa7def8aa3f622cf Mon Sep 17 00:00:00 2001
From: Bradley Lucier <lucier@math.purdue.edu>
Date: Tue, 23 May 2023 15:09:25 -0400
Subject: [PATCH] Add index-swap, fix assert in array-append

---
 lib/srfi/231.sld            | 2 +-
 lib/srfi/231/base.scm       | 6 ++++++
 lib/srfi/231/base.sld       | 2 +-
 lib/srfi/231/transforms.scm | 4 ++--
 4 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/lib/srfi/231.sld b/lib/srfi/231.sld
index 997bf7b2..3111f403 100644
--- a/lib/srfi/231.sld
+++ b/lib/srfi/231.sld
@@ -10,7 +10,7 @@
    ;; Miscellaneous Functions
    translation? permutation?
    ;; Indexes
-   index-rotate index-first index-last
+   index-rotate index-first index-last index-swap
    ;; Intervals
    make-interval interval? interval-dimension interval-lower-bound
    interval-upper-bound interval-lower-bounds->list
diff --git a/lib/srfi/231/base.scm b/lib/srfi/231/base.scm
index f52c4bae..26ccc6c1 100644
--- a/lib/srfi/231/base.scm
+++ b/lib/srfi/231/base.scm
@@ -28,6 +28,12 @@
                         (iota (- n (+ k 1)) (+ k 1))
                         (list k))))
 
+(define (index-swap n i j)
+  (let ((result (vector-iota n 0)))
+    (vector-set! result i j)
+    (vector-set! result j i)
+    result))
+
 ;; Intervals
 
 (define-record-type Interval
diff --git a/lib/srfi/231/base.sld b/lib/srfi/231/base.sld
index 285221c7..aba169d0 100644
--- a/lib/srfi/231/base.sld
+++ b/lib/srfi/231/base.sld
@@ -23,7 +23,7 @@
    interval-width interval-widths
    interval-empty?
    ;; Indexing
-   index-rotate index-first index-last
+   index-rotate index-first index-last index-swap
    indexer->coeffs coeffs->indexer default-indexer default-coeffs
    invert-default-index interval-cursor interval-cursor-next!
    interval-cursor-next interval-cursor-get interval-fold
diff --git a/lib/srfi/231/transforms.scm b/lib/srfi/231/transforms.scm
index 0426b180..66d81728 100644
--- a/lib/srfi/231/transforms.scm
+++ b/lib/srfi/231/transforms.scm
@@ -571,8 +571,8 @@
 (define (array-append axis arrays . o)
   (assert (and (exact-integer? axis)
                (pair? arrays)
-               (< -1 axis (array-dimension (car arrays)))
-               (every array? arrays)))
+               (every array? arrays)
+               (< -1 axis (array-dimension (car arrays)))))
   (let* ((a (car arrays))
          (a-domain (array-domain a))
          (storage (if (pair? o) (car o) generic-storage-class))