2015年6月21日日曜日

開発環境

計算機プログラムの構造と解釈[第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.を解いてみる。

その他参考書籍

問題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 コメント:

コメントを投稿