<< 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.