51 lines
1.2 KiB
Scheme
51 lines
1.2 KiB
Scheme
;;; 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)))))))
|