;; srfi-1::fold

(use srfi-8) ; receive
(use srfi-1) ; car+cdr

(define (cars+cdrs ls . rest-lists)
  (let/cc hop
    (let loop ((lists (cons ls rest-lists)))
      (if (null? lists)
          (values '() '())
          (receive (ls rest-lists)(car+cdr lists)
            (if (null? ls)
                (hop '() '())
                (receive (a d)(car+cdr ls)
                  (receive (cars cdrs)(loop rest-lists)
                    (values (cons a cars)(cons d cdrs))))))))))

(define (fold proc init ls . lists)
  (let loop ((lists (cons ls lists))(acc init))
    (receive (cars cdrs)(apply cars+cdrs lists)
      (let ((ans (apply proc (append cars (list acc)))))
        (if (any null? cdrs)
            ans
            (loop cdrs ans))))))

(fold + 0 (with-module srfi-1 (iota 10 1)))
;; 55
(fold * 1 (with-module srfi-1 (iota 5 1)))
;; 120
(fold + 0 '(1 2 3 4 5)'(1 2 3 4 5))
;; 30
(fold cons '() '(a b c))
;; (c b a)
(fold acons '() '(a b c)'(1 2 3))
;; ((c . 3) (b . 2) (a . 1))
(with-module srfi-1 (fold acons '() '(a b c)'(1 2 3)))
;; ((c . 3) (b . 2) (a . 1))

(fold acons '() '(1 2 3 4 5)'(a b c d))
;; ((4 . d) (3 . c) (2 . b) (1 . a))

(fold acons '() '(a b c)'(1 2 3 4 5))
;; ((c . 3) (b . 2) (a . 1))

(fold acons '() '(1 2 3)'(a b c d e))