<< Previous exercise (2.73) | Index | Next exercise (2.75) >>


Let's assume there is table indexed by Division name providing the 'record and 'salary generic procedures of one argument, the employee name and the record respectively. Here is a possible answer:

 ;; a) 
 (define (get-record division employee-name) 
   ((get division 'record) employee-name)) 
 ;; b) 
 (define (get-salary division record) 
   ((get division 'salary) record)) 
 ;; c) 
 (define (find-employee-record employee-name division-list) 
   (if (null? division-list) 
       (or (get-record (car division-list) employee-name) 
           (find-employee-record employee-name (cdr division-list))))) 

d) the new company needs to install its 'record and 'salary generic procedures into the lookup table using its name as the first key.


The answer above is slightly different from what I think. The table for this question should have a horizontal axis of division name(type) and a vertical axis of procedures(op).

Therefore: a) Each division's records consist of a single file, which contains a set of records keyed on employees' names. This single file should be structured as a list of employees' records, with a tag of the division name. And each employee's record should have a tag of their name. The way these tags are put must be supplied. E.g. the file of division-1 can be '(division-1 (Mike 2000) (Jack 3500)) Here is the corresponding answer:

 (define (install-division-1-package) 
   ;;internal procedures 
   (define (get-record name file) 
     (cond ((null? file) (error "no result")) 
           ((eq? name (get-name (cadr file))) (cons (cadr file) 
                                                    (get-record name (cdr file)))) 
           (else (get-record name (cdr file))))) 
   (define (get-name record) 
     (car record)) 
   ;;interface to the rest of the system 
   (put 'get-record 'division-1 get-record) 
   (put 'get-name 'division-1 get-name) 
 (define (get-record name file) 
   (apply-generic 'get-record name file)) 
 (define (apply-generic op name file) 
   (let ((division-name (type-tag file))) 
     (let ((proc (get op division-name))) 
       (if proc 
           (proc name file) 
           (error "no result"))))) 
 (define (type-tag file) 
   (car file)) 

b) Take division-1 above as an example, the answer just needs to be modified by adding a few lines:

 ;; Addition to the division-1 package 
 (define (get-salary name file) 
     (cond ((null? file) (error "no result")) 
           ((eq? name (get-name (cadr file))) (cons (cadr (cadr file)) 
                                                    (get-salary name (cdr file)))) 
           (else (get-salary name (cdr file))))) 
 (put 'get-salary 'division-1 get-salary) 
 ;;Addition to the environment 
 (define (get-salary name file) 
   (apply-generic 'get-salary name file)) 

c) Just implement "get-record" to all the divisions.

 (define (find-employee-record name list) 
   (if (null? list) 
       (error "no result") 
       (append (get-record (car list)) 
               (find-employee-record name (cdr list))))) 

d) Install a new package which specifies the procedures to look up name/salary in the new company's file.