(define (make-complex real imag) (list 'complex real imag))
(define (make-real number) (list 'real number))
(define (make-rational numerator denominator)
(let ((min-comm-divisor (gcd numerator denominator)))
(list 'rational (/ numerator min-comm-divisor) (/ denominator min-comm-divisor))))
(define (make-int number) (list 'int number))
(define (project-complex complex) (make-real list 'real (cadr complex)))
(define (project-real real)
(let ((rational (inexact->exact (cadr real))))
(make-rational (numerator rational) (denominator rational))))
(define (project-rational rational) (make-int (round (/ (cadr rational) (caddr rational)))))
(put 'project 'complex project-complex)
(put 'project 'real project-real)
(put 'project 'rational project-rational)
(define (project x) (apply-generic 'project x))
(define (can-drop? x)
(if (equal? x (raise (project x)))
#t
#f))
(define (drop x)
(if (not (can-drop? x))
x
(drop (project x))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(drop (apply proc (map contents args)))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(if (not (equal-level? a1 a2))
(if (= (choose-hight-level a1 a2) a1)
(apply-generic op a1 (raise-to a2 a1))
(apply-generic op (raise-to a1 a2) a2))
(error
"No method")))
(error
"No method"))))))