Scheme - データによる抽象の構築(抽象データの多重表現(データ主導プログラミングと加法性(レコードの構造化、put, get), 新しいパッケージのインストール))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)
異なる出版社で予約受付中

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.4(抽象データの多重表現)、2.4.3(データ主導プログラミングと加法性)、問題 2.74-b, c, d.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 2.74-b, c, d.

コード(BBEdit, Emacs)

sample.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

;; これまでに書いた手続き
(load "./procedures.scm")

;; 独立したファイルの構造の例1
;; (list '(name1 ((salary salary1)
;;               (address address1)
;;               ...))
;;       '(name2 ((address address2)
;;                (salary salary2)))
;;       ...)
(define (install-japan-package)
  (define file '())
  (define (get-record name file)
    (define (inner file)
      (cond ((null? file) #f)
            ((eq? (caar file)
                  name)
             (cadar file))
            (else
             (inner (cdr file)))))
    (inner file))
  (define (find record item)
    (cond ((null? record)
           (error item name))
          ((eq? (caar record)
                item)
           (cadar record))
          (else
           (find (cdr record) item))))
  (define (get-address name file)
    (find (get-record name file) 'address))
  (define (get-salary name)
    (find (get-record name file) 'salary))

  ;; 追加しなければならない型情報は事業所を特定するための型(今回の場合は'japan)
  ;; 理由は事務所によってファイルの構造が異なるから
  (put 'get-record 'japan get-record)
  (put 'get-salary 'japan get-salary)
  'done)

(define (install-new-office-package)
  ;; 省略
  (put 'get-record 'new-office get-record)
  (put 'get-salary 'new-office get-salary)
  'done)

;; b
(define (get-salary file name)
  ((get 'get-salary (type-tag file)) name (contents file)))

;; c
(define (get-record name file)
  ((get 'get-record (type-tag file)) name (contents file)))
   
(define (find-employee-record name files)
  (if (null? files)
      (error "Not found -- FIND-EMPLOYEE_RECORD" name)
      (let ((record (get-record (car files))))
        (if record
            record
            (find-employee_record name (cdr files))))))

;; put, getの実装はまだだから、出力結果による確認、テストは後回し

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample.scm
$