blob: ca33ba022282b431ce71aa4d0aa4ff6a09089de3 (
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
|
#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))
(if (= b 0)
a
(gcd-integer b (remainder a b))))
;; 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) (lambda (a b)
(gcd-integer a b)))
(put 'raise '(integer) raiseme)
;; sqrt and trig methods for complex nums
(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)
|
