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

fix vector*->array

Browse source
This commit is contained in:
Alex Shinn 2024-05-23 10:38:16 +09:00
parent 37dda638c3
commit 4677cfb85b
2 changed files with 7 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -2558,6 +2558,9 @@
(array->vector* (make-array (make-interval '#(0 0)) error))) (array->vector* (make-array (make-interval '#(0 0)) error)))
(test '#(#() #()) (test '#(#() #())
(array->vector* (make-array (make-interval '#(2 0)) error))) (array->vector* (make-array (make-interval '#(2 0)) error)))
(test (list->array (make-interval '#(2 3)) '(a b c 1 2 3))
(vector*->array 2 '#(#(a b c) #(1 2 3))))
) )
(test-group "permutation tests" (test-group "permutation tests"

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

@ -559,9 +559,9 @@
(vector-iota (interval-width domain 0) (vector-iota (interval-width domain 0)
(interval-lower-bound domain 0))))))) (interval-lower-bound domain 0)))))))
(define (flatten-vec vec) (define (flatten-vector->list vec)
(if (vector? (vector-ref vec 0)) (if (vector? (vector-ref vec 0))
(append-map flatten-vec vec) (append-map flatten-vector->list (vector->list vec))
(vector->list vec))) (vector->list vec)))
(define (vector*->array dimension nested-vec . o) (define (vector*->array dimension nested-vec . o)
@ -571,8 +571,8 @@
(lp (vector-ref vec 0) (cons (vector-length vec) lens) (- d 1))) (lp (vector-ref vec 0) (cons (vector-length vec) lens) (- d 1)))
(else (else
(apply list->array (apply list->array
(make-interval (list->vector (reverse lens))) (make-interval (reverse-list->vector lens))
(flatten-vec nested-vec) (flatten-vector->list nested-vec)
o))))) o)))))
(define (dimensions-compatible? a-domain b-domain axis) (define (dimensions-compatible? a-domain b-domain axis)