(define (+c c1 c2) (make-rect (+ (real c1) (real c2)) (+ (img c1) (img c2)))) (define (-c c1 c2) (make-rect (- (real c1) (real c2)) (- (img c1) (img c2)))) (define (*c c1 c2) (make-polar (* (mag c1) (mag c2)) (+ (angle c1) (angle c2)))) (define (/c c1 c2) (make-polar (/ (mag c1) (mag c2)) (- (angle c1) (angle c2))))
(define (make-rect x y) (cons x y)) (define (make-polar r u) (cons (* r (cos u)) (* r (sin u)))) (define (real c) (car c)) (define (img c) (cdr c)) (define (mag c) (let ((x (car c)) (y (cdr c))) (sqrt (+ (* x x) (* y y))))) (define (angle c) (let ((x (car c)) (y (cdr c))) (atan y x)))
(define (make-rect x y) (cons (sqrt (+ (* x x) (* y y))) (atan y x))) (define (make-polar r u) (cons r u)) (define (real c) (let ((r (car c)) (u (cdr c))) (* r (cos u)))) (define (img c) (let ((r (car c)) (u (cdr c))) (* r (sin u)))) (define (mag c) (car c)) (define (angle c) (cdr c))
(define (type object) (if (atom? object) (error "Missing type!" object) (car object))) (define (contents object) (if (atom? object) (error "Missing type!" object) (cdr object))) (define (attach-type type object) (cons type object)) (define (rect? object) (eq? (type object) 'rect)) (define (polar? object) (eq? (type object 'polar)) (define (make-rect x y) (attach-type 'rect (cons x y))) (define (make-polar r u) (attach-type 'polar (cons r u))) (define (real-rect c) (car c)) (define (real-polar c) (* (car c) (cos (cdr c)))) (define (img-rect c) (cdr c)) (define (img-polar c) (* (car c) (sin (cdr c)))) (define (mag-rect c) (sqrt (+ (* (car c) (car c)) (* (cdr c) (cdr c))))) (define (mag-polar c) (car c)) (define (angle-rect c) (atan (cdr c) (car c))) (define (angle-polar c) (cdr c)) (define (real object) (cond ((rect? object) (real-rect (contents object))) ((polar? object) (real-polar (contents object))) (else (error "Unknown type!" object)))) (define (img object) (cond ((rect? object) (img-rect (contents object))) ((polar? object) (img-polar (contents object))) (else (error "Unknown type!" object)))) (define (mag object) (cond ((rect? object) (mag-rect (contents object))) ((polar? object) (mag-polar (contents object))) (else (error "Unknown type!" object)))) (define (angle object) (cond ((rect? object) (angle-rect (contents object))) ((polar? object) (angle-polar (contents object))) (else (error "Unknown type!" object))))
(define (operate op object) (let ((proc (getprop (type object) op))) (if (null? proc) (error "Operator undefined for this type!" (list op (type object))) (proc (contents object))))) (define (real object) (operate 'real object)) (define (img object) (operate 'img object)) (define (mag object) (operate 'mag object)) (define (angle object) (operate 'angle object))
(define (make-number c) (attach-type 'number c)) (define (+number x y) (make-number (+ x y))) (define (-number x y) (make-number (- x y))) (define (*number x y) (make-number (* x y)) (define (/number x y) (make-number (/ x y)) (define (make-complex c) (attach-type 'complex c)) (define (+complex x y) (make-complex (+c x y))) (define (-complex x y) (make-complex (-c x y))) (define (*complex x y) (make-complex (*c x y)) (define (/complex x y) (make-complex (/c x y))
(define (operate-2 op object1 object2) (let ((t1 (type object1))) (if (eq? t1 (type object2)) (let ((proc (getprop t1 op))) (if (null? proc) (error "Operator undefined for this type!" (list op t1)) (proc (contents object1) (contents object2)))) (error "Operands not of same type!" (list object1 object2))))) (define (add object1 object2) (operate-2 'add object1 object2)) (define (sub object1 object2) (operate-2 'sub object1 object2)) (define (mul object1 object2) (operate-2 'mul object1 object2)) (define (div object1 object2) (operate-2 'div object1 object2))
(define (attach-type type contents) (if (member type '(number ...) contents (cons type contents))) (define (type object) (cond ((number? object) 'number) ... ... ... ((pair? object) (car object)) (else (error "Unknown type!" object)))) (define (contents object) (if (or (number? object) ...) object (cdr object)))
(define (operate-2 op objekt1 objekt2) (let ((t1 (type object1)) (t2 (type object2))) (if (eq? t1 t2) (let ((proc (getprop t1 op))) (if (null? proc) (error "Operator undefined for this type!" (list op t1)) (proc (contents object1) (contents object2)))) (let ((t1->t2 (getprop t1 t2)) (t2->t1 (getprop t2 t1))) (cond ((not (null? t1->t2)) (operate-2 op (t1->t2 object1) object2)) ((not (null? t2->t1)) (operate-2 op object1 (t2->t1 object1))) (else (error "Operator undefined for these types!" (list op t1 t2))))))))
(define (make-rect x y) (define (dispatch m) (cond ((eq? m 'type?) 'rect) ((eq? m 'real) x) ((eq? m 'img) y) ((eq? m 'mag) (sqrt (+ (* x x) (* y y)))) ((eq? m 'angle) (atan y x)) (else (error "Unknown operator!" m)))) dispatch) (define (make-polar r u) (define (dispatch m) (cond ((eq? m 'type?) 'polar) ((eq? m 'real) (* r (cos u))) ((eq? m 'img) (* r (sin u))) ((eq? m 'mag) r) ((eq? m 'angle) u) (else (error "Unknown operator!" m)))) dispatch)