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

Assert same domains in array-for-each, as per the spec and implicitly

Browse source 
depended on by the implementation.
This commit is contained in:
Alex Shinn 2021-08-16 15:07:07 +09:00
parent a14f2d179a
commit 57e4652ea6
1 changed files with 32 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lib/srfi/179/transforms.scm
View file

@ -291,6 +291,12 @@
(and (equal? (array-dimension (car ls)) (array-dimension (cadr ls))) (and (equal? (array-dimension (car ls)) (array-dimension (cadr ls)))
(same-dimensions? (cdr ls))))) (same-dimensions? (cdr ls)))))
(define (same-domains? ls)
(or (null? ls)
(null? (cdr ls))
(and (interval= (array-domain (car ls)) (array-domain (cadr ls)))
(same-domains? (cdr ls)))))
(define (array-map f array . arrays) (define (array-map f array . arrays)
(make-array (array-domain array) (make-array (array-domain array)
(let* ((ls (cons array arrays)) (let* ((ls (cons array arrays))
@ -300,13 +306,32 @@
(apply f (map (lambda (g) (apply g multi-index)) getters)))))) (apply f (map (lambda (g) (apply g multi-index)) getters))))))
(define (array-for-each f array . arrays) (define (array-for-each f array . arrays)
(interval-for-each (if (null? arrays)
(let* ((ls (cons array arrays)) (interval-for-each
(getters (map array-getter ls))) (let ((g (array-getter array)))
(assert (same-dimensions? ls)) (case (array-dimension array)
(lambda multi-index ((1)
(apply f (map (lambda (g) (apply g multi-index)) getters)))) (lambda (i) (f (g i))))
(array-domain array))) ((2)
(lambda (i j) (f (g i j))))
(else
(lambda multi-index
(f (apply g multi-index))))))
(array-domain array))
(interval-for-each
(let* ((lower (interval-lower-bounds->list (array-domain array)))
(ls (cons array arrays))
(getters
(cons (array-getter (car ls))
(map (lambda (ar)
(let ((getter (array-getter ar)))
(lambda multi-index
(apply getter multi-index))))
(cdr ls)))))
(assert (same-domains? ls))
(lambda multi-index
(apply f (map (lambda (g) (apply g multi-index)) getters))))
(array-domain array))))
(define (array-fold kons knil array) (define (array-fold kons knil array)
(interval-fold (lambda (acc . multi-index) (interval-fold (lambda (acc . multi-index)