SICP 演習問題2.73

get, putをどうしようどうしよう...

;;;get, put implements
;;;higeponさんのを参照した
(define operation-table (make-hash-table))

(define (put op type item)
    (if (not (hash-table-exists? operation-table op))
        (hash-table-put! operation-table op (make-hash-table)))
    (let ((type-table (hash-table-get operation-table op)))
      (hash-table-put! type-table type item)))

(define (get op type)
    (if (hash-table-exists? oepration-table op)
        (let ((type-table (hash-table-get oepration-table op)))
          (hash-table-get type-table type))
        (error "Not exists" op type)))

そうか，hash-tableの入れ子か．opをhash-tableにするのか．
はぁ，俺ってばかだぁとつい自虐的になってしまう．

;;;excercise2.73
;;;これは載っている
(define (deriv exp var)
  (cond [(number? exp) 0]
        [(variable? exp) (if (same-variable? exp var) 1 0)]
        [else ((get 'deriv (operator exp)) (operands exp) var)]))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

;;selector
(define (addend exp) (car exp))
(define (augend exp) (cadr exp))
(define (multiplier exp) (car exp))
(define (multiplicand exp) (cadr exp))
(define (base exp) (car exp))
(define (exponent exp) (cadr exp))
;;costractor
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
(define (make-exponentiation e1 e2) (list '** e1 e2))
;;operator
(define (deriv-sum exp var)
  (make-sum
   (deriv (addend exp) var)
   (deriv (augend exp) var)))
(define (deriv-product exp var)
  (make-sum
   (make-product (multiplier exp)
                 (deriv (multiplicand exp) var))
   (make-product (deriv (multiplier exp) var)
                 (multiplicand exp))))
(define (deriv-exponentiation exp var)
  (make-product (exponent exp)
                (make-product
                 (make-exponentiation (base exp)
                                      (- 1 (exponent exp)))
                 (deriv (base exp) var))))
;;putter
(put 'deriv '+  deriv-sum)
(put 'deriv '*  deriv-product)
(put 'deriv '** deriv-exponentiation)

putで一度手続きを入れてしまうと，その手続きにエラーがあったときに，一度テーブルから消してまた入れなければいけないのが面倒．
一応deleteも作った．

(define (delete op type)
  (if (hash-table-exists? operation-table op)
      (let ((type-table (hash-table-get operation-table op)))
        (hash-table-delete! type-table type))))