1 files changed, 58 insertions, 0 deletions
diff --git a/coding-exercises/2/78/install-rational-package.rkt b/coding-exercises/2/78/install-rational-package.rkt
new file mode 100644
index 0000000..db4475e
--- /dev/null
+++ b/coding-exercises/2/78/install-rational-package.rkt
@@ -0,0 +1,58 @@
+#lang racket
+(provide install-rational-package)
+(require "../../../shared/data-directed-programming.rkt")
+
+
+(define (install-rational-package put)
+  ;; internal
+  (define (numer x) (car x))
+  (define (denom x) (cdr x))
+  (define (make-rat n d)
+    (define (sign x)
+      (cond
+        ((and (< x 0) (< d 0)) (* -1 x))
+        ((and (< 0 x) (< d 0)) (* -1 x))
+        (else x)))
+    (let ((g (gcd n d)))
+      (cons (sign (/ n g)) (abs (/ d g)))))
+  (define (add-rat x y)
+    (make-rat (+ (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (sub-rat x y)
+    (make-rat (- (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (mul-rat x y)
+    (make-rat (* (numer x) (numer y))
+              (* (denom x) (denom y))))
+  (define (div-rat x y)
+    (make-rat (* (numer x) (denom y))
+              (* (denom x) (numer y))))
+
+  ;; predicates
+  (define (equ? x y)
+    (and (equal? (numer x) (numer y))
+         (equal? (denom x) (denom y))))
+  (define (=zero? x)
+    (equal? (numer x) 0))
+
+  ;; interface
+  (define (typetag x) (attach-tag 'rational x))
+  (put 'add '(rational rational)
+       (lambda (x y) (typetag (add-rat x y))))
+  (put 'sub '(rational rational)
+       (lambda (x y) (typetag (sub-rat x y))))
+  (put 'mul '(rational rational)
+       (lambda (x y) (typetag (mul-rat x y))))
+  (put 'div '(rational rational)
+       (lambda (x y) (typetag (div-rat x y))))
+
+  (put 'equ? '(rational rational)
+       (lambda (x y) (equ? x y)))
+  (put '=zero? '(rational)
+       (lambda (x) (=zero? x)))
+
+  (put 'make 'rational
+       (lambda (x y) (typetag (make-rat x y))))
+  'done)