scheme - 如何在scheme中实现put和get过程？

Question

我正在阅读 sicp书。我坚持第 2.4.3 节，Data-Directed Programming and Additivity .

如文中所述，第 3 章(第3.3.3) 。但是我没有找到这些程序，也许那里的程序名称会有所不同。

所以当我尝试运行书中给出的代码(示例)时，repl 抛出了如下错误:

1 ]=> (make-from-mag-ang 4 5)

;Unbound variable: get
;To continue, call RESTART with an option number:
; (RESTART 3) => Specify a value to use instead of get.
; (RESTART 2) => Define get to a given value.
; (RESTART 1) => Return to read-eval-print level 1.

代码如下:

(define (attach-tag type-tag contents)
  (cons type-tag contents))

(define (type-tag datum)
  (if (pair? datum)
    (car datum)
    (error "Bad tagged datum -- TYPE-TAG" datum)))

(define (contents datum)
  (if (pair? datum)
    (cdr datum)
    (error "Bad tagged datum -- CONTENTS" datum)))

(define (rectangular? z)
  (eq? (type-tag z) 'rectangular))

(define (polar? z)
  (eq? (type-tag z) 'polar))


(define (install-rectangular-package)
   ;; internal procedure
   (define (real-part z) (car z))
   (define (imag-part z) (cdr z))
   (define (magnitude z)
     (sqrt (+ (square (real-part z)) (square (imag-part z)))))
   (define (angle z)
     (atan (imag-part z) (real-part z)))
   (define (make-from-real-imag x y) (cons x y))
   (define (make-from-mag-ang r a)
     (cons (* r (cos a)) (* r (sin a))))

   ;; interface to the rest of the system
   (define (tag x) (attach-tag 'rectangular x))
   (put 'real-part '(rectangular) real-part)
   (put 'imag-part '(rectangular) imag-part)
   (put 'magnitude '(rectangular) magnitude)
   (put 'angle '(rectangular) angle)
   (put 'make-from-real-imag '(rectangular) (lambda (x y) (tag (make-from-real-imag x y))))
   (put 'make-from-mag-ang '(rectangular) (lambda (r a) (tag (make-from-mag-ang r a))))
   'done)


(define (install-polar-package)
  ;; internal procedure
  (define (real-part z) (* (magnitude z) (cos (angle z))))
  (define (imag-part z) (* (magnitude z) (sin (angle z))))
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y))) (atan y x)))
  (define (make-from-mag-ang r a) (cons r a))

  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag '(polar) (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang '(polar) (lambda (r a) (tag (make-from-mag-ang r a))))
  'done)


(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc 
        (apply poc (map contents args))
        (error "No method for these types -- APPLY-GENERIC" (list op type-tags))))))

(define (real-part z) (apply-generic 'real-part z))

(define (imag-part z) (apply-generic 'imag-part z))

(define (magnitude z) (apply-generic 'magnitude z))

(define (angle z) (apply-generic 'angle z))

(define (make-from-real-imag x y)
  ((get 'make-from-real-imag 'rectangular) x y))

(define (make-from-mag-ang r a)
  ((get 'make-from-mag-ang 'polar) r a))

谁能告诉我这些程序的实际执行情况，以便我可以继续阅读本书？任何帮助，将不胜感激。谢谢

Answer 1

参见 Representing Tables 部分

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup 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)
                  false))
            false)))
    (define (insert! 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)))))
      '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))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))