Data-Directed Programming SICP

Viewed 115

I have been trying to comprehend data-directed programming in SICP but couldn't so far. I have some questions about it. This is the original code from SICP:

(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 (assoc key records)
  (cond ((null? records) false)
        ((equal? key (caar records)) (car records))
        (else (assoc key (cdr records)))))


(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

(define (make-from-real-imag-rectangular x y)
  (attach-tag 'rectangular (cons x y)))

(define (make-from-mag-ang-polar r a)
  (attach-tag 'polar (cons r a)))

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

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

(define attach-tag cons)

(define type-tag car)

(define contents cdr)


(define (install-rectangular-package)
  ;;internal procedures
  (define (real-part z)(car z))
  (define (imag-part z)(cdr z))
  (define (make-from-real-imag)(cons x y))
  (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-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 procedures
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-mag-ang r a) (cons r a))
  (define (real-part z) (* (magnitude z) (cos (angle z))))
  (define (imag-part z) (* (magnitude z) (sin (angle z))))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y)))
          (atan y x)))
  ;; 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)


(install-polar-package)
(install-rectangular-package)

Firstly, I couldn't get how to put an entry to the table using make-from-real-imag or make-from-mag-ang

(put 'make-from-real-imag 'rectangular
     (lambda (x y) (tag (make-from-real-imag x y))))

Could you just show me how to call this procedure exactly to put an entry ?

When I call get without putting any entry like this:

(get 'real-part '(rectangular))

it returns (lambda (z) (car z)) why ? It should return as false if there is no entry in the table or is there a problem with my code ?

inside packages there are "interface to the rest of the system" parts in there how put procedure call selectors (real-part, imag-part, magnitude, angle) without any argument ?

(put 'real-part '(polar) real-part)
1 Answers

After I have seen Brian Harvey's cs61a lesson 16 which is about generic operators I have comprehended data directed programming a bit. Here is the youtube link of Brian Harvey's cs61a lesson 16 https://www.youtube.com/watch?v=zgbBNEuHs2w

When we call packages, procedures are put on to the table as lambda functions. That's why when we call (get 'real-part '(rectangular))it returns as (lambda (z) (car z))

So put procedures are called with packages for example(put 'real-part '(polar) real-part) and this procedure takes (define (real-part z) (* (magnitude z) (cos (angle z)))) as argument and put as an entry to the table

These procedures are continuation of above procedures in the book.

(define (map proc items)
  (if (null? items)
      nil
      (cons (proc (car items))
            (map proc (cdr items)))))

   
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (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)) 

To create a complex number for rectangular representation for example I call:

(define c-num1 (make-from-real-imag 5 3))

now we have a c-num1 object as (rectangular 5 . 3)

we can call any operation on this object with apply-generic

for example (apply-generic 'real-part c-num1) we get 5 or (apply-generic 'imag-part c-num1) we get 3 or we directly call (real-part c-num1) which is defined using apply-generic.

Related