blob: 6972b71f3a3d37c3c871ac9e45bd0765fdbd3a6d (
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
|
#lang racket
(provide install-integer)
(require "../../../shared/data-directed-programming.rkt")
(define (install-integer put get)
;; local methods
(define (tagme datum)
(attach-tag 'integer datum))
(define (make i)
(inexact->exact (round i)))
(define (raiseme i)
(if (equal? (type-tag i) 'integer)
((get 'make 'rational) i 1)
(error "cannot raise non integer in integer package")))
;; constructor
(put 'make 'integer (lambda (x)
(newline)
(display (list "MAKE INTEGER --" x (make x)))
(tagme (make x))))
(define (gcd-integer a b)
(newline)
(display (list "GCD-INTEGER -- " a b))
(newline)
(newline)
(if (= b 0)
a
(gcd-integer b (remainder a b))))
(define (reduce-integers n d)
(let ((g (gcd-integer n d)))
(list (/ n g)
(/ d g))))
;; methods
(put 'add '(integer integer) (lambda (x y) (+ x y)))
(put 'neg '(integer) (lambda (x) (- x)))
(put 'sub '(integer integer) (lambda (x y) (- x y)))
(put 'mul '(integer integer) (lambda (x y) (* x y)))
(put 'div '(integer integer) (lambda (x y) (/ x y)))
(put 'greatest-common-divisor '(integer integer) gcd-integer)
(put 'raise '(integer) raiseme)
(put 'reduce '(integer integer) reduce-integers)
;; sqrt and trig methods for complex nums
(put 'expt '(integer integer) expt)
(put 'sqr '(integer) sqr)
(put 'sqrt '(integer) sqrt)
(put 'atan '(integer integer) atan)
(put 'cos '(integer) cos)
(put 'sin '(integer) sin)
;; predicates
(put 'equ? '(integer integer) (lambda (x y) (= x y)))
(put '=zero? '(integer) (lambda (x) (= 0 x)))
'done)
|
