ex 3.28 3.29

sicp

わからないところは飛ばす！
悩んでたってしょうがない！
というわけで3.28と3.29の解答

;; ex 3.28
(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((new-value
           (logical-or (get-signal a1) (get-signal a2))))
      (after-delay or-gate-delay
                   (lambda ()
                     (set-signal! output new-value)))))
  (add-action! a1 or-action-procedure)
  (add-action! a2 or-action-procedure)
  'ok)

;; ex 3.29
(define (or-gate a1 a2 output)
  (let ((c (make-wire))
        (d (make-wire))
        (e (make-wire)))
    (inverter a1 c)
    (inverter a2 d)
    (and-gate c d e)
    (inverter e output)))

ex 3.24

sicp

表において、keyが等しいかどうかの述語same-key?をとるtableオブジェクト生成手続き。
keyの比較を行いながら探索するassocを内部で定義するようにした。

;; ex 3.24
;; assocを内部で実装してしまおう
(define (make-table-same-key same-key?)
  (define (my-assoc key records) ;; 比較をする述語を指定する
    (cond ((null? records) #f)
          ((same-key? key (caar records)) (car records))
          (else (assoc key (cdr records)))))
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (my-assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (my-assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  #f))
            #f)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (my-assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (my-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)))))
      'ok)
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))