1 665c255d 2023-08-04 jrmu ;; Exercise 2.74. Insatiable Enterprises, Inc., is a highly decentralized conglomerate company consisting of a large number of independent divisions located all over the world. The company's computer facilities have just been interconnected by means of a clever network-interfacing scheme that makes the entire network appear to any user to be a single computer. Insatiable's president, in her first attempt to exploit the ability of the network to extract administrative information from division files, is dismayed to discover that, although all the division files have been implemented as data structures in Scheme, the particular data structure used varies from division to division. A meeting of division managers is hastily called to search for a strategy to integrate the files that will satisfy headquarters' needs while preserving the existing autonomy of the divisions.
3 665c255d 2023-08-04 jrmu ;; Show how such a strategy can be implemented with data-directed programming. As an example, suppose that each division's personnel records consist of a single file, which contains a set of records keyed on employees' names. The structure of the set varies from division to division. Furthermore, each employee's record is itself a set (structured differently from division to division) that contains information keyed under identifiers such as address and salary. In particular:
5 665c255d 2023-08-04 jrmu (define (apply-generic op . args)
6 665c255d 2023-08-04 jrmu (let* ((type-tags (map type-tag args))
7 665c255d 2023-08-04 jrmu (proc (get op type-tags)))
9 665c255d 2023-08-04 jrmu (apply proc (map contents args))
10 665c255d 2023-08-04 jrmu (error "invalid operation/type"))))
12 665c255d 2023-08-04 jrmu (define (attach-tag type-tag contents)
13 665c255d 2023-08-04 jrmu (cons type-tag contents))
14 665c255d 2023-08-04 jrmu (define (type-tag datum)
15 665c255d 2023-08-04 jrmu (if (pair? datum)
17 665c255d 2023-08-04 jrmu (error "invalid datum")))
18 665c255d 2023-08-04 jrmu (define (contents datum)
19 665c255d 2023-08-04 jrmu (if (pair? datum)
21 665c255d 2023-08-04 jrmu (error "invalid datum")))
23 665c255d 2023-08-04 jrmu ;; returns name of given record
24 665c255d 2023-08-04 jrmu (define (name record)
25 665c255d 2023-08-04 jrmu (apply-generic 'name record))
26 665c255d 2023-08-04 jrmu (define (address record)
27 665c255d 2023-08-04 jrmu (apply-generic 'address record))
28 665c255d 2023-08-04 jrmu (define (salary record)
29 665c255d 2023-08-04 jrmu (apply-generic 'salary record))
30 665c255d 2023-08-04 jrmu (define (make-file1-record1 name salary address other)
31 665c255d 2023-08-04 jrmu ((get 'make-file1-record1 '(file1 record1)) name salary address other))
34 665c255d 2023-08-04 jrmu (define (install-file1)
35 665c255d 2023-08-04 jrmu (define (make-record1 name salary address other)
36 665c255d 2023-08-04 jrmu (list name salary address other))
37 665c255d 2023-08-04 jrmu (define (name-record1 record)
38 665c255d 2023-08-04 jrmu (car record))
39 665c255d 2023-08-04 jrmu ;; we'll implement the file as a simple unordered list
40 665c255d 2023-08-04 jrmu (define (in-file? file name)
41 665c255d 2023-08-04 jrmu (and (not (null? file))
42 665c255d 2023-08-04 jrmu (or (eq? (car file) name)
43 665c255d 2023-08-04 jrmu (cond ((null? file) #f)
44 665c255d 2023-08-04 jrmu ((eq? (car file) name) #t)
45 665c255d 2023-08-04 jrmu (else (in-file? (cdr file) name))))
48 665c255d 2023-08-04 jrmu (put 'make-file1-record1
49 665c255d 2023-08-04 jrmu '(file1 record1)
50 665c255d 2023-08-04 jrmu (lambda (name salary address other)
51 665c255d 2023-08-04 jrmu (attach-tag '(file1 record1)
52 665c255d 2023-08-04 jrmu (make-record1 name salary address other))))
54 665c255d 2023-08-04 jrmu (put 'name '(file1 record1) ...)
58 665c255d 2023-08-04 jrmu ;; I should define an in-file? procedure and an add-record procedure instead
60 665c255d 2023-08-04 jrmu ;; (define (make-file-internal list-of-records)
61 665c255d 2023-08-04 jrmu ;; list-of-records)
62 665c255d 2023-08-04 jrmu ;; (put 'make-file 'file1 (lambda (list-of-records)
63 665c255d 2023-08-04 jrmu ;; (attach-tag 'file1 (make-file-interal list-of-records))))
64 665c255d 2023-08-04 jrmu ;; (define (make-file1 list-of-records)
65 665c255d 2023-08-04 jrmu ;; ((get 'make-file 'file1) list-of-records))
67 665c255d 2023-08-04 jrmu ;; a. Implement for headquarters a get-record procedure that retrieves a specified employee's record from a specified personnel file. The procedure should be applicable to any division's file. Explain how the individual divisions' files should be structured. In particular, what type information must be supplied?
69 665c255d 2023-08-04 jrmu ;; get specified record from specified file
70 665c255d 2023-08-04 jrmu (define (get-record file name)
71 665c255d 2023-08-04 jrmu (apply-generic 'get-record file name))
73 665c255d 2023-08-04 jrmu (define (get-record-file1 file name)
74 665c255d 2023-08-04 jrmu (cond ((null? file) (error "person not found" name))
75 665c255d 2023-08-04 jrmu ((eq? (car file) name) (car file))
76 665c255d 2023-08-04 jrmu (else (get-record-file1 (cdr file) name))))
77 665c255d 2023-08-04 jrmu (put 'get-record '(file1 file1-record) get-record-file1)
79 665c255d 2023-08-04 jrmu ;; b. Implement for headquarters a get-salary procedure that returns the salary information from a given employee's record from any division's personnel file. How should the record be structured in order to make this operation work?
81 665c255d 2023-08-04 jrmu ;; c. Implement for headquarters a find-employee-record procedure. This should search all the divisions' files for the record of a given employee and return the record. Assume that this procedure takes as arguments an employee's name and a list of all the divisions' files.
83 665c255d 2023-08-04 jrmu ;; d. When Insatiable takes over a new company, what changes must be made in order to incorporate the new personnel information into the central system?
