private/fold.ss
#lang scheme/base
;; Fold combinators
(provide make-foldl make-foldr make-andmap make-ormap)

(define (make-foldl empty? first rest)
  (letrec ((f (lambda (cons empty ls)
                (cond [(empty? ls) empty]
                      [else (f cons
                               (cons (first ls) empty) 
                               (rest ls))]))))
    f))

(define (make-foldr empty? first rest)
  (letrec ((f (lambda (cons empty ls)
                (cond [(empty? ls) empty]
                      [else (cons (first ls)
                                  (f cons empty (rest ls)))]))))
    f))

(define (make-andmap empty? first rest)
  (let ((f (lambda (pred ls)
             (cond [(empty? ls) #t]
                   [else
                    (let loop ((ls ls))
                      (cond [(empty? (rest ls))
                             (pred (first ls))]
                            [else
                             (and (pred (first ls))
                                  (loop (rest ls)))]))]))))
    f))

(define (make-ormap empty? first rest)
  (let ((f (lambda (pred ls)
             (cond [(empty? ls) #f]
                   [else
                    (let loop ((ls ls))
                      (cond [(empty? (rest ls))
                             (pred (first ls))]
                            [else
                             (or (pred (first ls))
                                 (loop (rest ls)))]))]))))
    f))