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 list/vector*->array for list elements.

Browse source 
Issue #962.
This commit is contained in:
Alex Shinn 2024-05-25 22:41:45 +09:00
parent 6c49071833
commit 698dcb2bfb
2 changed files with 26 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1803,6 +1803,23 @@
list) list)
(make-array (make-interval '#(3 4) '#(4 5)) (make-array (make-interval '#(3 4) '#(4 5))
list))) list)))
(test-assert (array-every equal?
(list*->array 1 '(a b c))
(list->array (make-interval '#(3))
'(a b c))))
(test-assert (array-every equal?
(list*->array 2 '((a b c) (1 2 3)))
(list->array (make-interval '#(2 3))
'(a b c 1 2 3))))
(test-assert
(array-every equal?
(list*->array 2 '(((a b c) (1 2))))
(list->array (make-interval '#(1 2))
'((a b c) (1 2)))))
;; (test-assert
;; (array-every equal?
;; (list*->array 0 '())
;; (make-array (make-interval '#()) (lambda () '()))))
(test-error (array-any 1 2)) (test-error (array-any 1 2))
(test-error (array-any list 1)) (test-error (array-any list 1))
(test-error (array-any list (test-error (array-any list

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

@ -516,9 +516,9 @@
(else (else
(error "can't reshape" array new-domain))))) (error "can't reshape" array new-domain)))))
(define (flatten ls) (define (flatten ls d)
(if (pair? (car ls)) (if (and (positive? d) (pair? (car ls)))
(append-map flatten ls) (append-map (lambda (x) (flatten x (- d 1))) ls)
ls)) ls))
(define (list*->array dimension nested-ls . o) (define (list*->array dimension nested-ls . o)
@ -529,7 +529,7 @@
(else (else
(apply list->array (apply list->array
(make-interval (list->vector (reverse lens))) (make-interval (list->vector (reverse lens)))
(flatten nested-ls) (flatten nested-ls (- dimension 1))
o))))) o)))))
(define (array->list* a) (define (array->list* a)
@ -562,9 +562,10 @@
(vector-iota (interval-width domain 0) (vector-iota (interval-width domain 0)
(interval-lower-bound domain 0))))))) (interval-lower-bound domain 0)))))))
(define (flatten-vector->list vec) (define (flatten-vector->list vec d)
(if (vector? (vector-ref vec 0)) (if (and (positive? d) (vector? (vector-ref vec 0)))
(append-map flatten-vector->list (vector->list vec)) (append-map (lambda (x) (flatten-vector->list x (- d 1)))
(vector->list vec))
(vector->list vec))) (vector->list vec)))
(define (vector*->array dimension nested-vec . o) (define (vector*->array dimension nested-vec . o)
@ -575,7 +576,7 @@
(else (else
(apply list->array (apply list->array
(make-interval (reverse-list->vector lens)) (make-interval (reverse-list->vector lens))
(flatten-vector->list nested-vec) (flatten-vector->list nested-vec (- dimension 1))
o))))) o)))))
(define (dimensions-compatible? a-domain b-domain axis) (define (dimensions-compatible? a-domain b-domain axis)