SICP Practice

Practice 2.85

make number

(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))

project

(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))

drop

(define (can-drop? x)
  (if (equal? x (raise (project x)))
      #t
      #f))

(define (drop x)
  (if (not (can-drop? x))
      x
      (drop (project x))))

apply-generic

(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"))))))