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