-
Notifications
You must be signed in to change notification settings - Fork 0
/
2-74.scm
129 lines (97 loc) · 4.12 KB
/
2-74.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
;;; ハッシュテーブルを使い put, get を実装
;;; キーとして演算と型のリストを利用する
(define table (make-hash-table 'equal?))
(define (put op type item)
(hash-table-put! table (list op type) item))
(define (get op type)
(hash-table-get table (list op type)))
;;; 東京事業所は社員情報として、address, salary を持つ
(define (install-tokyo-division-package)
(define (employee-records file)
(cdr file))
(define (employee-name record)
(car record))
(define (employee-salary record)
(caddr record))
(define (get-record file name)
(define (find records)
(cond ((null? records) #f)
((equal? (employee-name (car records)) name)
(car records))
(else (find (cdr records)))))
(find (employee-records file)))
(define (get-salary file name)
(employee-salary (get-record file name)))
(put 'get-record 'tokyo get-record)
(put 'get-salary 'tokyo get-salary)
'done)
;;; 大阪事業所は社員情報として、address, salary, age を持つ
(define (install-osaka-division-package)
(define (employee-records file)
(cdr file))
(define (employee-name record)
(car record))
(define (employee-salary record)
(cadddr record))
(define (get-record file name)
(define (find records)
(cond ((null? records) #f)
((equal? (employee-name (car records)) name)
(car records))
(else (find (cdr records)))))
(find (employee-records file)))
(define (get-salary file name)
(employee-salary (get-record file name)))
(put 'get-record 'osaka get-record)
(put 'get-salary 'osaka get-salary)
'done)
;;; パッケージインストール
(install-tokyo-division-package)
(install-osaka-division-package)
;;; 東京事業所のファイル(データベース)
(define tokyo-file
(list 'tokyo
(list "suzuki" "東京都新宿区" 200000)
(list "sato" "東京都渋谷区" 300000)
(list "yoshida" "東京都三鷹市" 400000)))
;;; 大阪事業所のファイル(データベース)
(define osaka-file
(list 'osaka
(list "tanaka" "大阪府池田市" 28 250000)
(list "sato" "大阪府堺市" 33 320000)))
;;; a --------------------------------------------------------------------------
;;; それぞれの事業所ファイルに事業所を表す型タグを持たせる必要がある。
;;; また、自身の表現するレコードにアクセスする内部関数を持つ必要がある。
(define (division file)
(car file))
(define (get-record file name)
((get 'get-record (division file)) file name))
;;; 使用例
(get-record tokyo-file "suzuki") ; ("suzuki" "東京都新宿区" 200000)
(get-record tokyo-file "sato") ; ("sato" "東京都渋谷区" 300000)
(get-record osaka-file "sato") ; ("sato" "大阪府堺市" 33 320000)
;;; b --------------------------------------------------------------------------
;;; どの事業所の従業員レコードにも salary を持たせておき、
;;; それにアクセスできる関数を用意しておく。
(define (get-salary file name)
((get 'get-salary (division file)) file name))
;;; 使用例
(get-salary tokyo-file "suzuki") ; 200000
(get-salary tokyo-file "yoshida") ; 400000
(get-salary osaka-file "tanaka") ; 250000
;;; c --------------------------------------------------------------------------
(define (find-employee-record files name)
(if (null? files)
'()
(let ((record (get-record (car files) name)))
(if record
(cons record (find-employee-record (cdr files) name))
(find-employee-record (cdr files) name)))))
;;; 使用例
(find-employee-record (list tokyo-file osaka-file) "suzuki")
;; (("suzuki" "東京都新宿区" 200000))
(find-employee-record (list tokyo-file osaka-file) "sato")
;; (("sato" "東京都渋谷区" 300000) ("sato" "大阪府堺市" 33 320000))
;;; d --------------------------------------------------------------------------
;;; 別会社の事業部毎に install-tokyo-package, install-osaka-package と同様
;;; の手続きを作成して実行すれば良い。