blob: db4475e7a6a0b5eb00afe795e490fb68876770b3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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)
|
