;; DATA DIRECTED PROGRAMMING

; operation-table will hold the triples of
; operations, their type, and the associated action
(define operation-table ())

; takes an operation, the type of data it acts
; on, and an action that implements the operation
; on the type given.  Adds the triple to the 
; operation table
(define (put operation type action)
  (set! operation-table
        (cons (list operation type action)
              operation-table)))

; takes an operator and a type, and returns the action
; that implements the operator for that type in the
; operation-table
(define (get operator type)
  (define (get-aux list)
    (cond ((null? list) #f)
          ((and (equal? operator (caar list))
                (equal? type (cadar list)))
           (caddar list))
          (else (get-aux (cdr list)))))
  (get-aux operation-table))

(define (square x) (* x x))

; define the selectors in the rectangular representation
; each selector is defined as it was originally --
; and must put installed into the operation
(define (install-rectangular-package)
  ; note we could have defined procedures
  ; internally here and then called them by
  ; name as is done in the book
  (put 'real-part '(rectangular) car)
  (put 'imag-part '(rectangular) cdr)
  (put 'magnitude
       '(rectangular)
       (lambda (z)
         (sqrt (+ (square (car z))
                  (square (cdr z))))))
  (put 'angle
       '(rectangular)
       (lambda (z) (atan (cdr z) (car z))))
  (put 'make-from-real-imag
       'rectangular
       (lambda (x y)
         (attach-tag 'rectangular
                     (cons x y))))
  (put 'make-from-mag-ang
       'rectangular
       (lambda (r a)
         (attach-tag 'rectangular
                     (cons (* r (cos a))
                           (* r (sin a))))))
  'done)

; define the selectors in the polar representation
; each selector is defined as it was originally --
; and must put installed into the operation
(define (install-polar-package)
  (put 'magnitude '(polar) car)
  (put 'angle '(polar) cdr)
  (put 'real-part
       '(polar)
       (lambda (z)
         (* (car z) (cos (cdr z)))))
  (put 'imag-part
       '(polar)
       (lambda (z)
         (* (car z) (sin (cdr z)))))
  (put 'make-from-mag-ang
       'polar
       (lambda (r a)
         (attach-tag 'polar (cons r a))))
  (put 'make-from-real-imag
       'polar
       (lambda (x y)
         (attach-tag
           'polar
           (cons (sqrt (+ (square x)
                          (square y)))
                 (atan y x)))))
  'done)

;; THE CONSTRUCTORS
(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))

;;; general operation will implement selector
;; functions for complex numbers
(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
            "APPLY-GENERIC failed"
            (list op type-tags))))))

; selectors are implemented in terms of the 
; generic operation
(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))

;; install the operators in the table for each
;; representation
(install-rectangular-package)
(install-polar-package)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; MESSAGE PASSING VERSION ;;;;;;;;;;;
; message passing version takes a real and
; imaginary part of a complex number and
; returns an intelligent data object that
; can dispatch its operations
(define (make-from-real-imag-mp x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) x)
          ((eq? op 'imag-part y)
          ((eq? op 'magnitude)
           (sqrt (+ (square x) (square y))))
          ((eq? op 'angle) (atan y x))
          (else 
           (error "MAKE-FROM-REAL-IMAG failed"
                  op)))))
  dispatch)

; the individual parts are defined as
; they were above e.g.
;(define (real-part z)
;  (apply-generic 'real-part z))
; etc.

; apply-generic for message passing version
; notice that this function simply calls the
; data object as an function applied to the 
; operator
(define (apply-generic-mp op arg)
  (arg op))


;or more directly,
(define (real-part-mp z)
  (z 'real-part))



;;;;;;;; Operations for tagged data ;;;;;;;;;
; takes a tag and some contents and creates a
; tagged data element (consisting of the tag
; and the data contents
(define (attach-tag type-tag contents)
  (cons type-tag contents))

; takes a data item and returns the tag 
; associated with the data item.  Assume
; the data item is tagged as long as it
; is a pair.
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "TYPE-TAG finds bad datum"
             datum)))

; takes a data item and returns the content part
; of that data item.  Assume the data item is 
; tagged as long as it is a pair.
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "CONTENTS finds bad datum"
             datum)))


;;;;;;;;;;; USING COMPLEX NUMBERS ;;;;;;;;;;;;;;;;;
; adds together two complex numbers
; uses the representation of addition of coordinates
; in terms of real and imaginary parts
(define (add-complex z1 z2)
  (make-from-real-imag
    (+ (real-part z1) (real-part z2))
    (+ (imag-part z1) (imag-part z2))))

; subtract one complex number from another
; uses the representation of subtraction of coordinates
; in terms of real and imaginary parts
(define (sub-complex z1 z2)
  (make-from-real-imag
    (- (real-part z1) (real-part z2))
    (- (imag-part z1) (imag-part z2))))

; multiplies two complex numbers
; uses the representation as polar form
; in terms of magnitude and angle
(define (mul-complex z1 z2)
  (make-from-mag-ang
    (* (magnitude z1) (magnitude z2))
    (+ (angle z1) (angle z2))))

; divides one complex number from another
; uses the representation as polar form
; in terms of magnitude and angle
(define (div-complex z1 z2)
  (make-from-mag-ang
    (/ (magnitude z1) (magnitude z2))
    (- (angle z1) (angle z2))))