diff options
| -rw-r--r-- | coding-exercises/2/78.rkt | 5 | ||||
| -rw-r--r-- | coding-exercises/2/78/complex-polar.rkt | 24 | ||||
| -rw-r--r-- | coding-exercises/2/78/complex-rectangular.rkt | 29 | ||||
| -rw-r--r-- | shared/data-directed-programming.rkt | 8 |
4 files changed, 65 insertions, 1 deletions
diff --git a/coding-exercises/2/78.rkt b/coding-exercises/2/78.rkt index 3a4b100..637ea10 100644 --- a/coding-exercises/2/78.rkt +++ b/coding-exercises/2/78.rkt @@ -1,8 +1,13 @@ #lang racket (require "../../shared/data-directed-programming.rkt") +(require "./78/complex-rectangular.rkt") +(require "./78/complex-polar.rkt") ;; We are basically making a data directed framework for arithmethic operations in this module (define pkg (make-dispatch-table)) (define put (putter pkg)) (define get (getter pkg)) +(define print-tbl (printer pkg)) (define apply-generic (make-apply put get)) +(install-rectangular-package put) +(install-polar-package put) diff --git a/coding-exercises/2/78/complex-polar.rkt b/coding-exercises/2/78/complex-polar.rkt new file mode 100644 index 0000000..661627d --- /dev/null +++ b/coding-exercises/2/78/complex-polar.rkt @@ -0,0 +1,24 @@ +#lang racket +(provide install-polar-package) + +(define (install-polar-package) + (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 (+ (sqr x) (sqr y))) + (atan y x))) + ;; register in data-driven package) + (define (typtag x) + (attach-tag 'polar x)) + (put 'real-part '(polar) real-part) + (put 'imag-part '(polar) imag-part) + (put 'magnitude '(polar) magnitude) + (put 'angle '(polar))) diff --git a/coding-exercises/2/78/complex-rectangular.rkt b/coding-exercises/2/78/complex-rectangular.rkt new file mode 100644 index 0000000..41e93b6 --- /dev/null +++ b/coding-exercises/2/78/complex-rectangular.rkt @@ -0,0 +1,29 @@ +#lang racket +(provide install-rectangular-package) +(require "../../../shared/data-directed-programming.rkt") + + +(define (install-rectangular-package put) + (define (real-part z) (car z)) + (define (imag-part z) (cdr z)) + (define (make-from-real-imag x y) (cons x y)) + (define (magnitude z) (sqrt (+ (sqr (real-part z)) + (sqr (real-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 part + (define (typtag 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) (typtag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'rectangular + (lambda (r a) (typtag (make-from-mag-ang r a))))) diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt index c756537..6cecaf1 100644 --- a/shared/data-directed-programming.rkt +++ b/shared/data-directed-programming.rkt @@ -2,6 +2,7 @@ (provide make-apply make-dispatch-table + printer getter putter attach-tag @@ -36,6 +37,9 @@ ;; ('op (list ('(types) item))) (define (make-dispatch-table) (define dispatch-table '()) + (define (printer) + (newline) + (display dispatch-table)) (define (get op types) (let ((op-datum (find-type op dispatch-table))) (if op-datum @@ -67,12 +71,14 @@ (attach-tag op (list (attach-tag types item))) dispatch-table)))) - (list dispatch-table get put)) + (list dispatch-table get put printer)) (define (getter t) (cadr t)) (define (putter t) (caddr t)) +(define (printer t) + (cadddr t)) (define (make-apply put get) (lambda (op . args) |
