UNSLISP/util.scm

;;; Utilities.

;;; ;;;;;;;;;;;;;;;;
;;; Versions of FOLD
;;; ;;;;;;;;;;;;;;;;

(define fold
  (lambda (f init lst)
    (if (null? lst)
        init
        (fold f (f (car lst) init) (cdr lst)))))

(define fold-vector
  (lambda (f init vec)
    (if (list? vec)                    ; Support MiniScheme
        (fold f init vec)
        (letrec
            ((loop
              (lambda (i val)
                (if (= i (vector-length vec))
                    val
                    (loop (+ i 1) (f (vector-ref vec i) val))))))
          (loop 0 init)))))

;;; ;;;;;;;;;;;;;;;;;;;;
;;; Misc. list functions
;;; ;;;;;;;;;;;;;;;;;;;;

(define all
  (lambda (f lst)
    (cond
      ((null? lst) #t)
      ((not (f (car lst))) #f)
      (else (all f (cdr lst))))))

;;; (REVAPPEND L1 ... LN) returns L{N-1}, L{N-2}, ... reversed and
;;; appended to LN, in that order.
(define revappend
  (letrec ((loop
            (lambda (lst1 lst2)
              (if (null? lst1)
                  lst2
                  (loop (cdr lst1) (cons (car lst1) lst2))))))
    (lambda lists
      (cond
        ((null? lists) '())
        ((null? (cdr lists)) (car lists))
        (else
         (apply revappend (loop (car lists) (cadr lists))
                (cddr lists)))))))