Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add index-swap, fix assert in array-append

Browse source
This commit is contained in:
Bradley Lucier 2023-05-23 15:09:25 -04:00
parent 06f0cc0225
commit 27ea774e2e
4 changed files with 10 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lib/srfi/231.sld
View file

@ -10,7 +10,7 @@
;; Miscellaneous Functions ;; Miscellaneous Functions
translation? permutation? translation? permutation?
;; Indexes ;; Indexes
index-rotate index-first index-last index-rotate index-first index-last index-swap
;; Intervals ;; Intervals
make-interval interval? interval-dimension interval-lower-bound make-interval interval? interval-dimension interval-lower-bound
interval-upper-bound interval-lower-bounds->list interval-upper-bound interval-lower-bounds->list

6
lib/srfi/231/base.scm
View file

@ -28,6 +28,12 @@
(iota (- n (+ k 1)) (+ k 1)) (iota (- n (+ k 1)) (+ k 1))
(list k)))) (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 ;; Intervals
(define-record-type Interval (define-record-type Interval

2
lib/srfi/231/base.sld
View file

@ -23,7 +23,7 @@
interval-width interval-widths interval-width interval-widths
interval-empty? interval-empty?
;; Indexing ;; Indexing
index-rotate index-first index-last index-rotate index-first index-last index-swap
indexer->coeffs coeffs->indexer default-indexer default-coeffs indexer->coeffs coeffs->indexer default-indexer default-coeffs
invert-default-index interval-cursor interval-cursor-next! invert-default-index interval-cursor interval-cursor-next!
interval-cursor-next interval-cursor-get interval-fold interval-cursor-next interval-cursor-get interval-fold

4
lib/srfi/231/transforms.scm
View file

@ -571,8 +571,8 @@
(define (array-append axis arrays . o) (define (array-append axis arrays . o)
(assert (and (exact-integer? axis) (assert (and (exact-integer? axis)
(pair? arrays) (pair? arrays)
(< -1 axis (array-dimension (car arrays))) (every array? arrays)
(every array? arrays))) (< -1 axis (array-dimension (car arrays)))))
(let* ((a (car arrays)) (let* ((a (car arrays))
(a-domain (array-domain a)) (a-domain (array-domain a))
(storage (if (pair? o) (car o) generic-storage-class)) (storage (if (pair? o) (car o) generic-storage-class))