;;; 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
  ;
  array:copy!)

(import scheme)
(import (chicken module))
(import (only (chicken base) include-relative cut))
(import (rename (chicken base) (sub1 1-) (add1 1+)))
(import (chicken type))
(import (only (srfi 1) reverse!))
(import (srfi 63))

;;;

(include-relative "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 -> void))

(: array-copy (array -> array))
(: array-fold (('r #!rest -> 'r) 'r #!rest array -> 'r))

(include-relative "arraymap")

(define array-copy! array:copy!)

(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 (cut apply array-ref <> 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