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

Implementing array-decurry.

Browse source
This commit is contained in:
Alex Shinn 2023-02-16 21:20:37 +09:00
parent 18c958e836
commit 4dab8b81d4
2 changed files with 21 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -3512,7 +3512,9 @@ OTHER DEALINGS IN THE SOFTWARE.
((array-getter a) 3 4))
(let ((curried-a (array-curry a 1)))
(test '(3 4)
((array-getter ((array-getter curried-a) 3)) 4))))
((array-getter ((array-getter curried-a) 3)) 4))
(test (array->list a)
(array->list (array-decurry curried-a)))))
(test 0.
((array-getter sparse-array) 12345 6789))

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

@ -657,12 +657,21 @@
res))))
(define (array-decurry a . o)
(let ((storage (if (pair? o) (car o) generic-storage-class))
(mutable? (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(specialized-array-default-mutable?)))
(safe? (if (and (pair? o) (pair? (cdr o)) (pair? (cddr o)))
(car (cddr o))
(specialized-array-default-safe?))))
(error "TODO: array-decurry unimplemented")))
(let* ((storage (if (pair? o) (car o) generic-storage-class))
(mutable? (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(specialized-array-default-mutable?)))
(safe? (if (and (pair? o) (pair? (cdr o)) (pair? (cddr o)))
(car (cddr o))
(specialized-array-default-safe?)))
(a-domain (array-domain a))
(elt0 (apply array-ref a (interval-lower-bounds->list a-domain)))
(elt-domain (array-domain elt0))
(domain (interval-cartesian-product a-domain elt-domain))
(res (make-specialized-array domain storage mutable? safe?))
(curried-res (array-curry res (interval-dimension elt-domain))))
;; Prepare a res with the flattened domain, create a new curried
;; view of the res with the same domain as a, and assign each
;; curried view from a to the res.
(array-for-each array-assign! curried-res a)
res))