Add project and drop procedures

Not yet integrated into apply-generic.

2_78.rkt

@@ -228,6 +228,10 @@
   (put 'raise '(rational)
        (lambda (x)
          (make-real (/ (numer x) (denom x)))))
+  (put 'project '(rational)
+       (lambda (x)
+         (make-integer
+          (/ (numer x) (denom x)))))
 
   (put 'make 'rational
        (lambda (n d) (tag (make-rat n d))))
@@ -331,6 +335,9 @@
        (lambda (x y) (tag (make-from-real-imag x y))))
   (put 'make-from-mag-ang 'complex
        (lambda (r a) (tag (make-from-mag-ang r a))))
+  (put 'project '(complex)
+       (lambda (z)
+         (make-real (real-part z))))
   'done)
 
 
@@ -381,6 +388,16 @@
 (define (exp x y) (apply-generic 'exp x y))
 
 (define (raise x) (apply-generic 'raise x))
+(define (project x) (apply-generic 'project x))
+
+(define (drop x)
+  (if (null? x)
+      '()
+      (let ((p (project x)))
+        (cond ((null? p) x)
+              ((equ? x (raise p))
+               (drop p))
+              (else x)))))
 
 (install-scheme-number-package)
 (install-integer-package)