How to implement put & get procedure in scheme?

Question

I'm reading sicp book. I'm stuck with section 2.4.3, Data-Directed Programming and Additivity.

As mention in text, the implementation of put and get procedures are given in chapter 3(section 3.3.3) . But I didn't find these procedures, maybe the name of procedure will be different there.

So when I tried to run the code (example) given in book, repl thrown an error as given below:

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.

Here is the code:

(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))

can anyone tell the actual implementation of these procedure, so that I can move ahead in book? Any help would be appreciated. Thanks

soegaard soegaard · Accepted Answer · 2016-10-27T11:51:27

See the section 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!))

How to implement put & get procedure in scheme?

1 Answers