summaryrefslogtreecommitdiffstats
path: root/subarray.scm
diff options
context:
space:
mode:
Diffstat (limited to 'subarray.scm')
-rw-r--r--subarray.scm21
1 files changed, 15 insertions, 6 deletions
diff --git a/subarray.scm b/subarray.scm
index 152ccbb..9f84583 100644
--- a/subarray.scm
+++ b/subarray.scm
@@ -52,6 +52,15 @@
;;#2A((a b) (d e))
;;> (subarray ra #f '(1 2))
;;#2A((b c) (e f))
+;;> (subarray ra #f '(2 1))
+;;#2A((c b) (f e))
+;;@end example
+;;
+;;Arrays can be reflected (reversed) using @0:
+;;
+;;@example
+;;> (subarray '#1A(a b c d e) '(4 0))
+;;#1A(e d c b a)
;;@end example
(define (subarray array . selects)
(apply make-shared-array array
@@ -68,7 +77,10 @@
((list? (car sels))
(loop (cdr sels)
(cdr args)
- (cons (+ (car args) (caar sels)) lst)))
+ (cons (if (< (cadar sels) (caar sels))
+ (+ (- (caar sels) (car args)))
+ (+ (caar sels) (car args)))
+ lst)))
(else
(loop (cdr sels) (cdr args) (cons (car args) lst))))))
(let loop ((sels selects)
@@ -88,15 +100,12 @@
((list? (car sels))
(loop (cdr sels)
(cdr dims)
- (cons (list 0 (- (cadar sels) (caar sels))) ndims)))
+ (cons (list 0 (abs (- (cadar sels) (caar sels))))
+ ndims)))
(else
(loop (cdr sels) (cdr dims) (cons (car sels) ndims)))))))
;;@body
-;;Legacy alias for @r{subarray}.
-(define subarray0 subarray)
-
-;;@body
;;
;;Returns a subarray sharing contents with @1 except for slices removed
;;from either side of each dimension. Each of the @2 is an exact