計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)
開発環境
- OS X Yosemite - Apple (OS)
- Emacs(Text Editor)
- Scheme (プログラミング言語)
- kscheme, Gauche, GNU Guile (処理系)
計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.4(抽象データの多重表現)、2.4.3(データ主導プログラミングと加法性)、問題2.74-c.を解いてみる。
その他参考書籍
- Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
- プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
- Scheme手習い
問題2.74-c.
コード(Emacs)
(begin
(newline)
(define error
(lambda (message value)
(display message)
(display " ")
(display value)
(newline)))
(define print
(lambda (x)
(display x)
(newline)))
(define make-table
(lambda ()
(let ((local-table (list (quote *table*))))
(define assoc
(lambda (key records)
(cond ((null? records) #f)
((equal? key (caar records))
(car records))
(else (assoc key (cdr records))))))
(define lookup
(lambda (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)
#f))
#f))))
(define insert!
(lambda (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)))))
(quote ok)))
(define dispatch
(lambda (m)
(cond ((eq? m (quote lookup-proc)) lookup)
((eq? m (quote insert-proc!)) insert!)
(else (error "Unknown operation -- TABLE" m)))))
dispatch)))
(define operation-table (make-table))
(define get (operation-table (quote lookup-proc)))
(define put (operation-table (quote insert-proc!)))
(define install-division1-package
(lambda ()
(define make-record (lambda (name address salary)
(list name address salary)))
(define name (lambda (record) (car record)))
(define address (lambda (record) (cadr record)))
(define salary (lambda (record) (caddr record)))
(define make-personnel-file
(lambda (records)
(cons (quote division1) records)))
(define division (lambda (personnel-file) (car personnel-file)))
(define records (lambda (personnel-file) (cdr personnel-file)))
(define get-record
(lambda (personnel-file employee-name)
(define iter
(lambda (records)
(if (null? records)
(quote not-found)
(let ((record (car records)))
(if (eq? (name record) employee-name)
record
(iter (cdr records)))))))
(iter (records personnel-file))))
(define get-salary
(lambda (name personnel-file)
(let ((record (get-record personnel-file name)))
(if (eq? record (quote not-found))
(quote not-found)
(salary record)))))
(put (quote make-record) (quote division1) make-record)
(put (quote make-personnel-file) (quote division1) make-personnel-file)
(put (quote division) (quote division1) division)
(put (quote get-record) (quote division1) get-record)
(put (quote get-salary) (quote division1) get-salary)
(quote install-division1-package-done)))
(define make-record
(lambda (name address salary division)
((get (quote make-record) division) name address salary)))
(define make-personnel-file
(lambda (records division)
((get (quote make-personnel-file) division) records)))
(define get-record
(lambda (name personnel-file division)
((get (quote get-record) division)
personnel-file
name)))
(define division (lambda (personnel-file) (car personnel-file)))
(define get-salary
(lambda (name personnel-file)
((get (quote get-salary) (division personnel-file))
name personnel-file)))
(define find-employee-record
(lambda (name personnel-files)
(if (null? personnel-files)
(quote not-found)
(let ((personnel-file (car personnel-files)))
(let ((record (get-record name
personnel-file
(division personnel-file))))
(if (eq? record
(quote not-found))
(find-employee-record name (cdr personnel-files))
record))))))
(print (install-division1-package))
(define record11 (make-record (quote kamimura1)
(quote tokyo)
1
(quote division1)))
(define record12 (make-record (quote kamimura2)
(quote tokyo)
2
(quote division1)))
(define records1 (list record11 record12))
(define personnel-file-division1 (make-personnel-file records1
(quote division1)))
(define record21 (make-record (quote kamimura3)
(quote tokyo)
3
(quote division1)))
(define record22 (make-record (quote kamimura4)
(quote tokyo)
4
(quote division1)))
(define records2 (list record21 record22))
(define personnel-file-division2 (make-personnel-file records2
(quote division1)))
(define personnel-files (list personnel-file-division1
personnel-file-division2))
(print (find-employee-record (quote kamimura1) personnel-files))
(print (find-employee-record (quote kamimura2) personnel-files))
(print (find-employee-record (quote kamimura3) personnel-files))
(print (find-employee-record (quote kamimura4) personnel-files))
(quote done))
入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))
$ kscheme < sample74_c.scm kscm> install-division1-package-done (kamimura1 tokyo 1) (kamimura2 tokyo 2) (kamimura3 tokyo 3) (kamimura4 tokyo 4) done kscm> $
0 コメント:
コメントを投稿