blob: 45b1a6cb8cd357b0e9f569d0c5d1f69c694651c7 (
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
|
#lang racket
(provide install-real)
(require "../../../shared/data-directed-programming.rkt")
(define (install-real put get)
(define threshold 0.00001)
;; local methods
(define (tagme datum)
(attach-tag 'real datum))
(define (make i)
(let ((n (exact->inexact i)))
(if (< (abs n) threshold)
0.0
n)))
(define (raiseme r)
((get 'make-from-real-imag 'complex) r 0))
;; constructor
(put 'make 'real (lambda (x) (tagme (make x))))
;; methods
(put 'add '(real real) (lambda (x y) (tagme (make (+ x y)))))
(put 'neg '(real) (lambda (x) (tagme (make (- x)))))
(put 'sub '(real real) (lambda (x y) (tagme (make (- x y)))))
(put 'mul '(real real) (lambda (x y) (tagme (make (* x y)))))
(put 'div '(real real) (lambda (x y) (tagme (make (/ x y)))))
(put 'raise '(real) raiseme)
(put 'project '(real) (lambda (n)
((get 'make 'rational) (round n) 1)))
;; sqrt and trig methods for complex nums
(put 'sqr '(real) sqr)
(put 'sqrt '(real) sqrt)
(put 'cos '(real) cos)
(put 'sin '(real) sin)
(put 'atan '(real real) (lambda (x y) (atan x y)))
;; predicates
(put 'equ? '(real real) (lambda (x y) (= x y)))
(put '=zero? '(real) (lambda (x) (< x threshold)))
'done)
|