1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-23 22:20:24 -08:00
emacs/mps/example/scheme/test-common.scm
Gareth Rees ef1e9d50f4 More r4rs, r5rs.
Copied from Perforce
 Change: 180365
 ServerID: perforce.ravenbrook.com
2012-11-06 12:16:59 +00:00

23 lines
930 B
Scheme

;;; test-common.scm -- common definitions for the Scheme tests
(define (check exp result)
(let ((actually (eval exp)))
(if (not (equal? actually result))
(begin
(write-string "test: ") (write exp) (newline)
(write-string "expect: ") (write result) (newline)
(write-string "got: ") (write actually) (newline)
(error "failed!")))))
;; Return (f (f (f ... (f a) ... ))) with n invocations of f.
(define (church n f a)
(if (eqv? n 0)
a
(church (- n 1) f (f a))))
(define (map f l) (if (null? l) '() (cons (f (car l)) (map f (cdr l)))))
(define (all l) (if (null? l) #t (if (car l) (all (cdr l)) #f)))
(define (range n) (if (eqv? n 0) '() (append (range (- n 1)) (list n))))
(define (for-each f l) (if (null? l) #f (begin (f (car l)) (for-each f (cdr l)))))
(define (reduce f l a) (if (null? l) a (f (car l) (reduce f (cdr l) a))))
(define (sum l) (reduce + l 0))