exercise-6.scm (1541B)
1 2 ;; Exercise 2.6 3 4 (define (exercise-2.6) 5 (define zero 6 (lambda (f) 7 (lambda (x) 8 x))) 9 10 (define (add-1 n) 11 (lambda (f) 12 (lambda (x) 13 (f ((n f) x))))) 14 15 (add-1 zero) 16 17 (lambda (f) 18 (lambda (x) 19 (f ((zero f) x)))) 20 21 (lambda (f) 22 (lambda (x) 23 (f (((lambda (f) 24 (lambda (x) x)) f) x)))) 25 (lambda (f) 26 (lambda (x) 27 (f ((lambda (x) x) x)))) 28 29 (define one 30 (lambda (f) 31 (lambda (x) 32 (f x)))) 33 34 (add-1 one) 35 36 (lambda (f) 37 (lambda (x) 38 (f ((one f) x)))) 39 40 (lambda (f) 41 (lambda (x) 42 (f (((lambda (f) 43 (lambda (x) 44 (f x))) f) x)))) 45 46 (lambda (f) 47 (lambda (x) 48 (f ((lambda (x) 49 (f x)) x)))) 50 51 (lambda (f) 52 (lambda (x) 53 (f (f x)))) 54 55 (define two 56 (lambda (f) 57 (lambda (x) 58 (f (f x))))) 59 60 (define (church-+ a b) 61 (lambda (f) 62 (lambda (x) 63 ((b f) ((a f) x))))) 64 65 (test-begin "2.6") 66 (test-equal 0 ((zero 1+) 0)) 67 (test-equal 1 (((add-1 zero) 1+) 0)) 68 (test-equal 1 ((one 1+) 0)) 69 (test-equal 2 (((add-1 (add-1 zero)) 1+) 0)) 70 (test-equal 2 (((add-1 one) 1+) 0)) 71 (test-equal 2 ((two 1+) 0)) 72 (test-equal 3 (((add-1 two) 1+) 0)) 73 74 (do-ec (: elements (list (zip (list zero one two) 75 (iota 3)))) 76 (: a elements) 77 (: b elements) 78 (test-equal 79 (+ (cadr a) 80 (cadr b)) 81 (((church-+ (car a) 82 (car b)) 1+) 0))) 83 (test-end "2.6")) 84 85 (exercise-2.6)