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


 ;; SICP 2.74 
 ;a. Implement get-record, based on a foo x division table. 
 ;   Each division file must have a division func to extrat  
 ;   'type' and provide a instalation package to include  
 ;   specific get-record. The output is a tagged record. 
 ;   Get-record must return false if doesn't find employee record (c). 
     (define (attach-tag type-tag content) (cons type-tag content)) 
     (define (get-record employee-id file) 
         (attach-tag (division file)  
                     ((get 'get-record (division file)) employee-id file))) 
 ;b. get-salary 
     (define (get-salary record) 
         (let ((record-type (car record)) 
               (record-content (cdr record))) 
                 ((get 'get-salary record-type) record-content))) 
 ;c. find-employee-record 
     (define (find-employee-record employee-id file-list) 
         (if (null? file-list) 
             (let ((current-file (car file-list))) 
              (if (get-record employee-id current-file) 
                 (get-record employee-id current-file) 
                 (find-employee-record employee-id (cdr file-list)))))) 
 ;d. New company must provide a installation package for its 
 ;   record-file as new division. This instalation must include 
 ;   the new division get-record and get-salary implementations. 

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.

a) I am assuming that the individual divisions' files are structured such that there already exists, for each division, a get-record method. I am assuming there exists an (<operator>, personnel-file) table. The reason I am not assuming there exists an (<operator>, division) table is that this assumption would then require the additional assumption that there exists a method that takes personnel-file as argument and returns the division of that personnel-file. Since each division has exactly one personnel-file, we have a 1-1 correspondence between the two pieces of data. Indexing by personnel-file allows me to make one less assumption and have the same amount of columns. Thus, we have:

 (define (get-record employee personnel-file) 
   ((get 'get-record personnel-file) employee)) 

b) Now, I just assume that each record is structured such that each division can implement and has implemented their own get-salary method, that takes as argument the employee's record and returns the employee's salary. Thus:

 (define (get-salary employee personnel-file) 
   ((get 'get-salary personnel-file) (get-record employee personnel-file))) 

c) I'm assuming that each individual divisions get-record method returns '() if the employee is not employed in that division, and so the method that we implemented in part a) of this question returns '() in that case, too. We have:

 (define (find-employee-record employee division-files) 
   (cond ((null? division-files) '()) 
         ((not (null? (get-record employee (car division-files)))) 
          (get-record employee (car division-files))) 
         (else (find-employee-record employee (cdr division-files))))) 

d) Call the newly acquired division-file new-division-file. Entries corresponding to (get-record, new-division-file) and (get-salary, new-division-file) need to be added to our (<operator>, division-file) table. That is, the newly acquired company needs to implement locally their own versions of get-record, get-salary, then we need to add these implementations to our table, and then the methods defined in a), b), c) will work.