;;; slib-arraymap.scm  -*- Scheme -*-

(module slib-arraymap

(;export
  array-map!
  array-map
  array-for-each
  array-indexes
  array-index-for-each
  array-index-map!
  array:copy!
  array-copy
  array-fold)

(import scheme)
(import (chicken module))
(import (only (chicken base) include))
(import (chicken type))
(import (srfi 63))

;;;

(include "slib-compat")

;; Types

(define-type array-strict (struct array))                            ;SRFI 63
(define-type array (or string vector array-strict))

(: array-map! (array (#!rest -> *) #!rest array -> void))
(: array-map (array (#!rest -> *) #!rest array -> array))
(: array-for-each ((#!rest -> void) #!rest array -> void))
(: array-indexes (array -> array))
(: array-index-for-each (array (#!rest -> void) -> void))
(: array-index-map! (array (#!rest -> *) -> void))
(: array:copy! (array array -> void))

(: array-copy (array -> array))
(: array-fold (procedure * #!rest array -> *))

(include "arraymap")

(define (array-copy src)
  (let ((dst (apply make-array src (array-dimensions src))))
    (array:copy! dst src)
    dst ) )

(define (array-fold proc seed . ras)
  (let rafo ((rdims (array-dimensions (car ras))) (inds '()))
    (if (null? (cdr rdims))
      (let* (
        (sdni (reverse (cons #f inds)))
        (lastpair (last-pair sdni)) )
        (do ((i 0 (+ 1 i)))
            ((> i (+ -1 (car rdims))))
          (set-car! lastpair i)
          (set! seed (apply proc seed (map (lambda (x) (apply array-ref x sdni)) ras))) ) )
      (let (
        (crdims (cdr rdims))
        (ll (+ -1 (car rdims))) )
        (do ((i 0 (+ 1 i)))
            ((> i ll))
          (rafo crdims (cons i inds)) ) ) ) )
  seed )

) ;module slib-arraymap