# SICP section 2.5 - systems with generic operations

Admission: exercise 2.86 is as far as I’ll be taking it for this section. I’ve found it tiresome, as most exercises have felt like a variant of:

- Provide a new (generic) operation!
- Implement the new operation for existing numbers!
- Install a new number package!
- Extend the new number package!

Learning how to implement a type-based dispatch system in Scheme has been insightful, but wading through two whole sections of this stuff on repeat has defeated me.

Repetitiveness aside, the “object-orienty” feel to the exercises may have also played a part in curbing my enthusiasm. OO is a paradigm I’m already quite comfortable with (plus I get lots of practice writing Java™ at work), so I don’t see much point in dedicating what little free time I have to learning more of it.

I might revisit the remainder of this section at a later date. For now, I’ll forge ahead with the third chapter.

## Selected exercises

## Exercise 2.77

Recall the definitions of `apply-generic`

and `magnitude`

:

```
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(error
"No method for these types: APPLY-GENERIC"
(list op type-tags))))))
(define (magnitude z) (apply-generic 'magnitude z))
```

When Louis tries to evaluate the expression `(magnitude z)`

where `z`

is the object `'(complex rectangular 3 . 4)`

, `apply-generic`

first looks up the `magnitude`

operation for the `complex`

type in the table of operations. An error is thrown because it doesn’t exist.

In evaluating the expression `(magnitude z)`

, `apply-generic`

is invoked twice. First dispatch is to the `magnitude`

of `complex`

, second is to the `magnitude`

of `rectangular`

.

## Exercise 2.78

```
(define (attach-tag type-tag contents)
(if (number? contents)
contents
(cons type-tag contents)))
(define (type-tag datum)
(cond ((number? datum) 'scheme-number)
((pair? datum) (car datum))
(else (error "Bad tagged datum: TYPE-TAG" datum))))
(define (contents datum)
(cond ((number? datum) datum)
((pair? datum) (cdr datum))
(else (error "Bad tagged datum: CONTENTS" datum))))
```

Note: in the definition of `type-tag`

, we return `'scheme-number`

if `datum`

is a number. This is to allow `apply-generic`

to look up the appropriate `scheme-number`

operations.

Tests:

```
(add 3 142) ; 145
(sub 1468 131) ; 1337
```

## Exercise 2.79

```
; (install-scheme-number-package)
(put 'equ? '(scheme-number scheme-number)
(lambda (x y) (= x y)))
; (install-rational-package)
(define (equ-rat? x y)
(and (= (numer x) (numer y))
(= (denom x) (denom y))))
(put 'equ? '(rational rational) equ-rat?)
; (install-complex-package)
(define (equ-complex? x y)
(and (= (real-part x) (real-part y))
(= (imag-part x) (imag-part y))))
(put 'equ? '(complex complex) equ-complex?)
```

## Exercise 2.80

```
; (install-scheme-number-package)
(put '=zero? '(scheme-number)
(lambda (x) (= x 0)))
; (install-rational-package)
(define (=zero-rat? x)
(= (numer x) 0))
(put '=zero? '(rational) =zero-rat?)
; (install-complex-package)
(define (=zero-complex? x)
(and (= (real-part x) 0)
(= (imag-part x) 0)))
(put '=zero? '(complex) =zero-complex?)
```

## Exercise 2.81

Louis would like to add procedures to the coercion table to coerce arguments of each type to their own type:

```
(define (scheme-number->scheme-number n) n)
(define (complex->complex z) z)
(put-coercion 'scheme-number
'scheme-number
scheme-number->scheme-number)
(put-coercion 'complex 'complex complex->complex)
```

Part (a): the question asks what would happen if we call `exp`

with two complex numbers as arguments, given the following conditions:

- Louis’ coercion procedures are installed.
- We’ve defined a generic exponentiation operation:

```
(define (exp x y) (apply-generic 'exp x y))
```

- We’ve added an exponentiation procedure in the
`scheme-number`

package, but not in any of the others:

```
(put 'exp '(scheme-number scheme-number)
(lambda (x y) (tag (expt x y))))
```

If we call `exp`

with two arguments of type `scheme-number`

, Louis’ coercion procedure does nothing - it is never called. However, if we call `exp`

with two arguments of type `complex`

, the `apply-generic`

procedure recurses infinitely.

Part (b): no, Louis is wrong (has Louis *ever* been correct so far?). `apply-generic`

works correctly as-is.

Part (c):

```
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(define (no-method) (error "No method for these types"
(list op type-tags)))
(if proc
(apply proc (map contents args))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(if (equal? type1 type2)
(no-method)
(let ((t1->t2 (get-coercion type1 type2))
(t2->t1 (get-coercion type2 type1)))
(cond (t1->t2
(apply-generic op (t1->t2 a1) a2))
(t2->t1
(apply-generic op a1 (t2->t1 a2)))
(else (no-method))))))
(no-method))))))
```

## Exercise 2.82

Implementing the suggested strategy of coercing all the arguments to the type of the first argument, then to the type of the second argument, and so forth:

```
(define (apply-generic op . args)
(define (coerce-args type args)
(map (lambda (x)
(let ((t1->t2 (get-coercion (type-tag x) type)))
(if t1->t2 (t1->t2 x) x)))
args))
(define (apply-coerced types)
(if (null? types)
(error "No method for these types")
(let ((coerced-args (coerce-args (car types) args)))
(let ((proc (get op (map type-tag coerced-args))))
(if proc
(apply proc (map contents coerced-args))
(apply-coerced (cdr types)))))))
(let ((type-tags (map type-tag args)))
(apply-coerced type-tags)))
```

Tests:

```
(add (make-scheme-number 2) (make-scheme-number 4))
; '(scheme-number . 6)
(add (make-scheme-number 1) (make-complex-from-real-imag 2 7))
; '(complex rectangular 3 . 7)
```

## Exercise 2.83

```
; (install-scheme-number-package)
(define (scheme-number->rational x)
(make-rational x 1))
(put 'raise 'scheme-number scheme-number->rational)
; (install-rational-package)
(define (rational->real x)
(make-real (exact->inexact (/ (numer x) (denom x)))))
(put 'raise 'rational rational->real)
; (install-real-package)
(define (real->complex x)
(make-complex-from-real-imag x 0))
(put 'raise 'real real->complex)
```

## Exercise 2.84

The method I devised to test which of two types is higher in the tower of types is a simple one: assign each type a value. The greater the value, the higher the type is in the tower.

```
; Install into respective packages
(put 'level 'scheme-number 1)
(put 'level 'rational 2)
(put 'level 'real 3)
(put 'level 'polar 4)
(put 'level 'rectangular 4)
(put 'level 'complex 4)
```

```
(define (apply-generic op . args)
(define (coerce-to-type type arg)
(let ((lvl1 (get 'level type))
(lvl2 (get 'level (type-tag arg))))
(if (< lvl2 lvl1)
(coerce-to-type type ((get 'raise (type-tag arg))
(contents arg)))
arg)))
(define (coerce-args type args)
(map (lambda (x) (coerce-to-type type x)) args))
(define (apply-coerced types)
(if (null? types)
(error "No method for these types")
(let ((coerced-args (coerce-args (car types) args)))
(let ((proc (get op (map type-tag coerced-args))))
(if proc
(apply proc (map contents coerced-args))
(apply-coerced (cdr types)))))))
(let ((type-tags (map type-tag args)))
(apply-coerced type-tags)))
```

Tests:

```
(mul (make-scheme-number 2) (make-scheme-number 4))
; '(scheme-number . 8)
(sub (make-real 6) (make-rational 3 2))
; '(real . 4.5)
(add (make-scheme-number 1) (make-complex-from-real-imag 2 7))
; '(complex rectangular 3.0 . 7)
```

## Exercise 2.85

```
; (install-scheme-number-package)
(put 'equ? '(scheme-number scheme-number)
(lambda (x y) (= x y)))
; (install-rational-package)
(define (equ-rat? x y)
(and (= (numer x) (numer y))
(= (denom x) (denom y))))
(put 'equ? '(rational rational) equ-rat?)
(define (project x)
(make-scheme-number (numer x)))
(put 'project 'rational project)
; (install-real-package)
(put 'equ? '(real real)
(lambda (x y) (= x y)))
(define (project x)
(make-rational (inexact->exact (numerator x))
(inexact->exact (denominator x))))
(put 'project 'real project)
; (install-complex-package)
(define (equ-complex? x y)
(and (= (real-part x) (real-part y))
(= (imag-part x) (imag-part y))))
(put 'equ? '(complex complex) equ-complex?)
(define (project x)
(make-real (real-part x)))
(put 'project 'complex project)
```

Providing the generic operations `project`

, `raise`

and `equ?`

:

```
(define (project x)
(let ((do-project (get 'project (type-tag x))))
(if do-project
(do-project (contents x))
#f)))
(define (raise x)
(let ((do-raise (get 'raise (type-tag x))))
(if do-raise
(do-raise (contents x))
#f)))
(define (equ? x y)
(let ((type-tags (list (type-tag x) (type-tag y))))
(let ((do-equ? (get 'equ? type-tags)))
(if do-equ?
(do-equ? (contents x) (contents y))
#f))))
```

Note: all three operations return `#f`

if the operation does not exist for a type.

Defining the `drop`

procedure, with some quick tests:

```
(define (drop x)
(let ((projected (project x)))
(if projected
(let ((re-raised (raise projected)))
(if (equ? x re-raised)
(drop projected)
x))
x)))
; Tests
(drop (make-complex-from-real-imag 1 0))
; '(scheme-number . 1)
(drop (make-complex-from-real-imag 1.5 0))
; '(rational 3 . 2)
; Opted to allow conversion of a real number to fractions, hence
; why this drops one more level to 'rational, and not to 'real
```

Rewriting `apply-generic`

so that it “simplifies” its answers:

```
(define (apply-generic op . args)
(define (coerce-to-type type arg)
(let ((lvl1 (get 'level type))
(lvl2 (get 'level (type-tag arg))))
(if (< lvl2 lvl1)
(coerce-to-type type ((get 'raise (type-tag arg))
(contents arg)))
arg)))
(define (coerce-args type args)
(map (lambda (x) (coerce-to-type type x)) args))
(define (apply-coerced types)
(if (null? types)
(error "No method for these types")
(let ((coerced-args (coerce-args (car types) args)))
(let ((proc (get op (map type-tag coerced-args))))
(if proc
(apply proc (map contents coerced-args))
(apply-coerced (cdr types)))))))
(let ((type-tags (map type-tag args)))
(let ((result (apply-coerced type-tags)))
; Have to perform this check, as `apply-generic` is also used to
; provide generic selectors for the rectangular and polar packages
; which return numbers, and therefore cannot be "dropped"
(if (pair? result)
(drop result)
result))))
```

Tests:

```
(mul (make-scheme-number 2) (make-scheme-number 4))
; '(scheme-number . 8)
(sub (make-real 6) (make-rational 3 2))
; '(rational 9 . 2)
(add (make-scheme-number 1) (make-complex-from-real-imag 2 7))
; '(complex rectangular 3.0 . 7)
(add (make-real 1.5) (make-complex-from-real-imag 2 0))
; '(rational 7 . 2)
(add (make-rational 3 2) (make-complex-from-real-imag 2 1))
; '(complex rectangular 3.5 . 1)
(sub (make-complex-from-real-imag 7 4) (make-complex-from-real-imag 2 4))
; '(scheme-number . 5)
```

## Exercise 2.86

To handle complex numbers whose real parts, imaginary parts, magnitudes and angles can be either ordinary numbers, rational numbers, or other numbers we might wish to add, we have to make the following changes to the system:

- Provide generic operations
`sine`

,`cosine`

,`arctan`

,`square`

and`sqrt`

. - Implement these operations for
`scheme-number`

,`rational`

, and other numbers we might wish to add. - Modify the
`rectangular`

and`polar`

packages to use these generic operations. - Replace the primitive arithmetic operations
`+`

,`-`

,`*`

and`/`

in the`rectangular`

,`polar`

and`complex`

packages with their generic operation equivalents.