Array compact printer fix

Needs to emit start index if any of array dimensions begins with non-zero
index.

Author: shirok

ext/uvector/array.scm

@@ -124,19 +124,29 @@
   (format port ")"))
 
 ;; #<rank>a style.  FMT can be 'compact or 'dimensions
+;;  If compact,
+;;    - If all dimensions start from 0, we omit dimensions altogether.
+;;    - Otherwise, we show start index for every dimension
+;;  If dimensions
+;;    - We show start if it's not 0
+;;    - We show length for all dimensions
 (define (format-array/srfi-163 array port fmt)
-  (define (dims)
+  (define (dims full?)
     (with-output-to-string
       (^[] (dotimes [i (array-rank array)]
              (let ([s (array-start array i)]
                    [e (array-end array i)])
-               (cond [(= s 0) (begin (display #\:) (display (- e s)))]
-                     [else (begin (display #\@) (display s)
-                                  (display #\:) (display (- e s)))]))))))
+               (unless (and full? (= s 0)) (display #\@) (display s))
+               (when full? (begin (display #\:) (display (- e s)))))))))
+
   (format port "#~a~a~@[~a~]~s"
           (array-rank array)
           (array-tag (class-of array))
-          (and (eq? fmt 'dimensions) (dims))
+          (cond [(eq? fmt 'dimensions) (dims #t)]
+                [(not (every (^i (zero? (array-start array i)))
+                             (iota (array-rank array))))
+                 (dims #f)]
+                [else #f])
           (array->nested-list array)))
 
 (define-class <array> (<array-base>)

ext/uvector/test.scm

@@ -1820,6 +1820,62 @@
   (t "#1u8:2:1(1 2 3)" (test-error <read-error> #/rank and dimensions/))
   )
 
+(let ()
+  (define (t arr ex-compact ex-dimensions ex-reader-ctor)
+    (define (tt mode expect)
+      (test* #"array writer: ~mode" expect
+             (let ((ctrl (make-write-controls :array-format mode)))
+               (write-to-string arr (cut write <> ctrl)))))
+    (tt 'compact ex-compact)
+    (tt 'dimensions ex-dimensions)
+    (tt 'reader-ctor ex-reader-ctor))
+
+  (t (array (shape 0 2 0 3) 1 2 3 4 5 6)
+     "#2a((1 2 3) (4 5 6))"
+     "#2a:2:3((1 2 3) (4 5 6))"
+     "#,(<array> (0 2 0 3) 1 2 3 4 5 6)")
+
+  (t (array (shape 0 2 -1 2) 1 2 3 4 5 6)
+     "#2a@0@-1((1 2 3) (4 5 6))"
+     "#2a:2@-1:3((1 2 3) (4 5 6))"
+     "#,(<array> (0 2 -1 2) 1 2 3 4 5 6)")
+
+  (t (array (shape 1 3 0 3) 1 2 3 4 5 6)
+     "#2a@1@0((1 2 3) (4 5 6))"
+     "#2a@1:2:3((1 2 3) (4 5 6))"
+     "#,(<array> (1 3 0 3) 1 2 3 4 5 6)")
+
+  (t (u8array (shape 0 3) 1 2 3)
+     "#1u8(1 2 3)"
+     "#1u8:3(1 2 3)"
+     "#,(<u8array> (0 3) 1 2 3)")
+
+  (t (s16array (shape -1 0 0 1) 1)
+     "#2s16@-1@0((1))"
+     "#2s16@-1:1:1((1))"
+     "#,(<s16array> (-1 0 0 1) 1)")
+
+  (t (c32array (shape 0 2 1 3) 1 +i -i 1+i)
+     "#2c32@0@1((1.0 0.0+1.0i) (0.0-1.0i 1.0+1.0i))"
+     "#2c32:2@1:2((1.0 0.0+1.0i) (0.0-1.0i 1.0+1.0i))"
+     "#,(<c32array> (0 2 1 3) 1.0 0.0+1.0i 0.0-1.0i 1.0+1.0i)")
+
+  (t (array (shape 0 0 0 1))
+     "#2a()"
+     "#2a:0:1()"
+     "#,(<array> (0 0 0 1))")
+
+  (t (array (shape 0 1 0 0))
+     "#2a(())"
+     "#2a:1:0(())"
+     "#,(<array> (0 1 0 0))")
+
+  (t (array (shape -1 -1 1 1))
+     "#2a@-1@1()"
+     "#2a@-1:0@1:0()"
+     "#,(<array> (-1 -1 1 1))")
+  )
+
 
 (test-section "array-rank")
 (test* "array-rank (shape)" 2