問題2.74

;; a
;; それぞれの事業所のファイルには個別の型がついている。
;; placeという手続きによって型名を呼び出せる。

(define (get-record file name)
  ((get 'get-record (place file)) (records file) name))

(define (place obj)
  (car obj))

(define (records file)
  (cadr file))

(define (make-file place-name records)
  (list place-name records))

;; たとえば、tokyo事業所ではファイルはレコードのリストであった。
(define (install-tokyo-package) ;; example
  (define (get-record record name)
    (if (null? record)
        #f
        (if (eq? (get-name (car record)) name)
            (car record)
            (get-record (cdr record) name))))
  (put 'get-record '(tokyo) get-record))


;; b
;; それぞれの事業所のレコードには個別の型がついている。
;; placeという手続きによって型名を呼び出せる。
(define (get-salary record)
  ((get 'get-salary (place record)) (data record)))

;; placeはさっきと同じ

(define (data record)
  (cadr record))

(define (make-record place-name record)
  (list place-name record))

;; たとえば、tokyo支社ではレコードをalistで作っていた。
(define (install-tokyo-package)
  (define (get-salary record-data)
    (cdr (assoc 'salary record-dada))))

;; c
(define (find-employee-record name files)
  (if (null? files)
      #f
      (let ((found (get-record (car files) name)))
        (if found
            found
            (find-employee-record name (cdr files))))))

;;d
;; 事業所が増えるという話か、全然違う会社と合併する話なのかちょっとわからない。

;; 後者として話を進める。
;; 今ある事業所のタイプタグの一段階上にさらに抽象レイヤーを作る。
;; つまり、会社のタイプタグなどを作り、「それぞれの会社のすべての事業所ファイルの集合」への型付けを行う。
;; そしてfind-employee-recordなどの基本手続きをそのレイヤーの上に接続するように変更する。