;; 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))