Это упражнение сформулировано довольно обобщенно и допускает достаточно широкий диапазон трактовок. Я предлагаю один из вариантов по мотивам предшествующего раздела книги, который демонстрирует основные идеи.
Итак, пусть в компании Insatiable Enterprises, Inc. есть два отела: разработки (инженерный) и продаж.
В отделе разработки записи о сотрудниках содержат имена, должности и размеры окладов. Запись соединяет поля с помощью операций cons. Сами записи хранятся в списке. Для поиска записи в списке определена специальная процедура поиска.
(define (make-employee name position salary)
(cons name (cons position salary)))
(define (get-name employee)
(car employee))
(define (get-position employee)
(cadr employee))
(define (get-salary employee)
(cddr employee))
(define employees
(list (make-employee 'Hugo 'junior 60000)
(make-employee 'Alyssa 'senior 90000)
(make-employee 'Eva 'lead 100000)
(make-employee 'Ben 'senior 110000)))
(define (get-employee name)
(define (find-employee employees)
(cond ((null? employees) null)
((eq? name (get-name (car employees)))
(car employees))
(else (find-employee (cdr employees)))))
(find-employee employees))
В отделе продаж работают люди опытные и творческие. Поэтому записи о сотрудниках содержат самое главное: имена, размеры окладов и стаж. Запись соединяет поля просто в список. Сами записи задаются в специальная процедуре, возвращающей соответствующую запись по ключу – имени сотрудника.
(define (make-record name salary experience)
(list 'employee name salary experience))
(define (get-record-name record)
(cadr employee))
(define (get-record-salary record)
(caddr employee))
(define (get-record-experience record)
(cadddr employee))
(define (get-salesman who)
(cond ((eq? who 'Mike) (make-record 'Mike 200000 5))
((eq? who 'Jennifer) (make-record 'Jennifer 180000 3))
((eq? who 'Scott) (make-record 'Scott 250000 10))
(else null)))
Как видим, структуры представления данных в записи и хранения самих записей отличаются друг от друга довольно сильно. Для того, чтобы работать с ними единообразно, мы завернем данные об отделах в пакеты и поместим операции над данными в таблицу типов. В этой таблице тип будет задаваться именем отдела, а операциями будут имена обобщенных операций, например get-record.
(define (install-engineering-department)
(define (make-employee name position salary)
(cons name (cons position salary)))
(define (get-name employee)
(car employee))
(define (get-position employee)
(cadr employee))
(define (get-salary employee)
(cddr employee))
(define employees
(list (make-employee 'Hugo 'junior 60000)
(make-employee 'Alyssa 'senior 90000)
(make-employee 'Eva 'lead 100000)
(make-employee 'Ben 'senior 110000)))
(define (get-employee name)
(define (find-employee employees)
(cond ((null? employees) null)
((eq? name (get-name (car employees)))
(car employees))
(else (find-employee (cdr employees)))))
(find-employee employees))
(put 'get-record 'engineering get-employee)
(put 'get-salary 'engineering get-salary)
'done)
(define (install-sales-department)
(define (make-record name salary experience)
(list 'employee name salary experience))
(define (get-record-name record)
(cadr employee))
(define (get-record-salary record)
(caddr employee))
(define (get-record-experience record)
(cadddr employee))
(define (get-salesman who)
(cond ((eq? who 'Mike) (make-record 'Mike 200000 5))
((eq? who 'Jennifer) (make-record 'Jennifer 180000 3))
((eq? who 'Scott) (make-record 'Scott 250000 10))
(else null)))
(put 'get-record 'sales get-salesman)
(put 'get-salary 'sales get-record-salary)
'done)
а. Теперь мы можем легко написать обобщенную процедуру получения записи сотрудника по его имени и отделу:
(define (get-record name department)
((get 'get-record department) name))
б. Для того, чтобы получить зарплату сотрудника, мы сначала добываем из таблицы операцию извлечения информации о зарплате из записи для данного отдела, а затем применяем ее к записи сотрудника, полученной обобщенной процедурой get-record:
(define (get-salary name department)
((get 'get-salary department)
(get-record department name)))
в. Для поиска записи о сотруднике по всем подразделениям будем использовать описанную ниже процедуру, на вход которой достаточно будет передать имя сотрудника и список названий подразделений:
(define (find-employee-record name departments)
(if (null? departments)
null
(let ((record (get-record name (car departments))))
(if (null? record)
(find-employee-record name (cdr departments))
record))))
Здесь при реализации можно было бы использовать библиотечную процедуру findf.
г. Для внесения в систему информации о новых подразделениях достаточно будет установить пакет для соответствующего подразделения, в который включить специфичное для него описание данных о сотрудниках и дополнительно задать новую строку операций в таблице типов, соответствующую этому подразделению, с помощью набора вызовов put:
(define (install-new-department)
;; ...
(put 'get-record 'new get-record-new)
(put 'get-salary 'new get-salary-new)
'done)
При этом ничего менять ни в пакетах других подразделений, ни в обобщенных процедурах get-record, get-salary и т.д. не нужно! Именно в этом и заключается наш выигрыш.
