Scheme - 標準部品化力、オブジェクト及び状態 - 可変データでのモデル化 - 表の表現(キーの等価性)

計算機プログラムの構造と解釈
原著

開発環境

• macOS High Sierra - Apple(OS)
• Emacs (Text Editor)
• Scheme (プログラミング言語)
• Guile、kscm (ksc、ksi)(github) (コンパイラー、インタプリタ(翻訳系、解釈系(処理系)))

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第3章(標準部品化力、オブジェクト及び状態)、3.3(可変データでのモデル化)、3.3.3(表の表現)、問題3.24.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題3.24.

コード

#!/usr/bin/env guile --no-auto-compile
!#

(define (make-table same-key?)
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (same-key? key-1 (cdr local-table))))
        (if subtable
            (let ((record (same-key? key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  #f)))))
    (define (insert! key-1 key-2 value)
      (let ((subtable (same-key? key-1 (cdr local-table))))
        (if subtable
            (let ((record (same-key? 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 assoc))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

(for-each
 (lambda (kv)
   (put 'math (car kv) (cadr kv)))
 '((+ 43) (- 45) (* 42)))

(for-each
 (lambda (kv)
   (put 'letters (car kv) (cadr kv)))
 '((a 43) (b 98)))

(for-each
 (lambda (key)
   (display 'math)
   (display " ")
   (display key)
   (display ": ")
   (display (get 'math key))
   (newline))
 '(+ - * /))

(for-each
 (lambda (key)
   (display 'letters)
   (display " ")
   (display key)
   (display ": ")
   (display (get 'letters key))
   (newline))
 '(a b c))

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

$ ./sample24.scm
math +: 43
math -: 45
math *: 42
math /: #f
letters a: 43
letters b: 98
letters c: #f
$