1 (define (make-sum a1 a2)
2   (cond ((=number? a1 0) a2)
3 	((=number? a2 0) a1)
4 	((and (number? a1) (number? a2)) (+ a1 a2))
5 	(else (list a1 '+ a2))))
6 (define (make-product m1 m2)
7   (cond ((or (=number? m1 0) (=number? m2 0)) 0)
8 	((=number? m1 1) m2)
9 	((=number? m2 1) m1)
10 	((and (number? m1) (number? m2)) (* m1 m2))
11 	(else (list m1 '* m2))))
12 (define (sum? x)
13   (and (pair? x) (eq? (cadr x) '+)))
14 (define (addend s) (car s))
15 (define (augend s) (caddr s))
16 (define (product? x)
17   (and (pair? x) (eq? (cadr x) '*)))
18 (define (multiplier p) (car p))
19 (define (multiplicand p) (caddr p))
20 (define (non-num-members as)
21   (filter (lambda (x) (not (number? x))) as))
22 (define (num-members as)
23   (filter number? as))
24 (define (more-than-one-number? as)
25   (let ((nums (num-members as)))
26     (if (or (null? nums) (null? (cdr nums)))
27 	#f
28 	#t)))
29 (define (zero-is-the-only-number? as)
30   (let ((nums (num-members as)))
31     (if (null? nums)
32 	#f
33 	(and (= (car nums) 0) (null? (cdr nums))))))
34 (define (one-is-the-only-number? as)
35   (let ((nums (num-members as)))
36     (if (null? nums)
37 	#f
38 	(and (= (car nums) 1) (null? (cdr nums))))))
39 (define (insert-signs result items sign)
40   (cond ((null? items) result)
41 	((null? result)
42 	 (insert-signs (list (car items)) (cdr items) sign))
43 	(else (insert-signs (append result (list sign (car items)))
44 			    (cdr items) sign))))
45 
46 (define (make-sum . as)
47   (cond ((null? as) 0)
48 	((null? (cdr as)) (car as))
49 	((null? (non-num-members as)) (apply + as))
50 	((more-than-one-number? as)
51 	 (apply make-sum
52 		(append (non-num-members as)
53 			(list (apply + (num-members as))))))
54 	((zero-is-the-only-number? as)
55 	 (apply make-sum (non-num-members as)))
56 	(else (insert-signs '() as '+))))
57 (define (make-product . ms)
58   (cond ((null? ms) 1)
59 	((null? (cdr ms)) (car ms))
60 	((null? (non-num-members ms)) (apply * ms))
61 	((more-than-one-number? ms)
62 	 (apply make-product (append (non-num-members ms)
63 				     (list (apply * (num-members ms))))))
64 	((zero-is-the-only-number? ms) 0)
65 	((one-is-the-only-number? ms)
66 	 (apply make-product (non-num-members ms)))
67 	(else (insert-signs '() ms '*))))
68 (define (sum? x)
69   (cond ((not (pair? x)) #f)
70 	((member '+ x) true)
71 	(else #f)))
72 (define (product? x)
73   (cond ((not (pair? x)) #f)
74 	((and (not (sum? x)) (member '* x)) true)
75 	(else #f)))
76 (define (addend s)
77   (let* ((index (list-index (lambda (x) (eq? x '+)) s))
78 	 (a (take s index)))
79     (if (null? (cdr a))
80 	(car a)
81 	a)))
82 (define (augend s)
83   (let* ((index (list-index (lambda (x) (eq? x '+)) s))
84 	 (b (drop s (+ index 1))))
85     (if (null? (cdr b))
86 	(car b)
87 	b)))
88 (define (multiplier p)
89   (let* ((index (list-index (lambda (x) (eq? x '*)) p))
90 	 (a (take p index)))
91     (if (null? (cdr a))
92 	(car a)
93 	a)))
94 (define (multiplicand p)
95   (let* ((index (list-index (lambda (x) (eq? x '*)) p))
96 	 (b (drop p (+ index 1))))
97     (if (null? (cdr b))
98 	(car b)
99 	b)))
100 (multiplier '(x * y * (z + 2)))