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

Merge branch 'master' of github.com:ashinn/chibi-scheme

Browse source
This commit is contained in:
Alex Shinn 2023-06-04 06:06:47 +09:00
commit b06c4cca9d
2 changed files with 54 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -22,19 +22,33 @@
(lp (+ i 1)))))))))
(define (index-rotate n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (append (iota (- n k) k) (iota k))))
(define (index-first n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (cons k
(append (iota k)
(iota (- n (+ k 1)) (+ k 1))))))
(define (index-last n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (append (iota k)
(iota (- n (+ k 1)) (+ k 1))
(list k))))
(define (index-swap n i j)
(assert (and (exact-integer? n)
(exact-integer? i)
(exact-integer? j)
(< -1 i n)
(< -1 j n)))
(let ((result (vector-iota n 0)))
(vector-set! result i j)
(vector-set! result j i)

39
lib/srfi/231/test.sld
View file

@ -1,6 +1,6 @@
;; Adapted from original SRFI reference test suite:
;; SRFI 179: Nonempty Intervals and Generalized Arrays (Updated)
;; SRFI 231: Intervals and Generalized Arrays
;; Copyright 2016, 2018, 2020 Bradley J Lucier.
;; All Rights Reserved.
@ -29,8 +29,8 @@
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.
;;; A test program for SRFI 179:
;;; Nonempty Intervals and Generalized Arrays (Updated)
;;; A test program for SRFI 231:
;;; Intervals and Generalized Arrays
(define-library (srfi 231 test)
(import (scheme base) (scheme cxr) (scheme complex)
@ -903,7 +903,38 @@
(random-source-pseudo-randomize! default-random-source 7 23)
(test-begin "srfi-179: nonempty intervals and generalized arrays")
(test-begin "srfi-231: nonempty intervals and generalized arrays")
(test-group "index-* and miscellaneous tests"
(test-error (index-first 'a 3))
(test-error (index-first 5 'a))
(test-error (index-first -1 5))
(test-error (index-first 0 -2))
(test-error (index-first 3 5))
(test '#(3 0 1 2 4) (index-first 5 3))
(test-error (index-last 'a 3))
(test-error (index-last 5 'a))
(test-error (index-last -1 5))
(test-error (index-last 0 -2))
(test-error (index-last 3 5))
(test '#(0 1 2 4 3) (index-last 5 3))
(test-error (index-rotate 'a 3))
(test-error (index-rotate 5 'a))
(test-error (index-rotate -1 5))
(test-error (index-rotate 0 -2))
(test-error (index-rotate 3 5))
(test '#(3 4 0 1 2) (index-rotate 5 3))
(test-error (index-swap 'a 3 0))
(test-error (index-swap 5 'a 0))
(test-error (index-swap -1 5 0))
(test-error (index-swap 0 -2 0))
(test-error (index-swap 3 5 0))
(test '#(3 1 2 0 4) (index-swap 5 3 0))
)
(test-group "interval tests"
(test-error (make-interval 1 '#(3 4)))