Created
May 14, 2012 10:12
-
-
Save ainame/2693075 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; 組み込みしたいもの達 | |
| (define true #t) | |
| (define false #f) | |
| (define null '()) | |
| (define (make-table) | |
| (let ((local-table (list '*table*))) | |
| (define (lookup key-1 key-2) | |
| (let ((subtable (assoc key-1 (cdr local-table)))) | |
| (if subtable | |
| (let ((record (assoc key-2 (cdr subtable)))) | |
| (if record | |
| (cdr record) | |
| false)) | |
| false))) | |
| (define (insert! key-1 key-2 value) | |
| (let ((subtable (assoc key-1 (cdr local-table)))) | |
| (if subtable | |
| (let ((record (assoc key-2 (cdr subtable)))) | |
| (if record | |
| (set-cdr! record value) | |
| (set-cdr! subtable | |
| (cons (cons key-2 value) | |
| (cdr subtable))))) | |
| (set-cdr! local-table | |
| (cons (list key-1 | |
| (cons key-2 value)) | |
| (cdr local-table))))) | |
| 'ok) | |
| (define (dispatch m) | |
| (cond ((eq? m 'lookup-proc) lookup) | |
| ((eq? m 'insert-proc!) insert!) | |
| (else (error "Unknown operation --- TABLE" m)))) | |
| dispatch)) | |
| (define operation-table (make-table)) | |
| (define get (operation-table 'lookup-proc)) | |
| (define put (operation-table 'insert-proc!)) | |
| ;; アキナイ有限責任会社(Insatiable Enterprises, Inc)は全世界に存在する多数の独立事業所を持つ超分散型の多国籍企業である。 | |
| ;; この会社の計算機システムは、全体のネットワークがどの利用者にも一つの計算機と見えるような、 | |
| ;; 賢いネットワークインターフェース方式で相互接続された。社長はネットワークから | |
| ;; 事業所ファイルの管理情報を取り出す能力を初めて試みたとき、事業所ファイルはSchemeのデータ構造として実装してあったが、 | |
| ;; それぞれのデータ構造は、事業所毎に異なっているのを知って驚いた。事業所管理者の会合が急いで開かれ、 | |
| ;; 事業所の既存の自立性を保存したまま、本部の必要性を満たすようにファイルを統合戦略を探求した | |
| ;; データ主導プログラミングにより、そういう戦略を実装する方法を示せ。 | |
| ;; 例として各事業所の従業員レコードが、従業員の名前でキーをつけたレコードの集合からなる | |
| ;; 一つのファイルできているとする。集合の構造は事業所毎異なる。更に各従業員のレコード自体が | |
| ;; (事業所毎に異なった構造の)集合で、addressとsalaryという識別子でキーをつけた情報を含んでいる。 | |
| ;; a. 本部の為に、指定した従業員ファイルから、指定した従業員のレコードを検索する get-record 手続きを実装せよ。 | |
| ;; この手続きはどの事業所のファイルに対しても使えなければならない。 | |
| ;; それぞれの事業所ファイルはどう構造化すべきか説明せよ。得にどんな型情報が追加されるべきか。 | |
| ;; | |
| ;; 回答:リストのcarにtype-tagを持たせたデータ構造にする | |
| (define (install-A-office) | |
| (define (type-tag table) (car table)) | |
| (define (name x) (car x)) | |
| (define (address x) (cadr x)) | |
| (define (salary x) (caddr x)) | |
| (define (get-record table key) | |
| (if (equal? key (car (name table))) | |
| (car table) | |
| (get-record key (cdr table)))) | |
| (define (create-record name address salary) | |
| (list name address salary)) | |
| (define (insert-records values) | |
| (cons 'A values)) | |
| (put 'get-record 'A get-record) | |
| (put 'insert-records 'A insert-records) | |
| 'done) | |
| (install-A-office) | |
| (define (A-records) | |
| ((get 'insert-records 'A) | |
| (list | |
| (list 'a 'address1 'salary1) | |
| (list 'b 'address2 'salary2) | |
| (list 'c 'address3 'salary3)))) | |
| ;; b. 本部の為に、いずれの事業所の従業員ファイルからでも与えられた従業員のレコードから、 | |
| ;; 給与の情報を返す get-salary 手続きを実装せよ。この演算が働く為には、レコードをどう構造化すべきか。 | |
| ;; | |
| (define (install-A-office) | |
| (define (type-tag table) (car table)) | |
| (define (name x) (car x)) | |
| (define (address x) (cadr x)) | |
| (define (salary x) (caddr x)) | |
| (define (get-record table key) | |
| (if (equal? key (car (name table))) | |
| (car table) | |
| (get-record key (cdr table)))) | |
| (define (create-record name address salary) | |
| (list name address salary)) | |
| (define (insert-records values) | |
| (cons 'A values)) | |
| ;; 追加 | |
| (put 'get-record 'A get-record) | |
| (put 'insert-records 'A insert-records) | |
| (put 'get-salary 'A salary) | |
| 'done) | |
| (install-A-office) | |
| (define (get-salary record) | |
| (if record | |
| ((get 'get-salary 'A) record) | |
| false)) | |
| ;; c. 本部の為に、find-employee-record 手続きを実装せよ。全ての事業所ファイルから与えられた従業員のレコードを探し、 | |
| ;; それを返すものとする。この手続きは引数として従業員の名前と全事業所ファイルのリストを取るものと仮定せよ。 | |
| (define (find-employee-record employee-name . records-list) | |
| (map (lambda (records) | |
| ((get 'get-record (type-tag records)) employee-name)) | |
| records-list)) | |
| ;; d. この企業が別の会社を合併した時、新しい従業員情報を中央システムに組み込むにはどういう変更をすべきか。 | |
| ;; 回答:合併した企業の従業員情報をget-salaryやfind-employee-recordが | |
| ;; 使えるようにインターフェイスを実装したパッケージを作成する |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment