Add raise (2.83)
This commit is contained in:
parent
7147075c21
commit
285b2a3f9d
40
2_78.rkt
40
2_78.rkt
|
@ -143,6 +143,32 @@
|
||||||
(lambda (x) (tag x)))
|
(lambda (x) (tag x)))
|
||||||
'done)
|
'done)
|
||||||
|
|
||||||
|
;; Integers
|
||||||
|
|
||||||
|
(define (install-integer-package)
|
||||||
|
(define (tag x)
|
||||||
|
(attach-tag 'integer x))
|
||||||
|
(define value car)
|
||||||
|
(define (make-int x) (list x))
|
||||||
|
|
||||||
|
(put 'raise '(integer)
|
||||||
|
(lambda (x) (make-rational (value x) 1)))
|
||||||
|
(put 'make 'integer
|
||||||
|
(lambda (x) (tag (make-int x)))))
|
||||||
|
|
||||||
|
;; Reals
|
||||||
|
|
||||||
|
(define (install-real-package)
|
||||||
|
(define (tag x)
|
||||||
|
(attach-tag 'real x))
|
||||||
|
(define value car)
|
||||||
|
(define (make-real x) (list x))
|
||||||
|
|
||||||
|
(put 'raise '(real)
|
||||||
|
(lambda (x) (make-complex-from-real-imag (value x) 0)))
|
||||||
|
(put 'make 'real
|
||||||
|
(lambda (x) (tag (make-real x)))))
|
||||||
|
|
||||||
;; Rationals
|
;; Rationals
|
||||||
|
|
||||||
(define (install-rational-package)
|
(define (install-rational-package)
|
||||||
|
@ -184,6 +210,9 @@
|
||||||
(put 'equ? '(rational rational) eq-rat)
|
(put 'equ? '(rational rational) eq-rat)
|
||||||
(put '=zero? '(rational)
|
(put '=zero? '(rational)
|
||||||
(lambda (x) (= (numer x) 0)))
|
(lambda (x) (= (numer x) 0)))
|
||||||
|
(put 'raise '(rational)
|
||||||
|
(lambda (x)
|
||||||
|
(make-real (/ (numer x) (denom x)))))
|
||||||
|
|
||||||
(put 'make 'rational
|
(put 'make 'rational
|
||||||
(lambda (n d) (tag (make-rat n d))))
|
(lambda (n d) (tag (make-rat n d))))
|
||||||
|
@ -295,9 +324,15 @@
|
||||||
(define (make-scheme-number n)
|
(define (make-scheme-number n)
|
||||||
((get 'make 'scheme-number) n))
|
((get 'make 'scheme-number) n))
|
||||||
|
|
||||||
|
(define (make-integer x)
|
||||||
|
((get 'make 'integer) x))
|
||||||
|
|
||||||
(define (make-rational n d)
|
(define (make-rational n d)
|
||||||
((get 'make 'rational) n d))
|
((get 'make 'rational) n d))
|
||||||
|
|
||||||
|
(define (make-real x)
|
||||||
|
((get 'make 'real) x))
|
||||||
|
|
||||||
(define (make-complex-from-real-imag x y)
|
(define (make-complex-from-real-imag x y)
|
||||||
((get 'make-from-real-imag 'complex) x y))
|
((get 'make-from-real-imag 'complex) x y))
|
||||||
|
|
||||||
|
@ -329,8 +364,12 @@
|
||||||
(define (=zero? x) (apply-generic '=zero? x))
|
(define (=zero? x) (apply-generic '=zero? x))
|
||||||
(define (exp x y) (apply-generic 'exp x y))
|
(define (exp x y) (apply-generic 'exp x y))
|
||||||
|
|
||||||
|
(define (raise x) (apply-generic 'raise x))
|
||||||
|
|
||||||
(install-scheme-number-package)
|
(install-scheme-number-package)
|
||||||
|
(install-integer-package)
|
||||||
(install-rational-package)
|
(install-rational-package)
|
||||||
|
(install-real-package)
|
||||||
(install-polar-package)
|
(install-polar-package)
|
||||||
(install-rectangular-package)
|
(install-rectangular-package)
|
||||||
(install-complex-package)
|
(install-complex-package)
|
||||||
|
@ -378,3 +417,4 @@
|
||||||
;; that takes mixed types. For example, if we have an operator to add a complex to a rational.
|
;; that takes mixed types. For example, if we have an operator to add a complex to a rational.
|
||||||
;; It isn't possible to coerce from one to the other, so a mixed-type operator is needed, and this
|
;; It isn't possible to coerce from one to the other, so a mixed-type operator is needed, and this
|
||||||
;; approach would fail.
|
;; approach would fail.
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue